xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision f09ee9fb1fd5dfb93fb4f570c7a86535d3671960)
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 <petscdmplex.h>
5 #include <petscblaslapack.h>
6 #include <petsc/private/sfimpl.h>
7 #include <petsc/private/dmpleximpl.h>
8 
9 static PetscErrorCode MatMPIAIJRestrict(Mat,MPI_Comm,Mat*);
10 
11 /* if range is true,  it returns B s.t. span{B} = range(A)
12    if range is false, it returns B s.t. range(B) _|_ range(A) */
13 PetscErrorCode MatDenseOrthogonalRangeOrComplement(Mat A, PetscBool range, PetscInt lw, PetscScalar *work, PetscReal *rwork, Mat *B)
14 {
15 #if !defined(PETSC_USE_COMPLEX)
16   PetscScalar    *uwork,*data,*U, ds = 0.;
17   PetscReal      *sing;
18   PetscBLASInt   bM,bN,lwork,lierr,di = 1;
19   PetscInt       ulw,i,nr,nc,n;
20   PetscErrorCode ierr;
21 
22   PetscFunctionBegin;
23 #if defined(PETSC_MISSING_LAPACK_GESVD)
24   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"LAPACK _GESVD not available");
25 #else
26   ierr = MatGetSize(A,&nr,&nc);CHKERRQ(ierr);
27   if (!nr || !nc) PetscFunctionReturn(0);
28 
29   /* workspace */
30   if (!work) {
31     ulw  = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc));
32     ierr = PetscMalloc1(ulw,&uwork);CHKERRQ(ierr);
33   } else {
34     ulw   = lw;
35     uwork = work;
36   }
37   n = PetscMin(nr,nc);
38   if (!rwork) {
39     ierr = PetscMalloc1(n,&sing);CHKERRQ(ierr);
40   } else {
41     sing = rwork;
42   }
43 
44   /* SVD */
45   ierr = PetscMalloc1(nr*nr,&U);CHKERRQ(ierr);
46   ierr = PetscBLASIntCast(nr,&bM);CHKERRQ(ierr);
47   ierr = PetscBLASIntCast(nc,&bN);CHKERRQ(ierr);
48   ierr = PetscBLASIntCast(ulw,&lwork);CHKERRQ(ierr);
49   ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr);
50   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
51   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr));
52   ierr = PetscFPTrapPop();CHKERRQ(ierr);
53   if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
54   ierr = MatDenseRestoreArray(A,&data);CHKERRQ(ierr);
55   for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break;
56   if (!rwork) {
57     ierr = PetscFree(sing);CHKERRQ(ierr);
58   }
59   if (!work) {
60     ierr = PetscFree(uwork);CHKERRQ(ierr);
61   }
62   /* create B */
63   if (!range) {
64     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B);CHKERRQ(ierr);
65     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
66     ierr = PetscMemcpy(data,U+nr*i,(nr-i)*nr*sizeof(PetscScalar));CHKERRQ(ierr);
67   } else {
68     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,i,NULL,B);CHKERRQ(ierr);
69     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
70     ierr = PetscMemcpy(data,U,i*nr*sizeof(PetscScalar));CHKERRQ(ierr);
71   }
72   ierr = MatDenseRestoreArray(*B,&data);CHKERRQ(ierr);
73   ierr = PetscFree(U);CHKERRQ(ierr);
74 #endif
75 #else /* PETSC_USE_COMPLEX */
76   PetscFunctionBegin;
77   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented for complexes");
78 #endif
79   PetscFunctionReturn(0);
80 }
81 
82 /* TODO REMOVE */
83 #if defined(PRINT_GDET)
84 static int inc = 0;
85 static int lev = 0;
86 #endif
87 
88 PetscErrorCode PCBDDCComputeNedelecChangeEdge(Mat lG, IS edge, IS extrow, IS extcol, IS corners, Mat* Gins, Mat* GKins, PetscScalar cvals[2], PetscScalar *work, PetscReal *rwork)
89 {
90   PetscErrorCode ierr;
91   Mat            GE,GEd;
92   PetscInt       rsize,csize,esize;
93   PetscScalar    *ptr;
94 
95   PetscFunctionBegin;
96   ierr = ISGetSize(edge,&esize);CHKERRQ(ierr);
97   if (!esize) PetscFunctionReturn(0);
98   ierr = ISGetSize(extrow,&rsize);CHKERRQ(ierr);
99   ierr = ISGetSize(extcol,&csize);CHKERRQ(ierr);
100 
101   /* gradients */
102   ptr  = work + 5*esize;
103   ierr = MatCreateSubMatrix(lG,extrow,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
104   ierr = MatCreateSeqDense(PETSC_COMM_SELF,rsize,csize,ptr,Gins);CHKERRQ(ierr);
105   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,Gins);CHKERRQ(ierr);
106   ierr = MatDestroy(&GE);CHKERRQ(ierr);
107 
108   /* constants */
109   ptr += rsize*csize;
110   ierr = MatCreateSeqDense(PETSC_COMM_SELF,esize,csize,ptr,&GEd);CHKERRQ(ierr);
111   ierr = MatCreateSubMatrix(lG,edge,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
112   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,&GEd);CHKERRQ(ierr);
113   ierr = MatDestroy(&GE);CHKERRQ(ierr);
114   ierr = MatDenseOrthogonalRangeOrComplement(GEd,PETSC_FALSE,5*esize,work,rwork,GKins);CHKERRQ(ierr);
115   ierr = MatDestroy(&GEd);CHKERRQ(ierr);
116 
117   if (corners) {
118     Mat            GEc;
119     PetscScalar    *vals,v;
120 
121     ierr = MatCreateSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr);
122     ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr);
123     ierr = MatDenseGetArray(GEd,&vals);CHKERRQ(ierr);
124     /* v    = PetscAbsScalar(vals[0]) */;
125     v    = 1.;
126     cvals[0] = vals[0]/v;
127     cvals[1] = vals[1]/v;
128     ierr = MatDenseRestoreArray(GEd,&vals);CHKERRQ(ierr);
129     ierr = MatScale(*GKins,1./v);CHKERRQ(ierr);
130 #if defined(PRINT_GDET)
131     {
132       PetscViewer viewer;
133       char filename[256];
134       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
135       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
136       ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
137       ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr);
138       ierr = MatView(GEc,viewer);CHKERRQ(ierr);
139       ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr);
140       ierr = MatView(*GKins,viewer);CHKERRQ(ierr);
141       ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr);
142       ierr = MatView(GEd,viewer);CHKERRQ(ierr);
143       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
144     }
145 #endif
146     ierr = MatDestroy(&GEd);CHKERRQ(ierr);
147     ierr = MatDestroy(&GEc);CHKERRQ(ierr);
148   }
149 
150   PetscFunctionReturn(0);
151 }
152 
153 PetscErrorCode PCBDDCNedelecSupport(PC pc)
154 {
155   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
156   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
157   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
158   Vec                    tvec;
159   PetscSF                sfv;
160   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
161   MPI_Comm               comm;
162   IS                     lned,primals,allprimals,nedfieldlocal;
163   IS                     *eedges,*extrows,*extcols,*alleedges;
164   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
165   PetscScalar            *vals,*work;
166   PetscReal              *rwork;
167   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
168   PetscInt               ne,nv,Lv,order,n,field;
169   PetscInt               n_neigh,*neigh,*n_shared,**shared;
170   PetscInt               i,j,extmem,cum,maxsize,nee;
171   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
172   PetscInt               *sfvleaves,*sfvroots;
173   PetscInt               *corners,*cedges;
174   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
175 #if defined(PETSC_USE_DEBUG)
176   PetscInt               *emarks;
177 #endif
178   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
179   PetscErrorCode         ierr;
180 
181   PetscFunctionBegin;
182   /* If the discrete gradient is defined for a subset of dofs and global is true,
183      it assumes G is given in global ordering for all the dofs.
184      Otherwise, the ordering is global for the Nedelec field */
185   order      = pcbddc->nedorder;
186   conforming = pcbddc->conforming;
187   field      = pcbddc->nedfield;
188   global     = pcbddc->nedglobal;
189   setprimal  = PETSC_FALSE;
190   print      = PETSC_FALSE;
191   singular   = PETSC_FALSE;
192 
193   /* Command line customization */
194   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
195   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
196   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
197   ierr = PetscOptionsInt("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
198   /* print debug info TODO: to be removed */
199   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
200   ierr = PetscOptionsEnd();CHKERRQ(ierr);
201 
202   /* Return if there are no edges in the decomposition and the problem is not singular */
203   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
204   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
205   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
206   if (!singular) {
207     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
208     lrc[0] = PETSC_FALSE;
209     for (i=0;i<n;i++) {
210       if (PetscRealPart(vals[i]) > 2.) {
211         lrc[0] = PETSC_TRUE;
212         break;
213       }
214     }
215     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
216     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
217     if (!lrc[1]) PetscFunctionReturn(0);
218   }
219 
220   /* Get Nedelec field */
221   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
222   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);
223   if (pcbddc->n_ISForDofsLocal && field >= 0) {
224     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
225     nedfieldlocal = pcbddc->ISForDofsLocal[field];
226     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
227   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
228     ne            = n;
229     nedfieldlocal = NULL;
230     global        = PETSC_TRUE;
231   } else if (field == PETSC_DECIDE) {
232     PetscInt rst,ren,*idx;
233 
234     ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
235     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
236     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
237     for (i=rst;i<ren;i++) {
238       PetscInt nc;
239 
240       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
241       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
242       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
243     }
244     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
245     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
246     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
247     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
248     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
249   } else {
250     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
251   }
252 
253   /* Sanity checks */
254   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
255   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
256   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);
257 
258   /* Just set primal dofs and return */
259   if (setprimal) {
260     IS       enedfieldlocal;
261     PetscInt *eidxs;
262 
263     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
264     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
265     if (nedfieldlocal) {
266       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
267       for (i=0,cum=0;i<ne;i++) {
268         if (PetscRealPart(vals[idxs[i]]) > 2.) {
269           eidxs[cum++] = idxs[i];
270         }
271       }
272       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
273     } else {
274       for (i=0,cum=0;i<ne;i++) {
275         if (PetscRealPart(vals[i]) > 2.) {
276           eidxs[cum++] = i;
277         }
278       }
279     }
280     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
281     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
282     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
283     ierr = PetscFree(eidxs);CHKERRQ(ierr);
284     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
285     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
286     PetscFunctionReturn(0);
287   }
288 
289   /* Compute some l2g maps */
290   if (nedfieldlocal) {
291     IS is;
292 
293     /* need to map from the local Nedelec field to local numbering */
294     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
295     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
296     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
297     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
298     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
299     if (global) {
300       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
301       el2g = al2g;
302     } else {
303       IS gis;
304 
305       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
306       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
307       ierr = ISDestroy(&gis);CHKERRQ(ierr);
308     }
309     ierr = ISDestroy(&is);CHKERRQ(ierr);
310   } else {
311     /* restore default */
312     pcbddc->nedfield = -1;
313     /* one ref for the destruction of al2g, one for el2g */
314     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
315     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
316     el2g = al2g;
317     fl2g = NULL;
318   }
319 
320   /* Start communication to drop connections for interior edges (for cc analysis only) */
321   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
322   ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
323   if (nedfieldlocal) {
324     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
325     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
326     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
327   } else {
328     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
329   }
330   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
331   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
332 
333   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
334     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
335     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
336     if (global) {
337       PetscInt rst;
338 
339       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
340       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
341         if (matis->sf_rootdata[i] < 2) {
342           matis->sf_rootdata[cum++] = i + rst;
343         }
344       }
345       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
346       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
347     } else {
348       PetscInt *tbz;
349 
350       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
351       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
352       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
353       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
354       for (i=0,cum=0;i<ne;i++)
355         if (matis->sf_leafdata[idxs[i]] == 1)
356           tbz[cum++] = i;
357       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
358       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
359       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
360       ierr = PetscFree(tbz);CHKERRQ(ierr);
361     }
362   } else { /* we need the entire G to infer the nullspace */
363     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
364     G    = pcbddc->discretegradient;
365   }
366 
367   /* Extract subdomain relevant rows of G */
368   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
369   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
370   ierr = MatCreateSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
371   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
372   ierr = ISDestroy(&lned);CHKERRQ(ierr);
373   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
374   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
375   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
376 
377   /* SF for nodal dofs communications */
378   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
379   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
380   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
381   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
382   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
383   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
384   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
385   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
386   i    = singular ? 2 : 1;
387   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
388 
389   /* Destroy temporary G created in MATIS format and modified G */
390   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
391   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
392   ierr = MatDestroy(&G);CHKERRQ(ierr);
393 
394   if (print) {
395     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
396     ierr = MatView(lG,NULL);CHKERRQ(ierr);
397   }
398 
399   /* Save lG for values insertion in change of basis */
400   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
401 
402   /* Analyze the edge-nodes connections (duplicate lG) */
403   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
404   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
405   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
406   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
407   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
408   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
409   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
410   /* need to import the boundary specification to ensure the
411      proper detection of coarse edges' endpoints */
412   if (pcbddc->DirichletBoundariesLocal) {
413     IS is;
414 
415     if (fl2g) {
416       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
417     } else {
418       is = pcbddc->DirichletBoundariesLocal;
419     }
420     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
421     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
422     for (i=0;i<cum;i++) {
423       if (idxs[i] >= 0) {
424         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
425         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
426       }
427     }
428     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
429     if (fl2g) {
430       ierr = ISDestroy(&is);CHKERRQ(ierr);
431     }
432   }
433   if (pcbddc->NeumannBoundariesLocal) {
434     IS is;
435 
436     if (fl2g) {
437       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
438     } else {
439       is = pcbddc->NeumannBoundariesLocal;
440     }
441     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
442     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
443     for (i=0;i<cum;i++) {
444       if (idxs[i] >= 0) {
445         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
446       }
447     }
448     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
449     if (fl2g) {
450       ierr = ISDestroy(&is);CHKERRQ(ierr);
451     }
452   }
453 
454   /* Count neighs per dof */
455   ierr = PetscCalloc1(ne,&ecount);CHKERRQ(ierr);
456   ierr = PetscMalloc1(ne,&eneighs);CHKERRQ(ierr);
457   ierr = ISLocalToGlobalMappingGetInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
458   for (i=1,cum=0;i<n_neigh;i++) {
459     cum += n_shared[i];
460     for (j=0;j<n_shared[i];j++) {
461       ecount[shared[i][j]]++;
462     }
463   }
464   if (ne) {
465     ierr = PetscMalloc1(cum,&eneighs[0]);CHKERRQ(ierr);
466   }
467   for (i=1;i<ne;i++) eneighs[i] = eneighs[i-1] + ecount[i-1];
468   ierr = PetscMemzero(ecount,ne*sizeof(PetscInt));CHKERRQ(ierr);
469   for (i=1;i<n_neigh;i++) {
470     for (j=0;j<n_shared[i];j++) {
471       PetscInt k = shared[i][j];
472       eneighs[k][ecount[k]] = neigh[i];
473       ecount[k]++;
474     }
475   }
476   for (i=0;i<ne;i++) {
477     ierr = PetscSortRemoveDupsInt(&ecount[i],eneighs[i]);CHKERRQ(ierr);
478   }
479   ierr = ISLocalToGlobalMappingRestoreInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
480   ierr = PetscCalloc1(nv,&vcount);CHKERRQ(ierr);
481   ierr = PetscMalloc1(nv,&vneighs);CHKERRQ(ierr);
482   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
483   for (i=1,cum=0;i<n_neigh;i++) {
484     cum += n_shared[i];
485     for (j=0;j<n_shared[i];j++) {
486       vcount[shared[i][j]]++;
487     }
488   }
489   if (nv) {
490     ierr = PetscMalloc1(cum,&vneighs[0]);CHKERRQ(ierr);
491   }
492   for (i=1;i<nv;i++) vneighs[i] = vneighs[i-1] + vcount[i-1];
493   ierr = PetscMemzero(vcount,nv*sizeof(PetscInt));CHKERRQ(ierr);
494   for (i=1;i<n_neigh;i++) {
495     for (j=0;j<n_shared[i];j++) {
496       PetscInt k = shared[i][j];
497       vneighs[k][vcount[k]] = neigh[i];
498       vcount[k]++;
499     }
500   }
501   for (i=0;i<nv;i++) {
502     ierr = PetscSortRemoveDupsInt(&vcount[i],vneighs[i]);CHKERRQ(ierr);
503   }
504   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
505 
506   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
507      for proper detection of coarse edges' endpoints */
508   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
509   for (i=0;i<ne;i++) {
510     if ((ecount[i] > 1 && !PetscBTLookup(btbd,i)) || (ecount[i] == 1 && PetscBTLookup(btb,i))) {
511       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
512     }
513   }
514   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
515   if (!conforming) {
516     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
517     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
518   }
519   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
520   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
521   cum  = 0;
522   for (i=0;i<ne;i++) {
523     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
524     if (!PetscBTLookup(btee,i)) {
525       marks[cum++] = i;
526       continue;
527     }
528     /* set badly connected edge dofs as primal */
529     if (!conforming) {
530       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
531         marks[cum++] = i;
532         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
533         for (j=ii[i];j<ii[i+1];j++) {
534           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
535         }
536       } else {
537         /* every edge dofs should be connected trough a certain number of nodal dofs
538            to other edge dofs belonging to coarse edges
539            - at most 2 endpoints
540            - order-1 interior nodal dofs
541            - no undefined nodal dofs (nconn < order)
542         */
543         PetscInt ends = 0,ints = 0, undef = 0;
544         for (j=ii[i];j<ii[i+1];j++) {
545           PetscInt v = jj[j],k;
546           PetscInt nconn = iit[v+1]-iit[v];
547           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
548           if (nconn > order) ends++;
549           else if (nconn == order) ints++;
550           else undef++;
551         }
552         if (undef || ends > 2 || ints != order -1) {
553           marks[cum++] = i;
554           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
555           for (j=ii[i];j<ii[i+1];j++) {
556             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
557           }
558         }
559       }
560     }
561     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
562     if (!order && ii[i+1] != ii[i]) {
563       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
564       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
565     }
566   }
567   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
568   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
569   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
570   if (!conforming) {
571     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
572     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
573   }
574   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
575 
576   /* identify splitpoints and corner candidates */
577   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
578   if (print) {
579     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
580     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
581     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
582     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
583   }
584   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
585   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
586   for (i=0;i<nv;i++) {
587     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
588     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
589     if (!order) { /* variable order */
590       PetscReal vorder = 0.;
591 
592       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
593       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
594       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%d)",vorder,test);
595       ord  = 1;
596     }
597 #if defined(PETSC_USE_DEBUG)
598     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);
599 #endif
600     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
601       if (PetscBTLookup(btbd,jj[j])) {
602         bdir = PETSC_TRUE;
603         break;
604       }
605       if (vc != ecount[jj[j]]) {
606         sneighs = PETSC_FALSE;
607       } else {
608         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
609         for (k=0;k<vc;k++) {
610           if (vn[k] != en[k]) {
611             sneighs = PETSC_FALSE;
612             break;
613           }
614         }
615       }
616     }
617     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
618       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %d (%d %d %d)\n",i,!sneighs,test >= 3*ord,bdir);
619       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
620     } else if (test == ord) {
621       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
622         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %d\n",i);
623         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
624       } else {
625         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %d\n",i);
626         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
627       }
628     }
629   }
630   ierr = PetscFree(ecount);CHKERRQ(ierr);
631   ierr = PetscFree(vcount);CHKERRQ(ierr);
632   if (ne) {
633     ierr = PetscFree(eneighs[0]);CHKERRQ(ierr);
634   }
635   if (nv) {
636     ierr = PetscFree(vneighs[0]);CHKERRQ(ierr);
637   }
638   ierr = PetscFree(eneighs);CHKERRQ(ierr);
639   ierr = PetscFree(vneighs);CHKERRQ(ierr);
640   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
641 
642   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
643   if (order != 1) {
644     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
645     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
646     for (i=0;i<nv;i++) {
647       if (PetscBTLookup(btvcand,i)) {
648         PetscBool found = PETSC_FALSE;
649         for (j=ii[i];j<ii[i+1] && !found;j++) {
650           PetscInt k,e = jj[j];
651           if (PetscBTLookup(bte,e)) continue;
652           for (k=iit[e];k<iit[e+1];k++) {
653             PetscInt v = jjt[k];
654             if (v != i && PetscBTLookup(btvcand,v)) {
655               found = PETSC_TRUE;
656               break;
657             }
658           }
659         }
660         if (!found) {
661           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d CLEARED\n",i);
662           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
663         } else {
664           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d ACCEPTED\n",i);
665         }
666       }
667     }
668     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
669   }
670   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
671   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
672   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
673 
674   /* Get the local G^T explicitly */
675   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
676   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
677   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
678 
679   /* Mark interior nodal dofs */
680   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
681   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
682   for (i=1;i<n_neigh;i++) {
683     for (j=0;j<n_shared[i];j++) {
684       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
685     }
686   }
687   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
688 
689   /* communicate corners and splitpoints */
690   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
691   ierr = PetscMemzero(sfvleaves,nv*sizeof(PetscInt));CHKERRQ(ierr);
692   ierr = PetscMemzero(sfvroots,Lv*sizeof(PetscInt));CHKERRQ(ierr);
693   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
694 
695   if (print) {
696     IS tbz;
697 
698     cum = 0;
699     for (i=0;i<nv;i++)
700       if (sfvleaves[i])
701         vmarks[cum++] = i;
702 
703     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
704     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
705     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
706     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
707   }
708 
709   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
710   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
711   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
712   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
713 
714   /* Zero rows of lGt corresponding to identified corners
715      and interior nodal dofs */
716   cum = 0;
717   for (i=0;i<nv;i++) {
718     if (sfvleaves[i]) {
719       vmarks[cum++] = i;
720       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
721     }
722     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
723   }
724   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
725   if (print) {
726     IS tbz;
727 
728     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
729     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
730     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
731     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
732   }
733   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
734   ierr = PetscFree(vmarks);CHKERRQ(ierr);
735   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
736   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
737 
738   /* Recompute G */
739   ierr = MatDestroy(&lG);CHKERRQ(ierr);
740   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
741   if (print) {
742     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
743     ierr = MatView(lG,NULL);CHKERRQ(ierr);
744     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
745     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
746   }
747 
748   /* Get primal dofs (if any) */
749   cum = 0;
750   for (i=0;i<ne;i++) {
751     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
752   }
753   if (fl2g) {
754     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
755   }
756   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
757   if (print) {
758     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
759     ierr = ISView(primals,NULL);CHKERRQ(ierr);
760   }
761   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
762   /* TODO: what if the user passed in some of them ?  */
763   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
764   ierr = ISDestroy(&primals);CHKERRQ(ierr);
765 
766   /* Compute edge connectivity */
767   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
768   ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr);
769   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
770   if (fl2g) {
771     PetscBT   btf;
772     PetscInt  *iia,*jja,*iiu,*jju;
773     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
774 
775     /* create CSR for all local dofs */
776     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
777     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
778       if (pcbddc->mat_graph->nvtxs_csr != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid size of CSR graph %d. Should be %d\n",pcbddc->mat_graph->nvtxs_csr,n);
779       iiu = pcbddc->mat_graph->xadj;
780       jju = pcbddc->mat_graph->adjncy;
781     } else if (pcbddc->use_local_adj) {
782       rest = PETSC_TRUE;
783       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
784     } else {
785       free   = PETSC_TRUE;
786       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
787       iiu[0] = 0;
788       for (i=0;i<n;i++) {
789         iiu[i+1] = i+1;
790         jju[i]   = -1;
791       }
792     }
793 
794     /* import sizes of CSR */
795     iia[0] = 0;
796     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
797 
798     /* overwrite entries corresponding to the Nedelec field */
799     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
800     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
801     for (i=0;i<ne;i++) {
802       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
803       iia[idxs[i]+1] = ii[i+1]-ii[i];
804     }
805 
806     /* iia in CSR */
807     for (i=0;i<n;i++) iia[i+1] += iia[i];
808 
809     /* jja in CSR */
810     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
811     for (i=0;i<n;i++)
812       if (!PetscBTLookup(btf,i))
813         for (j=0;j<iiu[i+1]-iiu[i];j++)
814           jja[iia[i]+j] = jju[iiu[i]+j];
815 
816     /* map edge dofs connectivity */
817     if (jj) {
818       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
819       for (i=0;i<ne;i++) {
820         PetscInt e = idxs[i];
821         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
822       }
823     }
824     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
825     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
826     if (rest) {
827       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
828     }
829     if (free) {
830       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
831     }
832     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
833   } else {
834     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
835   }
836 
837   /* Analyze interface for edge dofs */
838   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
839   pcbddc->mat_graph->twodim = PETSC_FALSE;
840 
841   /* Get coarse edges in the edge space */
842   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
843   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
844 
845   if (fl2g) {
846     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
847     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
848     for (i=0;i<nee;i++) {
849       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
850     }
851   } else {
852     eedges  = alleedges;
853     primals = allprimals;
854   }
855 
856   /* Mark fine edge dofs with their coarse edge id */
857   ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
858   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
859   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
860   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
861   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
862   if (print) {
863     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
864     ierr = ISView(primals,NULL);CHKERRQ(ierr);
865   }
866 
867   maxsize = 0;
868   for (i=0;i<nee;i++) {
869     PetscInt size,mark = i+1;
870 
871     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
872     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
873     for (j=0;j<size;j++) marks[idxs[j]] = mark;
874     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
875     maxsize = PetscMax(maxsize,size);
876   }
877 
878   /* Find coarse edge endpoints */
879   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
880   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
881   for (i=0;i<nee;i++) {
882     PetscInt mark = i+1,size;
883 
884     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
885     if (!size && nedfieldlocal) continue;
886     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
887     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
888     if (print) {
889       PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %d\n",i);
890       ISView(eedges[i],NULL);
891     }
892     for (j=0;j<size;j++) {
893       PetscInt k, ee = idxs[j];
894       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %d\n",ee);
895       for (k=ii[ee];k<ii[ee+1];k++) {
896         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %d\n",jj[k]);
897         if (PetscBTLookup(btv,jj[k])) {
898           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %d\n",jj[k]);
899         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
900           PetscInt  k2;
901           PetscBool corner = PETSC_FALSE;
902           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
903             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]));
904             /* it's a corner if either is connected with an edge dof belonging to a different cc or
905                if the edge dof lie on the natural part of the boundary */
906             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
907               corner = PETSC_TRUE;
908               break;
909             }
910           }
911           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
912             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %d\n",jj[k]);
913             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
914           } else {
915             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
916           }
917         }
918       }
919     }
920     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
921   }
922   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
923   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
924   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
925 
926   /* Reset marked primal dofs */
927   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
928   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
929   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
930   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
931 
932   /* Now use the initial lG */
933   ierr = MatDestroy(&lG);CHKERRQ(ierr);
934   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
935   lG   = lGinit;
936   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
937 
938   /* Compute extended cols indices */
939   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
940   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
941   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
942   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
943   i   *= maxsize;
944   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
945   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
946   eerr = PETSC_FALSE;
947   for (i=0;i<nee;i++) {
948     PetscInt size,found = 0;
949 
950     cum  = 0;
951     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
952     if (!size && nedfieldlocal) continue;
953     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
954     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
955     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
956     for (j=0;j<size;j++) {
957       PetscInt k,ee = idxs[j];
958       for (k=ii[ee];k<ii[ee+1];k++) {
959         PetscInt vv = jj[k];
960         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
961         else if (!PetscBTLookupSet(btvc,vv)) found++;
962       }
963     }
964     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
965     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
966     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
967     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
968     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
969     /* it may happen that endpoints are not defined at this point
970        if it is the case, mark this edge for a second pass */
971     if (cum != size -1 || found != 2) {
972       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
973       if (print) {
974         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
975         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
976         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
977         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
978       }
979       eerr = PETSC_TRUE;
980     }
981   }
982   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
983   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
984   if (done) {
985     PetscInt *newprimals;
986 
987     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
988     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
989     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
990     ierr = PetscMemcpy(newprimals,idxs,cum*sizeof(PetscInt));CHKERRQ(ierr);
991     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
992     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
993     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %d)\n",eerr);
994     for (i=0;i<nee;i++) {
995       PetscBool has_candidates = PETSC_FALSE;
996       if (PetscBTLookup(bter,i)) {
997         PetscInt size,mark = i+1;
998 
999         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1000         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1001         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
1002         for (j=0;j<size;j++) {
1003           PetscInt k,ee = idxs[j];
1004           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %d [%d %d)\n",ee,ii[ee],ii[ee+1]);
1005           for (k=ii[ee];k<ii[ee+1];k++) {
1006             /* set all candidates located on the edge as corners */
1007             if (PetscBTLookup(btvcand,jj[k])) {
1008               PetscInt k2,vv = jj[k];
1009               has_candidates = PETSC_TRUE;
1010               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %d\n",vv);
1011               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
1012               /* set all edge dofs connected to candidate as primals */
1013               for (k2=iit[vv];k2<iit[vv+1];k2++) {
1014                 if (marks[jjt[k2]] == mark) {
1015                   PetscInt k3,ee2 = jjt[k2];
1016                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %d\n",ee2);
1017                   newprimals[cum++] = ee2;
1018                   /* finally set the new corners */
1019                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
1020                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %d\n",jj[k3]);
1021                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
1022                   }
1023                 }
1024               }
1025             } else {
1026               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %d\n",jj[k]);
1027             }
1028           }
1029         }
1030         if (!has_candidates) { /* circular edge */
1031           PetscInt k, ee = idxs[0],*tmarks;
1032 
1033           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
1034           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %d\n",i);
1035           for (k=ii[ee];k<ii[ee+1];k++) {
1036             PetscInt k2;
1037             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %d\n",jj[k]);
1038             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
1039             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
1040           }
1041           for (j=0;j<size;j++) {
1042             if (tmarks[idxs[j]] > 1) {
1043               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %d\n",idxs[j]);
1044               newprimals[cum++] = idxs[j];
1045             }
1046           }
1047           ierr = PetscFree(tmarks);CHKERRQ(ierr);
1048         }
1049         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1050       }
1051       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1052     }
1053     ierr = PetscFree(extcols);CHKERRQ(ierr);
1054     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1055     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1056     if (fl2g) {
1057       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1058       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1059       for (i=0;i<nee;i++) {
1060         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1061       }
1062       ierr = PetscFree(eedges);CHKERRQ(ierr);
1063     }
1064     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1065     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1066     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1067     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1068     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1069     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1070     pcbddc->mat_graph->twodim = PETSC_FALSE;
1071     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1072     if (fl2g) {
1073       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1074       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1075       for (i=0;i<nee;i++) {
1076         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1077       }
1078     } else {
1079       eedges  = alleedges;
1080       primals = allprimals;
1081     }
1082     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1083 
1084     /* Mark again */
1085     ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
1086     for (i=0;i<nee;i++) {
1087       PetscInt size,mark = i+1;
1088 
1089       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1090       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1091       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1092       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1093     }
1094     if (print) {
1095       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1096       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1097     }
1098 
1099     /* Recompute extended cols */
1100     eerr = PETSC_FALSE;
1101     for (i=0;i<nee;i++) {
1102       PetscInt size;
1103 
1104       cum  = 0;
1105       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1106       if (!size && nedfieldlocal) continue;
1107       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1108       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1109       for (j=0;j<size;j++) {
1110         PetscInt k,ee = idxs[j];
1111         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1112       }
1113       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1114       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1115       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1116       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1117       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1118       if (cum != size -1) {
1119         if (print) {
1120           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1121           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1122           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1123           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1124         }
1125         eerr = PETSC_TRUE;
1126       }
1127     }
1128   }
1129   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1130   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1131   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1132   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1133   /* an error should not occur at this point */
1134   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1135 
1136   /* Check the number of endpoints */
1137   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1138   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1139   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1140   for (i=0;i<nee;i++) {
1141     PetscInt size, found = 0, gc[2];
1142 
1143     /* init with defaults */
1144     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1145     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1146     if (!size && nedfieldlocal) continue;
1147     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1148     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1149     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1150     for (j=0;j<size;j++) {
1151       PetscInt k,ee = idxs[j];
1152       for (k=ii[ee];k<ii[ee+1];k++) {
1153         PetscInt vv = jj[k];
1154         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1155           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %d\n",i);
1156           corners[i*2+found++] = vv;
1157         }
1158       }
1159     }
1160     if (found != 2) {
1161       PetscInt e;
1162       if (fl2g) {
1163         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1164       } else {
1165         e = idxs[0];
1166       }
1167       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %d corners for edge %d (astart %d, estart %d)\n",found,i,e,idxs[0]);
1168     }
1169 
1170     /* get primal dof index on this coarse edge */
1171     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1172     if (gc[0] > gc[1]) {
1173       PetscInt swap  = corners[2*i];
1174       corners[2*i]   = corners[2*i+1];
1175       corners[2*i+1] = swap;
1176     }
1177     cedges[i] = idxs[size-1];
1178     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1179     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %d: ce %d, corners (%d,%d)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1180   }
1181   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1182   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1183 
1184 #if defined(PETSC_USE_DEBUG)
1185   /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1186      not interfere with neighbouring coarse edges */
1187   ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1188   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1189   for (i=0;i<nv;i++) {
1190     PetscInt emax = 0,eemax = 0;
1191 
1192     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1193     ierr = PetscMemzero(emarks,(nee+1)*sizeof(PetscInt));CHKERRQ(ierr);
1194     for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1195     for (j=1;j<nee+1;j++) {
1196       if (emax < emarks[j]) {
1197         emax = emarks[j];
1198         eemax = j;
1199       }
1200     }
1201     /* not relevant for edges */
1202     if (!eemax) continue;
1203 
1204     for (j=ii[i];j<ii[i+1];j++) {
1205       if (marks[jj[j]] && marks[jj[j]] != eemax) {
1206         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\n",marks[jj[j]]-1,eemax,i,jj[j]);
1207       }
1208     }
1209   }
1210   ierr = PetscFree(emarks);CHKERRQ(ierr);
1211   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1212 #endif
1213 
1214   /* Compute extended rows indices for edge blocks of the change of basis */
1215   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1216   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1217   extmem *= maxsize;
1218   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1219   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1220   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1221   for (i=0;i<nv;i++) {
1222     PetscInt mark = 0,size,start;
1223 
1224     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1225     for (j=ii[i];j<ii[i+1];j++)
1226       if (marks[jj[j]] && !mark)
1227         mark = marks[jj[j]];
1228 
1229     /* not relevant */
1230     if (!mark) continue;
1231 
1232     /* import extended row */
1233     mark--;
1234     start = mark*extmem+extrowcum[mark];
1235     size = ii[i+1]-ii[i];
1236     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %d > %d",extrowcum[mark] + size,extmem);
1237     ierr = PetscMemcpy(extrow+start,jj+ii[i],size*sizeof(PetscInt));CHKERRQ(ierr);
1238     extrowcum[mark] += size;
1239   }
1240   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1241   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1242   ierr = PetscFree(marks);CHKERRQ(ierr);
1243 
1244   /* Compress extrows */
1245   cum  = 0;
1246   for (i=0;i<nee;i++) {
1247     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1248     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1249     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1250     cum  = PetscMax(cum,size);
1251   }
1252   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1253   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1254   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1255 
1256   /* Workspace for lapack inner calls and VecSetValues */
1257   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1258 
1259   /* Create change of basis matrix (preallocation can be improved) */
1260   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1261   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1262                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1263   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1264   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1265   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1266   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1267   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1268   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1269   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1270 
1271   /* Defaults to identity */
1272   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1273   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1274   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1275   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1276 
1277   /* Create discrete gradient for the coarser level if needed */
1278   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1279   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1280   if (pcbddc->current_level < pcbddc->max_levels) {
1281     ISLocalToGlobalMapping cel2g,cvl2g;
1282     IS                     wis,gwis;
1283     PetscInt               cnv,cne;
1284 
1285     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1286     if (fl2g) {
1287       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1288     } else {
1289       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1290       pcbddc->nedclocal = wis;
1291     }
1292     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1293     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1294     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1295     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1296     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1297     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1298 
1299     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1300     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1301     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1302     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1303     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1304     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1305     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1306 
1307     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1308     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1309     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1310     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1311     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1312     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1313     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1314     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1315   }
1316   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1317 
1318 #if defined(PRINT_GDET)
1319   inc = 0;
1320   lev = pcbddc->current_level;
1321 #endif
1322 
1323   /* Insert values in the change of basis matrix */
1324   for (i=0;i<nee;i++) {
1325     Mat         Gins = NULL, GKins = NULL;
1326     IS          cornersis = NULL;
1327     PetscScalar cvals[2];
1328 
1329     if (pcbddc->nedcG) {
1330       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1331     }
1332     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1333     if (Gins && GKins) {
1334       PetscScalar    *data;
1335       const PetscInt *rows,*cols;
1336       PetscInt       nrh,nch,nrc,ncc;
1337 
1338       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1339       /* H1 */
1340       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1341       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1342       ierr = MatDenseGetArray(Gins,&data);CHKERRQ(ierr);
1343       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1344       ierr = MatDenseRestoreArray(Gins,&data);CHKERRQ(ierr);
1345       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1346       /* complement */
1347       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1348       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %d",i);
1349       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);
1350       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);
1351       ierr = MatDenseGetArray(GKins,&data);CHKERRQ(ierr);
1352       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1353       ierr = MatDenseRestoreArray(GKins,&data);CHKERRQ(ierr);
1354 
1355       /* coarse discrete gradient */
1356       if (pcbddc->nedcG) {
1357         PetscInt cols[2];
1358 
1359         cols[0] = 2*i;
1360         cols[1] = 2*i+1;
1361         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1362       }
1363       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1364     }
1365     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1366     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1367     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1368     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1369     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1370   }
1371   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1372 
1373   /* Start assembling */
1374   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1375   if (pcbddc->nedcG) {
1376     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1377   }
1378 
1379   /* Free */
1380   if (fl2g) {
1381     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1382     for (i=0;i<nee;i++) {
1383       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1384     }
1385     ierr = PetscFree(eedges);CHKERRQ(ierr);
1386   }
1387 
1388   /* hack mat_graph with primal dofs on the coarse edges */
1389   {
1390     PCBDDCGraph graph   = pcbddc->mat_graph;
1391     PetscInt    *oqueue = graph->queue;
1392     PetscInt    *ocptr  = graph->cptr;
1393     PetscInt    ncc,*idxs;
1394 
1395     /* find first primal edge */
1396     if (pcbddc->nedclocal) {
1397       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1398     } else {
1399       if (fl2g) {
1400         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1401       }
1402       idxs = cedges;
1403     }
1404     cum = 0;
1405     while (cum < nee && cedges[cum] < 0) cum++;
1406 
1407     /* adapt connected components */
1408     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1409     graph->cptr[0] = 0;
1410     for (i=0,ncc=0;i<graph->ncc;i++) {
1411       PetscInt lc = ocptr[i+1]-ocptr[i];
1412       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1413         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1414         graph->queue[graph->cptr[ncc]] = cedges[cum];
1415         ncc++;
1416         lc--;
1417         cum++;
1418         while (cum < nee && cedges[cum] < 0) cum++;
1419       }
1420       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1421       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1422       ncc++;
1423     }
1424     graph->ncc = ncc;
1425     if (pcbddc->nedclocal) {
1426       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1427     }
1428     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1429   }
1430   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1431   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1432   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1433   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1434 
1435   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1436   ierr = PetscFree(extrow);CHKERRQ(ierr);
1437   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1438   ierr = PetscFree(corners);CHKERRQ(ierr);
1439   ierr = PetscFree(cedges);CHKERRQ(ierr);
1440   ierr = PetscFree(extrows);CHKERRQ(ierr);
1441   ierr = PetscFree(extcols);CHKERRQ(ierr);
1442   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1443 
1444   /* Complete assembling */
1445   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1446   if (pcbddc->nedcG) {
1447     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1448 #if 0
1449     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1450     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1451 #endif
1452   }
1453 
1454   /* set change of basis */
1455   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1456   ierr = MatDestroy(&T);CHKERRQ(ierr);
1457 
1458   PetscFunctionReturn(0);
1459 }
1460 
1461 /* the near-null space of BDDC carries information on quadrature weights,
1462    and these can be collinear -> so cheat with MatNullSpaceCreate
1463    and create a suitable set of basis vectors first */
1464 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1465 {
1466   PetscErrorCode ierr;
1467   PetscInt       i;
1468 
1469   PetscFunctionBegin;
1470   for (i=0;i<nvecs;i++) {
1471     PetscInt first,last;
1472 
1473     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1474     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1475     if (i>=first && i < last) {
1476       PetscScalar *data;
1477       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1478       if (!has_const) {
1479         data[i-first] = 1.;
1480       } else {
1481         data[2*i-first] = 1./PetscSqrtReal(2.);
1482         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1483       }
1484       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1485     }
1486     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1487   }
1488   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1489   for (i=0;i<nvecs;i++) { /* reset vectors */
1490     PetscInt first,last;
1491     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1492     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1493     if (i>=first && i < last) {
1494       PetscScalar *data;
1495       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1496       if (!has_const) {
1497         data[i-first] = 0.;
1498       } else {
1499         data[2*i-first] = 0.;
1500         data[2*i-first+1] = 0.;
1501       }
1502       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1503     }
1504     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1505     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1506   }
1507   PetscFunctionReturn(0);
1508 }
1509 
1510 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1511 {
1512   Mat                    loc_divudotp;
1513   Vec                    p,v,vins,quad_vec,*quad_vecs;
1514   ISLocalToGlobalMapping map;
1515   IS                     *faces,*edges;
1516   PetscScalar            *vals;
1517   const PetscScalar      *array;
1518   PetscInt               i,maxneighs,lmaxneighs,maxsize,nf,ne;
1519   PetscMPIInt            rank;
1520   PetscErrorCode         ierr;
1521 
1522   PetscFunctionBegin;
1523   ierr = PCBDDCGraphGetCandidatesIS(graph,&nf,&faces,&ne,&edges,NULL);CHKERRQ(ierr);
1524   if (graph->twodim) {
1525     lmaxneighs = 2;
1526   } else {
1527     lmaxneighs = 1;
1528     for (i=0;i<ne;i++) {
1529       const PetscInt *idxs;
1530       ierr = ISGetIndices(edges[i],&idxs);CHKERRQ(ierr);
1531       lmaxneighs = PetscMax(lmaxneighs,graph->count[idxs[0]]);
1532       ierr = ISRestoreIndices(edges[i],&idxs);CHKERRQ(ierr);
1533     }
1534     lmaxneighs++; /* graph count does not include self */
1535   }
1536   ierr = MPIU_Allreduce(&lmaxneighs,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1537   maxsize = 0;
1538   for (i=0;i<ne;i++) {
1539     PetscInt nn;
1540     ierr = ISGetLocalSize(edges[i],&nn);CHKERRQ(ierr);
1541     maxsize = PetscMax(maxsize,nn);
1542   }
1543   for (i=0;i<nf;i++) {
1544     PetscInt nn;
1545     ierr = ISGetLocalSize(faces[i],&nn);CHKERRQ(ierr);
1546     maxsize = PetscMax(maxsize,nn);
1547   }
1548   ierr = PetscMalloc1(maxsize,&vals);CHKERRQ(ierr);
1549   /* create vectors to hold quadrature weights */
1550   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1551   if (!transpose) {
1552     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1553   } else {
1554     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1555   }
1556   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1557   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1558   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1559   for (i=0;i<maxneighs;i++) {
1560     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1561     ierr = VecSetLocalToGlobalMapping(quad_vecs[i],map);CHKERRQ(ierr);
1562   }
1563 
1564   /* compute local quad vec */
1565   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1566   if (!transpose) {
1567     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1568   } else {
1569     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1570   }
1571   ierr = VecSet(p,1.);CHKERRQ(ierr);
1572   if (!transpose) {
1573     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1574   } else {
1575     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1576   }
1577   if (vl2l) {
1578     Mat        lA;
1579     VecScatter sc;
1580 
1581     ierr = MatISGetLocalMat(A,&lA);CHKERRQ(ierr);
1582     ierr = MatCreateVecs(lA,&vins,NULL);CHKERRQ(ierr);
1583     ierr = VecScatterCreate(v,vl2l,vins,NULL,&sc);CHKERRQ(ierr);
1584     ierr = VecScatterBegin(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1585     ierr = VecScatterEnd(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1586     ierr = VecScatterDestroy(&sc);CHKERRQ(ierr);
1587   } else {
1588     vins = v;
1589   }
1590   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1591   ierr = VecDestroy(&p);CHKERRQ(ierr);
1592 
1593   /* insert in global quadrature vecs */
1594   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1595   for (i=0;i<nf;i++) {
1596     const PetscInt    *idxs;
1597     PetscInt          idx,nn,j;
1598 
1599     ierr = ISGetIndices(faces[i],&idxs);CHKERRQ(ierr);
1600     ierr = ISGetLocalSize(faces[i],&nn);CHKERRQ(ierr);
1601     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1602     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1603     idx  = -(idx+1);
1604     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1605     ierr = ISRestoreIndices(faces[i],&idxs);CHKERRQ(ierr);
1606   }
1607   for (i=0;i<ne;i++) {
1608     const PetscInt    *idxs;
1609     PetscInt          idx,nn,j;
1610 
1611     ierr = ISGetIndices(edges[i],&idxs);CHKERRQ(ierr);
1612     ierr = ISGetLocalSize(edges[i],&nn);CHKERRQ(ierr);
1613     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1614     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1615     idx  = -(idx+1);
1616     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1617     ierr = ISRestoreIndices(edges[i],&idxs);CHKERRQ(ierr);
1618   }
1619   ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nf,&faces,&ne,&edges,NULL);CHKERRQ(ierr);
1620   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1621   if (vl2l) {
1622     ierr = VecDestroy(&vins);CHKERRQ(ierr);
1623   }
1624   ierr = VecDestroy(&v);CHKERRQ(ierr);
1625   ierr = PetscFree(vals);CHKERRQ(ierr);
1626 
1627   /* assemble near null space */
1628   for (i=0;i<maxneighs;i++) {
1629     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1630   }
1631   for (i=0;i<maxneighs;i++) {
1632     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1633     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1634   }
1635   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1636   PetscFunctionReturn(0);
1637 }
1638 
1639 
1640 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1641 {
1642   PetscErrorCode ierr;
1643   Vec            local,global;
1644   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1645   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1646   PetscBool      monolithic = PETSC_FALSE;
1647 
1648   PetscFunctionBegin;
1649   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC topology options","PC");CHKERRQ(ierr);
1650   ierr = PetscOptionsBool("-pc_bddc_monolithic","Don't split dofs by block size",NULL,monolithic,&monolithic,NULL);CHKERRQ(ierr);
1651   ierr = PetscOptionsEnd();CHKERRQ(ierr);
1652   /* need to convert from global to local topology information and remove references to information in global ordering */
1653   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1654   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1655   if (pcbddc->user_provided_isfordofs) {
1656     if (pcbddc->n_ISForDofs) {
1657       PetscInt i;
1658       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1659       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1660         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1661         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1662       }
1663       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1664       pcbddc->n_ISForDofs = 0;
1665       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1666     }
1667   } else {
1668     if (!pcbddc->n_ISForDofsLocal) { /* field split not present */
1669       DM dm;
1670 
1671       ierr = PCGetDM(pc, &dm);CHKERRQ(ierr);
1672       if (!dm) {
1673         ierr = MatGetDM(pc->pmat, &dm);CHKERRQ(ierr);
1674       }
1675       if (dm && !monolithic) {
1676         IS      *fields;
1677         PetscInt nf,i;
1678         ierr = DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL);CHKERRQ(ierr);
1679         ierr = PetscMalloc1(nf,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1680         for (i=0;i<nf;i++) {
1681           ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1682           ierr = ISDestroy(&fields[i]);CHKERRQ(ierr);
1683         }
1684         ierr = PetscFree(fields);CHKERRQ(ierr);
1685         pcbddc->n_ISForDofsLocal = nf;
1686       } else { /* See if MATIS has fields attached by the conversion from MatNest */
1687         PetscContainer   c;
1688 
1689         ierr = PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c);CHKERRQ(ierr);
1690         if (c && !monolithic) {
1691           MatISLocalFields lf;
1692           ierr = PetscContainerGetPointer(c,(void**)&lf);CHKERRQ(ierr);
1693           ierr = PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf);CHKERRQ(ierr);
1694         } else { /* fallback, create the default fields if bs > 1 */
1695           PetscInt i, n = matis->A->rmap->n;
1696           ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1697           if (i > 1 && !monolithic) {
1698             pcbddc->n_ISForDofsLocal = i;
1699             ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1700             for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1701               ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1702             }
1703           }
1704         }
1705       }
1706     } else {
1707       PetscInt i;
1708       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1709         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1710       }
1711     }
1712   }
1713 
1714   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1715     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1716   } else if (pcbddc->DirichletBoundariesLocal) {
1717     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1718   }
1719   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1720     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1721   } else if (pcbddc->NeumannBoundariesLocal) {
1722     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1723   }
1724   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1725     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1726   }
1727   ierr = VecDestroy(&global);CHKERRQ(ierr);
1728   ierr = VecDestroy(&local);CHKERRQ(ierr);
1729 
1730   PetscFunctionReturn(0);
1731 }
1732 
1733 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1734 {
1735   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1736   PetscErrorCode  ierr;
1737   IS              nis;
1738   const PetscInt  *idxs;
1739   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1740   PetscBool       *ld;
1741 
1742   PetscFunctionBegin;
1743   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1744   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
1745   if (mop == MPI_LAND) {
1746     /* init rootdata with true */
1747     ld   = (PetscBool*) matis->sf_rootdata;
1748     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1749   } else {
1750     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscBool));CHKERRQ(ierr);
1751   }
1752   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscBool));CHKERRQ(ierr);
1753   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1754   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1755   ld   = (PetscBool*) matis->sf_leafdata;
1756   for (i=0;i<nd;i++)
1757     if (-1 < idxs[i] && idxs[i] < n)
1758       ld[idxs[i]] = PETSC_TRUE;
1759   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1760   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1761   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1762   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1763   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1764   if (mop == MPI_LAND) {
1765     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1766   } else {
1767     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1768   }
1769   for (i=0,nnd=0;i<n;i++)
1770     if (ld[i])
1771       nidxs[nnd++] = i;
1772   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1773   ierr = ISDestroy(is);CHKERRQ(ierr);
1774   *is  = nis;
1775   PetscFunctionReturn(0);
1776 }
1777 
1778 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1779 {
1780   PC_IS             *pcis = (PC_IS*)(pc->data);
1781   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1782   PetscErrorCode    ierr;
1783 
1784   PetscFunctionBegin;
1785   if (!pcbddc->benign_have_null) {
1786     PetscFunctionReturn(0);
1787   }
1788   if (pcbddc->ChangeOfBasisMatrix) {
1789     Vec swap;
1790 
1791     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1792     swap = pcbddc->work_change;
1793     pcbddc->work_change = r;
1794     r = swap;
1795   }
1796   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1797   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1798   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1799   ierr = VecSet(z,0.);CHKERRQ(ierr);
1800   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1801   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1802   if (pcbddc->ChangeOfBasisMatrix) {
1803     pcbddc->work_change = r;
1804     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1805     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1806   }
1807   PetscFunctionReturn(0);
1808 }
1809 
1810 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1811 {
1812   PCBDDCBenignMatMult_ctx ctx;
1813   PetscErrorCode          ierr;
1814   PetscBool               apply_right,apply_left,reset_x;
1815 
1816   PetscFunctionBegin;
1817   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1818   if (transpose) {
1819     apply_right = ctx->apply_left;
1820     apply_left = ctx->apply_right;
1821   } else {
1822     apply_right = ctx->apply_right;
1823     apply_left = ctx->apply_left;
1824   }
1825   reset_x = PETSC_FALSE;
1826   if (apply_right) {
1827     const PetscScalar *ax;
1828     PetscInt          nl,i;
1829 
1830     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1831     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1832     ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr);
1833     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1834     for (i=0;i<ctx->benign_n;i++) {
1835       PetscScalar    sum,val;
1836       const PetscInt *idxs;
1837       PetscInt       nz,j;
1838       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1839       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1840       sum = 0.;
1841       if (ctx->apply_p0) {
1842         val = ctx->work[idxs[nz-1]];
1843         for (j=0;j<nz-1;j++) {
1844           sum += ctx->work[idxs[j]];
1845           ctx->work[idxs[j]] += val;
1846         }
1847       } else {
1848         for (j=0;j<nz-1;j++) {
1849           sum += ctx->work[idxs[j]];
1850         }
1851       }
1852       ctx->work[idxs[nz-1]] -= sum;
1853       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1854     }
1855     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1856     reset_x = PETSC_TRUE;
1857   }
1858   if (transpose) {
1859     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1860   } else {
1861     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1862   }
1863   if (reset_x) {
1864     ierr = VecResetArray(x);CHKERRQ(ierr);
1865   }
1866   if (apply_left) {
1867     PetscScalar *ay;
1868     PetscInt    i;
1869 
1870     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1871     for (i=0;i<ctx->benign_n;i++) {
1872       PetscScalar    sum,val;
1873       const PetscInt *idxs;
1874       PetscInt       nz,j;
1875       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1876       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1877       val = -ay[idxs[nz-1]];
1878       if (ctx->apply_p0) {
1879         sum = 0.;
1880         for (j=0;j<nz-1;j++) {
1881           sum += ay[idxs[j]];
1882           ay[idxs[j]] += val;
1883         }
1884         ay[idxs[nz-1]] += sum;
1885       } else {
1886         for (j=0;j<nz-1;j++) {
1887           ay[idxs[j]] += val;
1888         }
1889         ay[idxs[nz-1]] = 0.;
1890       }
1891       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1892     }
1893     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
1894   }
1895   PetscFunctionReturn(0);
1896 }
1897 
1898 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
1899 {
1900   PetscErrorCode ierr;
1901 
1902   PetscFunctionBegin;
1903   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
1904   PetscFunctionReturn(0);
1905 }
1906 
1907 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
1908 {
1909   PetscErrorCode ierr;
1910 
1911   PetscFunctionBegin;
1912   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
1913   PetscFunctionReturn(0);
1914 }
1915 
1916 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
1917 {
1918   PC_IS                   *pcis = (PC_IS*)pc->data;
1919   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
1920   PCBDDCBenignMatMult_ctx ctx;
1921   PetscErrorCode          ierr;
1922 
1923   PetscFunctionBegin;
1924   if (!restore) {
1925     Mat                A_IB,A_BI;
1926     PetscScalar        *work;
1927     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
1928 
1929     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
1930     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
1931     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
1932     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
1933     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
1934     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
1935     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
1936     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
1937     ierr = PetscNew(&ctx);CHKERRQ(ierr);
1938     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
1939     ctx->apply_left = PETSC_TRUE;
1940     ctx->apply_right = PETSC_FALSE;
1941     ctx->apply_p0 = PETSC_FALSE;
1942     ctx->benign_n = pcbddc->benign_n;
1943     if (reuse) {
1944       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
1945       ctx->free = PETSC_FALSE;
1946     } else { /* TODO: could be optimized for successive solves */
1947       ISLocalToGlobalMapping N_to_D;
1948       PetscInt               i;
1949 
1950       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
1951       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
1952       for (i=0;i<pcbddc->benign_n;i++) {
1953         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1954       }
1955       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
1956       ctx->free = PETSC_TRUE;
1957     }
1958     ctx->A = pcis->A_IB;
1959     ctx->work = work;
1960     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
1961     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1962     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1963     pcis->A_IB = A_IB;
1964 
1965     /* A_BI as A_IB^T */
1966     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
1967     pcbddc->benign_original_mat = pcis->A_BI;
1968     pcis->A_BI = A_BI;
1969   } else {
1970     if (!pcbddc->benign_original_mat) {
1971       PetscFunctionReturn(0);
1972     }
1973     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
1974     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
1975     pcis->A_IB = ctx->A;
1976     ctx->A = NULL;
1977     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
1978     pcis->A_BI = pcbddc->benign_original_mat;
1979     pcbddc->benign_original_mat = NULL;
1980     if (ctx->free) {
1981       PetscInt i;
1982       for (i=0;i<ctx->benign_n;i++) {
1983         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1984       }
1985       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
1986     }
1987     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
1988     ierr = PetscFree(ctx);CHKERRQ(ierr);
1989   }
1990   PetscFunctionReturn(0);
1991 }
1992 
1993 /* used just in bddc debug mode */
1994 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
1995 {
1996   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1997   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1998   Mat            An;
1999   PetscErrorCode ierr;
2000 
2001   PetscFunctionBegin;
2002   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
2003   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
2004   if (is1) {
2005     ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
2006     ierr = MatDestroy(&An);CHKERRQ(ierr);
2007   } else {
2008     *B = An;
2009   }
2010   PetscFunctionReturn(0);
2011 }
2012 
2013 /* TODO: add reuse flag */
2014 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2015 {
2016   Mat            Bt;
2017   PetscScalar    *a,*bdata;
2018   const PetscInt *ii,*ij;
2019   PetscInt       m,n,i,nnz,*bii,*bij;
2020   PetscBool      flg_row;
2021   PetscErrorCode ierr;
2022 
2023   PetscFunctionBegin;
2024   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2025   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2026   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2027   nnz = n;
2028   for (i=0;i<ii[n];i++) {
2029     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2030   }
2031   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2032   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2033   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2034   nnz = 0;
2035   bii[0] = 0;
2036   for (i=0;i<n;i++) {
2037     PetscInt j;
2038     for (j=ii[i];j<ii[i+1];j++) {
2039       PetscScalar entry = a[j];
2040       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || ij[j] == i) {
2041         bij[nnz] = ij[j];
2042         bdata[nnz] = entry;
2043         nnz++;
2044       }
2045     }
2046     bii[i+1] = nnz;
2047   }
2048   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2049   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2050   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2051   {
2052     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2053     b->free_a = PETSC_TRUE;
2054     b->free_ij = PETSC_TRUE;
2055   }
2056   *B = Bt;
2057   PetscFunctionReturn(0);
2058 }
2059 
2060 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscInt *ncc, IS* cc[], IS* primalv)
2061 {
2062   Mat                    B = NULL;
2063   DM                     dm;
2064   IS                     is_dummy,*cc_n;
2065   ISLocalToGlobalMapping l2gmap_dummy;
2066   PCBDDCGraph            graph;
2067   PetscInt               *xadj_filtered = NULL,*adjncy_filtered = NULL;
2068   PetscInt               i,n;
2069   PetscInt               *xadj,*adjncy;
2070   PetscBool              isplex = PETSC_FALSE;
2071   PetscErrorCode         ierr;
2072 
2073   PetscFunctionBegin;
2074   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2075   ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
2076   if (!dm) {
2077     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
2078   }
2079   if (dm) {
2080     ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr);
2081   }
2082   if (isplex) { /* this code has been modified from plexpartition.c */
2083     PetscInt       p, pStart, pEnd, a, adjSize, idx, size, nroots;
2084     PetscInt      *adj = NULL;
2085     IS             cellNumbering;
2086     const PetscInt *cellNum;
2087     PetscBool      useCone, useClosure;
2088     PetscSection   section;
2089     PetscSegBuffer adjBuffer;
2090     PetscSF        sfPoint;
2091     PetscErrorCode ierr;
2092 
2093     PetscFunctionBegin;
2094     ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
2095     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2096     ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
2097     /* Build adjacency graph via a section/segbuffer */
2098     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &section);CHKERRQ(ierr);
2099     ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
2100     ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr);
2101     /* Always use FVM adjacency to create partitioner graph */
2102     ierr = DMPlexGetAdjacencyUseCone(dm, &useCone);CHKERRQ(ierr);
2103     ierr = DMPlexGetAdjacencyUseClosure(dm, &useClosure);CHKERRQ(ierr);
2104     ierr = DMPlexSetAdjacencyUseCone(dm, PETSC_TRUE);CHKERRQ(ierr);
2105     ierr = DMPlexSetAdjacencyUseClosure(dm, PETSC_FALSE);CHKERRQ(ierr);
2106     ierr = DMPlexCreateCellNumbering_Internal(dm, PETSC_TRUE, &cellNumbering);CHKERRQ(ierr);
2107     ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr);
2108     for (n = 0, p = pStart; p < pEnd; p++) {
2109       /* Skip non-owned cells in parallel (ParMetis expects no overlap) */
2110       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2111       adjSize = PETSC_DETERMINE;
2112       ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr);
2113       for (a = 0; a < adjSize; ++a) {
2114         const PetscInt point = adj[a];
2115         if (point != p && pStart <= point && point < pEnd) {
2116           PetscInt *PETSC_RESTRICT pBuf;
2117           ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr);
2118           ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr);
2119           *pBuf = point;
2120         }
2121       }
2122       n++;
2123     }
2124     ierr = DMPlexSetAdjacencyUseCone(dm, useCone);CHKERRQ(ierr);
2125     ierr = DMPlexSetAdjacencyUseClosure(dm, useClosure);CHKERRQ(ierr);
2126     /* Derive CSR graph from section/segbuffer */
2127     ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
2128     ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
2129     ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr);
2130     for (idx = 0, p = pStart; p < pEnd; p++) {
2131       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2132       ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr);
2133     }
2134     xadj[n] = size;
2135     ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr);
2136     /* Clean up */
2137     ierr = ISDestroy(&cellNumbering);CHKERRQ(ierr);
2138     ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr);
2139     ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
2140     ierr = PetscFree(adj);CHKERRQ(ierr);
2141     graph->xadj = xadj;
2142     graph->adjncy = adjncy;
2143   } else {
2144     Mat       A;
2145     PetscBool filter = PETSC_FALSE, isseqaij, flg_row;
2146 
2147     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2148     if (!A->rmap->N || !A->cmap->N) {
2149       *ncc = 0;
2150       *cc = NULL;
2151       PetscFunctionReturn(0);
2152     }
2153     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2154     if (!isseqaij && filter) {
2155       PetscBool isseqdense;
2156 
2157       ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2158       if (!isseqdense) {
2159         ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2160       } else { /* TODO: rectangular case and LDA */
2161         PetscScalar *array;
2162         PetscReal   chop=1.e-6;
2163 
2164         ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2165         ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2166         ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2167         for (i=0;i<n;i++) {
2168           PetscInt j;
2169           for (j=i+1;j<n;j++) {
2170             PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2171             if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2172             if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2173           }
2174         }
2175         ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2176         ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2177       }
2178     } else {
2179       ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
2180       B = A;
2181     }
2182     ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2183 
2184     /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2185     if (filter) {
2186       PetscScalar *data;
2187       PetscInt    j,cum;
2188 
2189       ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2190       ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2191       cum = 0;
2192       for (i=0;i<n;i++) {
2193         PetscInt t;
2194 
2195         for (j=xadj[i];j<xadj[i+1];j++) {
2196           if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2197             continue;
2198           }
2199           adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2200         }
2201         t = xadj_filtered[i];
2202         xadj_filtered[i] = cum;
2203         cum += t;
2204       }
2205       ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2206       graph->xadj = xadj_filtered;
2207       graph->adjncy = adjncy_filtered;
2208     } else {
2209       graph->xadj = xadj;
2210       graph->adjncy = adjncy;
2211     }
2212   }
2213   /* compute local connected components using PCBDDCGraph */
2214   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2215   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2216   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2217   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2218   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2219   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2220   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2221 
2222   /* partial clean up */
2223   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2224   if (B) {
2225     PetscBool flg_row;
2226     ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2227     ierr = MatDestroy(&B);CHKERRQ(ierr);
2228   }
2229   if (isplex) {
2230     ierr = PetscFree(xadj);CHKERRQ(ierr);
2231     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2232   }
2233 
2234   /* get back data */
2235   if (isplex) {
2236     if (ncc) *ncc = graph->ncc;
2237     if (cc || primalv) {
2238       Mat          A;
2239       PetscBT      btv,btvt;
2240       PetscSection subSection;
2241       PetscInt     *ids,cum,cump,*cids,*pids;
2242 
2243       ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr);
2244       ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2245       ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr);
2246       ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr);
2247       ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr);
2248 
2249       cids[0] = 0;
2250       for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) {
2251         PetscInt j;
2252 
2253         ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr);
2254         for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) {
2255           PetscInt k, size, *closure = NULL, cell = graph->queue[j];
2256 
2257           ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2258           for (k = 0; k < 2*size; k += 2) {
2259             PetscInt s, p = closure[k], off, dof, cdof;
2260 
2261             ierr = PetscSectionGetConstraintDof(subSection, p, &cdof);CHKERRQ(ierr);
2262             ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr);
2263             ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr);
2264             for (s = 0; s < dof-cdof; s++) {
2265               if (PetscBTLookupSet(btvt,off+s)) continue;
2266               if (!PetscBTLookup(btv,off+s)) {
2267                 ids[cum++] = off+s;
2268               } else { /* cross-vertex */
2269                 pids[cump++] = off+s;
2270               }
2271             }
2272           }
2273           ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2274         }
2275         cids[i+1] = cum;
2276         /* mark dofs as already assigned */
2277         for (j = cids[i]; j < cids[i+1]; j++) {
2278           ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr);
2279         }
2280       }
2281       if (cc) {
2282         ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2283         for (i = 0; i < graph->ncc; i++) {
2284           ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2285         }
2286         *cc = cc_n;
2287       }
2288       if (primalv) {
2289         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr);
2290       }
2291       ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr);
2292       ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
2293       ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr);
2294     }
2295   } else {
2296     if (ncc) *ncc = graph->ncc;
2297     if (cc) {
2298       ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2299       for (i=0;i<graph->ncc;i++) {
2300         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);
2301       }
2302       *cc = cc_n;
2303     }
2304     if (primalv) *primalv = NULL;
2305   }
2306   /* clean up graph */
2307   graph->xadj = 0;
2308   graph->adjncy = 0;
2309   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2310   PetscFunctionReturn(0);
2311 }
2312 
2313 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2314 {
2315   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2316   PC_IS*         pcis = (PC_IS*)(pc->data);
2317   IS             dirIS = NULL;
2318   PetscInt       i;
2319   PetscErrorCode ierr;
2320 
2321   PetscFunctionBegin;
2322   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2323   if (zerodiag) {
2324     Mat            A;
2325     Vec            vec3_N;
2326     PetscScalar    *vals;
2327     const PetscInt *idxs;
2328     PetscInt       nz,*count;
2329 
2330     /* p0 */
2331     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2332     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2333     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2334     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2335     for (i=0;i<nz;i++) vals[i] = 1.;
2336     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2337     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2338     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2339     /* v_I */
2340     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2341     for (i=0;i<nz;i++) vals[i] = 0.;
2342     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2343     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2344     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2345     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2346     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2347     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2348     if (dirIS) {
2349       PetscInt n;
2350 
2351       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2352       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2353       for (i=0;i<n;i++) vals[i] = 0.;
2354       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2355       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2356     }
2357     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2358     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2359     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2360     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2361     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2362     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2363     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2364     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]));
2365     ierr = PetscFree(vals);CHKERRQ(ierr);
2366     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2367 
2368     /* there should not be any pressure dofs lying on the interface */
2369     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2370     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2371     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2372     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2373     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2374     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]);
2375     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2376     ierr = PetscFree(count);CHKERRQ(ierr);
2377   }
2378   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2379 
2380   /* check PCBDDCBenignGetOrSetP0 */
2381   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2382   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2383   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2384   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2385   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2386   for (i=0;i<pcbddc->benign_n;i++) {
2387     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2388     if (val != -PetscGlobalRank-i) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error testing PCBDDCBenignGetOrSetP0! Found %g at %d instead of %g\n",PetscRealPart(pcbddc->benign_p0[i]),i,-PetscGlobalRank-i);CHKERRQ(ierr);
2389   }
2390   PetscFunctionReturn(0);
2391 }
2392 
2393 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, IS *zerodiaglocal)
2394 {
2395   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2396   IS             pressures,zerodiag,zerodiag_save,*zerodiag_subs;
2397   PetscInt       nz,n;
2398   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2399   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2400   PetscErrorCode ierr;
2401 
2402   PetscFunctionBegin;
2403   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2404   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2405   for (n=0;n<pcbddc->benign_n;n++) {
2406     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2407   }
2408   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2409   pcbddc->benign_n = 0;
2410 
2411   /* if a local info on dofs is present, uses the last field for "pressures" (or fid by command line)
2412      otherwise, it uses only zerodiagonal dofs (ok if the pressure block is all zero; it could fail if it is not)
2413      Checks if all the pressure dofs in each subdomain have a zero diagonal
2414      If not, a change of basis on pressures is not needed
2415      since the local Schur complements are already SPD
2416   */
2417   has_null_pressures = PETSC_TRUE;
2418   have_null = PETSC_TRUE;
2419   if (pcbddc->n_ISForDofsLocal) {
2420     IS       iP = NULL;
2421     PetscInt npl,*idxs,p = pcbddc->n_ISForDofsLocal-1;
2422 
2423     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2424     ierr = PetscOptionsInt("-pc_bddc_pressure_field","Field id for pressures",NULL,p,&p,NULL);CHKERRQ(ierr);
2425     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2426     if (p < 0 || p > pcbddc->n_ISForDofsLocal-1) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %D",p);
2427     /* Dofs splitting for BDDC cannot have PETSC_COMM_SELF, so create a sequential IS */
2428     ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[p],&npl);CHKERRQ(ierr);
2429     ierr = ISGetIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2430     ierr = ISCreateGeneral(PETSC_COMM_SELF,npl,idxs,PETSC_COPY_VALUES,&pressures);CHKERRQ(ierr);
2431     ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2432     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2433     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2434     if (iP) {
2435       IS newpressures;
2436 
2437       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2438       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2439       pressures = newpressures;
2440     }
2441     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2442     if (!sorted) {
2443       ierr = ISSort(pressures);CHKERRQ(ierr);
2444     }
2445   } else {
2446     pressures = NULL;
2447   }
2448   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2449   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2450   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2451   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2452   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2453   if (!sorted) {
2454     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2455   }
2456   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2457   zerodiag_save = zerodiag;
2458   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2459   if (!nz) {
2460     if (n) have_null = PETSC_FALSE;
2461     has_null_pressures = PETSC_FALSE;
2462     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2463   }
2464   recompute_zerodiag = PETSC_FALSE;
2465   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2466   zerodiag_subs    = NULL;
2467   pcbddc->benign_n = 0;
2468   n_interior_dofs  = 0;
2469   interior_dofs    = NULL;
2470   nneu             = 0;
2471   if (pcbddc->NeumannBoundariesLocal) {
2472     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2473   }
2474   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2475   if (checkb) { /* need to compute interior nodes */
2476     PetscInt n,i,j;
2477     PetscInt n_neigh,*neigh,*n_shared,**shared;
2478     PetscInt *iwork;
2479 
2480     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2481     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2482     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2483     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2484     for (i=1;i<n_neigh;i++)
2485       for (j=0;j<n_shared[i];j++)
2486           iwork[shared[i][j]] += 1;
2487     for (i=0;i<n;i++)
2488       if (!iwork[i])
2489         interior_dofs[n_interior_dofs++] = i;
2490     ierr = PetscFree(iwork);CHKERRQ(ierr);
2491     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2492   }
2493   if (has_null_pressures) {
2494     IS             *subs;
2495     PetscInt       nsubs,i,j,nl;
2496     const PetscInt *idxs;
2497     PetscScalar    *array;
2498     Vec            *work;
2499     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2500 
2501     subs  = pcbddc->local_subs;
2502     nsubs = pcbddc->n_local_subs;
2503     /* 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) */
2504     if (checkb) {
2505       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2506       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2507       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2508       /* work[0] = 1_p */
2509       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2510       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2511       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2512       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2513       /* work[0] = 1_v */
2514       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2515       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2516       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2517       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2518       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2519     }
2520     if (nsubs > 1) {
2521       ierr = PetscCalloc1(nsubs,&zerodiag_subs);CHKERRQ(ierr);
2522       for (i=0;i<nsubs;i++) {
2523         ISLocalToGlobalMapping l2g;
2524         IS                     t_zerodiag_subs;
2525         PetscInt               nl;
2526 
2527         ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2528         ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,zerodiag,&t_zerodiag_subs);CHKERRQ(ierr);
2529         ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2530         if (nl) {
2531           PetscBool valid = PETSC_TRUE;
2532 
2533           if (checkb) {
2534             ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2535             ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2536             ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2537             ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2538             for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2539             ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2540             ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2541             ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2542             ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2543             ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2544             ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2545             for (j=0;j<n_interior_dofs;j++) {
2546               if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2547                 valid = PETSC_FALSE;
2548                 break;
2549               }
2550             }
2551             ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2552           }
2553           if (valid && nneu) {
2554             const PetscInt *idxs;
2555             PetscInt       nzb;
2556 
2557             ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2558             ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2559             ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2560             if (nzb) valid = PETSC_FALSE;
2561           }
2562           if (valid && pressures) {
2563             IS t_pressure_subs;
2564             ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2565             ierr = ISEqual(t_pressure_subs,t_zerodiag_subs,&valid);CHKERRQ(ierr);
2566             ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2567           }
2568           if (valid) {
2569             ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[pcbddc->benign_n]);CHKERRQ(ierr);
2570             pcbddc->benign_n++;
2571           } else {
2572             recompute_zerodiag = PETSC_TRUE;
2573           }
2574         }
2575         ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2576         ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2577       }
2578     } else { /* there's just one subdomain (or zero if they have not been detected */
2579       PetscBool valid = PETSC_TRUE;
2580 
2581       if (nneu) valid = PETSC_FALSE;
2582       if (valid && pressures) {
2583         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2584       }
2585       if (valid && checkb) {
2586         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2587         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2588         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2589         for (j=0;j<n_interior_dofs;j++) {
2590           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2591             valid = PETSC_FALSE;
2592             break;
2593           }
2594         }
2595         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2596       }
2597       if (valid) {
2598         pcbddc->benign_n = 1;
2599         ierr = PetscMalloc1(pcbddc->benign_n,&zerodiag_subs);CHKERRQ(ierr);
2600         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2601         zerodiag_subs[0] = zerodiag;
2602       }
2603     }
2604     if (checkb) {
2605       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2606     }
2607   }
2608   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2609 
2610   if (!pcbddc->benign_n) {
2611     PetscInt n;
2612 
2613     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2614     recompute_zerodiag = PETSC_FALSE;
2615     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2616     if (n) {
2617       has_null_pressures = PETSC_FALSE;
2618       have_null = PETSC_FALSE;
2619     }
2620   }
2621 
2622   /* final check for null pressures */
2623   if (zerodiag && pressures) {
2624     PetscInt nz,np;
2625     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2626     ierr = ISGetLocalSize(pressures,&np);CHKERRQ(ierr);
2627     if (nz != np) have_null = PETSC_FALSE;
2628   }
2629 
2630   if (recompute_zerodiag) {
2631     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2632     if (pcbddc->benign_n == 1) {
2633       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2634       zerodiag = zerodiag_subs[0];
2635     } else {
2636       PetscInt i,nzn,*new_idxs;
2637 
2638       nzn = 0;
2639       for (i=0;i<pcbddc->benign_n;i++) {
2640         PetscInt ns;
2641         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2642         nzn += ns;
2643       }
2644       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2645       nzn = 0;
2646       for (i=0;i<pcbddc->benign_n;i++) {
2647         PetscInt ns,*idxs;
2648         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2649         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2650         ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr);
2651         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2652         nzn += ns;
2653       }
2654       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2655       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2656     }
2657     have_null = PETSC_FALSE;
2658   }
2659 
2660   /* Prepare matrix to compute no-net-flux */
2661   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2662     Mat                    A,loc_divudotp;
2663     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2664     IS                     row,col,isused = NULL;
2665     PetscInt               M,N,n,st,n_isused;
2666 
2667     if (pressures) {
2668       isused = pressures;
2669     } else {
2670       isused = zerodiag_save;
2671     }
2672     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2673     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2674     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2675     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");
2676     n_isused = 0;
2677     if (isused) {
2678       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2679     }
2680     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2681     st = st-n_isused;
2682     if (n) {
2683       const PetscInt *gidxs;
2684 
2685       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2686       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2687       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2688       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2689       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2690       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2691     } else {
2692       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2693       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2694       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2695     }
2696     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2697     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2698     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2699     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2700     ierr = ISDestroy(&row);CHKERRQ(ierr);
2701     ierr = ISDestroy(&col);CHKERRQ(ierr);
2702     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2703     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2704     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2705     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2706     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2707     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2708     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2709     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2710     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2711     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2712   }
2713   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2714 
2715   /* change of basis and p0 dofs */
2716   if (has_null_pressures) {
2717     IS             zerodiagc;
2718     const PetscInt *idxs,*idxsc;
2719     PetscInt       i,s,*nnz;
2720 
2721     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2722     ierr = ISComplement(zerodiag,0,n,&zerodiagc);CHKERRQ(ierr);
2723     ierr = ISGetIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2724     /* local change of basis for pressures */
2725     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2726     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2727     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2728     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2729     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2730     for (i=0;i<n-nz;i++) nnz[idxsc[i]] = 1; /* identity on velocities plus pressure dofs for non-singular subdomains */
2731     for (i=0;i<pcbddc->benign_n;i++) {
2732       PetscInt nzs,j;
2733 
2734       ierr = ISGetLocalSize(zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2735       ierr = ISGetIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2736       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2737       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2738       ierr = ISRestoreIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2739     }
2740     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2741     ierr = PetscFree(nnz);CHKERRQ(ierr);
2742     /* set identity on velocities */
2743     for (i=0;i<n-nz;i++) {
2744       ierr = MatSetValue(pcbddc->benign_change,idxsc[i],idxsc[i],1.,INSERT_VALUES);CHKERRQ(ierr);
2745     }
2746     ierr = ISRestoreIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2747     ierr = ISDestroy(&zerodiagc);CHKERRQ(ierr);
2748     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2749     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2750     /* set change on pressures */
2751     for (s=0;s<pcbddc->benign_n;s++) {
2752       PetscScalar *array;
2753       PetscInt    nzs;
2754 
2755       ierr = ISGetLocalSize(zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2756       ierr = ISGetIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2757       for (i=0;i<nzs-1;i++) {
2758         PetscScalar vals[2];
2759         PetscInt    cols[2];
2760 
2761         cols[0] = idxs[i];
2762         cols[1] = idxs[nzs-1];
2763         vals[0] = 1.;
2764         vals[1] = 1.;
2765         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2766       }
2767       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2768       for (i=0;i<nzs-1;i++) array[i] = -1.;
2769       array[nzs-1] = 1.;
2770       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2771       /* store local idxs for p0 */
2772       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2773       ierr = ISRestoreIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2774       ierr = PetscFree(array);CHKERRQ(ierr);
2775     }
2776     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2777     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2778     /* project if needed */
2779     if (pcbddc->benign_change_explicit) {
2780       Mat M;
2781 
2782       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2783       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2784       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2785       ierr = MatDestroy(&M);CHKERRQ(ierr);
2786     }
2787     /* store global idxs for p0 */
2788     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2789   }
2790   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2791   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2792 
2793   /* determines if the coarse solver will be singular or not */
2794   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2795   /* determines if the problem has subdomains with 0 pressure block */
2796   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2797   *zerodiaglocal = zerodiag;
2798   PetscFunctionReturn(0);
2799 }
2800 
2801 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2802 {
2803   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2804   PetscScalar    *array;
2805   PetscErrorCode ierr;
2806 
2807   PetscFunctionBegin;
2808   if (!pcbddc->benign_sf) {
2809     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
2810     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2811   }
2812   if (get) {
2813     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2814     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2815     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2816     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2817   } else {
2818     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
2819     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2820     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2821     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
2822   }
2823   PetscFunctionReturn(0);
2824 }
2825 
2826 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
2827 {
2828   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2829   PetscErrorCode ierr;
2830 
2831   PetscFunctionBegin;
2832   /* TODO: add error checking
2833     - avoid nested pop (or push) calls.
2834     - cannot push before pop.
2835     - cannot call this if pcbddc->local_mat is NULL
2836   */
2837   if (!pcbddc->benign_n) {
2838     PetscFunctionReturn(0);
2839   }
2840   if (pop) {
2841     if (pcbddc->benign_change_explicit) {
2842       IS       is_p0;
2843       MatReuse reuse;
2844 
2845       /* extract B_0 */
2846       reuse = MAT_INITIAL_MATRIX;
2847       if (pcbddc->benign_B0) {
2848         reuse = MAT_REUSE_MATRIX;
2849       }
2850       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
2851       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
2852       /* remove rows and cols from local problem */
2853       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
2854       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
2855       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
2856       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
2857     } else {
2858       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
2859       PetscScalar *vals;
2860       PetscInt    i,n,*idxs_ins;
2861 
2862       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
2863       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
2864       if (!pcbddc->benign_B0) {
2865         PetscInt *nnz;
2866         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
2867         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
2868         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2869         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
2870         for (i=0;i<pcbddc->benign_n;i++) {
2871           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
2872           nnz[i] = n - nnz[i];
2873         }
2874         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
2875         ierr = PetscFree(nnz);CHKERRQ(ierr);
2876       }
2877 
2878       for (i=0;i<pcbddc->benign_n;i++) {
2879         PetscScalar *array;
2880         PetscInt    *idxs,j,nz,cum;
2881 
2882         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
2883         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
2884         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2885         for (j=0;j<nz;j++) vals[j] = 1.;
2886         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2887         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
2888         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
2889         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
2890         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2891         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2892         cum = 0;
2893         for (j=0;j<n;j++) {
2894           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
2895             vals[cum] = array[j];
2896             idxs_ins[cum] = j;
2897             cum++;
2898           }
2899         }
2900         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
2901         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2902         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2903       }
2904       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2905       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2906       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
2907     }
2908   } else { /* push */
2909     if (pcbddc->benign_change_explicit) {
2910       PetscInt i;
2911 
2912       for (i=0;i<pcbddc->benign_n;i++) {
2913         PetscScalar *B0_vals;
2914         PetscInt    *B0_cols,B0_ncol;
2915 
2916         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2917         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2918         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2919         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
2920         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2921       }
2922       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2923       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2924     } else {
2925       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!\n");
2926     }
2927   }
2928   PetscFunctionReturn(0);
2929 }
2930 
2931 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
2932 {
2933   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
2934   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
2935   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
2936   PetscBLASInt    *B_iwork,*B_ifail;
2937   PetscScalar     *work,lwork;
2938   PetscScalar     *St,*S,*eigv;
2939   PetscScalar     *Sarray,*Starray;
2940   PetscReal       *eigs,thresh;
2941   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
2942   PetscBool       allocated_S_St;
2943 #if defined(PETSC_USE_COMPLEX)
2944   PetscReal       *rwork;
2945 #endif
2946   PetscErrorCode  ierr;
2947 
2948   PetscFunctionBegin;
2949   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
2950   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
2951   if (sub_schurs->n_subs && (!sub_schurs->is_hermitian || !sub_schurs->is_posdef)) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Adaptive selection not yet implemented for general matrix pencils (herm %d, posdef %d)\nRerun with -sub_schurs_hermitian 1 -sub_schurs_posdef 1 if the problem is SPD",sub_schurs->is_hermitian,sub_schurs->is_posdef);
2952 
2953   if (pcbddc->dbg_flag) {
2954     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2955     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
2956     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
2957     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
2958   }
2959 
2960   if (pcbddc->dbg_flag) {
2961     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %d (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);
2962   }
2963 
2964   /* max size of subsets */
2965   mss = 0;
2966   for (i=0;i<sub_schurs->n_subs;i++) {
2967     PetscInt subset_size;
2968 
2969     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2970     mss = PetscMax(mss,subset_size);
2971   }
2972 
2973   /* min/max and threshold */
2974   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
2975   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
2976   nmax = PetscMax(nmin,nmax);
2977   allocated_S_St = PETSC_FALSE;
2978   if (nmin) {
2979     allocated_S_St = PETSC_TRUE;
2980   }
2981 
2982   /* allocate lapack workspace */
2983   cum = cum2 = 0;
2984   maxneigs = 0;
2985   for (i=0;i<sub_schurs->n_subs;i++) {
2986     PetscInt n,subset_size;
2987 
2988     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2989     n = PetscMin(subset_size,nmax);
2990     cum += subset_size;
2991     cum2 += subset_size*n;
2992     maxneigs = PetscMax(maxneigs,n);
2993   }
2994   if (mss) {
2995     if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
2996       PetscBLASInt B_itype = 1;
2997       PetscBLASInt B_N = mss;
2998       PetscReal    zero = 0.0;
2999       PetscReal    eps = 0.0; /* dlamch? */
3000 
3001       B_lwork = -1;
3002       S = NULL;
3003       St = NULL;
3004       eigs = NULL;
3005       eigv = NULL;
3006       B_iwork = NULL;
3007       B_ifail = NULL;
3008 #if defined(PETSC_USE_COMPLEX)
3009       rwork = NULL;
3010 #endif
3011       thresh = 1.0;
3012       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3013 #if defined(PETSC_USE_COMPLEX)
3014       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));
3015 #else
3016       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));
3017 #endif
3018       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3019       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3020     } else {
3021         /* TODO */
3022     }
3023   } else {
3024     lwork = 0;
3025   }
3026 
3027   nv = 0;
3028   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) */
3029     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
3030   }
3031   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
3032   if (allocated_S_St) {
3033     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
3034   }
3035   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
3036 #if defined(PETSC_USE_COMPLEX)
3037   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
3038 #endif
3039   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3040                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3041                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3042                       nv+cum,&pcbddc->adaptive_constraints_idxs,
3043                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
3044   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
3045 
3046   maxneigs = 0;
3047   cum = cumarray = 0;
3048   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3049   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3050   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3051     const PetscInt *idxs;
3052 
3053     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3054     for (cum=0;cum<nv;cum++) {
3055       pcbddc->adaptive_constraints_n[cum] = 1;
3056       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3057       pcbddc->adaptive_constraints_data[cum] = 1.0;
3058       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3059       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3060     }
3061     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3062   }
3063 
3064   if (mss) { /* multilevel */
3065     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3066     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3067   }
3068 
3069   thresh = pcbddc->adaptive_threshold;
3070   for (i=0;i<sub_schurs->n_subs;i++) {
3071     const PetscInt *idxs;
3072     PetscReal      upper,lower;
3073     PetscInt       j,subset_size,eigs_start = 0;
3074     PetscBLASInt   B_N;
3075     PetscBool      same_data = PETSC_FALSE;
3076 
3077     if (pcbddc->use_deluxe_scaling) {
3078       upper = PETSC_MAX_REAL;
3079       lower = thresh;
3080     } else {
3081       upper = 1./thresh;
3082       lower = 0.;
3083     }
3084     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3085     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3086     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
3087     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3088       if (sub_schurs->is_hermitian) {
3089         PetscInt j,k;
3090         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */
3091           ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3092           ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3093         }
3094         for (j=0;j<subset_size;j++) {
3095           for (k=j;k<subset_size;k++) {
3096             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3097             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3098           }
3099         }
3100       } else {
3101         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3102         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3103       }
3104     } else {
3105       S = Sarray + cumarray;
3106       St = Starray + cumarray;
3107     }
3108     /* see if we can save some work */
3109     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3110       ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr);
3111     }
3112 
3113     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3114       B_neigs = 0;
3115     } else {
3116       if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
3117         PetscBLASInt B_itype = 1;
3118         PetscBLASInt B_IL, B_IU;
3119         PetscReal    eps = -1.0; /* dlamch? */
3120         PetscInt     nmin_s;
3121         PetscBool    compute_range = PETSC_FALSE;
3122 
3123         if (pcbddc->dbg_flag) {
3124           PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Computing for sub %d/%d size %d count %d fid %d.\n",i,sub_schurs->n_subs,subset_size,pcbddc->mat_graph->count[idxs[0]]+1,pcbddc->mat_graph->which_dof[idxs[0]]);
3125         }
3126 
3127         compute_range = PETSC_FALSE;
3128         if (thresh > 1.+PETSC_SMALL && !same_data) {
3129           compute_range = PETSC_TRUE;
3130         }
3131 
3132         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3133         if (compute_range) {
3134 
3135           /* ask for eigenvalues larger than thresh */
3136 #if defined(PETSC_USE_COMPLEX)
3137           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));
3138 #else
3139           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));
3140 #endif
3141         } else if (!same_data) {
3142           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3143           B_IL = 1;
3144 #if defined(PETSC_USE_COMPLEX)
3145           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));
3146 #else
3147           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));
3148 #endif
3149         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3150           PetscInt k;
3151           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3152           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3153           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3154           nmin = nmax;
3155           ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr);
3156           for (k=0;k<nmax;k++) {
3157             eigs[k] = 1./PETSC_SMALL;
3158             eigv[k*(subset_size+1)] = 1.0;
3159           }
3160         }
3161         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3162         if (B_ierr) {
3163           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3164           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);
3165           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);
3166         }
3167 
3168         if (B_neigs > nmax) {
3169           if (pcbddc->dbg_flag) {
3170             PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %d.\n",B_neigs,nmax);
3171           }
3172           if (pcbddc->use_deluxe_scaling) eigs_start = B_neigs -nmax;
3173           B_neigs = nmax;
3174         }
3175 
3176         nmin_s = PetscMin(nmin,B_N);
3177         if (B_neigs < nmin_s) {
3178           PetscBLASInt B_neigs2;
3179 
3180           if (pcbddc->use_deluxe_scaling) {
3181             B_IL = B_N - nmin_s + 1;
3182             B_IU = B_N - B_neigs;
3183           } else {
3184             B_IL = B_neigs + 1;
3185             B_IU = nmin_s;
3186           }
3187           if (pcbddc->dbg_flag) {
3188             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);
3189           }
3190           if (sub_schurs->is_hermitian) {
3191             PetscInt j,k;
3192             for (j=0;j<subset_size;j++) {
3193               for (k=j;k<subset_size;k++) {
3194                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3195                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3196               }
3197             }
3198           } else {
3199             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3200             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3201           }
3202           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3203 #if defined(PETSC_USE_COMPLEX)
3204           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));
3205 #else
3206           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));
3207 #endif
3208           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3209           B_neigs += B_neigs2;
3210         }
3211         if (B_ierr) {
3212           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3213           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);
3214           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);
3215         }
3216         if (pcbddc->dbg_flag) {
3217           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3218           for (j=0;j<B_neigs;j++) {
3219             if (eigs[j] == 0.0) {
3220               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3221             } else {
3222               if (pcbddc->use_deluxe_scaling) {
3223                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3224               } else {
3225                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3226               }
3227             }
3228           }
3229         }
3230       } else {
3231           /* TODO */
3232       }
3233     }
3234     /* change the basis back to the original one */
3235     if (sub_schurs->change) {
3236       Mat change,phi,phit;
3237 
3238       if (pcbddc->dbg_flag > 1) {
3239         PetscInt ii;
3240         for (ii=0;ii<B_neigs;ii++) {
3241           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3242           for (j=0;j<B_N;j++) {
3243 #if defined(PETSC_USE_COMPLEX)
3244             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3245             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3246             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3247 #else
3248             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3249 #endif
3250           }
3251         }
3252       }
3253       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3254       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3255       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3256       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3257       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3258       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3259     }
3260     maxneigs = PetscMax(B_neigs,maxneigs);
3261     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3262     if (B_neigs) {
3263       ierr = PetscMemcpy(pcbddc->adaptive_constraints_data+pcbddc->adaptive_constraints_data_ptr[cum],eigv+eigs_start*subset_size,B_neigs*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3264 
3265       if (pcbddc->dbg_flag > 1) {
3266         PetscInt ii;
3267         for (ii=0;ii<B_neigs;ii++) {
3268           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3269           for (j=0;j<B_N;j++) {
3270 #if defined(PETSC_USE_COMPLEX)
3271             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3272             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3273             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3274 #else
3275             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3276 #endif
3277           }
3278         }
3279       }
3280       ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
3281       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3282       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3283       cum++;
3284     }
3285     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3286     /* shift for next computation */
3287     cumarray += subset_size*subset_size;
3288   }
3289   if (pcbddc->dbg_flag) {
3290     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3291   }
3292 
3293   if (mss) {
3294     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3295     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3296     /* destroy matrices (junk) */
3297     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3298     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3299   }
3300   if (allocated_S_St) {
3301     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3302   }
3303   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3304 #if defined(PETSC_USE_COMPLEX)
3305   ierr = PetscFree(rwork);CHKERRQ(ierr);
3306 #endif
3307   if (pcbddc->dbg_flag) {
3308     PetscInt maxneigs_r;
3309     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3310     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %d\n",maxneigs_r);CHKERRQ(ierr);
3311   }
3312   PetscFunctionReturn(0);
3313 }
3314 
3315 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3316 {
3317   PetscScalar    *coarse_submat_vals;
3318   PetscErrorCode ierr;
3319 
3320   PetscFunctionBegin;
3321   /* Setup local scatters R_to_B and (optionally) R_to_D */
3322   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3323   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3324 
3325   /* Setup local neumann solver ksp_R */
3326   /* PCBDDCSetUpLocalScatters should be called first! */
3327   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3328 
3329   /*
3330      Setup local correction and local part of coarse basis.
3331      Gives back the dense local part of the coarse matrix in column major ordering
3332   */
3333   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3334 
3335   /* Compute total number of coarse nodes and setup coarse solver */
3336   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3337 
3338   /* free */
3339   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3340   PetscFunctionReturn(0);
3341 }
3342 
3343 PetscErrorCode PCBDDCResetCustomization(PC pc)
3344 {
3345   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3346   PetscErrorCode ierr;
3347 
3348   PetscFunctionBegin;
3349   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3350   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3351   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3352   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3353   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3354   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3355   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3356   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3357   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3358   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3359   PetscFunctionReturn(0);
3360 }
3361 
3362 PetscErrorCode PCBDDCResetTopography(PC pc)
3363 {
3364   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3365   PetscInt       i;
3366   PetscErrorCode ierr;
3367 
3368   PetscFunctionBegin;
3369   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3370   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3371   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3372   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3373   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3374   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3375   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3376   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3377   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3378   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3379   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3380   for (i=0;i<pcbddc->n_local_subs;i++) {
3381     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3382   }
3383   pcbddc->n_local_subs = 0;
3384   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3385   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3386   pcbddc->graphanalyzed        = PETSC_FALSE;
3387   pcbddc->recompute_topography = PETSC_TRUE;
3388   PetscFunctionReturn(0);
3389 }
3390 
3391 PetscErrorCode PCBDDCResetSolvers(PC pc)
3392 {
3393   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3394   PetscErrorCode ierr;
3395 
3396   PetscFunctionBegin;
3397   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3398   if (pcbddc->coarse_phi_B) {
3399     PetscScalar *array;
3400     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3401     ierr = PetscFree(array);CHKERRQ(ierr);
3402   }
3403   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3404   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3405   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3406   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3407   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3408   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3409   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3410   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3411   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3412   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3413   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3414   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3415   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3416   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3417   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3418   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3419   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3420   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3421   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3422   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3423   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3424   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3425   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3426   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3427   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3428   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3429   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3430   if (pcbddc->benign_zerodiag_subs) {
3431     PetscInt i;
3432     for (i=0;i<pcbddc->benign_n;i++) {
3433       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3434     }
3435     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3436   }
3437   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3438   PetscFunctionReturn(0);
3439 }
3440 
3441 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3442 {
3443   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3444   PC_IS          *pcis = (PC_IS*)pc->data;
3445   VecType        impVecType;
3446   PetscInt       n_constraints,n_R,old_size;
3447   PetscErrorCode ierr;
3448 
3449   PetscFunctionBegin;
3450   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3451   n_R = pcis->n - pcbddc->n_vertices;
3452   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3453   /* local work vectors (try to avoid unneeded work)*/
3454   /* R nodes */
3455   old_size = -1;
3456   if (pcbddc->vec1_R) {
3457     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3458   }
3459   if (n_R != old_size) {
3460     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3461     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3462     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3463     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3464     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3465     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3466   }
3467   /* local primal dofs */
3468   old_size = -1;
3469   if (pcbddc->vec1_P) {
3470     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3471   }
3472   if (pcbddc->local_primal_size != old_size) {
3473     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3474     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3475     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3476     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3477   }
3478   /* local explicit constraints */
3479   old_size = -1;
3480   if (pcbddc->vec1_C) {
3481     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3482   }
3483   if (n_constraints && n_constraints != old_size) {
3484     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3485     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3486     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3487     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3488   }
3489   PetscFunctionReturn(0);
3490 }
3491 
3492 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3493 {
3494   PetscErrorCode  ierr;
3495   /* pointers to pcis and pcbddc */
3496   PC_IS*          pcis = (PC_IS*)pc->data;
3497   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3498   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3499   /* submatrices of local problem */
3500   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3501   /* submatrices of local coarse problem */
3502   Mat             S_VV,S_CV,S_VC,S_CC;
3503   /* working matrices */
3504   Mat             C_CR;
3505   /* additional working stuff */
3506   PC              pc_R;
3507   Mat             F,Brhs = NULL;
3508   Vec             dummy_vec;
3509   PetscBool       isLU,isCHOL,isILU,need_benign_correction,sparserhs;
3510   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3511   PetscScalar     *work;
3512   PetscInt        *idx_V_B;
3513   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3514   PetscInt        i,n_R,n_D,n_B;
3515 
3516   /* some shortcuts to scalars */
3517   PetscScalar     one=1.0,m_one=-1.0;
3518 
3519   PetscFunctionBegin;
3520   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");
3521 
3522   /* Set Non-overlapping dimensions */
3523   n_vertices = pcbddc->n_vertices;
3524   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3525   n_B = pcis->n_B;
3526   n_D = pcis->n - n_B;
3527   n_R = pcis->n - n_vertices;
3528 
3529   /* vertices in boundary numbering */
3530   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3531   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3532   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",n_vertices,i);
3533 
3534   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3535   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3536   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3537   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3538   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3539   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3540   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3541   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3542   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3543   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3544 
3545   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3546   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3547   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3548   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3549   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3550   lda_rhs = n_R;
3551   need_benign_correction = PETSC_FALSE;
3552   if (isLU || isILU || isCHOL) {
3553     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3554   } else if (sub_schurs && sub_schurs->reuse_solver) {
3555     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3556     MatFactorType      type;
3557 
3558     F = reuse_solver->F;
3559     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3560     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3561     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3562     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3563   } else {
3564     F = NULL;
3565   }
3566 
3567   /* determine if we can use a sparse right-hand side */
3568   sparserhs = PETSC_FALSE;
3569   if (F) {
3570     const MatSolverPackage solver;
3571 
3572     ierr = MatFactorGetSolverPackage(F,&solver);CHKERRQ(ierr);
3573     ierr = PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs);CHKERRQ(ierr);
3574   }
3575 
3576   /* allocate workspace */
3577   n = 0;
3578   if (n_constraints) {
3579     n += lda_rhs*n_constraints;
3580   }
3581   if (n_vertices) {
3582     n = PetscMax(2*lda_rhs*n_vertices,n);
3583     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3584   }
3585   if (!pcbddc->symmetric_primal) {
3586     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3587   }
3588   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3589 
3590   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3591   dummy_vec = NULL;
3592   if (need_benign_correction && lda_rhs != n_R && F) {
3593     ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,lda_rhs,work,&dummy_vec);CHKERRQ(ierr);
3594   }
3595 
3596   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3597   if (n_constraints) {
3598     Mat         M1,M2,M3,C_B;
3599     IS          is_aux;
3600     PetscScalar *array,*array2;
3601 
3602     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3603     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3604 
3605     /* Extract constraints on R nodes: C_{CR}  */
3606     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
3607     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
3608     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
3609 
3610     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
3611     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
3612     if (!sparserhs) {
3613       ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
3614       for (i=0;i<n_constraints;i++) {
3615         const PetscScalar *row_cmat_values;
3616         const PetscInt    *row_cmat_indices;
3617         PetscInt          size_of_constraint,j;
3618 
3619         ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3620         for (j=0;j<size_of_constraint;j++) {
3621           work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
3622         }
3623         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3624       }
3625       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs);CHKERRQ(ierr);
3626     } else {
3627       Mat tC_CR;
3628 
3629       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
3630       if (lda_rhs != n_R) {
3631         PetscScalar *aa;
3632         PetscInt    r,*ii,*jj;
3633         PetscBool   done;
3634 
3635         ierr = MatGetRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3636         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");CHKERRQ(ierr);
3637         ierr = MatSeqAIJGetArray(C_CR,&aa);CHKERRQ(ierr);
3638         ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR);CHKERRQ(ierr);
3639         ierr = MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3640         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");CHKERRQ(ierr);
3641       } else {
3642         ierr  = PetscObjectReference((PetscObject)C_CR);CHKERRQ(ierr);
3643         tC_CR = C_CR;
3644       }
3645       ierr = MatCreateTranspose(tC_CR,&Brhs);CHKERRQ(ierr);
3646       ierr = MatDestroy(&tC_CR);CHKERRQ(ierr);
3647     }
3648     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
3649     if (F) {
3650       if (need_benign_correction) {
3651         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3652 
3653         /* rhs is already zero on interior dofs, no need to change the rhs */
3654         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
3655       }
3656       ierr = MatMatSolve(F,Brhs,local_auxmat2_R);CHKERRQ(ierr);
3657       if (need_benign_correction) {
3658         PetscScalar        *marr;
3659         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3660 
3661         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3662         if (lda_rhs != n_R) {
3663           for (i=0;i<n_constraints;i++) {
3664             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3665             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3666             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3667           }
3668         } else {
3669           for (i=0;i<n_constraints;i++) {
3670             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3671             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3672             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3673           }
3674         }
3675         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3676       }
3677     } else {
3678       PetscScalar *marr;
3679 
3680       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3681       for (i=0;i<n_constraints;i++) {
3682         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3683         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
3684         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3685         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3686         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3687       }
3688       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3689     }
3690     if (sparserhs) {
3691       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
3692     }
3693     ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
3694     if (!pcbddc->switch_static) {
3695       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3696       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3697       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3698       for (i=0;i<n_constraints;i++) {
3699         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
3700         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
3701         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3702         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3703         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3704         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3705       }
3706       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3707       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3708       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3709     } else {
3710       if (lda_rhs != n_R) {
3711         IS dummy;
3712 
3713         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
3714         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3715         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
3716       } else {
3717         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
3718         pcbddc->local_auxmat2 = local_auxmat2_R;
3719       }
3720       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3721     }
3722     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3723     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
3724     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
3725     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M1);CHKERRQ(ierr);
3726     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
3727     if (isCHOL) {
3728       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
3729     } else {
3730       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
3731     }
3732     ierr = VecSet(pcbddc->vec1_C,one);CHKERRQ(ierr);
3733     ierr = MatDiagonalSet(M2,pcbddc->vec1_C,INSERT_VALUES);CHKERRQ(ierr);
3734     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
3735     ierr = MatDestroy(&M2);CHKERRQ(ierr);
3736     ierr = MatDestroy(&M3);CHKERRQ(ierr);
3737     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
3738     ierr = MatMatMult(M1,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
3739     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
3740     ierr = MatCopy(M1,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
3741     ierr = MatDestroy(&M1);CHKERRQ(ierr);
3742   }
3743 
3744   /* Get submatrices from subdomain matrix */
3745   if (n_vertices) {
3746     IS        is_aux;
3747     PetscBool isseqaij;
3748 
3749     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
3750       IS tis;
3751 
3752       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
3753       ierr = ISSort(tis);CHKERRQ(ierr);
3754       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
3755       ierr = ISDestroy(&tis);CHKERRQ(ierr);
3756     } else {
3757       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
3758     }
3759     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3760     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3761     ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
3762     if (!isseqaij) { /* MatMatMult(A_VR,A_RRmA_RV) below will raise an error */
3763       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
3764     }
3765     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3766     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3767   }
3768 
3769   /* Matrix of coarse basis functions (local) */
3770   if (pcbddc->coarse_phi_B) {
3771     PetscInt on_B,on_primal,on_D=n_D;
3772     if (pcbddc->coarse_phi_D) {
3773       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
3774     }
3775     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
3776     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
3777       PetscScalar *marray;
3778 
3779       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
3780       ierr = PetscFree(marray);CHKERRQ(ierr);
3781       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3782       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3783       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3784       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3785     }
3786   }
3787 
3788   if (!pcbddc->coarse_phi_B) {
3789     PetscScalar *marr;
3790 
3791     /* memory size */
3792     n = n_B*pcbddc->local_primal_size;
3793     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
3794     if (!pcbddc->symmetric_primal) n *= 2;
3795     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
3796     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3797     marr += n_B*pcbddc->local_primal_size;
3798     if (pcbddc->switch_static || pcbddc->dbg_flag) {
3799       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3800       marr += n_D*pcbddc->local_primal_size;
3801     }
3802     if (!pcbddc->symmetric_primal) {
3803       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3804       marr += n_B*pcbddc->local_primal_size;
3805       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3806         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3807       }
3808     } else {
3809       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
3810       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
3811       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3812         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
3813         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
3814       }
3815     }
3816   }
3817 
3818   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
3819   p0_lidx_I = NULL;
3820   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
3821     const PetscInt *idxs;
3822 
3823     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3824     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
3825     for (i=0;i<pcbddc->benign_n;i++) {
3826       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
3827     }
3828     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3829   }
3830 
3831   /* vertices */
3832   if (n_vertices) {
3833     PetscBool restoreavr = PETSC_FALSE;
3834 
3835     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
3836 
3837     if (n_R) {
3838       Mat          A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
3839       PetscBLASInt B_N,B_one = 1;
3840       PetscScalar  *x,*y;
3841 
3842       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
3843       if (need_benign_correction) {
3844         ISLocalToGlobalMapping RtoN;
3845         IS                     is_p0;
3846         PetscInt               *idxs_p0,n;
3847 
3848         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
3849         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
3850         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
3851         if (n != pcbddc->benign_n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in R numbering for benign p0! %d != %d\n",n,pcbddc->benign_n);
3852         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
3853         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
3854         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
3855         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3856       }
3857 
3858       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3859       if (!sparserhs || need_benign_correction) {
3860         if (lda_rhs == n_R) {
3861           ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3862         } else {
3863           PetscScalar    *av,*array;
3864           const PetscInt *xadj,*adjncy;
3865           PetscInt       n;
3866           PetscBool      flg_row;
3867 
3868           array = work+lda_rhs*n_vertices;
3869           ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3870           ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3871           ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3872           ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
3873           for (i=0;i<n;i++) {
3874             PetscInt j;
3875             for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
3876           }
3877           ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3878           ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3879           ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
3880         }
3881         if (need_benign_correction) {
3882           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3883           PetscScalar        *marr;
3884 
3885           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
3886           /* need \Phi^T A_RV = (I+L)A_RV, L given by
3887 
3888                  | 0 0  0 | (V)
3889              L = | 0 0 -1 | (P-p0)
3890                  | 0 0 -1 | (p0)
3891 
3892           */
3893           for (i=0;i<reuse_solver->benign_n;i++) {
3894             const PetscScalar *vals;
3895             const PetscInt    *idxs,*idxs_zero;
3896             PetscInt          n,j,nz;
3897 
3898             ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3899             ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3900             ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3901             for (j=0;j<n;j++) {
3902               PetscScalar val = vals[j];
3903               PetscInt    k,col = idxs[j];
3904               for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
3905             }
3906             ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3907             ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3908           }
3909           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
3910         }
3911         ierr = PetscObjectReference((PetscObject)A_RV);CHKERRQ(ierr);
3912         Brhs = A_RV;
3913       } else {
3914         Mat tA_RVT,A_RVT;
3915 
3916         if (!pcbddc->symmetric_primal) {
3917           ierr = MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT);CHKERRQ(ierr);
3918         } else {
3919           restoreavr = PETSC_TRUE;
3920           ierr  = MatScale(A_VR,-1.0);CHKERRQ(ierr);
3921           ierr  = PetscObjectReference((PetscObject)A_VR);CHKERRQ(ierr);
3922           A_RVT = A_VR;
3923         }
3924         if (lda_rhs != n_R) {
3925           PetscScalar *aa;
3926           PetscInt    r,*ii,*jj;
3927           PetscBool   done;
3928 
3929           ierr = MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3930           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");CHKERRQ(ierr);
3931           ierr = MatSeqAIJGetArray(A_RVT,&aa);CHKERRQ(ierr);
3932           ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT);CHKERRQ(ierr);
3933           ierr = MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3934           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");CHKERRQ(ierr);
3935         } else {
3936           ierr   = PetscObjectReference((PetscObject)A_RVT);CHKERRQ(ierr);
3937           tA_RVT = A_RVT;
3938         }
3939         ierr = MatCreateTranspose(tA_RVT,&Brhs);CHKERRQ(ierr);
3940         ierr = MatDestroy(&tA_RVT);CHKERRQ(ierr);
3941         ierr = MatDestroy(&A_RVT);CHKERRQ(ierr);
3942       }
3943       if (F) {
3944         /* need to correct the rhs */
3945         if (need_benign_correction) {
3946           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3947           PetscScalar        *marr;
3948 
3949           ierr = MatDenseGetArray(Brhs,&marr);CHKERRQ(ierr);
3950           if (lda_rhs != n_R) {
3951             for (i=0;i<n_vertices;i++) {
3952               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3953               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3954               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3955             }
3956           } else {
3957             for (i=0;i<n_vertices;i++) {
3958               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3959               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3960               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3961             }
3962           }
3963           ierr = MatDenseRestoreArray(Brhs,&marr);CHKERRQ(ierr);
3964         }
3965         ierr = MatMatSolve(F,Brhs,A_RRmA_RV);CHKERRQ(ierr);
3966         if (restoreavr) {
3967           ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr);
3968         }
3969         /* need to correct the solution */
3970         if (need_benign_correction) {
3971           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3972           PetscScalar        *marr;
3973 
3974           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3975           if (lda_rhs != n_R) {
3976             for (i=0;i<n_vertices;i++) {
3977               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3978               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3979               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3980             }
3981           } else {
3982             for (i=0;i<n_vertices;i++) {
3983               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3984               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3985               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3986             }
3987           }
3988           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3989         }
3990       } else {
3991         ierr = MatDenseGetArray(Brhs,&y);CHKERRQ(ierr);
3992         for (i=0;i<n_vertices;i++) {
3993           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
3994           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
3995           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3996           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3997           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3998         }
3999         ierr = MatDenseRestoreArray(Brhs,&y);CHKERRQ(ierr);
4000       }
4001       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4002       ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4003       /* S_VV and S_CV */
4004       if (n_constraints) {
4005         Mat B;
4006 
4007         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
4008         for (i=0;i<n_vertices;i++) {
4009           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4010           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
4011           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4012           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4013           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4014           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4015         }
4016         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4017         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
4018         ierr = MatDestroy(&B);CHKERRQ(ierr);
4019         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4020         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4021         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
4022         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
4023         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
4024         ierr = MatDestroy(&B);CHKERRQ(ierr);
4025       }
4026       if (lda_rhs != n_R) {
4027         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4028         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4029         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
4030       }
4031       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
4032       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
4033       if (need_benign_correction) {
4034         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4035         PetscScalar      *marr,*sums;
4036 
4037         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
4038         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
4039         for (i=0;i<reuse_solver->benign_n;i++) {
4040           const PetscScalar *vals;
4041           const PetscInt    *idxs,*idxs_zero;
4042           PetscInt          n,j,nz;
4043 
4044           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4045           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4046           for (j=0;j<n_vertices;j++) {
4047             PetscInt k;
4048             sums[j] = 0.;
4049             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
4050           }
4051           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4052           for (j=0;j<n;j++) {
4053             PetscScalar val = vals[j];
4054             PetscInt k;
4055             for (k=0;k<n_vertices;k++) {
4056               marr[idxs[j]+k*n_vertices] += val*sums[k];
4057             }
4058           }
4059           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4060           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4061         }
4062         ierr = PetscFree(sums);CHKERRQ(ierr);
4063         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
4064         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
4065       }
4066       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4067       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
4068       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
4069       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
4070       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4071       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
4072       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
4073       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4074       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
4075     } else {
4076       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4077     }
4078     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
4079 
4080     /* coarse basis functions */
4081     for (i=0;i<n_vertices;i++) {
4082       PetscScalar *y;
4083 
4084       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4085       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4086       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4087       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4088       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4089       y[n_B*i+idx_V_B[i]] = 1.0;
4090       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4091       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4092 
4093       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4094         PetscInt j;
4095 
4096         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4097         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4098         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4099         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4100         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4101         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4102         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4103       }
4104       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4105     }
4106     /* if n_R == 0 the object is not destroyed */
4107     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4108   }
4109   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4110 
4111   if (n_constraints) {
4112     Mat B;
4113 
4114     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4115     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4116     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4117     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4118     if (n_vertices) {
4119       if (isCHOL) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4120         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4121       } else {
4122         Mat S_VCt;
4123 
4124         if (lda_rhs != n_R) {
4125           ierr = MatDestroy(&B);CHKERRQ(ierr);
4126           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4127           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4128         }
4129         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4130         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4131         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4132       }
4133     }
4134     ierr = MatDestroy(&B);CHKERRQ(ierr);
4135     /* coarse basis functions */
4136     for (i=0;i<n_constraints;i++) {
4137       PetscScalar *y;
4138 
4139       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4140       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4141       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4142       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4143       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4144       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4145       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4146       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4147         PetscInt j;
4148 
4149         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4150         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4151         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4152         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4153         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4154         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4155         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4156       }
4157       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4158     }
4159   }
4160   if (n_constraints) {
4161     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4162   }
4163   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4164 
4165   /* coarse matrix entries relative to B_0 */
4166   if (pcbddc->benign_n) {
4167     Mat         B0_B,B0_BPHI;
4168     IS          is_dummy;
4169     PetscScalar *data;
4170     PetscInt    j;
4171 
4172     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4173     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4174     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4175     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4176     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4177     ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr);
4178     for (j=0;j<pcbddc->benign_n;j++) {
4179       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4180       for (i=0;i<pcbddc->local_primal_size;i++) {
4181         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4182         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4183       }
4184     }
4185     ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr);
4186     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4187     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4188   }
4189 
4190   /* compute other basis functions for non-symmetric problems */
4191   if (!pcbddc->symmetric_primal) {
4192     Mat         B_V=NULL,B_C=NULL;
4193     PetscScalar *marray;
4194 
4195     if (n_constraints) {
4196       Mat S_CCT,C_CRT;
4197 
4198       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4199       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4200       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4201       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4202       if (n_vertices) {
4203         Mat S_VCT;
4204 
4205         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4206         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4207         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4208       }
4209       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4210     } else {
4211       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4212     }
4213     if (n_vertices && n_R) {
4214       PetscScalar    *av,*marray;
4215       const PetscInt *xadj,*adjncy;
4216       PetscInt       n;
4217       PetscBool      flg_row;
4218 
4219       /* B_V = B_V - A_VR^T */
4220       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4221       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4222       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4223       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4224       for (i=0;i<n;i++) {
4225         PetscInt j;
4226         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4227       }
4228       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4229       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4230       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4231     }
4232 
4233     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4234     if (n_vertices) {
4235       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4236       for (i=0;i<n_vertices;i++) {
4237         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4238         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4239         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4240         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4241         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4242       }
4243       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4244     }
4245     if (B_C) {
4246       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4247       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4248         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4249         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4250         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4251         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4252         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4253       }
4254       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4255     }
4256     /* coarse basis functions */
4257     for (i=0;i<pcbddc->local_primal_size;i++) {
4258       PetscScalar *y;
4259 
4260       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4261       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4262       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4263       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4264       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4265       if (i<n_vertices) {
4266         y[n_B*i+idx_V_B[i]] = 1.0;
4267       }
4268       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4269       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4270 
4271       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4272         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4273         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4274         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4275         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4276         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4277         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4278       }
4279       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4280     }
4281     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4282     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4283   }
4284 
4285   /* free memory */
4286   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4287   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4288   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4289   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4290   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4291   ierr = PetscFree(work);CHKERRQ(ierr);
4292   if (n_vertices) {
4293     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4294   }
4295   if (n_constraints) {
4296     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4297   }
4298   /* Checking coarse_sub_mat and coarse basis functios */
4299   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4300   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4301   if (pcbddc->dbg_flag) {
4302     Mat         coarse_sub_mat;
4303     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4304     Mat         coarse_phi_D,coarse_phi_B;
4305     Mat         coarse_psi_D,coarse_psi_B;
4306     Mat         A_II,A_BB,A_IB,A_BI;
4307     Mat         C_B,CPHI;
4308     IS          is_dummy;
4309     Vec         mones;
4310     MatType     checkmattype=MATSEQAIJ;
4311     PetscReal   real_value;
4312 
4313     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4314       Mat A;
4315       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4316       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4317       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4318       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4319       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4320       ierr = MatDestroy(&A);CHKERRQ(ierr);
4321     } else {
4322       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4323       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4324       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4325       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4326     }
4327     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4328     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4329     if (!pcbddc->symmetric_primal) {
4330       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4331       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4332     }
4333     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4334 
4335     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4336     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4337     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4338     if (!pcbddc->symmetric_primal) {
4339       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4340       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4341       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4342       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4343       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4344       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4345       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4346       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4347       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4348       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4349       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4350       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4351     } else {
4352       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4353       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4354       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4355       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4356       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4357       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4358       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4359       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4360     }
4361     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4362     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4363     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4364     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4365     if (pcbddc->benign_n) {
4366       Mat         B0_B,B0_BPHI;
4367       PetscScalar *data,*data2;
4368       PetscInt    j;
4369 
4370       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4371       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4372       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4373       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4374       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4375       ierr = MatDenseGetArray(B0_BPHI,&data2);CHKERRQ(ierr);
4376       for (j=0;j<pcbddc->benign_n;j++) {
4377         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4378         for (i=0;i<pcbddc->local_primal_size;i++) {
4379           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4380           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4381         }
4382       }
4383       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4384       ierr = MatDenseRestoreArray(B0_BPHI,&data2);CHKERRQ(ierr);
4385       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4386       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4387       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4388     }
4389 #if 0
4390   {
4391     PetscViewer viewer;
4392     char filename[256];
4393     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4394     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4395     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4396     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4397     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4398     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4399     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4400     if (save_change) {
4401       Mat phi_B;
4402       ierr = MatMatMult(save_change,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&phi_B);CHKERRQ(ierr);
4403       ierr = PetscObjectSetName((PetscObject)phi_B,"phi_B");CHKERRQ(ierr);
4404       ierr = MatView(phi_B,viewer);CHKERRQ(ierr);
4405       ierr = MatDestroy(&phi_B);CHKERRQ(ierr);
4406     } else {
4407       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4408       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4409     }
4410     if (pcbddc->coarse_phi_D) {
4411       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4412       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4413     }
4414     if (pcbddc->coarse_psi_B) {
4415       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4416       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4417     }
4418     if (pcbddc->coarse_psi_D) {
4419       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4420       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4421     }
4422     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4423   }
4424 #endif
4425     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4426     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4427     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4428     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4429 
4430     /* check constraints */
4431     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4432     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4433     if (!pcbddc->benign_n) { /* TODO: add benign case */
4434       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4435     } else {
4436       PetscScalar *data;
4437       Mat         tmat;
4438       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4439       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4440       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4441       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4442       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4443     }
4444     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4445     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4446     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4447     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4448     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4449     if (!pcbddc->symmetric_primal) {
4450       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4451       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4452       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4453       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4454       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4455     }
4456     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4457     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4458     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4459     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4460     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4461     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4462     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4463     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4464     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4465     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4466     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4467     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4468     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4469     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4470     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4471     if (!pcbddc->symmetric_primal) {
4472       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4473       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4474     }
4475     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4476   }
4477   /* get back data */
4478   *coarse_submat_vals_n = coarse_submat_vals;
4479   PetscFunctionReturn(0);
4480 }
4481 
4482 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4483 {
4484   Mat            *work_mat;
4485   IS             isrow_s,iscol_s;
4486   PetscBool      rsorted,csorted;
4487   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4488   PetscErrorCode ierr;
4489 
4490   PetscFunctionBegin;
4491   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4492   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4493   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4494   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4495 
4496   if (!rsorted) {
4497     const PetscInt *idxs;
4498     PetscInt *idxs_sorted,i;
4499 
4500     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4501     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4502     for (i=0;i<rsize;i++) {
4503       idxs_perm_r[i] = i;
4504     }
4505     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4506     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4507     for (i=0;i<rsize;i++) {
4508       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4509     }
4510     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4511     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4512   } else {
4513     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4514     isrow_s = isrow;
4515   }
4516 
4517   if (!csorted) {
4518     if (isrow == iscol) {
4519       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4520       iscol_s = isrow_s;
4521     } else {
4522       const PetscInt *idxs;
4523       PetscInt       *idxs_sorted,i;
4524 
4525       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4526       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4527       for (i=0;i<csize;i++) {
4528         idxs_perm_c[i] = i;
4529       }
4530       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4531       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4532       for (i=0;i<csize;i++) {
4533         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4534       }
4535       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4536       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4537     }
4538   } else {
4539     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4540     iscol_s = iscol;
4541   }
4542 
4543   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4544 
4545   if (!rsorted || !csorted) {
4546     Mat      new_mat;
4547     IS       is_perm_r,is_perm_c;
4548 
4549     if (!rsorted) {
4550       PetscInt *idxs_r,i;
4551       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4552       for (i=0;i<rsize;i++) {
4553         idxs_r[idxs_perm_r[i]] = i;
4554       }
4555       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4556       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4557     } else {
4558       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4559     }
4560     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4561 
4562     if (!csorted) {
4563       if (isrow_s == iscol_s) {
4564         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4565         is_perm_c = is_perm_r;
4566       } else {
4567         PetscInt *idxs_c,i;
4568         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4569         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4570         for (i=0;i<csize;i++) {
4571           idxs_c[idxs_perm_c[i]] = i;
4572         }
4573         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4574         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4575       }
4576     } else {
4577       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4578     }
4579     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4580 
4581     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4582     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4583     work_mat[0] = new_mat;
4584     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4585     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4586   }
4587 
4588   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4589   *B = work_mat[0];
4590   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4591   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4592   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4593   PetscFunctionReturn(0);
4594 }
4595 
4596 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
4597 {
4598   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
4599   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4600   Mat            new_mat,lA;
4601   IS             is_local,is_global;
4602   PetscInt       local_size;
4603   PetscBool      isseqaij;
4604   PetscErrorCode ierr;
4605 
4606   PetscFunctionBegin;
4607   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4608   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
4609   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
4610   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
4611   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
4612   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
4613   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
4614 
4615   /* check */
4616   if (pcbddc->dbg_flag) {
4617     Vec       x,x_change;
4618     PetscReal error;
4619 
4620     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
4621     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
4622     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
4623     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4624     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4625     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
4626     if (!pcbddc->change_interior) {
4627       const PetscScalar *x,*y,*v;
4628       PetscReal         lerror = 0.;
4629       PetscInt          i;
4630 
4631       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
4632       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
4633       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
4634       for (i=0;i<local_size;i++)
4635         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
4636           lerror = PetscAbsScalar(x[i]-y[i]);
4637       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
4638       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
4639       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
4640       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4641       if (error > PETSC_SMALL) {
4642         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4643           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e\n",error);
4644         } else {
4645           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e\n",error);
4646         }
4647       }
4648     }
4649     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4650     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4651     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
4652     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
4653     if (error > PETSC_SMALL) {
4654       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4655         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
4656       } else {
4657         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e\n",error);
4658       }
4659     }
4660     ierr = VecDestroy(&x);CHKERRQ(ierr);
4661     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
4662   }
4663 
4664   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
4665   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
4666 
4667   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
4668   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4669   if (isseqaij) {
4670     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4671     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4672     if (lA) {
4673       Mat work;
4674       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4675       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4676       ierr = MatDestroy(&work);CHKERRQ(ierr);
4677     }
4678   } else {
4679     Mat work_mat;
4680 
4681     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4682     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4683     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4684     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
4685     if (lA) {
4686       Mat work;
4687       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4688       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4689       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4690       ierr = MatDestroy(&work);CHKERRQ(ierr);
4691     }
4692   }
4693   if (matis->A->symmetric_set) {
4694     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
4695 #if !defined(PETSC_USE_COMPLEX)
4696     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
4697 #endif
4698   }
4699   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
4700   PetscFunctionReturn(0);
4701 }
4702 
4703 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
4704 {
4705   PC_IS*          pcis = (PC_IS*)(pc->data);
4706   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
4707   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4708   PetscInt        *idx_R_local=NULL;
4709   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
4710   PetscInt        vbs,bs;
4711   PetscBT         bitmask=NULL;
4712   PetscErrorCode  ierr;
4713 
4714   PetscFunctionBegin;
4715   /*
4716     No need to setup local scatters if
4717       - primal space is unchanged
4718         AND
4719       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
4720         AND
4721       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
4722   */
4723   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
4724     PetscFunctionReturn(0);
4725   }
4726   /* destroy old objects */
4727   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
4728   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
4729   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
4730   /* Set Non-overlapping dimensions */
4731   n_B = pcis->n_B;
4732   n_D = pcis->n - n_B;
4733   n_vertices = pcbddc->n_vertices;
4734 
4735   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
4736 
4737   /* create auxiliary bitmask and allocate workspace */
4738   if (!sub_schurs || !sub_schurs->reuse_solver) {
4739     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
4740     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
4741     for (i=0;i<n_vertices;i++) {
4742       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
4743     }
4744 
4745     for (i=0, n_R=0; i<pcis->n; i++) {
4746       if (!PetscBTLookup(bitmask,i)) {
4747         idx_R_local[n_R++] = i;
4748       }
4749     }
4750   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
4751     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4752 
4753     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4754     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
4755   }
4756 
4757   /* Block code */
4758   vbs = 1;
4759   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
4760   if (bs>1 && !(n_vertices%bs)) {
4761     PetscBool is_blocked = PETSC_TRUE;
4762     PetscInt  *vary;
4763     if (!sub_schurs || !sub_schurs->reuse_solver) {
4764       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
4765       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
4766       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
4767       /* 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 */
4768       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
4769       for (i=0; i<pcis->n/bs; i++) {
4770         if (vary[i]!=0 && vary[i]!=bs) {
4771           is_blocked = PETSC_FALSE;
4772           break;
4773         }
4774       }
4775       ierr = PetscFree(vary);CHKERRQ(ierr);
4776     } else {
4777       /* Verify directly the R set */
4778       for (i=0; i<n_R/bs; i++) {
4779         PetscInt j,node=idx_R_local[bs*i];
4780         for (j=1; j<bs; j++) {
4781           if (node != idx_R_local[bs*i+j]-j) {
4782             is_blocked = PETSC_FALSE;
4783             break;
4784           }
4785         }
4786       }
4787     }
4788     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
4789       vbs = bs;
4790       for (i=0;i<n_R/vbs;i++) {
4791         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
4792       }
4793     }
4794   }
4795   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
4796   if (sub_schurs && sub_schurs->reuse_solver) {
4797     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4798 
4799     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4800     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
4801     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
4802     reuse_solver->is_R = pcbddc->is_R_local;
4803   } else {
4804     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
4805   }
4806 
4807   /* print some info if requested */
4808   if (pcbddc->dbg_flag) {
4809     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4810     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4811     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4812     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
4813     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
4814     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);
4815     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4816   }
4817 
4818   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
4819   if (!sub_schurs || !sub_schurs->reuse_solver) {
4820     IS       is_aux1,is_aux2;
4821     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
4822 
4823     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4824     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
4825     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
4826     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4827     for (i=0; i<n_D; i++) {
4828       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
4829     }
4830     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4831     for (i=0, j=0; i<n_R; i++) {
4832       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
4833         aux_array1[j++] = i;
4834       }
4835     }
4836     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4837     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4838     for (i=0, j=0; i<n_B; i++) {
4839       if (!PetscBTLookup(bitmask,is_indices[i])) {
4840         aux_array2[j++] = i;
4841       }
4842     }
4843     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4844     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
4845     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
4846     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4847     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
4848 
4849     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4850       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
4851       for (i=0, j=0; i<n_R; i++) {
4852         if (PetscBTLookup(bitmask,idx_R_local[i])) {
4853           aux_array1[j++] = i;
4854         }
4855       }
4856       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4857       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4858       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4859     }
4860     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
4861     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4862   } else {
4863     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4864     IS                 tis;
4865     PetscInt           schur_size;
4866 
4867     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
4868     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
4869     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
4870     ierr = ISDestroy(&tis);CHKERRQ(ierr);
4871     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4872       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
4873       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4874       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4875     }
4876   }
4877   PetscFunctionReturn(0);
4878 }
4879 
4880 
4881 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
4882 {
4883   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
4884   PC_IS          *pcis = (PC_IS*)pc->data;
4885   PC             pc_temp;
4886   Mat            A_RR;
4887   MatReuse       reuse;
4888   PetscScalar    m_one = -1.0;
4889   PetscReal      value;
4890   PetscInt       n_D,n_R;
4891   PetscBool      check_corr[2],issbaij;
4892   PetscErrorCode ierr;
4893   /* prefixes stuff */
4894   char           dir_prefix[256],neu_prefix[256],str_level[16];
4895   size_t         len;
4896 
4897   PetscFunctionBegin;
4898 
4899   /* compute prefixes */
4900   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
4901   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
4902   if (!pcbddc->current_level) {
4903     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4904     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4905     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4906     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4907   } else {
4908     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
4909     sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
4910     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
4911     len -= 15; /* remove "pc_bddc_coarse_" */
4912     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
4913     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
4914     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4915     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4916     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4917     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4918     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
4919     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
4920   }
4921 
4922   /* DIRICHLET PROBLEM */
4923   if (dirichlet) {
4924     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4925     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4926       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented\n");
4927       if (pcbddc->dbg_flag) {
4928         Mat    A_IIn;
4929 
4930         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
4931         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
4932         pcis->A_II = A_IIn;
4933       }
4934     }
4935     if (pcbddc->local_mat->symmetric_set) {
4936       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
4937     }
4938     /* Matrix for Dirichlet problem is pcis->A_II */
4939     n_D = pcis->n - pcis->n_B;
4940     if (!pcbddc->ksp_D) { /* create object if not yet build */
4941       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
4942       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
4943       /* default */
4944       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
4945       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
4946       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4947       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4948       if (issbaij) {
4949         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
4950       } else {
4951         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
4952       }
4953       /* Allow user's customization */
4954       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
4955       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4956     }
4957     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
4958     if (sub_schurs && sub_schurs->reuse_solver) {
4959       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4960 
4961       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
4962     }
4963     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
4964     if (!n_D) {
4965       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4966       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
4967     }
4968     /* Set Up KSP for Dirichlet problem of BDDC */
4969     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
4970     /* set ksp_D into pcis data */
4971     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
4972     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
4973     pcis->ksp_D = pcbddc->ksp_D;
4974   }
4975 
4976   /* NEUMANN PROBLEM */
4977   A_RR = 0;
4978   if (neumann) {
4979     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4980     PetscInt        ibs,mbs;
4981     PetscBool       issbaij, reuse_neumann_solver;
4982     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
4983 
4984     reuse_neumann_solver = PETSC_FALSE;
4985     if (sub_schurs && sub_schurs->reuse_solver) {
4986       IS iP;
4987 
4988       reuse_neumann_solver = PETSC_TRUE;
4989       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
4990       if (iP) reuse_neumann_solver = PETSC_FALSE;
4991     }
4992     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
4993     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
4994     if (pcbddc->ksp_R) { /* already created ksp */
4995       PetscInt nn_R;
4996       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
4997       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
4998       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
4999       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
5000         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
5001         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5002         reuse = MAT_INITIAL_MATRIX;
5003       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5004         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5005           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5006           reuse = MAT_INITIAL_MATRIX;
5007         } else { /* safe to reuse the matrix */
5008           reuse = MAT_REUSE_MATRIX;
5009         }
5010       }
5011       /* last check */
5012       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5013         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5014         reuse = MAT_INITIAL_MATRIX;
5015       }
5016     } else { /* first time, so we need to create the matrix */
5017       reuse = MAT_INITIAL_MATRIX;
5018     }
5019     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
5020     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5021     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5022     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5023     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5024       if (matis->A == pcbddc->local_mat) {
5025         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5026         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5027       } else {
5028         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5029       }
5030     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5031       if (matis->A == pcbddc->local_mat) {
5032         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5033         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5034       } else {
5035         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5036       }
5037     }
5038     /* extract A_RR */
5039     if (reuse_neumann_solver) {
5040       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5041 
5042       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5043         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5044         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5045           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5046         } else {
5047           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5048         }
5049       } else {
5050         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5051         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5052         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5053       }
5054     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5055       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5056     }
5057     if (pcbddc->local_mat->symmetric_set) {
5058       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
5059     }
5060     if (!pcbddc->ksp_R) { /* create object if not present */
5061       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5062       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5063       /* default */
5064       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5065       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5066       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5067       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5068       if (issbaij) {
5069         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5070       } else {
5071         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5072       }
5073       /* Allow user's customization */
5074       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5075       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
5076     }
5077     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5078     if (!n_R) {
5079       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5080       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5081     }
5082     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5083     /* Reuse solver if it is present */
5084     if (reuse_neumann_solver) {
5085       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5086 
5087       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5088     }
5089     /* Set Up KSP for Neumann problem of BDDC */
5090     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
5091   }
5092 
5093   if (pcbddc->dbg_flag) {
5094     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5095     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5096     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5097   }
5098 
5099   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5100   check_corr[0] = check_corr[1] = PETSC_FALSE;
5101   if (pcbddc->NullSpace_corr[0]) {
5102     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5103   }
5104   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5105     check_corr[0] = PETSC_TRUE;
5106     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5107   }
5108   if (neumann && pcbddc->NullSpace_corr[2]) {
5109     check_corr[1] = PETSC_TRUE;
5110     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5111   }
5112 
5113   /* check Dirichlet and Neumann solvers */
5114   if (pcbddc->dbg_flag) {
5115     if (dirichlet) { /* Dirichlet */
5116       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5117       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5118       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5119       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5120       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5121       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);
5122       if (check_corr[0]) {
5123         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_TRUE);CHKERRQ(ierr);
5124       }
5125       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5126     }
5127     if (neumann) { /* Neumann */
5128       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5129       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5130       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5131       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5132       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5133       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);
5134       if (check_corr[1]) {
5135         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_FALSE);CHKERRQ(ierr);
5136       }
5137       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5138     }
5139   }
5140   /* free Neumann problem's matrix */
5141   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5142   PetscFunctionReturn(0);
5143 }
5144 
5145 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5146 {
5147   PetscErrorCode  ierr;
5148   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5149   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5150   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5151 
5152   PetscFunctionBegin;
5153   if (!reuse_solver) {
5154     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5155   }
5156   if (!pcbddc->switch_static) {
5157     if (applytranspose && pcbddc->local_auxmat1) {
5158       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5159       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5160     }
5161     if (!reuse_solver) {
5162       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5163       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5164     } else {
5165       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5166 
5167       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5168       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5169     }
5170   } else {
5171     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5172     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5173     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5174     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5175     if (applytranspose && pcbddc->local_auxmat1) {
5176       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5177       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5178       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5179       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5180     }
5181   }
5182   if (!reuse_solver || pcbddc->switch_static) {
5183     if (applytranspose) {
5184       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5185     } else {
5186       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5187     }
5188   } else {
5189     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5190 
5191     if (applytranspose) {
5192       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5193     } else {
5194       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5195     }
5196   }
5197   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5198   if (!pcbddc->switch_static) {
5199     if (!reuse_solver) {
5200       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5201       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5202     } else {
5203       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5204 
5205       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5206       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5207     }
5208     if (!applytranspose && pcbddc->local_auxmat1) {
5209       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5210       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5211     }
5212   } else {
5213     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5214     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5215     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5216     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5217     if (!applytranspose && pcbddc->local_auxmat1) {
5218       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5219       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5220     }
5221     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5222     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5223     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5224     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5225   }
5226   PetscFunctionReturn(0);
5227 }
5228 
5229 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5230 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5231 {
5232   PetscErrorCode ierr;
5233   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5234   PC_IS*            pcis = (PC_IS*)  (pc->data);
5235   const PetscScalar zero = 0.0;
5236 
5237   PetscFunctionBegin;
5238   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5239   if (!pcbddc->benign_apply_coarse_only) {
5240     if (applytranspose) {
5241       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5242       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5243     } else {
5244       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5245       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5246     }
5247   } else {
5248     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5249   }
5250 
5251   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5252   if (pcbddc->benign_n) {
5253     PetscScalar *array;
5254     PetscInt    j;
5255 
5256     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5257     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5258     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5259   }
5260 
5261   /* start communications from local primal nodes to rhs of coarse solver */
5262   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5263   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5264   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5265 
5266   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5267   if (pcbddc->coarse_ksp) {
5268     Mat          coarse_mat;
5269     Vec          rhs,sol;
5270     MatNullSpace nullsp;
5271     PetscBool    isbddc = PETSC_FALSE;
5272 
5273     if (pcbddc->benign_have_null) {
5274       PC        coarse_pc;
5275 
5276       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5277       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5278       /* we need to propagate to coarser levels the need for a possible benign correction */
5279       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5280         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5281         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5282         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5283       }
5284     }
5285     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5286     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5287     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5288     ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5289     if (nullsp) {
5290       ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5291     }
5292     if (applytranspose) {
5293       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5294       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5295     } else {
5296       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5297         PC        coarse_pc;
5298 
5299         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5300         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5301         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5302         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5303       } else {
5304         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5305       }
5306     }
5307     /* we don't need the benign correction at coarser levels anymore */
5308     if (pcbddc->benign_have_null && isbddc) {
5309       PC        coarse_pc;
5310       PC_BDDC*  coarsepcbddc;
5311 
5312       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5313       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5314       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5315       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5316     }
5317     if (nullsp) {
5318       ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5319     }
5320   }
5321 
5322   /* Local solution on R nodes */
5323   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5324     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5325   }
5326   /* communications from coarse sol to local primal nodes */
5327   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5328   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5329 
5330   /* Sum contributions from the two levels */
5331   if (!pcbddc->benign_apply_coarse_only) {
5332     if (applytranspose) {
5333       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5334       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5335     } else {
5336       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5337       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5338     }
5339     /* store p0 */
5340     if (pcbddc->benign_n) {
5341       PetscScalar *array;
5342       PetscInt    j;
5343 
5344       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5345       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5346       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5347     }
5348   } else { /* expand the coarse solution */
5349     if (applytranspose) {
5350       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5351     } else {
5352       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5353     }
5354   }
5355   PetscFunctionReturn(0);
5356 }
5357 
5358 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5359 {
5360   PetscErrorCode ierr;
5361   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5362   PetscScalar    *array;
5363   Vec            from,to;
5364 
5365   PetscFunctionBegin;
5366   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5367     from = pcbddc->coarse_vec;
5368     to = pcbddc->vec1_P;
5369     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5370       Vec tvec;
5371 
5372       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5373       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5374       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5375       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5376       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5377       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5378     }
5379   } else { /* from local to global -> put data in coarse right hand side */
5380     from = pcbddc->vec1_P;
5381     to = pcbddc->coarse_vec;
5382   }
5383   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5384   PetscFunctionReturn(0);
5385 }
5386 
5387 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5388 {
5389   PetscErrorCode ierr;
5390   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5391   PetscScalar    *array;
5392   Vec            from,to;
5393 
5394   PetscFunctionBegin;
5395   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5396     from = pcbddc->coarse_vec;
5397     to = pcbddc->vec1_P;
5398   } else { /* from local to global -> put data in coarse right hand side */
5399     from = pcbddc->vec1_P;
5400     to = pcbddc->coarse_vec;
5401   }
5402   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5403   if (smode == SCATTER_FORWARD) {
5404     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5405       Vec tvec;
5406 
5407       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5408       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5409       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5410       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5411     }
5412   } else {
5413     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5414      ierr = VecResetArray(from);CHKERRQ(ierr);
5415     }
5416   }
5417   PetscFunctionReturn(0);
5418 }
5419 
5420 /* uncomment for testing purposes */
5421 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5422 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5423 {
5424   PetscErrorCode    ierr;
5425   PC_IS*            pcis = (PC_IS*)(pc->data);
5426   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5427   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5428   /* one and zero */
5429   PetscScalar       one=1.0,zero=0.0;
5430   /* space to store constraints and their local indices */
5431   PetscScalar       *constraints_data;
5432   PetscInt          *constraints_idxs,*constraints_idxs_B;
5433   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5434   PetscInt          *constraints_n;
5435   /* iterators */
5436   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5437   /* BLAS integers */
5438   PetscBLASInt      lwork,lierr;
5439   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5440   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5441   /* reuse */
5442   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5443   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5444   /* change of basis */
5445   PetscBool         qr_needed;
5446   PetscBT           change_basis,qr_needed_idx;
5447   /* auxiliary stuff */
5448   PetscInt          *nnz,*is_indices;
5449   PetscInt          ncc;
5450   /* some quantities */
5451   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5452   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5453 
5454   PetscFunctionBegin;
5455   /* Destroy Mat objects computed previously */
5456   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5457   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5458   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5459   /* save info on constraints from previous setup (if any) */
5460   olocal_primal_size = pcbddc->local_primal_size;
5461   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5462   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5463   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5464   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5465   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5466   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5467 
5468   if (!pcbddc->adaptive_selection) {
5469     IS           ISForVertices,*ISForFaces,*ISForEdges;
5470     MatNullSpace nearnullsp;
5471     const Vec    *nearnullvecs;
5472     Vec          *localnearnullsp;
5473     PetscScalar  *array;
5474     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5475     PetscBool    nnsp_has_cnst;
5476     /* LAPACK working arrays for SVD or POD */
5477     PetscBool    skip_lapack,boolforchange;
5478     PetscScalar  *work;
5479     PetscReal    *singular_vals;
5480 #if defined(PETSC_USE_COMPLEX)
5481     PetscReal    *rwork;
5482 #endif
5483 #if defined(PETSC_MISSING_LAPACK_GESVD)
5484     PetscScalar  *temp_basis,*correlation_mat;
5485 #else
5486     PetscBLASInt dummy_int=1;
5487     PetscScalar  dummy_scalar=1.;
5488 #endif
5489 
5490     /* Get index sets for faces, edges and vertices from graph */
5491     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
5492     /* print some info */
5493     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
5494       PetscInt nv;
5495 
5496       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
5497       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
5498       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5499       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5500       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
5501       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
5502       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
5503       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5504       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5505     }
5506 
5507     /* free unneeded index sets */
5508     if (!pcbddc->use_vertices) {
5509       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5510     }
5511     if (!pcbddc->use_edges) {
5512       for (i=0;i<n_ISForEdges;i++) {
5513         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5514       }
5515       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5516       n_ISForEdges = 0;
5517     }
5518     if (!pcbddc->use_faces) {
5519       for (i=0;i<n_ISForFaces;i++) {
5520         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5521       }
5522       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5523       n_ISForFaces = 0;
5524     }
5525 
5526     /* check if near null space is attached to global mat */
5527     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
5528     if (nearnullsp) {
5529       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
5530       /* remove any stored info */
5531       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
5532       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5533       /* store information for BDDC solver reuse */
5534       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
5535       pcbddc->onearnullspace = nearnullsp;
5536       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5537       for (i=0;i<nnsp_size;i++) {
5538         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
5539       }
5540     } else { /* if near null space is not provided BDDC uses constants by default */
5541       nnsp_size = 0;
5542       nnsp_has_cnst = PETSC_TRUE;
5543     }
5544     /* get max number of constraints on a single cc */
5545     max_constraints = nnsp_size;
5546     if (nnsp_has_cnst) max_constraints++;
5547 
5548     /*
5549          Evaluate maximum storage size needed by the procedure
5550          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
5551          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
5552          There can be multiple constraints per connected component
5553                                                                                                                                                            */
5554     n_vertices = 0;
5555     if (ISForVertices) {
5556       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
5557     }
5558     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
5559     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
5560 
5561     total_counts = n_ISForFaces+n_ISForEdges;
5562     total_counts *= max_constraints;
5563     total_counts += n_vertices;
5564     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
5565 
5566     total_counts = 0;
5567     max_size_of_constraint = 0;
5568     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
5569       IS used_is;
5570       if (i<n_ISForEdges) {
5571         used_is = ISForEdges[i];
5572       } else {
5573         used_is = ISForFaces[i-n_ISForEdges];
5574       }
5575       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
5576       total_counts += j;
5577       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
5578     }
5579     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);
5580 
5581     /* get local part of global near null space vectors */
5582     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
5583     for (k=0;k<nnsp_size;k++) {
5584       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
5585       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5586       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5587     }
5588 
5589     /* whether or not to skip lapack calls */
5590     skip_lapack = PETSC_TRUE;
5591     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
5592 
5593     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
5594     if (!skip_lapack) {
5595       PetscScalar temp_work;
5596 
5597 #if defined(PETSC_MISSING_LAPACK_GESVD)
5598       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
5599       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
5600       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
5601       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
5602 #if defined(PETSC_USE_COMPLEX)
5603       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
5604 #endif
5605       /* now we evaluate the optimal workspace using query with lwork=-1 */
5606       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5607       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
5608       lwork = -1;
5609       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5610 #if !defined(PETSC_USE_COMPLEX)
5611       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
5612 #else
5613       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
5614 #endif
5615       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5616       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
5617 #else /* on missing GESVD */
5618       /* SVD */
5619       PetscInt max_n,min_n;
5620       max_n = max_size_of_constraint;
5621       min_n = max_constraints;
5622       if (max_size_of_constraint < max_constraints) {
5623         min_n = max_size_of_constraint;
5624         max_n = max_constraints;
5625       }
5626       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
5627 #if defined(PETSC_USE_COMPLEX)
5628       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
5629 #endif
5630       /* now we evaluate the optimal workspace using query with lwork=-1 */
5631       lwork = -1;
5632       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
5633       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
5634       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
5635       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5636 #if !defined(PETSC_USE_COMPLEX)
5637       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));
5638 #else
5639       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));
5640 #endif
5641       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5642       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
5643 #endif /* on missing GESVD */
5644       /* Allocate optimal workspace */
5645       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
5646       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
5647     }
5648     /* Now we can loop on constraining sets */
5649     total_counts = 0;
5650     constraints_idxs_ptr[0] = 0;
5651     constraints_data_ptr[0] = 0;
5652     /* vertices */
5653     if (n_vertices) {
5654       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5655       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5656       for (i=0;i<n_vertices;i++) {
5657         constraints_n[total_counts] = 1;
5658         constraints_data[total_counts] = 1.0;
5659         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
5660         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
5661         total_counts++;
5662       }
5663       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5664       n_vertices = total_counts;
5665     }
5666 
5667     /* edges and faces */
5668     total_counts_cc = total_counts;
5669     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
5670       IS        used_is;
5671       PetscBool idxs_copied = PETSC_FALSE;
5672 
5673       if (ncc<n_ISForEdges) {
5674         used_is = ISForEdges[ncc];
5675         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
5676       } else {
5677         used_is = ISForFaces[ncc-n_ISForEdges];
5678         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
5679       }
5680       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
5681 
5682       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
5683       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5684       /* change of basis should not be performed on local periodic nodes */
5685       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
5686       if (nnsp_has_cnst) {
5687         PetscScalar quad_value;
5688 
5689         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5690         idxs_copied = PETSC_TRUE;
5691 
5692         if (!pcbddc->use_nnsp_true) {
5693           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
5694         } else {
5695           quad_value = 1.0;
5696         }
5697         for (j=0;j<size_of_constraint;j++) {
5698           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
5699         }
5700         temp_constraints++;
5701         total_counts++;
5702       }
5703       for (k=0;k<nnsp_size;k++) {
5704         PetscReal real_value;
5705         PetscScalar *ptr_to_data;
5706 
5707         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5708         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
5709         for (j=0;j<size_of_constraint;j++) {
5710           ptr_to_data[j] = array[is_indices[j]];
5711         }
5712         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5713         /* check if array is null on the connected component */
5714         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5715         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
5716         if (real_value > 0.0) { /* keep indices and values */
5717           temp_constraints++;
5718           total_counts++;
5719           if (!idxs_copied) {
5720             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5721             idxs_copied = PETSC_TRUE;
5722           }
5723         }
5724       }
5725       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5726       valid_constraints = temp_constraints;
5727       if (!pcbddc->use_nnsp_true && temp_constraints) {
5728         if (temp_constraints == 1) { /* just normalize the constraint */
5729           PetscScalar norm,*ptr_to_data;
5730 
5731           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5732           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5733           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
5734           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
5735           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
5736         } else { /* perform SVD */
5737           PetscReal   tol = 1.0e-8; /* tolerance for retaining eigenmodes */
5738           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5739 
5740 #if defined(PETSC_MISSING_LAPACK_GESVD)
5741           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
5742              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
5743              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
5744                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
5745                 from that computed using LAPACKgesvd
5746              -> This is due to a different computation of eigenvectors in LAPACKheev
5747              -> The quality of the POD-computed basis will be the same */
5748           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
5749           /* Store upper triangular part of correlation matrix */
5750           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5751           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5752           for (j=0;j<temp_constraints;j++) {
5753             for (k=0;k<j+1;k++) {
5754               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));
5755             }
5756           }
5757           /* compute eigenvalues and eigenvectors of correlation matrix */
5758           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5759           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
5760 #if !defined(PETSC_USE_COMPLEX)
5761           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
5762 #else
5763           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
5764 #endif
5765           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5766           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
5767           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
5768           j = 0;
5769           while (j < temp_constraints && singular_vals[j] < tol) j++;
5770           total_counts = total_counts-j;
5771           valid_constraints = temp_constraints-j;
5772           /* scale and copy POD basis into used quadrature memory */
5773           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5774           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5775           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
5776           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5777           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
5778           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
5779           if (j<temp_constraints) {
5780             PetscInt ii;
5781             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
5782             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5783             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));
5784             ierr = PetscFPTrapPop();CHKERRQ(ierr);
5785             for (k=0;k<temp_constraints-j;k++) {
5786               for (ii=0;ii<size_of_constraint;ii++) {
5787                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
5788               }
5789             }
5790           }
5791 #else  /* on missing GESVD */
5792           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5793           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5794           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5795           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5796 #if !defined(PETSC_USE_COMPLEX)
5797           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));
5798 #else
5799           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));
5800 #endif
5801           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
5802           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5803           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
5804           k = temp_constraints;
5805           if (k > size_of_constraint) k = size_of_constraint;
5806           j = 0;
5807           while (j < k && singular_vals[k-j-1] < tol) j++;
5808           valid_constraints = k-j;
5809           total_counts = total_counts-temp_constraints+valid_constraints;
5810 #endif /* on missing GESVD */
5811         }
5812       }
5813       /* update pointers information */
5814       if (valid_constraints) {
5815         constraints_n[total_counts_cc] = valid_constraints;
5816         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
5817         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
5818         /* set change_of_basis flag */
5819         if (boolforchange) {
5820           PetscBTSet(change_basis,total_counts_cc);
5821         }
5822         total_counts_cc++;
5823       }
5824     }
5825     /* free workspace */
5826     if (!skip_lapack) {
5827       ierr = PetscFree(work);CHKERRQ(ierr);
5828 #if defined(PETSC_USE_COMPLEX)
5829       ierr = PetscFree(rwork);CHKERRQ(ierr);
5830 #endif
5831       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
5832 #if defined(PETSC_MISSING_LAPACK_GESVD)
5833       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
5834       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
5835 #endif
5836     }
5837     for (k=0;k<nnsp_size;k++) {
5838       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
5839     }
5840     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
5841     /* free index sets of faces, edges and vertices */
5842     for (i=0;i<n_ISForFaces;i++) {
5843       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5844     }
5845     if (n_ISForFaces) {
5846       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5847     }
5848     for (i=0;i<n_ISForEdges;i++) {
5849       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5850     }
5851     if (n_ISForEdges) {
5852       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5853     }
5854     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5855   } else {
5856     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5857 
5858     total_counts = 0;
5859     n_vertices = 0;
5860     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
5861       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
5862     }
5863     max_constraints = 0;
5864     total_counts_cc = 0;
5865     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5866       total_counts += pcbddc->adaptive_constraints_n[i];
5867       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
5868       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
5869     }
5870     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
5871     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
5872     constraints_idxs = pcbddc->adaptive_constraints_idxs;
5873     constraints_data = pcbddc->adaptive_constraints_data;
5874     /* constraints_n differs from pcbddc->adaptive_constraints_n */
5875     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
5876     total_counts_cc = 0;
5877     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5878       if (pcbddc->adaptive_constraints_n[i]) {
5879         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
5880       }
5881     }
5882 #if 0
5883     printf("Found %d totals (%d)\n",total_counts_cc,total_counts);
5884     for (i=0;i<total_counts_cc;i++) {
5885       printf("const %d, start %d",i,constraints_idxs_ptr[i]);
5886       printf(" end %d:\n",constraints_idxs_ptr[i+1]);
5887       for (j=constraints_idxs_ptr[i];j<constraints_idxs_ptr[i+1];j++) {
5888         printf(" %d",constraints_idxs[j]);
5889       }
5890       printf("\n");
5891       printf("number of cc: %d\n",constraints_n[i]);
5892     }
5893     for (i=0;i<n_vertices;i++) {
5894       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i]);
5895     }
5896     for (i=0;i<sub_schurs->n_subs;i++) {
5897       PetscPrintf(PETSC_COMM_SELF,"[%d] sub %d, edge %d, n %d\n",PetscGlobalRank,i,(PetscBool)PetscBTLookup(sub_schurs->is_edge,i),pcbddc->adaptive_constraints_n[i+n_vertices]);
5898     }
5899 #endif
5900 
5901     max_size_of_constraint = 0;
5902     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]);
5903     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
5904     /* Change of basis */
5905     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
5906     if (pcbddc->use_change_of_basis) {
5907       for (i=0;i<sub_schurs->n_subs;i++) {
5908         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
5909           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
5910         }
5911       }
5912     }
5913   }
5914   pcbddc->local_primal_size = total_counts;
5915   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5916 
5917   /* map constraints_idxs in boundary numbering */
5918   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
5919   if (i != constraints_idxs_ptr[total_counts_cc]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for constraints indices %D != %D\n",constraints_idxs_ptr[total_counts_cc],i);
5920 
5921   /* Create constraint matrix */
5922   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5923   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
5924   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
5925 
5926   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
5927   /* determine if a QR strategy is needed for change of basis */
5928   qr_needed = PETSC_FALSE;
5929   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
5930   total_primal_vertices=0;
5931   pcbddc->local_primal_size_cc = 0;
5932   for (i=0;i<total_counts_cc;i++) {
5933     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5934     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
5935       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
5936       pcbddc->local_primal_size_cc += 1;
5937     } else if (PetscBTLookup(change_basis,i)) {
5938       for (k=0;k<constraints_n[i];k++) {
5939         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5940       }
5941       pcbddc->local_primal_size_cc += constraints_n[i];
5942       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
5943         PetscBTSet(qr_needed_idx,i);
5944         qr_needed = PETSC_TRUE;
5945       }
5946     } else {
5947       pcbddc->local_primal_size_cc += 1;
5948     }
5949   }
5950   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
5951   pcbddc->n_vertices = total_primal_vertices;
5952   /* permute indices in order to have a sorted set of vertices */
5953   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5954   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);
5955   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5956   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
5957 
5958   /* nonzero structure of constraint matrix */
5959   /* and get reference dof for local constraints */
5960   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
5961   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
5962 
5963   j = total_primal_vertices;
5964   total_counts = total_primal_vertices;
5965   cum = total_primal_vertices;
5966   for (i=n_vertices;i<total_counts_cc;i++) {
5967     if (!PetscBTLookup(change_basis,i)) {
5968       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
5969       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
5970       cum++;
5971       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5972       for (k=0;k<constraints_n[i];k++) {
5973         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5974         nnz[j+k] = size_of_constraint;
5975       }
5976       j += constraints_n[i];
5977     }
5978   }
5979   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
5980   ierr = PetscFree(nnz);CHKERRQ(ierr);
5981 
5982   /* set values in constraint matrix */
5983   for (i=0;i<total_primal_vertices;i++) {
5984     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
5985   }
5986   total_counts = total_primal_vertices;
5987   for (i=n_vertices;i<total_counts_cc;i++) {
5988     if (!PetscBTLookup(change_basis,i)) {
5989       PetscInt *cols;
5990 
5991       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5992       cols = constraints_idxs+constraints_idxs_ptr[i];
5993       for (k=0;k<constraints_n[i];k++) {
5994         PetscInt    row = total_counts+k;
5995         PetscScalar *vals;
5996 
5997         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
5998         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
5999       }
6000       total_counts += constraints_n[i];
6001     }
6002   }
6003   /* assembling */
6004   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6005   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6006 
6007   /*
6008   ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
6009   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
6010   ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
6011   */
6012   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6013   if (pcbddc->use_change_of_basis) {
6014     /* dual and primal dofs on a single cc */
6015     PetscInt     dual_dofs,primal_dofs;
6016     /* working stuff for GEQRF */
6017     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
6018     PetscBLASInt lqr_work;
6019     /* working stuff for UNGQR */
6020     PetscScalar  *gqr_work,lgqr_work_t;
6021     PetscBLASInt lgqr_work;
6022     /* working stuff for TRTRS */
6023     PetscScalar  *trs_rhs;
6024     PetscBLASInt Blas_NRHS;
6025     /* pointers for values insertion into change of basis matrix */
6026     PetscInt     *start_rows,*start_cols;
6027     PetscScalar  *start_vals;
6028     /* working stuff for values insertion */
6029     PetscBT      is_primal;
6030     PetscInt     *aux_primal_numbering_B;
6031     /* matrix sizes */
6032     PetscInt     global_size,local_size;
6033     /* temporary change of basis */
6034     Mat          localChangeOfBasisMatrix;
6035     /* extra space for debugging */
6036     PetscScalar  *dbg_work;
6037 
6038     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6039     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6040     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6041     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6042     /* nonzeros for local mat */
6043     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6044     if (!pcbddc->benign_change || pcbddc->fake_change) {
6045       for (i=0;i<pcis->n;i++) nnz[i]=1;
6046     } else {
6047       const PetscInt *ii;
6048       PetscInt       n;
6049       PetscBool      flg_row;
6050       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6051       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6052       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6053     }
6054     for (i=n_vertices;i<total_counts_cc;i++) {
6055       if (PetscBTLookup(change_basis,i)) {
6056         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6057         if (PetscBTLookup(qr_needed_idx,i)) {
6058           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6059         } else {
6060           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6061           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6062         }
6063       }
6064     }
6065     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6066     ierr = PetscFree(nnz);CHKERRQ(ierr);
6067     /* Set interior change in the matrix */
6068     if (!pcbddc->benign_change || pcbddc->fake_change) {
6069       for (i=0;i<pcis->n;i++) {
6070         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6071       }
6072     } else {
6073       const PetscInt *ii,*jj;
6074       PetscScalar    *aa;
6075       PetscInt       n;
6076       PetscBool      flg_row;
6077       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6078       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6079       for (i=0;i<n;i++) {
6080         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6081       }
6082       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6083       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6084     }
6085 
6086     if (pcbddc->dbg_flag) {
6087       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6088       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6089     }
6090 
6091 
6092     /* Now we loop on the constraints which need a change of basis */
6093     /*
6094        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6095        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6096 
6097        Basic blocks of change of basis matrix T computed by
6098 
6099           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6100 
6101             | 1        0   ...        0         s_1/S |
6102             | 0        1   ...        0         s_2/S |
6103             |              ...                        |
6104             | 0        ...            1     s_{n-1}/S |
6105             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6106 
6107             with S = \sum_{i=1}^n s_i^2
6108             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6109                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6110 
6111           - QR decomposition of constraints otherwise
6112     */
6113     if (qr_needed) {
6114       /* space to store Q */
6115       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6116       /* array to store scaling factors for reflectors */
6117       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6118       /* first we issue queries for optimal work */
6119       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6120       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6121       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6122       lqr_work = -1;
6123       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6124       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6125       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6126       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6127       lgqr_work = -1;
6128       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6129       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6130       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6131       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6132       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6133       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6134       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
6135       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6136       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6137       /* array to store rhs and solution of triangular solver */
6138       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6139       /* allocating workspace for check */
6140       if (pcbddc->dbg_flag) {
6141         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6142       }
6143     }
6144     /* array to store whether a node is primal or not */
6145     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6146     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6147     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6148     if (i != total_primal_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",total_primal_vertices,i);
6149     for (i=0;i<total_primal_vertices;i++) {
6150       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6151     }
6152     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6153 
6154     /* loop on constraints and see whether or not they need a change of basis and compute it */
6155     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6156       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6157       if (PetscBTLookup(change_basis,total_counts)) {
6158         /* get constraint info */
6159         primal_dofs = constraints_n[total_counts];
6160         dual_dofs = size_of_constraint-primal_dofs;
6161 
6162         if (pcbddc->dbg_flag) {
6163           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);
6164         }
6165 
6166         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6167 
6168           /* copy quadrature constraints for change of basis check */
6169           if (pcbddc->dbg_flag) {
6170             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6171           }
6172           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6173           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6174 
6175           /* compute QR decomposition of constraints */
6176           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6177           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6178           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6179           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6180           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6181           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6182           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6183 
6184           /* explictly compute R^-T */
6185           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
6186           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6187           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6188           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6189           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6190           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6191           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6192           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6193           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6194           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6195 
6196           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6197           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6198           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6199           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6200           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6201           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6202           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6203           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
6204           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6205 
6206           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6207              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6208              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6209           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6210           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6211           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6212           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6213           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6214           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6215           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6216           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));
6217           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6218           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6219 
6220           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6221           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6222           /* insert cols for primal dofs */
6223           for (j=0;j<primal_dofs;j++) {
6224             start_vals = &qr_basis[j*size_of_constraint];
6225             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6226             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6227           }
6228           /* insert cols for dual dofs */
6229           for (j=0,k=0;j<dual_dofs;k++) {
6230             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6231               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6232               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6233               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6234               j++;
6235             }
6236           }
6237 
6238           /* check change of basis */
6239           if (pcbddc->dbg_flag) {
6240             PetscInt   ii,jj;
6241             PetscBool valid_qr=PETSC_TRUE;
6242             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6243             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6244             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6245             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6246             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6247             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6248             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6249             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));
6250             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6251             for (jj=0;jj<size_of_constraint;jj++) {
6252               for (ii=0;ii<primal_dofs;ii++) {
6253                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6254                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
6255               }
6256             }
6257             if (!valid_qr) {
6258               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6259               for (jj=0;jj<size_of_constraint;jj++) {
6260                 for (ii=0;ii<primal_dofs;ii++) {
6261                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6262                     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]));
6263                   }
6264                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
6265                     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]));
6266                   }
6267                 }
6268               }
6269             } else {
6270               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6271             }
6272           }
6273         } else { /* simple transformation block */
6274           PetscInt    row,col;
6275           PetscScalar val,norm;
6276 
6277           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6278           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6279           for (j=0;j<size_of_constraint;j++) {
6280             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6281             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6282             if (!PetscBTLookup(is_primal,row_B)) {
6283               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6284               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6285               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6286             } else {
6287               for (k=0;k<size_of_constraint;k++) {
6288                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6289                 if (row != col) {
6290                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6291                 } else {
6292                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6293                 }
6294                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6295               }
6296             }
6297           }
6298           if (pcbddc->dbg_flag) {
6299             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6300           }
6301         }
6302       } else {
6303         if (pcbddc->dbg_flag) {
6304           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d does not need a change of basis (size %d)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6305         }
6306       }
6307     }
6308 
6309     /* free workspace */
6310     if (qr_needed) {
6311       if (pcbddc->dbg_flag) {
6312         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6313       }
6314       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6315       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6316       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6317       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6318       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6319     }
6320     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6321     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6322     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6323 
6324     /* assembling of global change of variable */
6325     if (!pcbddc->fake_change) {
6326       Mat      tmat;
6327       PetscInt bs;
6328 
6329       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6330       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6331       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6332       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6333       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6334       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6335       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6336       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6337       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6338       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6339       ierr = MatISGetMPIXAIJ(tmat,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6340       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6341       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6342       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6343       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6344       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6345       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6346       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6347 
6348       /* check */
6349       if (pcbddc->dbg_flag) {
6350         PetscReal error;
6351         Vec       x,x_change;
6352 
6353         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6354         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6355         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6356         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6357         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6358         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6359         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6360         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6361         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6362         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6363         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6364         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6365         if (error > PETSC_SMALL) {
6366           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
6367         }
6368         ierr = VecDestroy(&x);CHKERRQ(ierr);
6369         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6370       }
6371       /* adapt sub_schurs computed (if any) */
6372       if (pcbddc->use_deluxe_scaling) {
6373         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6374 
6375         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");CHKERRQ(ierr);
6376         if (sub_schurs && sub_schurs->S_Ej_all) {
6377           Mat                    S_new,tmat;
6378           IS                     is_all_N,is_V_Sall = NULL;
6379 
6380           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6381           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6382           if (pcbddc->deluxe_zerorows) {
6383             ISLocalToGlobalMapping NtoSall;
6384             IS                     is_V;
6385             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6386             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6387             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6388             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6389             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6390           }
6391           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6392           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6393           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6394           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6395           if (pcbddc->deluxe_zerorows) {
6396             const PetscScalar *array;
6397             const PetscInt    *idxs_V,*idxs_all;
6398             PetscInt          i,n_V;
6399 
6400             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6401             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6402             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6403             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6404             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6405             for (i=0;i<n_V;i++) {
6406               PetscScalar val;
6407               PetscInt    idx;
6408 
6409               idx = idxs_V[i];
6410               val = array[idxs_all[idxs_V[i]]];
6411               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6412             }
6413             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6414             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6415             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6416             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6417             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6418           }
6419           sub_schurs->S_Ej_all = S_new;
6420           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6421           if (sub_schurs->sum_S_Ej_all) {
6422             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6423             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6424             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6425             if (pcbddc->deluxe_zerorows) {
6426               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6427             }
6428             sub_schurs->sum_S_Ej_all = S_new;
6429             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6430           }
6431           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6432           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6433         }
6434         /* destroy any change of basis context in sub_schurs */
6435         if (sub_schurs && sub_schurs->change) {
6436           PetscInt i;
6437 
6438           for (i=0;i<sub_schurs->n_subs;i++) {
6439             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6440           }
6441           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6442         }
6443       }
6444       if (pcbddc->switch_static) { /* need to save the local change */
6445         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6446       } else {
6447         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6448       }
6449       /* determine if any process has changed the pressures locally */
6450       pcbddc->change_interior = pcbddc->benign_have_null;
6451     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6452       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6453       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6454       pcbddc->use_qr_single = qr_needed;
6455     }
6456   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6457     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6458       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6459       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6460     } else {
6461       Mat benign_global = NULL;
6462       if (pcbddc->benign_have_null) {
6463         Mat tmat;
6464 
6465         pcbddc->change_interior = PETSC_TRUE;
6466         ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6467         ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6468         ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6469         ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6470         ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6471         ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6472         ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6473         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6474         if (pcbddc->benign_change) {
6475           Mat M;
6476 
6477           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6478           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6479           ierr = MatISSetLocalMat(tmat,M);CHKERRQ(ierr);
6480           ierr = MatDestroy(&M);CHKERRQ(ierr);
6481         } else {
6482           Mat         eye;
6483           PetscScalar *array;
6484 
6485           ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6486           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&eye);CHKERRQ(ierr);
6487           for (i=0;i<pcis->n;i++) {
6488             ierr = MatSetValue(eye,i,i,array[i],INSERT_VALUES);CHKERRQ(ierr);
6489           }
6490           ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6491           ierr = MatAssemblyBegin(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6492           ierr = MatAssemblyEnd(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6493           ierr = MatISSetLocalMat(tmat,eye);CHKERRQ(ierr);
6494           ierr = MatDestroy(&eye);CHKERRQ(ierr);
6495         }
6496         ierr = MatISGetMPIXAIJ(tmat,MAT_INITIAL_MATRIX,&benign_global);CHKERRQ(ierr);
6497         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6498       }
6499       if (pcbddc->user_ChangeOfBasisMatrix) {
6500         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6501         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6502       } else if (pcbddc->benign_have_null) {
6503         pcbddc->ChangeOfBasisMatrix = benign_global;
6504       }
6505     }
6506     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6507       IS             is_global;
6508       const PetscInt *gidxs;
6509 
6510       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6511       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6512       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6513       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6514       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6515     }
6516   }
6517   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6518     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6519   }
6520 
6521   if (!pcbddc->fake_change) {
6522     /* add pressure dofs to set of primal nodes for numbering purposes */
6523     for (i=0;i<pcbddc->benign_n;i++) {
6524       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
6525       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
6526       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
6527       pcbddc->local_primal_size_cc++;
6528       pcbddc->local_primal_size++;
6529     }
6530 
6531     /* check if a new primal space has been introduced (also take into account benign trick) */
6532     pcbddc->new_primal_space_local = PETSC_TRUE;
6533     if (olocal_primal_size == pcbddc->local_primal_size) {
6534       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6535       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6536       if (!pcbddc->new_primal_space_local) {
6537         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6538         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6539       }
6540     }
6541     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
6542     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6543   }
6544   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
6545 
6546   /* flush dbg viewer */
6547   if (pcbddc->dbg_flag) {
6548     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6549   }
6550 
6551   /* free workspace */
6552   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
6553   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
6554   if (!pcbddc->adaptive_selection) {
6555     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
6556     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
6557   } else {
6558     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
6559                       pcbddc->adaptive_constraints_idxs_ptr,
6560                       pcbddc->adaptive_constraints_data_ptr,
6561                       pcbddc->adaptive_constraints_idxs,
6562                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
6563     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
6564     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
6565   }
6566   PetscFunctionReturn(0);
6567 }
6568 
6569 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
6570 {
6571   ISLocalToGlobalMapping map;
6572   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
6573   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
6574   PetscInt               i,N;
6575   PetscBool              rcsr = PETSC_FALSE;
6576   PetscErrorCode         ierr;
6577 
6578   PetscFunctionBegin;
6579   if (pcbddc->recompute_topography) {
6580     pcbddc->graphanalyzed = PETSC_FALSE;
6581     /* Reset previously computed graph */
6582     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
6583     /* Init local Graph struct */
6584     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
6585     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
6586     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
6587 
6588     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
6589       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6590     }
6591     /* Check validity of the csr graph passed in by the user */
6592     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\n",pcbddc->mat_graph->nvtxs_csr,pcbddc->mat_graph->nvtxs);
6593 
6594     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
6595     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
6596       PetscInt  *xadj,*adjncy;
6597       PetscInt  nvtxs;
6598       PetscBool flg_row=PETSC_FALSE;
6599 
6600       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6601       if (flg_row) {
6602         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
6603         pcbddc->computed_rowadj = PETSC_TRUE;
6604       }
6605       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6606       rcsr = PETSC_TRUE;
6607     }
6608     if (pcbddc->dbg_flag) {
6609       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6610     }
6611 
6612     /* Setup of Graph */
6613     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
6614     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6615 
6616     /* attach info on disconnected subdomains if present */
6617     if (pcbddc->n_local_subs) {
6618       PetscInt *local_subs;
6619 
6620       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
6621       for (i=0;i<pcbddc->n_local_subs;i++) {
6622         const PetscInt *idxs;
6623         PetscInt       nl,j;
6624 
6625         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
6626         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6627         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
6628         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6629       }
6630       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
6631       pcbddc->mat_graph->local_subs = local_subs;
6632     }
6633   }
6634 
6635   if (!pcbddc->graphanalyzed) {
6636     /* Graph's connected components analysis */
6637     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
6638     pcbddc->graphanalyzed = PETSC_TRUE;
6639   }
6640   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
6641   PetscFunctionReturn(0);
6642 }
6643 
6644 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
6645 {
6646   PetscInt       i,j;
6647   PetscScalar    *alphas;
6648   PetscErrorCode ierr;
6649 
6650   PetscFunctionBegin;
6651   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
6652   for (i=0;i<n;i++) {
6653     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
6654     ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],alphas);CHKERRQ(ierr);
6655     for (j=0;j<n-i-1;j++) alphas[j] = PetscConj(-alphas[j]);
6656     ierr = VecMAXPY(vecs[j],n-i-1,alphas,vecs+i);CHKERRQ(ierr);
6657   }
6658   ierr = PetscFree(alphas);CHKERRQ(ierr);
6659   PetscFunctionReturn(0);
6660 }
6661 
6662 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
6663 {
6664   Mat            A;
6665   PetscInt       n_neighs,*neighs,*n_shared,**shared;
6666   PetscMPIInt    size,rank,color;
6667   PetscInt       *xadj,*adjncy;
6668   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
6669   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
6670   PetscInt       void_procs,*procs_candidates = NULL;
6671   PetscInt       xadj_count,*count;
6672   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
6673   PetscSubcomm   psubcomm;
6674   MPI_Comm       subcomm;
6675   PetscErrorCode ierr;
6676 
6677   PetscFunctionBegin;
6678   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6679   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6680   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);
6681   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
6682   PetscValidLogicalCollectiveInt(mat,redprocs,3);
6683   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %d\n",*n_subdomains);
6684 
6685   if (have_void) *have_void = PETSC_FALSE;
6686   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
6687   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
6688   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
6689   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
6690   im_active = !!n;
6691   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6692   void_procs = size - active_procs;
6693   /* get ranks of of non-active processes in mat communicator */
6694   if (void_procs) {
6695     PetscInt ncand;
6696 
6697     if (have_void) *have_void = PETSC_TRUE;
6698     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
6699     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6700     for (i=0,ncand=0;i<size;i++) {
6701       if (!procs_candidates[i]) {
6702         procs_candidates[ncand++] = i;
6703       }
6704     }
6705     /* force n_subdomains to be not greater that the number of non-active processes */
6706     *n_subdomains = PetscMin(void_procs,*n_subdomains);
6707   }
6708 
6709   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
6710      number of subdomains requested 1 -> send to master or first candidate in voids  */
6711   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
6712   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
6713     PetscInt issize,isidx,dest;
6714     if (*n_subdomains == 1) dest = 0;
6715     else dest = rank;
6716     if (im_active) {
6717       issize = 1;
6718       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6719         isidx = procs_candidates[dest];
6720       } else {
6721         isidx = dest;
6722       }
6723     } else {
6724       issize = 0;
6725       isidx = -1;
6726     }
6727     if (*n_subdomains != 1) *n_subdomains = active_procs;
6728     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
6729     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6730     PetscFunctionReturn(0);
6731   }
6732   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
6733   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
6734   threshold = PetscMax(threshold,2);
6735 
6736   /* Get info on mapping */
6737   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6738 
6739   /* build local CSR graph of subdomains' connectivity */
6740   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
6741   xadj[0] = 0;
6742   xadj[1] = PetscMax(n_neighs-1,0);
6743   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
6744   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
6745   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
6746   for (i=1;i<n_neighs;i++)
6747     for (j=0;j<n_shared[i];j++)
6748       count[shared[i][j]] += 1;
6749 
6750   xadj_count = 0;
6751   for (i=1;i<n_neighs;i++) {
6752     for (j=0;j<n_shared[i];j++) {
6753       if (count[shared[i][j]] < threshold) {
6754         adjncy[xadj_count] = neighs[i];
6755         adjncy_wgt[xadj_count] = n_shared[i];
6756         xadj_count++;
6757         break;
6758       }
6759     }
6760   }
6761   xadj[1] = xadj_count;
6762   ierr = PetscFree(count);CHKERRQ(ierr);
6763   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6764   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6765 
6766   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
6767 
6768   /* Restrict work on active processes only */
6769   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
6770   if (void_procs) {
6771     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
6772     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
6773     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
6774     subcomm = PetscSubcommChild(psubcomm);
6775   } else {
6776     psubcomm = NULL;
6777     subcomm = PetscObjectComm((PetscObject)mat);
6778   }
6779 
6780   v_wgt = NULL;
6781   if (!color) {
6782     ierr = PetscFree(xadj);CHKERRQ(ierr);
6783     ierr = PetscFree(adjncy);CHKERRQ(ierr);
6784     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6785   } else {
6786     Mat             subdomain_adj;
6787     IS              new_ranks,new_ranks_contig;
6788     MatPartitioning partitioner;
6789     PetscInt        rstart=0,rend=0;
6790     PetscInt        *is_indices,*oldranks;
6791     PetscMPIInt     size;
6792     PetscBool       aggregate;
6793 
6794     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
6795     if (void_procs) {
6796       PetscInt prank = rank;
6797       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
6798       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
6799       for (i=0;i<xadj[1];i++) {
6800         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
6801       }
6802       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6803     } else {
6804       oldranks = NULL;
6805     }
6806     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
6807     if (aggregate) { /* TODO: all this part could be made more efficient */
6808       PetscInt    lrows,row,ncols,*cols;
6809       PetscMPIInt nrank;
6810       PetscScalar *vals;
6811 
6812       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
6813       lrows = 0;
6814       if (nrank<redprocs) {
6815         lrows = size/redprocs;
6816         if (nrank<size%redprocs) lrows++;
6817       }
6818       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
6819       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
6820       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6821       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6822       row = nrank;
6823       ncols = xadj[1]-xadj[0];
6824       cols = adjncy;
6825       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
6826       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
6827       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6828       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6829       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6830       ierr = PetscFree(xadj);CHKERRQ(ierr);
6831       ierr = PetscFree(adjncy);CHKERRQ(ierr);
6832       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6833       ierr = PetscFree(vals);CHKERRQ(ierr);
6834       if (use_vwgt) {
6835         Vec               v;
6836         const PetscScalar *array;
6837         PetscInt          nl;
6838 
6839         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
6840         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
6841         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
6842         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
6843         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
6844         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
6845         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
6846         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
6847         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
6848         ierr = VecDestroy(&v);CHKERRQ(ierr);
6849       }
6850     } else {
6851       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
6852       if (use_vwgt) {
6853         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
6854         v_wgt[0] = n;
6855       }
6856     }
6857     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
6858 
6859     /* Partition */
6860     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
6861     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
6862     if (v_wgt) {
6863       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
6864     }
6865     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
6866     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
6867     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
6868     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
6869     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
6870 
6871     /* renumber new_ranks to avoid "holes" in new set of processors */
6872     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
6873     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
6874     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6875     if (!aggregate) {
6876       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6877 #if defined(PETSC_USE_DEBUG)
6878         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6879 #endif
6880         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
6881       } else if (oldranks) {
6882         ranks_send_to_idx[0] = oldranks[is_indices[0]];
6883       } else {
6884         ranks_send_to_idx[0] = is_indices[0];
6885       }
6886     } else {
6887       PetscInt    idxs[1];
6888       PetscMPIInt tag;
6889       MPI_Request *reqs;
6890 
6891       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
6892       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
6893       for (i=rstart;i<rend;i++) {
6894         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
6895       }
6896       ierr = MPI_Recv(idxs,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
6897       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
6898       ierr = PetscFree(reqs);CHKERRQ(ierr);
6899       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6900 #if defined(PETSC_USE_DEBUG)
6901         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6902 #endif
6903         ranks_send_to_idx[0] = procs_candidates[oldranks[idxs[0]]];
6904       } else if (oldranks) {
6905         ranks_send_to_idx[0] = oldranks[idxs[0]];
6906       } else {
6907         ranks_send_to_idx[0] = idxs[0];
6908       }
6909     }
6910     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6911     /* clean up */
6912     ierr = PetscFree(oldranks);CHKERRQ(ierr);
6913     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
6914     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
6915     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
6916   }
6917   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
6918   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6919 
6920   /* assemble parallel IS for sends */
6921   i = 1;
6922   if (!color) i=0;
6923   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
6924   PetscFunctionReturn(0);
6925 }
6926 
6927 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
6928 
6929 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[])
6930 {
6931   Mat                    local_mat;
6932   IS                     is_sends_internal;
6933   PetscInt               rows,cols,new_local_rows;
6934   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
6935   PetscBool              ismatis,isdense,newisdense,destroy_mat;
6936   ISLocalToGlobalMapping l2gmap;
6937   PetscInt*              l2gmap_indices;
6938   const PetscInt*        is_indices;
6939   MatType                new_local_type;
6940   /* buffers */
6941   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
6942   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
6943   PetscInt               *recv_buffer_idxs_local;
6944   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
6945   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
6946   /* MPI */
6947   MPI_Comm               comm,comm_n;
6948   PetscSubcomm           subcomm;
6949   PetscMPIInt            n_sends,n_recvs,commsize;
6950   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
6951   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
6952   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
6953   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
6954   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
6955   PetscErrorCode         ierr;
6956 
6957   PetscFunctionBegin;
6958   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6959   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6960   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);
6961   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
6962   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
6963   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
6964   PetscValidLogicalCollectiveBool(mat,reuse,6);
6965   PetscValidLogicalCollectiveInt(mat,nis,8);
6966   PetscValidLogicalCollectiveInt(mat,nvecs,10);
6967   if (nvecs) {
6968     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
6969     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
6970   }
6971   /* further checks */
6972   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
6973   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
6974   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
6975   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
6976   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
6977   if (reuse && *mat_n) {
6978     PetscInt mrows,mcols,mnrows,mncols;
6979     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
6980     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
6981     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
6982     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
6983     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
6984     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
6985     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
6986   }
6987   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
6988   PetscValidLogicalCollectiveInt(mat,bs,0);
6989 
6990   /* prepare IS for sending if not provided */
6991   if (!is_sends) {
6992     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
6993     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
6994   } else {
6995     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
6996     is_sends_internal = is_sends;
6997   }
6998 
6999   /* get comm */
7000   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
7001 
7002   /* compute number of sends */
7003   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
7004   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7005 
7006   /* compute number of receives */
7007   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
7008   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
7009   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
7010   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7011   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7012   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7013   ierr = PetscFree(iflags);CHKERRQ(ierr);
7014 
7015   /* restrict comm if requested */
7016   subcomm = 0;
7017   destroy_mat = PETSC_FALSE;
7018   if (restrict_comm) {
7019     PetscMPIInt color,subcommsize;
7020 
7021     color = 0;
7022     if (restrict_full) {
7023       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7024     } else {
7025       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7026     }
7027     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
7028     subcommsize = commsize - subcommsize;
7029     /* check if reuse has been requested */
7030     if (reuse) {
7031       if (*mat_n) {
7032         PetscMPIInt subcommsize2;
7033         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
7034         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7035         comm_n = PetscObjectComm((PetscObject)*mat_n);
7036       } else {
7037         comm_n = PETSC_COMM_SELF;
7038       }
7039     } else { /* MAT_INITIAL_MATRIX */
7040       PetscMPIInt rank;
7041 
7042       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
7043       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7044       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7045       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7046       comm_n = PetscSubcommChild(subcomm);
7047     }
7048     /* flag to destroy *mat_n if not significative */
7049     if (color) destroy_mat = PETSC_TRUE;
7050   } else {
7051     comm_n = comm;
7052   }
7053 
7054   /* prepare send/receive buffers */
7055   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
7056   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
7057   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
7058   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
7059   if (nis) {
7060     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
7061   }
7062 
7063   /* Get data from local matrices */
7064   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7065     /* TODO: See below some guidelines on how to prepare the local buffers */
7066     /*
7067        send_buffer_vals should contain the raw values of the local matrix
7068        send_buffer_idxs should contain:
7069        - MatType_PRIVATE type
7070        - PetscInt        size_of_l2gmap
7071        - PetscInt        global_row_indices[size_of_l2gmap]
7072        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7073     */
7074   else {
7075     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7076     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7077     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7078     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7079     send_buffer_idxs[1] = i;
7080     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7081     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
7082     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7083     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7084     for (i=0;i<n_sends;i++) {
7085       ilengths_vals[is_indices[i]] = len*len;
7086       ilengths_idxs[is_indices[i]] = len+2;
7087     }
7088   }
7089   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7090   /* additional is (if any) */
7091   if (nis) {
7092     PetscMPIInt psum;
7093     PetscInt j;
7094     for (j=0,psum=0;j<nis;j++) {
7095       PetscInt plen;
7096       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7097       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7098       psum += len+1; /* indices + lenght */
7099     }
7100     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7101     for (j=0,psum=0;j<nis;j++) {
7102       PetscInt plen;
7103       const PetscInt *is_array_idxs;
7104       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7105       send_buffer_idxs_is[psum] = plen;
7106       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7107       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
7108       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7109       psum += plen+1; /* indices + lenght */
7110     }
7111     for (i=0;i<n_sends;i++) {
7112       ilengths_idxs_is[is_indices[i]] = psum;
7113     }
7114     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7115   }
7116 
7117   buf_size_idxs = 0;
7118   buf_size_vals = 0;
7119   buf_size_idxs_is = 0;
7120   buf_size_vecs = 0;
7121   for (i=0;i<n_recvs;i++) {
7122     buf_size_idxs += (PetscInt)olengths_idxs[i];
7123     buf_size_vals += (PetscInt)olengths_vals[i];
7124     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7125     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7126   }
7127   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7128   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7129   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7130   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7131 
7132   /* get new tags for clean communications */
7133   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7134   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7135   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7136   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7137 
7138   /* allocate for requests */
7139   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7140   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7141   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7142   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7143   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7144   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7145   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7146   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7147 
7148   /* communications */
7149   ptr_idxs = recv_buffer_idxs;
7150   ptr_vals = recv_buffer_vals;
7151   ptr_idxs_is = recv_buffer_idxs_is;
7152   ptr_vecs = recv_buffer_vecs;
7153   for (i=0;i<n_recvs;i++) {
7154     source_dest = onodes[i];
7155     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7156     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7157     ptr_idxs += olengths_idxs[i];
7158     ptr_vals += olengths_vals[i];
7159     if (nis) {
7160       source_dest = onodes_is[i];
7161       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);
7162       ptr_idxs_is += olengths_idxs_is[i];
7163     }
7164     if (nvecs) {
7165       source_dest = onodes[i];
7166       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7167       ptr_vecs += olengths_idxs[i]-2;
7168     }
7169   }
7170   for (i=0;i<n_sends;i++) {
7171     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7172     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7173     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7174     if (nis) {
7175       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);
7176     }
7177     if (nvecs) {
7178       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7179       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7180     }
7181   }
7182   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7183   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7184 
7185   /* assemble new l2g map */
7186   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7187   ptr_idxs = recv_buffer_idxs;
7188   new_local_rows = 0;
7189   for (i=0;i<n_recvs;i++) {
7190     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7191     ptr_idxs += olengths_idxs[i];
7192   }
7193   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7194   ptr_idxs = recv_buffer_idxs;
7195   new_local_rows = 0;
7196   for (i=0;i<n_recvs;i++) {
7197     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
7198     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7199     ptr_idxs += olengths_idxs[i];
7200   }
7201   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7202   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7203   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7204 
7205   /* infer new local matrix type from received local matrices type */
7206   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7207   /* 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) */
7208   if (n_recvs) {
7209     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7210     ptr_idxs = recv_buffer_idxs;
7211     for (i=0;i<n_recvs;i++) {
7212       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7213         new_local_type_private = MATAIJ_PRIVATE;
7214         break;
7215       }
7216       ptr_idxs += olengths_idxs[i];
7217     }
7218     switch (new_local_type_private) {
7219       case MATDENSE_PRIVATE:
7220         new_local_type = MATSEQAIJ;
7221         bs = 1;
7222         break;
7223       case MATAIJ_PRIVATE:
7224         new_local_type = MATSEQAIJ;
7225         bs = 1;
7226         break;
7227       case MATBAIJ_PRIVATE:
7228         new_local_type = MATSEQBAIJ;
7229         break;
7230       case MATSBAIJ_PRIVATE:
7231         new_local_type = MATSEQSBAIJ;
7232         break;
7233       default:
7234         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7235         break;
7236     }
7237   } else { /* by default, new_local_type is seqaij */
7238     new_local_type = MATSEQAIJ;
7239     bs = 1;
7240   }
7241 
7242   /* create MATIS object if needed */
7243   if (!reuse) {
7244     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7245     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7246   } else {
7247     /* it also destroys the local matrices */
7248     if (*mat_n) {
7249       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7250     } else { /* this is a fake object */
7251       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7252     }
7253   }
7254   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7255   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7256 
7257   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7258 
7259   /* Global to local map of received indices */
7260   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7261   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7262   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7263 
7264   /* restore attributes -> type of incoming data and its size */
7265   buf_size_idxs = 0;
7266   for (i=0;i<n_recvs;i++) {
7267     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7268     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7269     buf_size_idxs += (PetscInt)olengths_idxs[i];
7270   }
7271   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7272 
7273   /* set preallocation */
7274   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7275   if (!newisdense) {
7276     PetscInt *new_local_nnz=0;
7277 
7278     ptr_idxs = recv_buffer_idxs_local;
7279     if (n_recvs) {
7280       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7281     }
7282     for (i=0;i<n_recvs;i++) {
7283       PetscInt j;
7284       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7285         for (j=0;j<*(ptr_idxs+1);j++) {
7286           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7287         }
7288       } else {
7289         /* TODO */
7290       }
7291       ptr_idxs += olengths_idxs[i];
7292     }
7293     if (new_local_nnz) {
7294       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7295       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7296       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7297       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7298       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7299       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7300     } else {
7301       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7302     }
7303     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7304   } else {
7305     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7306   }
7307 
7308   /* set values */
7309   ptr_vals = recv_buffer_vals;
7310   ptr_idxs = recv_buffer_idxs_local;
7311   for (i=0;i<n_recvs;i++) {
7312     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7313       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7314       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7315       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7316       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7317       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7318     } else {
7319       /* TODO */
7320     }
7321     ptr_idxs += olengths_idxs[i];
7322     ptr_vals += olengths_vals[i];
7323   }
7324   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7325   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7326   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7327   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7328   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7329 
7330 #if 0
7331   if (!restrict_comm) { /* check */
7332     Vec       lvec,rvec;
7333     PetscReal infty_error;
7334 
7335     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7336     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7337     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7338     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7339     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7340     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7341     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7342     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7343     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7344   }
7345 #endif
7346 
7347   /* assemble new additional is (if any) */
7348   if (nis) {
7349     PetscInt **temp_idxs,*count_is,j,psum;
7350 
7351     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7352     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7353     ptr_idxs = recv_buffer_idxs_is;
7354     psum = 0;
7355     for (i=0;i<n_recvs;i++) {
7356       for (j=0;j<nis;j++) {
7357         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7358         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7359         psum += plen;
7360         ptr_idxs += plen+1; /* shift pointer to received data */
7361       }
7362     }
7363     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7364     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7365     for (i=1;i<nis;i++) {
7366       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7367     }
7368     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7369     ptr_idxs = recv_buffer_idxs_is;
7370     for (i=0;i<n_recvs;i++) {
7371       for (j=0;j<nis;j++) {
7372         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7373         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7374         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7375         ptr_idxs += plen+1; /* shift pointer to received data */
7376       }
7377     }
7378     for (i=0;i<nis;i++) {
7379       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7380       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7381       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7382     }
7383     ierr = PetscFree(count_is);CHKERRQ(ierr);
7384     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7385     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7386   }
7387   /* free workspace */
7388   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7389   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7390   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7391   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7392   if (isdense) {
7393     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7394     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7395   } else {
7396     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7397   }
7398   if (nis) {
7399     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7400     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7401   }
7402 
7403   if (nvecs) {
7404     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7405     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7406     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7407     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7408     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7409     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7410     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7411     /* set values */
7412     ptr_vals = recv_buffer_vecs;
7413     ptr_idxs = recv_buffer_idxs_local;
7414     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7415     for (i=0;i<n_recvs;i++) {
7416       PetscInt j;
7417       for (j=0;j<*(ptr_idxs+1);j++) {
7418         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7419       }
7420       ptr_idxs += olengths_idxs[i];
7421       ptr_vals += olengths_idxs[i]-2;
7422     }
7423     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7424     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7425     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7426   }
7427 
7428   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7429   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7430   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7431   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7432   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7433   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7434   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7435   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7436   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7437   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7438   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7439   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7440   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7441   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7442   ierr = PetscFree(onodes);CHKERRQ(ierr);
7443   if (nis) {
7444     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7445     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7446     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7447   }
7448   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7449   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7450     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7451     for (i=0;i<nis;i++) {
7452       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7453     }
7454     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7455       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7456     }
7457     *mat_n = NULL;
7458   }
7459   PetscFunctionReturn(0);
7460 }
7461 
7462 /* temporary hack into ksp private data structure */
7463 #include <petsc/private/kspimpl.h>
7464 
7465 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7466 {
7467   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7468   PC_IS                  *pcis = (PC_IS*)pc->data;
7469   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7470   Mat                    coarsedivudotp = NULL;
7471   Mat                    coarseG,t_coarse_mat_is;
7472   MatNullSpace           CoarseNullSpace = NULL;
7473   ISLocalToGlobalMapping coarse_islg;
7474   IS                     coarse_is,*isarray;
7475   PetscInt               i,im_active=-1,active_procs=-1;
7476   PetscInt               nis,nisdofs,nisneu,nisvert;
7477   PC                     pc_temp;
7478   PCType                 coarse_pc_type;
7479   KSPType                coarse_ksp_type;
7480   PetscBool              multilevel_requested,multilevel_allowed;
7481   PetscBool              isredundant,isbddc,isnn,coarse_reuse;
7482   PetscInt               ncoarse,nedcfield;
7483   PetscBool              compute_vecs = PETSC_FALSE;
7484   PetscScalar            *array;
7485   MatReuse               coarse_mat_reuse;
7486   PetscBool              restr, full_restr, have_void;
7487   PetscMPIInt            commsize;
7488   PetscErrorCode         ierr;
7489 
7490   PetscFunctionBegin;
7491   /* Assign global numbering to coarse dofs */
7492   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 */
7493     PetscInt ocoarse_size;
7494     compute_vecs = PETSC_TRUE;
7495 
7496     pcbddc->new_primal_space = PETSC_TRUE;
7497     ocoarse_size = pcbddc->coarse_size;
7498     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
7499     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
7500     /* see if we can avoid some work */
7501     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
7502       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
7503       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
7504         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
7505         coarse_reuse = PETSC_FALSE;
7506       } else { /* we can safely reuse already computed coarse matrix */
7507         coarse_reuse = PETSC_TRUE;
7508       }
7509     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
7510       coarse_reuse = PETSC_FALSE;
7511     }
7512     /* reset any subassembling information */
7513     if (!coarse_reuse || pcbddc->recompute_topography) {
7514       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7515     }
7516   } else { /* primal space is unchanged, so we can reuse coarse matrix */
7517     coarse_reuse = PETSC_TRUE;
7518   }
7519   /* assemble coarse matrix */
7520   if (coarse_reuse && pcbddc->coarse_ksp) {
7521     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
7522     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
7523     coarse_mat_reuse = MAT_REUSE_MATRIX;
7524   } else {
7525     coarse_mat = NULL;
7526     coarse_mat_reuse = MAT_INITIAL_MATRIX;
7527   }
7528 
7529   /* creates temporary l2gmap and IS for coarse indexes */
7530   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
7531   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
7532 
7533   /* creates temporary MATIS object for coarse matrix */
7534   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
7535   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7536   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
7537   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7538   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);
7539   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
7540   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7541   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7542   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
7543 
7544   /* count "active" (i.e. with positive local size) and "void" processes */
7545   im_active = !!(pcis->n);
7546   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7547 
7548   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
7549   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
7550   /* full_restr : just use the receivers from the subassembling pattern */
7551   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&commsize);CHKERRQ(ierr);
7552   coarse_mat_is = NULL;
7553   multilevel_allowed = PETSC_FALSE;
7554   multilevel_requested = PETSC_FALSE;
7555   pcbddc->coarse_eqs_per_proc = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
7556   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
7557   if (multilevel_requested) {
7558     ncoarse = active_procs/pcbddc->coarsening_ratio;
7559     restr = PETSC_FALSE;
7560     full_restr = PETSC_FALSE;
7561   } else {
7562     ncoarse = pcbddc->coarse_size/pcbddc->coarse_eqs_per_proc;
7563     restr = PETSC_TRUE;
7564     full_restr = PETSC_TRUE;
7565   }
7566   if (!pcbddc->coarse_size || commsize == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
7567   ncoarse = PetscMax(1,ncoarse);
7568   if (!pcbddc->coarse_subassembling) {
7569     if (pcbddc->coarsening_ratio > 1) {
7570       if (multilevel_requested) {
7571         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7572       } else {
7573         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7574       }
7575     } else {
7576       PetscMPIInt rank;
7577       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
7578       have_void = (active_procs == (PetscInt)commsize) ? PETSC_FALSE : PETSC_TRUE;
7579       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7580     }
7581   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
7582     PetscInt    psum;
7583     if (pcbddc->coarse_ksp) psum = 1;
7584     else psum = 0;
7585     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7586     if (ncoarse < commsize) have_void = PETSC_TRUE;
7587   }
7588   /* determine if we can go multilevel */
7589   if (multilevel_requested) {
7590     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
7591     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
7592   }
7593   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
7594 
7595   /* dump subassembling pattern */
7596   if (pcbddc->dbg_flag && multilevel_allowed) {
7597     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
7598   }
7599 
7600   /* compute dofs splitting and neumann boundaries for coarse dofs */
7601   nedcfield = -1;
7602   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal)) { /* protects from unneded computations */
7603     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
7604     const PetscInt         *idxs;
7605     ISLocalToGlobalMapping tmap;
7606 
7607     /* create map between primal indices (in local representative ordering) and local primal numbering */
7608     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
7609     /* allocate space for temporary storage */
7610     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
7611     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
7612     /* allocate for IS array */
7613     nisdofs = pcbddc->n_ISForDofsLocal;
7614     if (pcbddc->nedclocal) {
7615       if (pcbddc->nedfield > -1) {
7616         nedcfield = pcbddc->nedfield;
7617       } else {
7618         nedcfield = 0;
7619         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%d)",nisdofs);
7620         nisdofs = 1;
7621       }
7622     }
7623     nisneu = !!pcbddc->NeumannBoundariesLocal;
7624     nisvert = 0; /* nisvert is not used */
7625     nis = nisdofs + nisneu + nisvert;
7626     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
7627     /* dofs splitting */
7628     for (i=0;i<nisdofs;i++) {
7629       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
7630       if (nedcfield != i) {
7631         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
7632         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7633         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7634         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7635       } else {
7636         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
7637         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7638         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7639         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %d != %d\n",tsize,nout);
7640         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7641       }
7642       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7643       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7644       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
7645     }
7646     /* neumann boundaries */
7647     if (pcbddc->NeumannBoundariesLocal) {
7648       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
7649       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
7650       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7651       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7652       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7653       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7654       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
7655       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
7656     }
7657     /* free memory */
7658     ierr = PetscFree(tidxs);CHKERRQ(ierr);
7659     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
7660     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
7661   } else {
7662     nis = 0;
7663     nisdofs = 0;
7664     nisneu = 0;
7665     nisvert = 0;
7666     isarray = NULL;
7667   }
7668   /* destroy no longer needed map */
7669   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
7670 
7671   /* subassemble */
7672   if (multilevel_allowed) {
7673     Vec       vp[1];
7674     PetscInt  nvecs = 0;
7675     PetscBool reuse,reuser;
7676 
7677     if (coarse_mat) reuse = PETSC_TRUE;
7678     else reuse = PETSC_FALSE;
7679     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7680     vp[0] = NULL;
7681     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
7682       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
7683       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
7684       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
7685       nvecs = 1;
7686 
7687       if (pcbddc->divudotp) {
7688         Mat      B,loc_divudotp;
7689         Vec      v,p;
7690         IS       dummy;
7691         PetscInt np;
7692 
7693         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
7694         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
7695         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
7696         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
7697         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
7698         ierr = VecSet(p,1.);CHKERRQ(ierr);
7699         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
7700         ierr = VecDestroy(&p);CHKERRQ(ierr);
7701         ierr = MatDestroy(&B);CHKERRQ(ierr);
7702         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
7703         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
7704         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
7705         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
7706         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
7707         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
7708         ierr = VecDestroy(&v);CHKERRQ(ierr);
7709       }
7710     }
7711     if (reuser) {
7712       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7713     } else {
7714       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7715     }
7716     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
7717       PetscScalar *arraym,*arrayv;
7718       PetscInt    nl;
7719       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
7720       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
7721       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7722       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
7723       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
7724       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
7725       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7726       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
7727     } else {
7728       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
7729     }
7730   } else {
7731     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
7732   }
7733   if (coarse_mat_is || coarse_mat) {
7734     PetscMPIInt size;
7735     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)coarse_mat_is),&size);CHKERRQ(ierr);
7736     if (!multilevel_allowed) {
7737       ierr = MatISGetMPIXAIJ(coarse_mat_is,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
7738     } else {
7739       Mat A;
7740 
7741       /* if this matrix is present, it means we are not reusing the coarse matrix */
7742       if (coarse_mat_is) {
7743         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
7744         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
7745         coarse_mat = coarse_mat_is;
7746       }
7747       /* be sure we don't have MatSeqDENSE as local mat */
7748       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
7749       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
7750     }
7751   }
7752   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
7753   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
7754 
7755   /* create local to global scatters for coarse problem */
7756   if (compute_vecs) {
7757     PetscInt lrows;
7758     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
7759     if (coarse_mat) {
7760       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
7761     } else {
7762       lrows = 0;
7763     }
7764     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
7765     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
7766     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
7767     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7768     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7769   }
7770   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
7771 
7772   /* set defaults for coarse KSP and PC */
7773   if (multilevel_allowed) {
7774     coarse_ksp_type = KSPRICHARDSON;
7775     coarse_pc_type = PCBDDC;
7776   } else {
7777     coarse_ksp_type = KSPPREONLY;
7778     coarse_pc_type = PCREDUNDANT;
7779   }
7780 
7781   /* print some info if requested */
7782   if (pcbddc->dbg_flag) {
7783     if (!multilevel_allowed) {
7784       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
7785       if (multilevel_requested) {
7786         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);
7787       } else if (pcbddc->max_levels) {
7788         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
7789       }
7790       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7791     }
7792   }
7793 
7794   /* communicate coarse discrete gradient */
7795   coarseG = NULL;
7796   if (pcbddc->nedcG && multilevel_allowed) {
7797     MPI_Comm ccomm;
7798     if (coarse_mat) {
7799       ccomm = PetscObjectComm((PetscObject)coarse_mat);
7800     } else {
7801       ccomm = MPI_COMM_NULL;
7802     }
7803     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
7804   }
7805 
7806   /* create the coarse KSP object only once with defaults */
7807   if (coarse_mat) {
7808     PetscViewer dbg_viewer = NULL;
7809     if (pcbddc->dbg_flag) {
7810       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
7811       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7812     }
7813     if (!pcbddc->coarse_ksp) {
7814       char prefix[256],str_level[16];
7815       size_t len;
7816 
7817       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
7818       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
7819       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
7820       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
7821       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7822       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
7823       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
7824       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7825       /* TODO is this logic correct? should check for coarse_mat type */
7826       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7827       /* prefix */
7828       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
7829       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
7830       if (!pcbddc->current_level) {
7831         ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
7832         ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
7833       } else {
7834         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
7835         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
7836         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
7837         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
7838         sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
7839         ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
7840       }
7841       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
7842       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7843       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
7844       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
7845       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
7846       /* allow user customization */
7847       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
7848     }
7849     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7850     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7851     if (nisdofs) {
7852       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
7853       for (i=0;i<nisdofs;i++) {
7854         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7855       }
7856     }
7857     if (nisneu) {
7858       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
7859       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
7860     }
7861     if (nisvert) {
7862       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
7863       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
7864     }
7865     if (coarseG) {
7866       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
7867     }
7868 
7869     /* get some info after set from options */
7870     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
7871     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
7872     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
7873     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
7874     if (isbddc && !multilevel_allowed) {
7875       ierr   = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7876       isbddc = PETSC_FALSE;
7877     }
7878     /* multilevel cannot be done with coarse PCs different from BDDC or NN */
7879     if (multilevel_requested && !isbddc && !isnn) {
7880       ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
7881       isbddc = PETSC_TRUE;
7882       isnn   = PETSC_FALSE;
7883     }
7884     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
7885     if (isredundant) {
7886       KSP inner_ksp;
7887       PC  inner_pc;
7888 
7889       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
7890       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
7891       ierr = PCFactorSetReuseFill(inner_pc,PETSC_TRUE);CHKERRQ(ierr);
7892     }
7893 
7894     /* parameters which miss an API */
7895     if (isbddc) {
7896       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
7897       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
7898       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
7899       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
7900       if (pcbddc_coarse->benign_saddle_point) {
7901         Mat                    coarsedivudotp_is;
7902         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
7903         IS                     row,col;
7904         const PetscInt         *gidxs;
7905         PetscInt               n,st,M,N;
7906 
7907         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
7908         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
7909         st   = st-n;
7910         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
7911         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
7912         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
7913         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7914         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
7915         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7916         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
7917         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
7918         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
7919         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
7920         ierr = ISDestroy(&row);CHKERRQ(ierr);
7921         ierr = ISDestroy(&col);CHKERRQ(ierr);
7922         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
7923         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
7924         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
7925         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
7926         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
7927         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
7928         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
7929         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7930         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
7931         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
7932         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
7933         if (pcbddc->adaptive_threshold < 1.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
7934       }
7935     }
7936 
7937     /* propagate symmetry info of coarse matrix */
7938     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
7939     if (pc->pmat->symmetric_set) {
7940       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
7941     }
7942     if (pc->pmat->hermitian_set) {
7943       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
7944     }
7945     if (pc->pmat->spd_set) {
7946       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
7947     }
7948     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
7949       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
7950     }
7951     /* set operators */
7952     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7953     if (pcbddc->dbg_flag) {
7954       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7955     }
7956   }
7957   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
7958   ierr = PetscFree(isarray);CHKERRQ(ierr);
7959 #if 0
7960   {
7961     PetscViewer viewer;
7962     char filename[256];
7963     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
7964     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
7965     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
7966     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
7967     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
7968     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
7969   }
7970 #endif
7971 
7972   if (pcbddc->coarse_ksp) {
7973     Vec crhs,csol;
7974 
7975     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
7976     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
7977     if (!csol) {
7978       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
7979     }
7980     if (!crhs) {
7981       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
7982     }
7983   }
7984   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7985 
7986   /* compute null space for coarse solver if the benign trick has been requested */
7987   if (pcbddc->benign_null) {
7988 
7989     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
7990     for (i=0;i<pcbddc->benign_n;i++) {
7991       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
7992     }
7993     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
7994     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
7995     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7996     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7997     if (coarse_mat) {
7998       Vec         nullv;
7999       PetscScalar *array,*array2;
8000       PetscInt    nl;
8001 
8002       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
8003       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
8004       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8005       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
8006       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
8007       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
8008       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8009       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
8010       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
8011       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
8012     }
8013   }
8014 
8015   if (pcbddc->coarse_ksp) {
8016     PetscBool ispreonly;
8017 
8018     if (CoarseNullSpace) {
8019       PetscBool isnull;
8020       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
8021       if (isnull) {
8022         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
8023       }
8024       /* TODO: add local nullspaces (if any) */
8025     }
8026     /* setup coarse ksp */
8027     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
8028     /* Check coarse problem if in debug mode or if solving with an iterative method */
8029     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
8030     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
8031       KSP       check_ksp;
8032       KSPType   check_ksp_type;
8033       PC        check_pc;
8034       Vec       check_vec,coarse_vec;
8035       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8036       PetscInt  its;
8037       PetscBool compute_eigs;
8038       PetscReal *eigs_r,*eigs_c;
8039       PetscInt  neigs;
8040       const char *prefix;
8041 
8042       /* Create ksp object suitable for estimation of extreme eigenvalues */
8043       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
8044       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8045       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8046       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
8047       /* prevent from setup unneeded object */
8048       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
8049       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
8050       if (ispreonly) {
8051         check_ksp_type = KSPPREONLY;
8052         compute_eigs = PETSC_FALSE;
8053       } else {
8054         check_ksp_type = KSPGMRES;
8055         compute_eigs = PETSC_TRUE;
8056       }
8057       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
8058       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
8059       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
8060       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
8061       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
8062       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
8063       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
8064       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
8065       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
8066       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
8067       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
8068       /* create random vec */
8069       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
8070       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8071       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8072       /* solve coarse problem */
8073       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8074       /* set eigenvalue estimation if preonly has not been requested */
8075       if (compute_eigs) {
8076         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8077         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8078         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8079         if (neigs) {
8080           lambda_max = eigs_r[neigs-1];
8081           lambda_min = eigs_r[0];
8082           if (pcbddc->use_coarse_estimates) {
8083             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8084               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8085               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8086             }
8087           }
8088         }
8089       }
8090 
8091       /* check coarse problem residual error */
8092       if (pcbddc->dbg_flag) {
8093         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8094         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8095         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8096         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8097         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8098         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8099         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8100         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8101         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8102         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8103         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8104         if (CoarseNullSpace) {
8105           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8106         }
8107         if (compute_eigs) {
8108           PetscReal          lambda_max_s,lambda_min_s;
8109           KSPConvergedReason reason;
8110           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8111           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8112           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8113           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8114           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);
8115           for (i=0;i<neigs;i++) {
8116             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8117           }
8118         }
8119         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8120         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8121       }
8122       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8123       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8124       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8125       if (compute_eigs) {
8126         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8127         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8128       }
8129     }
8130   }
8131   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8132   /* print additional info */
8133   if (pcbddc->dbg_flag) {
8134     /* waits until all processes reaches this point */
8135     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8136     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
8137     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8138   }
8139 
8140   /* free memory */
8141   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8142   PetscFunctionReturn(0);
8143 }
8144 
8145 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8146 {
8147   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8148   PC_IS*         pcis = (PC_IS*)pc->data;
8149   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8150   IS             subset,subset_mult,subset_n;
8151   PetscInt       local_size,coarse_size=0;
8152   PetscInt       *local_primal_indices=NULL;
8153   const PetscInt *t_local_primal_indices;
8154   PetscErrorCode ierr;
8155 
8156   PetscFunctionBegin;
8157   /* Compute global number of coarse dofs */
8158   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8159   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8160   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8161   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8162   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8163   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8164   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8165   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8166   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8167   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);
8168   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8169   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8170   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
8171   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8172   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8173 
8174   /* check numbering */
8175   if (pcbddc->dbg_flag) {
8176     PetscScalar coarsesum,*array,*array2;
8177     PetscInt    i;
8178     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8179 
8180     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8181     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8182     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8183     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8184     /* counter */
8185     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8186     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8187     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8188     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8189     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8190     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8191     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8192     for (i=0;i<pcbddc->local_primal_size;i++) {
8193       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8194     }
8195     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8196     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8197     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8198     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8199     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8200     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8201     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8202     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8203     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8204     for (i=0;i<pcis->n;i++) {
8205       if (array[i] != 0.0 && array[i] != array2[i]) {
8206         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8207         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8208         set_error = PETSC_TRUE;
8209         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8210         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);
8211       }
8212     }
8213     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8214     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8215     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8216     for (i=0;i<pcis->n;i++) {
8217       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8218     }
8219     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8220     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8221     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8222     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8223     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8224     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8225     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8226       PetscInt *gidxs;
8227 
8228       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8229       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8230       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8231       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8232       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8233       for (i=0;i<pcbddc->local_primal_size;i++) {
8234         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);
8235       }
8236       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8237       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8238     }
8239     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8240     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8241     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8242   }
8243   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
8244   /* get back data */
8245   *coarse_size_n = coarse_size;
8246   *local_primal_indices_n = local_primal_indices;
8247   PetscFunctionReturn(0);
8248 }
8249 
8250 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8251 {
8252   IS             localis_t;
8253   PetscInt       i,lsize,*idxs,n;
8254   PetscScalar    *vals;
8255   PetscErrorCode ierr;
8256 
8257   PetscFunctionBegin;
8258   /* get indices in local ordering exploiting local to global map */
8259   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8260   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8261   for (i=0;i<lsize;i++) vals[i] = 1.0;
8262   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8263   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8264   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8265   if (idxs) { /* multilevel guard */
8266     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8267   }
8268   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8269   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8270   ierr = PetscFree(vals);CHKERRQ(ierr);
8271   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8272   /* now compute set in local ordering */
8273   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8274   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8275   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8276   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8277   for (i=0,lsize=0;i<n;i++) {
8278     if (PetscRealPart(vals[i]) > 0.5) {
8279       lsize++;
8280     }
8281   }
8282   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8283   for (i=0,lsize=0;i<n;i++) {
8284     if (PetscRealPart(vals[i]) > 0.5) {
8285       idxs[lsize++] = i;
8286     }
8287   }
8288   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8289   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8290   *localis = localis_t;
8291   PetscFunctionReturn(0);
8292 }
8293 
8294 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8295 {
8296   PC_IS               *pcis=(PC_IS*)pc->data;
8297   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8298   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8299   Mat                 S_j;
8300   PetscInt            *used_xadj,*used_adjncy;
8301   PetscBool           free_used_adj;
8302   PetscErrorCode      ierr;
8303 
8304   PetscFunctionBegin;
8305   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8306   free_used_adj = PETSC_FALSE;
8307   if (pcbddc->sub_schurs_layers == -1) {
8308     used_xadj = NULL;
8309     used_adjncy = NULL;
8310   } else {
8311     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8312       used_xadj = pcbddc->mat_graph->xadj;
8313       used_adjncy = pcbddc->mat_graph->adjncy;
8314     } else if (pcbddc->computed_rowadj) {
8315       used_xadj = pcbddc->mat_graph->xadj;
8316       used_adjncy = pcbddc->mat_graph->adjncy;
8317     } else {
8318       PetscBool      flg_row=PETSC_FALSE;
8319       const PetscInt *xadj,*adjncy;
8320       PetscInt       nvtxs;
8321 
8322       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8323       if (flg_row) {
8324         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8325         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8326         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8327         free_used_adj = PETSC_TRUE;
8328       } else {
8329         pcbddc->sub_schurs_layers = -1;
8330         used_xadj = NULL;
8331         used_adjncy = NULL;
8332       }
8333       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8334     }
8335   }
8336 
8337   /* setup sub_schurs data */
8338   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8339   if (!sub_schurs->schur_explicit) {
8340     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8341     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8342     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);
8343   } else {
8344     Mat       change = NULL;
8345     Vec       scaling = NULL;
8346     IS        change_primal = NULL, iP;
8347     PetscInt  benign_n;
8348     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8349     PetscBool isseqaij,need_change = PETSC_FALSE;
8350     PetscBool discrete_harmonic = PETSC_FALSE;
8351 
8352     if (!pcbddc->use_vertices && reuse_solvers) {
8353       PetscInt n_vertices;
8354 
8355       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8356       reuse_solvers = (PetscBool)!n_vertices;
8357     }
8358     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8359     if (!isseqaij) {
8360       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8361       if (matis->A == pcbddc->local_mat) {
8362         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8363         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8364       } else {
8365         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8366       }
8367     }
8368     if (!pcbddc->benign_change_explicit) {
8369       benign_n = pcbddc->benign_n;
8370     } else {
8371       benign_n = 0;
8372     }
8373     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
8374        We need a global reduction to avoid possible deadlocks.
8375        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
8376     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
8377       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
8378       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8379       need_change = (PetscBool)(!need_change);
8380     }
8381     /* If the user defines additional constraints, we import them here.
8382        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 */
8383     if (need_change) {
8384       PC_IS   *pcisf;
8385       PC_BDDC *pcbddcf;
8386       PC      pcf;
8387 
8388       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
8389       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
8390       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
8391       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
8392 
8393       /* hacks */
8394       pcisf                        = (PC_IS*)pcf->data;
8395       pcisf->is_B_local            = pcis->is_B_local;
8396       pcisf->vec1_N                = pcis->vec1_N;
8397       pcisf->BtoNmap               = pcis->BtoNmap;
8398       pcisf->n                     = pcis->n;
8399       pcisf->n_B                   = pcis->n_B;
8400       pcbddcf                      = (PC_BDDC*)pcf->data;
8401       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
8402       pcbddcf->mat_graph           = pcbddc->mat_graph;
8403       pcbddcf->use_faces           = PETSC_TRUE;
8404       pcbddcf->use_change_of_basis = PETSC_TRUE;
8405       pcbddcf->use_change_on_faces = PETSC_TRUE;
8406       pcbddcf->use_qr_single       = PETSC_TRUE;
8407       pcbddcf->fake_change         = PETSC_TRUE;
8408 
8409       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
8410       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
8411       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
8412       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
8413       change = pcbddcf->ConstraintMatrix;
8414       pcbddcf->ConstraintMatrix = NULL;
8415 
8416       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
8417       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
8418       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
8419       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
8420       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
8421       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
8422       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
8423       pcf->ops->destroy = NULL;
8424       pcf->ops->reset   = NULL;
8425       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
8426     }
8427     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
8428 
8429     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
8430     if (iP) {
8431       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
8432       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
8433       ierr = PetscOptionsEnd();CHKERRQ(ierr);
8434     }
8435     if (discrete_harmonic) {
8436       Mat A;
8437       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
8438       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
8439       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
8440       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);
8441       ierr = MatDestroy(&A);CHKERRQ(ierr);
8442     } else {
8443       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);
8444     }
8445     ierr = MatDestroy(&change);CHKERRQ(ierr);
8446     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
8447   }
8448   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8449 
8450   /* free adjacency */
8451   if (free_used_adj) {
8452     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
8453   }
8454   PetscFunctionReturn(0);
8455 }
8456 
8457 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
8458 {
8459   PC_IS               *pcis=(PC_IS*)pc->data;
8460   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8461   PCBDDCGraph         graph;
8462   PetscErrorCode      ierr;
8463 
8464   PetscFunctionBegin;
8465   /* attach interface graph for determining subsets */
8466   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
8467     IS       verticesIS,verticescomm;
8468     PetscInt vsize,*idxs;
8469 
8470     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8471     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
8472     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8473     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
8474     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8475     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8476     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
8477     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
8478     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
8479     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
8480     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
8481   } else {
8482     graph = pcbddc->mat_graph;
8483   }
8484   /* print some info */
8485   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
8486     IS       vertices;
8487     PetscInt nv,nedges,nfaces;
8488     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
8489     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8490     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
8491     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8492     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
8493     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
8494     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
8495     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
8496     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8497     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8498     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8499   }
8500 
8501   /* sub_schurs init */
8502   if (!pcbddc->sub_schurs) {
8503     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
8504   }
8505   ierr = PCBDDCSubSchursInit(pcbddc->sub_schurs,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap,pcbddc->sub_schurs_rebuild);CHKERRQ(ierr);
8506   pcbddc->sub_schurs->prefix = ((PetscObject)pc)->prefix;
8507 
8508   /* free graph struct */
8509   if (pcbddc->sub_schurs_rebuild) {
8510     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
8511   }
8512   PetscFunctionReturn(0);
8513 }
8514 
8515 PetscErrorCode PCBDDCCheckOperator(PC pc)
8516 {
8517   PC_IS               *pcis=(PC_IS*)pc->data;
8518   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8519   PetscErrorCode      ierr;
8520 
8521   PetscFunctionBegin;
8522   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
8523     IS             zerodiag = NULL;
8524     Mat            S_j,B0_B=NULL;
8525     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
8526     PetscScalar    *p0_check,*array,*array2;
8527     PetscReal      norm;
8528     PetscInt       i;
8529 
8530     /* B0 and B0_B */
8531     if (zerodiag) {
8532       IS       dummy;
8533 
8534       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
8535       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
8536       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
8537       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8538     }
8539     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
8540     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
8541     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
8542     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8543     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8544     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8545     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8546     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
8547     /* S_j */
8548     ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8549     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8550 
8551     /* mimic vector in \widetilde{W}_\Gamma */
8552     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
8553     /* continuous in primal space */
8554     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
8555     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8556     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8557     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8558     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
8559     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
8560     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8561     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8562     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8563     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8564     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8565     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8566     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
8567     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
8568 
8569     /* assemble rhs for coarse problem */
8570     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
8571     /* local with Schur */
8572     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
8573     if (zerodiag) {
8574       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8575       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
8576       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8577       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
8578     }
8579     /* sum on primal nodes the local contributions */
8580     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8581     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8582     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8583     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8584     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
8585     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8586     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8587     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
8588     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8589     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8590     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8591     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8592     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8593     /* scale primal nodes (BDDC sums contibutions) */
8594     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
8595     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8596     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8597     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8598     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8599     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8600     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8601     /* global: \widetilde{B0}_B w_\Gamma */
8602     if (zerodiag) {
8603       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
8604       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8605       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
8606       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8607     }
8608     /* BDDC */
8609     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
8610     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
8611 
8612     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
8613     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
8614     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
8615     PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);
8616     for (i=0;i<pcbddc->benign_n;i++) {
8617       PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%d] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));
8618     }
8619     ierr = PetscFree(p0_check);CHKERRQ(ierr);
8620     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
8621     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
8622     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
8623     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8624     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
8625   }
8626   PetscFunctionReturn(0);
8627 }
8628 
8629 #include <../src/mat/impls/aij/mpi/mpiaij.h>
8630 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
8631 {
8632   Mat            At;
8633   IS             rows;
8634   PetscInt       rst,ren;
8635   PetscErrorCode ierr;
8636   PetscLayout    rmap;
8637 
8638   PetscFunctionBegin;
8639   rst = ren = 0;
8640   if (ccomm != MPI_COMM_NULL) {
8641     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
8642     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
8643     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
8644     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
8645     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
8646   }
8647   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
8648   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
8649   ierr = ISDestroy(&rows);CHKERRQ(ierr);
8650 
8651   if (ccomm != MPI_COMM_NULL) {
8652     Mat_MPIAIJ *a,*b;
8653     IS         from,to;
8654     Vec        gvec;
8655     PetscInt   lsize;
8656 
8657     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
8658     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
8659     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
8660     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
8661     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
8662     a    = (Mat_MPIAIJ*)At->data;
8663     b    = (Mat_MPIAIJ*)(*B)->data;
8664     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
8665     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
8666     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
8667     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
8668     b->A = a->A;
8669     b->B = a->B;
8670 
8671     b->donotstash      = a->donotstash;
8672     b->roworiented     = a->roworiented;
8673     b->rowindices      = 0;
8674     b->rowvalues       = 0;
8675     b->getrowactive    = PETSC_FALSE;
8676 
8677     (*B)->rmap         = rmap;
8678     (*B)->factortype   = A->factortype;
8679     (*B)->assembled    = PETSC_TRUE;
8680     (*B)->insertmode   = NOT_SET_VALUES;
8681     (*B)->preallocated = PETSC_TRUE;
8682 
8683     if (a->colmap) {
8684 #if defined(PETSC_USE_CTABLE)
8685       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
8686 #else
8687       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
8688       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8689       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8690 #endif
8691     } else b->colmap = 0;
8692     if (a->garray) {
8693       PetscInt len;
8694       len  = a->B->cmap->n;
8695       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
8696       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
8697       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
8698     } else b->garray = 0;
8699 
8700     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
8701     b->lvec = a->lvec;
8702     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
8703 
8704     /* cannot use VecScatterCopy */
8705     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
8706     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
8707     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
8708     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
8709     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
8710     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
8711     ierr = ISDestroy(&from);CHKERRQ(ierr);
8712     ierr = ISDestroy(&to);CHKERRQ(ierr);
8713     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
8714   }
8715   ierr = MatDestroy(&At);CHKERRQ(ierr);
8716   PetscFunctionReturn(0);
8717 }
8718