xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 4d43cd7aaa02a7d0c1aeaa106cfcff04c43dc8ab)
1 #include <../src/mat/impls/aij/seq/aij.h>
2 #include <../src/ksp/pc/impls/bddc/bddc.h>
3 #include <../src/ksp/pc/impls/bddc/bddcprivate.h>
4 #include <../src/mat/impls/dense/seq/dense.h>
5 #include <petscdmplex.h>
6 #include <petscblaslapack.h>
7 #include <petsc/private/sfimpl.h>
8 #include <petsc/private/dmpleximpl.h>
9 #include <petscdmda.h>
10 
11 static PetscErrorCode MatMPIAIJRestrict(Mat,MPI_Comm,Mat*);
12 
13 /* if range is true,  it returns B s.t. span{B} = range(A)
14    if range is false, it returns B s.t. range(B) _|_ range(A) */
15 PetscErrorCode MatDenseOrthogonalRangeOrComplement(Mat A, PetscBool range, PetscInt lw, PetscScalar *work, PetscReal *rwork, Mat *B)
16 {
17 #if !defined(PETSC_USE_COMPLEX)
18   PetscScalar    *uwork,*data,*U, ds = 0.;
19   PetscReal      *sing;
20   PetscBLASInt   bM,bN,lwork,lierr,di = 1;
21   PetscInt       ulw,i,nr,nc,n;
22   PetscErrorCode ierr;
23 
24   PetscFunctionBegin;
25 #if defined(PETSC_MISSING_LAPACK_GESVD)
26   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"LAPACK _GESVD not available");
27 #else
28   ierr = MatGetSize(A,&nr,&nc);CHKERRQ(ierr);
29   if (!nr || !nc) PetscFunctionReturn(0);
30 
31   /* workspace */
32   if (!work) {
33     ulw  = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc));
34     ierr = PetscMalloc1(ulw,&uwork);CHKERRQ(ierr);
35   } else {
36     ulw   = lw;
37     uwork = work;
38   }
39   n = PetscMin(nr,nc);
40   if (!rwork) {
41     ierr = PetscMalloc1(n,&sing);CHKERRQ(ierr);
42   } else {
43     sing = rwork;
44   }
45 
46   /* SVD */
47   ierr = PetscMalloc1(nr*nr,&U);CHKERRQ(ierr);
48   ierr = PetscBLASIntCast(nr,&bM);CHKERRQ(ierr);
49   ierr = PetscBLASIntCast(nc,&bN);CHKERRQ(ierr);
50   ierr = PetscBLASIntCast(ulw,&lwork);CHKERRQ(ierr);
51   ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr);
52   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
53   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr));
54   ierr = PetscFPTrapPop();CHKERRQ(ierr);
55   if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
56   ierr = MatDenseRestoreArray(A,&data);CHKERRQ(ierr);
57   for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break;
58   if (!rwork) {
59     ierr = PetscFree(sing);CHKERRQ(ierr);
60   }
61   if (!work) {
62     ierr = PetscFree(uwork);CHKERRQ(ierr);
63   }
64   /* create B */
65   if (!range) {
66     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B);CHKERRQ(ierr);
67     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
68     ierr = PetscMemcpy(data,U+nr*i,(nr-i)*nr*sizeof(PetscScalar));CHKERRQ(ierr);
69   } else {
70     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,i,NULL,B);CHKERRQ(ierr);
71     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
72     ierr = PetscMemcpy(data,U,i*nr*sizeof(PetscScalar));CHKERRQ(ierr);
73   }
74   ierr = MatDenseRestoreArray(*B,&data);CHKERRQ(ierr);
75   ierr = PetscFree(U);CHKERRQ(ierr);
76 #endif
77 #else /* PETSC_USE_COMPLEX */
78   PetscFunctionBegin;
79   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented for complexes");
80 #endif
81   PetscFunctionReturn(0);
82 }
83 
84 /* TODO REMOVE */
85 #if defined(PRINT_GDET)
86 static int inc = 0;
87 static int lev = 0;
88 #endif
89 
90 PetscErrorCode PCBDDCComputeNedelecChangeEdge(Mat lG, IS edge, IS extrow, IS extcol, IS corners, Mat* Gins, Mat* GKins, PetscScalar cvals[2], PetscScalar *work, PetscReal *rwork)
91 {
92   PetscErrorCode ierr;
93   Mat            GE,GEd;
94   PetscInt       rsize,csize,esize;
95   PetscScalar    *ptr;
96 
97   PetscFunctionBegin;
98   ierr = ISGetSize(edge,&esize);CHKERRQ(ierr);
99   if (!esize) PetscFunctionReturn(0);
100   ierr = ISGetSize(extrow,&rsize);CHKERRQ(ierr);
101   ierr = ISGetSize(extcol,&csize);CHKERRQ(ierr);
102 
103   /* gradients */
104   ptr  = work + 5*esize;
105   ierr = MatCreateSubMatrix(lG,extrow,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
106   ierr = MatCreateSeqDense(PETSC_COMM_SELF,rsize,csize,ptr,Gins);CHKERRQ(ierr);
107   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,Gins);CHKERRQ(ierr);
108   ierr = MatDestroy(&GE);CHKERRQ(ierr);
109 
110   /* constants */
111   ptr += rsize*csize;
112   ierr = MatCreateSeqDense(PETSC_COMM_SELF,esize,csize,ptr,&GEd);CHKERRQ(ierr);
113   ierr = MatCreateSubMatrix(lG,edge,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
114   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,&GEd);CHKERRQ(ierr);
115   ierr = MatDestroy(&GE);CHKERRQ(ierr);
116   ierr = MatDenseOrthogonalRangeOrComplement(GEd,PETSC_FALSE,5*esize,work,rwork,GKins);CHKERRQ(ierr);
117   ierr = MatDestroy(&GEd);CHKERRQ(ierr);
118 
119   if (corners) {
120     Mat            GEc;
121     PetscScalar    *vals,v;
122 
123     ierr = MatCreateSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr);
124     ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr);
125     ierr = MatDenseGetArray(GEd,&vals);CHKERRQ(ierr);
126     /* v    = PetscAbsScalar(vals[0]) */;
127     v    = 1.;
128     cvals[0] = vals[0]/v;
129     cvals[1] = vals[1]/v;
130     ierr = MatDenseRestoreArray(GEd,&vals);CHKERRQ(ierr);
131     ierr = MatScale(*GKins,1./v);CHKERRQ(ierr);
132 #if defined(PRINT_GDET)
133     {
134       PetscViewer viewer;
135       char filename[256];
136       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
137       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
138       ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
139       ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr);
140       ierr = MatView(GEc,viewer);CHKERRQ(ierr);
141       ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr);
142       ierr = MatView(*GKins,viewer);CHKERRQ(ierr);
143       ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr);
144       ierr = MatView(GEd,viewer);CHKERRQ(ierr);
145       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
146     }
147 #endif
148     ierr = MatDestroy(&GEd);CHKERRQ(ierr);
149     ierr = MatDestroy(&GEc);CHKERRQ(ierr);
150   }
151 
152   PetscFunctionReturn(0);
153 }
154 
155 PetscErrorCode PCBDDCNedelecSupport(PC pc)
156 {
157   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
158   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
159   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
160   Vec                    tvec;
161   PetscSF                sfv;
162   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
163   MPI_Comm               comm;
164   IS                     lned,primals,allprimals,nedfieldlocal;
165   IS                     *eedges,*extrows,*extcols,*alleedges;
166   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
167   PetscScalar            *vals,*work;
168   PetscReal              *rwork;
169   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
170   PetscInt               ne,nv,Lv,order,n,field;
171   PetscInt               n_neigh,*neigh,*n_shared,**shared;
172   PetscInt               i,j,extmem,cum,maxsize,nee;
173   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
174   PetscInt               *sfvleaves,*sfvroots;
175   PetscInt               *corners,*cedges;
176   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
177 #if defined(PETSC_USE_DEBUG)
178   PetscInt               *emarks;
179 #endif
180   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
181   PetscErrorCode         ierr;
182 
183   PetscFunctionBegin;
184   /* If the discrete gradient is defined for a subset of dofs and global is true,
185      it assumes G is given in global ordering for all the dofs.
186      Otherwise, the ordering is global for the Nedelec field */
187   order      = pcbddc->nedorder;
188   conforming = pcbddc->conforming;
189   field      = pcbddc->nedfield;
190   global     = pcbddc->nedglobal;
191   setprimal  = PETSC_FALSE;
192   print      = PETSC_FALSE;
193   singular   = PETSC_FALSE;
194 
195   /* Command line customization */
196   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
197   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
198   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
199   ierr = PetscOptionsInt("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
200   /* print debug info TODO: to be removed */
201   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
202   ierr = PetscOptionsEnd();CHKERRQ(ierr);
203 
204   /* Return if there are no edges in the decomposition and the problem is not singular */
205   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
206   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
207   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
208   if (!singular) {
209     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
210     lrc[0] = PETSC_FALSE;
211     for (i=0;i<n;i++) {
212       if (PetscRealPart(vals[i]) > 2.) {
213         lrc[0] = PETSC_TRUE;
214         break;
215       }
216     }
217     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
218     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
219     if (!lrc[1]) PetscFunctionReturn(0);
220   }
221 
222   /* Get Nedelec field */
223   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
224   if (pcbddc->n_ISForDofsLocal && field >= pcbddc->n_ISForDofsLocal) SETERRQ2(comm,PETSC_ERR_USER,"Invalid field for Nedelec %d: number of fields is %d",field,pcbddc->n_ISForDofsLocal);
225   if (pcbddc->n_ISForDofsLocal && field >= 0) {
226     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
227     nedfieldlocal = pcbddc->ISForDofsLocal[field];
228     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
229   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
230     ne            = n;
231     nedfieldlocal = NULL;
232     global        = PETSC_TRUE;
233   } else if (field == PETSC_DECIDE) {
234     PetscInt rst,ren,*idx;
235 
236     ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
237     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
238     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
239     for (i=rst;i<ren;i++) {
240       PetscInt nc;
241 
242       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
243       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
244       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
245     }
246     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
247     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
248     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
249     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
250     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
251   } else {
252     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
253   }
254 
255   /* Sanity checks */
256   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
257   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
258   if (order && ne%order) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"The number of local edge dofs %d it's not a multiple of the order %d",ne,order);
259 
260   /* Just set primal dofs and return */
261   if (setprimal) {
262     IS       enedfieldlocal;
263     PetscInt *eidxs;
264 
265     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
266     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
267     if (nedfieldlocal) {
268       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
269       for (i=0,cum=0;i<ne;i++) {
270         if (PetscRealPart(vals[idxs[i]]) > 2.) {
271           eidxs[cum++] = idxs[i];
272         }
273       }
274       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
275     } else {
276       for (i=0,cum=0;i<ne;i++) {
277         if (PetscRealPart(vals[i]) > 2.) {
278           eidxs[cum++] = i;
279         }
280       }
281     }
282     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
283     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
284     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
285     ierr = PetscFree(eidxs);CHKERRQ(ierr);
286     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
287     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
288     PetscFunctionReturn(0);
289   }
290 
291   /* Compute some l2g maps */
292   if (nedfieldlocal) {
293     IS is;
294 
295     /* need to map from the local Nedelec field to local numbering */
296     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
297     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
298     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
299     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
300     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
301     if (global) {
302       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
303       el2g = al2g;
304     } else {
305       IS gis;
306 
307       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
308       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
309       ierr = ISDestroy(&gis);CHKERRQ(ierr);
310     }
311     ierr = ISDestroy(&is);CHKERRQ(ierr);
312   } else {
313     /* restore default */
314     pcbddc->nedfield = -1;
315     /* one ref for the destruction of al2g, one for el2g */
316     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
317     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
318     el2g = al2g;
319     fl2g = NULL;
320   }
321 
322   /* Start communication to drop connections for interior edges (for cc analysis only) */
323   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
324   ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
325   if (nedfieldlocal) {
326     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
327     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
328     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
329   } else {
330     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
331   }
332   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
333   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
334 
335   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
336     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
337     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
338     if (global) {
339       PetscInt rst;
340 
341       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
342       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
343         if (matis->sf_rootdata[i] < 2) {
344           matis->sf_rootdata[cum++] = i + rst;
345         }
346       }
347       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
348       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
349     } else {
350       PetscInt *tbz;
351 
352       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
353       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
354       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
355       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
356       for (i=0,cum=0;i<ne;i++)
357         if (matis->sf_leafdata[idxs[i]] == 1)
358           tbz[cum++] = i;
359       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
360       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
361       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
362       ierr = PetscFree(tbz);CHKERRQ(ierr);
363     }
364   } else { /* we need the entire G to infer the nullspace */
365     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
366     G    = pcbddc->discretegradient;
367   }
368 
369   /* Extract subdomain relevant rows of G */
370   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
371   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
372   ierr = MatCreateSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
373   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
374   ierr = ISDestroy(&lned);CHKERRQ(ierr);
375   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
376   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
377   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
378 
379   /* SF for nodal dofs communications */
380   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
381   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
382   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
383   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
384   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
385   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
386   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
387   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
388   i    = singular ? 2 : 1;
389   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
390 
391   /* Destroy temporary G created in MATIS format and modified G */
392   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
393   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
394   ierr = MatDestroy(&G);CHKERRQ(ierr);
395 
396   if (print) {
397     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
398     ierr = MatView(lG,NULL);CHKERRQ(ierr);
399   }
400 
401   /* Save lG for values insertion in change of basis */
402   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
403 
404   /* Analyze the edge-nodes connections (duplicate lG) */
405   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
406   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
407   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
408   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
409   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
410   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
411   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
412   /* need to import the boundary specification to ensure the
413      proper detection of coarse edges' endpoints */
414   if (pcbddc->DirichletBoundariesLocal) {
415     IS is;
416 
417     if (fl2g) {
418       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
419     } else {
420       is = pcbddc->DirichletBoundariesLocal;
421     }
422     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
423     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
424     for (i=0;i<cum;i++) {
425       if (idxs[i] >= 0) {
426         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
427         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
428       }
429     }
430     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
431     if (fl2g) {
432       ierr = ISDestroy(&is);CHKERRQ(ierr);
433     }
434   }
435   if (pcbddc->NeumannBoundariesLocal) {
436     IS is;
437 
438     if (fl2g) {
439       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
440     } else {
441       is = pcbddc->NeumannBoundariesLocal;
442     }
443     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
444     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
445     for (i=0;i<cum;i++) {
446       if (idxs[i] >= 0) {
447         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
448       }
449     }
450     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
451     if (fl2g) {
452       ierr = ISDestroy(&is);CHKERRQ(ierr);
453     }
454   }
455 
456   /* Count neighs per dof */
457   ierr = ISLocalToGlobalMappingGetNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
458   ierr = ISLocalToGlobalMappingGetNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
459 
460   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
461      for proper detection of coarse edges' endpoints */
462   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
463   for (i=0;i<ne;i++) {
464     if ((ecount[i] > 2 && !PetscBTLookup(btbd,i)) || (ecount[i] == 2 && PetscBTLookup(btb,i))) {
465       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
466     }
467   }
468   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
469   if (!conforming) {
470     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
471     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
472   }
473   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
474   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
475   cum  = 0;
476   for (i=0;i<ne;i++) {
477     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
478     if (!PetscBTLookup(btee,i)) {
479       marks[cum++] = i;
480       continue;
481     }
482     /* set badly connected edge dofs as primal */
483     if (!conforming) {
484       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
485         marks[cum++] = i;
486         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
487         for (j=ii[i];j<ii[i+1];j++) {
488           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
489         }
490       } else {
491         /* every edge dofs should be connected trough a certain number of nodal dofs
492            to other edge dofs belonging to coarse edges
493            - at most 2 endpoints
494            - order-1 interior nodal dofs
495            - no undefined nodal dofs (nconn < order)
496         */
497         PetscInt ends = 0,ints = 0, undef = 0;
498         for (j=ii[i];j<ii[i+1];j++) {
499           PetscInt v = jj[j],k;
500           PetscInt nconn = iit[v+1]-iit[v];
501           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
502           if (nconn > order) ends++;
503           else if (nconn == order) ints++;
504           else undef++;
505         }
506         if (undef || ends > 2 || ints != order -1) {
507           marks[cum++] = i;
508           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
509           for (j=ii[i];j<ii[i+1];j++) {
510             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
511           }
512         }
513       }
514     }
515     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
516     if (!order && ii[i+1] != ii[i]) {
517       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
518       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
519     }
520   }
521   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
522   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
523   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
524   if (!conforming) {
525     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
526     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
527   }
528   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
529 
530   /* identify splitpoints and corner candidates */
531   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
532   if (print) {
533     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
534     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
535     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
536     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
537   }
538   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
539   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
540   for (i=0;i<nv;i++) {
541     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
542     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
543     if (!order) { /* variable order */
544       PetscReal vorder = 0.;
545 
546       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
547       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
548       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%d)",vorder,test);
549       ord  = 1;
550     }
551 #if defined(PETSC_USE_DEBUG)
552     if (test%ord) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected number of edge dofs %d connected with nodal dof %d with order %d",test,i,ord);
553 #endif
554     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
555       if (PetscBTLookup(btbd,jj[j])) {
556         bdir = PETSC_TRUE;
557         break;
558       }
559       if (vc != ecount[jj[j]]) {
560         sneighs = PETSC_FALSE;
561       } else {
562         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
563         for (k=0;k<vc;k++) {
564           if (vn[k] != en[k]) {
565             sneighs = PETSC_FALSE;
566             break;
567           }
568         }
569       }
570     }
571     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
572       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %d (%d %d %d)\n",i,!sneighs,test >= 3*ord,bdir);
573       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
574     } else if (test == ord) {
575       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
576         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %d\n",i);
577         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
578       } else {
579         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %d\n",i);
580         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
581       }
582     }
583   }
584   ierr = ISLocalToGlobalMappingRestoreNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
585   ierr = ISLocalToGlobalMappingRestoreNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
586   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
587 
588   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
589   if (order != 1) {
590     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
591     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
592     for (i=0;i<nv;i++) {
593       if (PetscBTLookup(btvcand,i)) {
594         PetscBool found = PETSC_FALSE;
595         for (j=ii[i];j<ii[i+1] && !found;j++) {
596           PetscInt k,e = jj[j];
597           if (PetscBTLookup(bte,e)) continue;
598           for (k=iit[e];k<iit[e+1];k++) {
599             PetscInt v = jjt[k];
600             if (v != i && PetscBTLookup(btvcand,v)) {
601               found = PETSC_TRUE;
602               break;
603             }
604           }
605         }
606         if (!found) {
607           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d CLEARED\n",i);
608           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
609         } else {
610           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d ACCEPTED\n",i);
611         }
612       }
613     }
614     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
615   }
616   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
617   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
618   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
619 
620   /* Get the local G^T explicitly */
621   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
622   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
623   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
624 
625   /* Mark interior nodal dofs */
626   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
627   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
628   for (i=1;i<n_neigh;i++) {
629     for (j=0;j<n_shared[i];j++) {
630       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
631     }
632   }
633   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
634 
635   /* communicate corners and splitpoints */
636   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
637   ierr = PetscMemzero(sfvleaves,nv*sizeof(PetscInt));CHKERRQ(ierr);
638   ierr = PetscMemzero(sfvroots,Lv*sizeof(PetscInt));CHKERRQ(ierr);
639   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
640 
641   if (print) {
642     IS tbz;
643 
644     cum = 0;
645     for (i=0;i<nv;i++)
646       if (sfvleaves[i])
647         vmarks[cum++] = i;
648 
649     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
650     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
651     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
652     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
653   }
654 
655   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
656   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
657   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
658   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
659 
660   /* Zero rows of lGt corresponding to identified corners
661      and interior nodal dofs */
662   cum = 0;
663   for (i=0;i<nv;i++) {
664     if (sfvleaves[i]) {
665       vmarks[cum++] = i;
666       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
667     }
668     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
669   }
670   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
671   if (print) {
672     IS tbz;
673 
674     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
675     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
676     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
677     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
678   }
679   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
680   ierr = PetscFree(vmarks);CHKERRQ(ierr);
681   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
682   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
683 
684   /* Recompute G */
685   ierr = MatDestroy(&lG);CHKERRQ(ierr);
686   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
687   if (print) {
688     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
689     ierr = MatView(lG,NULL);CHKERRQ(ierr);
690     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
691     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
692   }
693 
694   /* Get primal dofs (if any) */
695   cum = 0;
696   for (i=0;i<ne;i++) {
697     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
698   }
699   if (fl2g) {
700     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
701   }
702   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
703   if (print) {
704     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
705     ierr = ISView(primals,NULL);CHKERRQ(ierr);
706   }
707   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
708   /* TODO: what if the user passed in some of them ?  */
709   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
710   ierr = ISDestroy(&primals);CHKERRQ(ierr);
711 
712   /* Compute edge connectivity */
713   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
714   ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr);
715   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
716   if (fl2g) {
717     PetscBT   btf;
718     PetscInt  *iia,*jja,*iiu,*jju;
719     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
720 
721     /* create CSR for all local dofs */
722     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
723     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
724       if (pcbddc->mat_graph->nvtxs_csr != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid size of CSR graph %d. Should be %d\n",pcbddc->mat_graph->nvtxs_csr,n);
725       iiu = pcbddc->mat_graph->xadj;
726       jju = pcbddc->mat_graph->adjncy;
727     } else if (pcbddc->use_local_adj) {
728       rest = PETSC_TRUE;
729       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
730     } else {
731       free   = PETSC_TRUE;
732       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
733       iiu[0] = 0;
734       for (i=0;i<n;i++) {
735         iiu[i+1] = i+1;
736         jju[i]   = -1;
737       }
738     }
739 
740     /* import sizes of CSR */
741     iia[0] = 0;
742     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
743 
744     /* overwrite entries corresponding to the Nedelec field */
745     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
746     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
747     for (i=0;i<ne;i++) {
748       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
749       iia[idxs[i]+1] = ii[i+1]-ii[i];
750     }
751 
752     /* iia in CSR */
753     for (i=0;i<n;i++) iia[i+1] += iia[i];
754 
755     /* jja in CSR */
756     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
757     for (i=0;i<n;i++)
758       if (!PetscBTLookup(btf,i))
759         for (j=0;j<iiu[i+1]-iiu[i];j++)
760           jja[iia[i]+j] = jju[iiu[i]+j];
761 
762     /* map edge dofs connectivity */
763     if (jj) {
764       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
765       for (i=0;i<ne;i++) {
766         PetscInt e = idxs[i];
767         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
768       }
769     }
770     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
771     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
772     if (rest) {
773       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
774     }
775     if (free) {
776       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
777     }
778     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
779   } else {
780     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
781   }
782 
783   /* Analyze interface for edge dofs */
784   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
785   pcbddc->mat_graph->twodim = PETSC_FALSE;
786 
787   /* Get coarse edges in the edge space */
788   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
789   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
790 
791   if (fl2g) {
792     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
793     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
794     for (i=0;i<nee;i++) {
795       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
796     }
797   } else {
798     eedges  = alleedges;
799     primals = allprimals;
800   }
801 
802   /* Mark fine edge dofs with their coarse edge id */
803   ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
804   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
805   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
806   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
807   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
808   if (print) {
809     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
810     ierr = ISView(primals,NULL);CHKERRQ(ierr);
811   }
812 
813   maxsize = 0;
814   for (i=0;i<nee;i++) {
815     PetscInt size,mark = i+1;
816 
817     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
818     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
819     for (j=0;j<size;j++) marks[idxs[j]] = mark;
820     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
821     maxsize = PetscMax(maxsize,size);
822   }
823 
824   /* Find coarse edge endpoints */
825   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
826   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
827   for (i=0;i<nee;i++) {
828     PetscInt mark = i+1,size;
829 
830     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
831     if (!size && nedfieldlocal) continue;
832     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
833     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
834     if (print) {
835       PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %d\n",i);
836       ISView(eedges[i],NULL);
837     }
838     for (j=0;j<size;j++) {
839       PetscInt k, ee = idxs[j];
840       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %d\n",ee);
841       for (k=ii[ee];k<ii[ee+1];k++) {
842         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %d\n",jj[k]);
843         if (PetscBTLookup(btv,jj[k])) {
844           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %d\n",jj[k]);
845         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
846           PetscInt  k2;
847           PetscBool corner = PETSC_FALSE;
848           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
849             if (print) PetscPrintf(PETSC_COMM_SELF,"        INSPECTING %d: mark %d (ref mark %d), boundary %d\n",jjt[k2],marks[jjt[k2]],mark,!!PetscBTLookup(btb,jjt[k2]));
850             /* it's a corner if either is connected with an edge dof belonging to a different cc or
851                if the edge dof lie on the natural part of the boundary */
852             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
853               corner = PETSC_TRUE;
854               break;
855             }
856           }
857           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
858             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %d\n",jj[k]);
859             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
860           } else {
861             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
862           }
863         }
864       }
865     }
866     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
867   }
868   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
869   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
870   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
871 
872   /* Reset marked primal dofs */
873   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
874   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
875   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
876   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
877 
878   /* Now use the initial lG */
879   ierr = MatDestroy(&lG);CHKERRQ(ierr);
880   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
881   lG   = lGinit;
882   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
883 
884   /* Compute extended cols indices */
885   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
886   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
887   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
888   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
889   i   *= maxsize;
890   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
891   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
892   eerr = PETSC_FALSE;
893   for (i=0;i<nee;i++) {
894     PetscInt size,found = 0;
895 
896     cum  = 0;
897     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
898     if (!size && nedfieldlocal) continue;
899     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
900     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
901     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
902     for (j=0;j<size;j++) {
903       PetscInt k,ee = idxs[j];
904       for (k=ii[ee];k<ii[ee+1];k++) {
905         PetscInt vv = jj[k];
906         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
907         else if (!PetscBTLookupSet(btvc,vv)) found++;
908       }
909     }
910     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
911     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
912     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
913     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
914     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
915     /* it may happen that endpoints are not defined at this point
916        if it is the case, mark this edge for a second pass */
917     if (cum != size -1 || found != 2) {
918       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
919       if (print) {
920         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
921         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
922         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
923         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
924       }
925       eerr = PETSC_TRUE;
926     }
927   }
928   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
929   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
930   if (done) {
931     PetscInt *newprimals;
932 
933     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
934     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
935     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
936     ierr = PetscMemcpy(newprimals,idxs,cum*sizeof(PetscInt));CHKERRQ(ierr);
937     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
938     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
939     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %d)\n",eerr);
940     for (i=0;i<nee;i++) {
941       PetscBool has_candidates = PETSC_FALSE;
942       if (PetscBTLookup(bter,i)) {
943         PetscInt size,mark = i+1;
944 
945         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
946         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
947         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
948         for (j=0;j<size;j++) {
949           PetscInt k,ee = idxs[j];
950           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %d [%d %d)\n",ee,ii[ee],ii[ee+1]);
951           for (k=ii[ee];k<ii[ee+1];k++) {
952             /* set all candidates located on the edge as corners */
953             if (PetscBTLookup(btvcand,jj[k])) {
954               PetscInt k2,vv = jj[k];
955               has_candidates = PETSC_TRUE;
956               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %d\n",vv);
957               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
958               /* set all edge dofs connected to candidate as primals */
959               for (k2=iit[vv];k2<iit[vv+1];k2++) {
960                 if (marks[jjt[k2]] == mark) {
961                   PetscInt k3,ee2 = jjt[k2];
962                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %d\n",ee2);
963                   newprimals[cum++] = ee2;
964                   /* finally set the new corners */
965                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
966                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %d\n",jj[k3]);
967                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
968                   }
969                 }
970               }
971             } else {
972               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %d\n",jj[k]);
973             }
974           }
975         }
976         if (!has_candidates) { /* circular edge */
977           PetscInt k, ee = idxs[0],*tmarks;
978 
979           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
980           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %d\n",i);
981           for (k=ii[ee];k<ii[ee+1];k++) {
982             PetscInt k2;
983             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %d\n",jj[k]);
984             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
985             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
986           }
987           for (j=0;j<size;j++) {
988             if (tmarks[idxs[j]] > 1) {
989               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %d\n",idxs[j]);
990               newprimals[cum++] = idxs[j];
991             }
992           }
993           ierr = PetscFree(tmarks);CHKERRQ(ierr);
994         }
995         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
996       }
997       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
998     }
999     ierr = PetscFree(extcols);CHKERRQ(ierr);
1000     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1001     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1002     if (fl2g) {
1003       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1004       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1005       for (i=0;i<nee;i++) {
1006         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1007       }
1008       ierr = PetscFree(eedges);CHKERRQ(ierr);
1009     }
1010     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1011     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1012     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1013     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1014     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1015     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1016     pcbddc->mat_graph->twodim = PETSC_FALSE;
1017     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1018     if (fl2g) {
1019       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1020       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1021       for (i=0;i<nee;i++) {
1022         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1023       }
1024     } else {
1025       eedges  = alleedges;
1026       primals = allprimals;
1027     }
1028     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1029 
1030     /* Mark again */
1031     ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
1032     for (i=0;i<nee;i++) {
1033       PetscInt size,mark = i+1;
1034 
1035       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1036       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1037       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1038       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1039     }
1040     if (print) {
1041       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1042       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1043     }
1044 
1045     /* Recompute extended cols */
1046     eerr = PETSC_FALSE;
1047     for (i=0;i<nee;i++) {
1048       PetscInt size;
1049 
1050       cum  = 0;
1051       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1052       if (!size && nedfieldlocal) continue;
1053       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1054       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1055       for (j=0;j<size;j++) {
1056         PetscInt k,ee = idxs[j];
1057         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1058       }
1059       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1060       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1061       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1062       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1063       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1064       if (cum != size -1) {
1065         if (print) {
1066           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1067           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1068           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1069           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1070         }
1071         eerr = PETSC_TRUE;
1072       }
1073     }
1074   }
1075   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1076   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1077   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1078   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1079   /* an error should not occur at this point */
1080   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1081 
1082   /* Check the number of endpoints */
1083   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1084   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1085   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1086   for (i=0;i<nee;i++) {
1087     PetscInt size, found = 0, gc[2];
1088 
1089     /* init with defaults */
1090     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1091     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1092     if (!size && nedfieldlocal) continue;
1093     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1094     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1095     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1096     for (j=0;j<size;j++) {
1097       PetscInt k,ee = idxs[j];
1098       for (k=ii[ee];k<ii[ee+1];k++) {
1099         PetscInt vv = jj[k];
1100         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1101           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %d\n",i);
1102           corners[i*2+found++] = vv;
1103         }
1104       }
1105     }
1106     if (found != 2) {
1107       PetscInt e;
1108       if (fl2g) {
1109         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1110       } else {
1111         e = idxs[0];
1112       }
1113       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %d corners for edge %d (astart %d, estart %d)\n",found,i,e,idxs[0]);
1114     }
1115 
1116     /* get primal dof index on this coarse edge */
1117     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1118     if (gc[0] > gc[1]) {
1119       PetscInt swap  = corners[2*i];
1120       corners[2*i]   = corners[2*i+1];
1121       corners[2*i+1] = swap;
1122     }
1123     cedges[i] = idxs[size-1];
1124     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1125     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %d: ce %d, corners (%d,%d)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1126   }
1127   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1128   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1129 
1130 #if defined(PETSC_USE_DEBUG)
1131   /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1132      not interfere with neighbouring coarse edges */
1133   ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1134   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1135   for (i=0;i<nv;i++) {
1136     PetscInt emax = 0,eemax = 0;
1137 
1138     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1139     ierr = PetscMemzero(emarks,(nee+1)*sizeof(PetscInt));CHKERRQ(ierr);
1140     for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1141     for (j=1;j<nee+1;j++) {
1142       if (emax < emarks[j]) {
1143         emax = emarks[j];
1144         eemax = j;
1145       }
1146     }
1147     /* not relevant for edges */
1148     if (!eemax) continue;
1149 
1150     for (j=ii[i];j<ii[i+1];j++) {
1151       if (marks[jj[j]] && marks[jj[j]] != eemax) {
1152         SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_SUP,"Found 2 coarse edges (id %d and %d) connected through the %d nodal dof at edge dof %d\n",marks[jj[j]]-1,eemax,i,jj[j]);
1153       }
1154     }
1155   }
1156   ierr = PetscFree(emarks);CHKERRQ(ierr);
1157   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1158 #endif
1159 
1160   /* Compute extended rows indices for edge blocks of the change of basis */
1161   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1162   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1163   extmem *= maxsize;
1164   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1165   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1166   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1167   for (i=0;i<nv;i++) {
1168     PetscInt mark = 0,size,start;
1169 
1170     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1171     for (j=ii[i];j<ii[i+1];j++)
1172       if (marks[jj[j]] && !mark)
1173         mark = marks[jj[j]];
1174 
1175     /* not relevant */
1176     if (!mark) continue;
1177 
1178     /* import extended row */
1179     mark--;
1180     start = mark*extmem+extrowcum[mark];
1181     size = ii[i+1]-ii[i];
1182     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %d > %d",extrowcum[mark] + size,extmem);
1183     ierr = PetscMemcpy(extrow+start,jj+ii[i],size*sizeof(PetscInt));CHKERRQ(ierr);
1184     extrowcum[mark] += size;
1185   }
1186   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1187   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1188   ierr = PetscFree(marks);CHKERRQ(ierr);
1189 
1190   /* Compress extrows */
1191   cum  = 0;
1192   for (i=0;i<nee;i++) {
1193     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1194     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1195     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1196     cum  = PetscMax(cum,size);
1197   }
1198   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1199   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1200   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1201 
1202   /* Workspace for lapack inner calls and VecSetValues */
1203   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1204 
1205   /* Create change of basis matrix (preallocation can be improved) */
1206   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1207   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1208                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1209   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1210   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1211   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1212   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1213   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1214   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1215   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1216 
1217   /* Defaults to identity */
1218   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1219   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1220   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1221   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1222 
1223   /* Create discrete gradient for the coarser level if needed */
1224   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1225   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1226   if (pcbddc->current_level < pcbddc->max_levels) {
1227     ISLocalToGlobalMapping cel2g,cvl2g;
1228     IS                     wis,gwis;
1229     PetscInt               cnv,cne;
1230 
1231     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1232     if (fl2g) {
1233       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1234     } else {
1235       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1236       pcbddc->nedclocal = wis;
1237     }
1238     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1239     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1240     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1241     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1242     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1243     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1244 
1245     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1246     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1247     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1248     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1249     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1250     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1251     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1252 
1253     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1254     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1255     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1256     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1257     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1258     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1259     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1260     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1261   }
1262   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1263 
1264 #if defined(PRINT_GDET)
1265   inc = 0;
1266   lev = pcbddc->current_level;
1267 #endif
1268 
1269   /* Insert values in the change of basis matrix */
1270   for (i=0;i<nee;i++) {
1271     Mat         Gins = NULL, GKins = NULL;
1272     IS          cornersis = NULL;
1273     PetscScalar cvals[2];
1274 
1275     if (pcbddc->nedcG) {
1276       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1277     }
1278     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1279     if (Gins && GKins) {
1280       PetscScalar    *data;
1281       const PetscInt *rows,*cols;
1282       PetscInt       nrh,nch,nrc,ncc;
1283 
1284       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1285       /* H1 */
1286       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1287       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1288       ierr = MatDenseGetArray(Gins,&data);CHKERRQ(ierr);
1289       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1290       ierr = MatDenseRestoreArray(Gins,&data);CHKERRQ(ierr);
1291       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1292       /* complement */
1293       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1294       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %d",i);
1295       if (ncc + nch != nrc) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"The sum of the number of columns of GKins %d and Gins %d does not match %d for coarse edge %d",ncc,nch,nrc,i);
1296       if (ncc != 1 && pcbddc->nedcG) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot generate the coarse discrete gradient for coarse edge %d with ncc %d",i,ncc);
1297       ierr = MatDenseGetArray(GKins,&data);CHKERRQ(ierr);
1298       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1299       ierr = MatDenseRestoreArray(GKins,&data);CHKERRQ(ierr);
1300 
1301       /* coarse discrete gradient */
1302       if (pcbddc->nedcG) {
1303         PetscInt cols[2];
1304 
1305         cols[0] = 2*i;
1306         cols[1] = 2*i+1;
1307         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1308       }
1309       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1310     }
1311     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1312     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1313     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1314     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1315     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1316   }
1317   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1318 
1319   /* Start assembling */
1320   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1321   if (pcbddc->nedcG) {
1322     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1323   }
1324 
1325   /* Free */
1326   if (fl2g) {
1327     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1328     for (i=0;i<nee;i++) {
1329       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1330     }
1331     ierr = PetscFree(eedges);CHKERRQ(ierr);
1332   }
1333 
1334   /* hack mat_graph with primal dofs on the coarse edges */
1335   {
1336     PCBDDCGraph graph   = pcbddc->mat_graph;
1337     PetscInt    *oqueue = graph->queue;
1338     PetscInt    *ocptr  = graph->cptr;
1339     PetscInt    ncc,*idxs;
1340 
1341     /* find first primal edge */
1342     if (pcbddc->nedclocal) {
1343       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1344     } else {
1345       if (fl2g) {
1346         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1347       }
1348       idxs = cedges;
1349     }
1350     cum = 0;
1351     while (cum < nee && cedges[cum] < 0) cum++;
1352 
1353     /* adapt connected components */
1354     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1355     graph->cptr[0] = 0;
1356     for (i=0,ncc=0;i<graph->ncc;i++) {
1357       PetscInt lc = ocptr[i+1]-ocptr[i];
1358       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1359         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1360         graph->queue[graph->cptr[ncc]] = cedges[cum];
1361         ncc++;
1362         lc--;
1363         cum++;
1364         while (cum < nee && cedges[cum] < 0) cum++;
1365       }
1366       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1367       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1368       ncc++;
1369     }
1370     graph->ncc = ncc;
1371     if (pcbddc->nedclocal) {
1372       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1373     }
1374     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1375   }
1376   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1377   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1378   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1379   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1380 
1381   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1382   ierr = PetscFree(extrow);CHKERRQ(ierr);
1383   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1384   ierr = PetscFree(corners);CHKERRQ(ierr);
1385   ierr = PetscFree(cedges);CHKERRQ(ierr);
1386   ierr = PetscFree(extrows);CHKERRQ(ierr);
1387   ierr = PetscFree(extcols);CHKERRQ(ierr);
1388   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1389 
1390   /* Complete assembling */
1391   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1392   if (pcbddc->nedcG) {
1393     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1394 #if 0
1395     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1396     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1397 #endif
1398   }
1399 
1400   /* set change of basis */
1401   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1402   ierr = MatDestroy(&T);CHKERRQ(ierr);
1403 
1404   PetscFunctionReturn(0);
1405 }
1406 
1407 /* the near-null space of BDDC carries information on quadrature weights,
1408    and these can be collinear -> so cheat with MatNullSpaceCreate
1409    and create a suitable set of basis vectors first */
1410 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1411 {
1412   PetscErrorCode ierr;
1413   PetscInt       i;
1414 
1415   PetscFunctionBegin;
1416   for (i=0;i<nvecs;i++) {
1417     PetscInt first,last;
1418 
1419     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1420     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1421     if (i>=first && i < last) {
1422       PetscScalar *data;
1423       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1424       if (!has_const) {
1425         data[i-first] = 1.;
1426       } else {
1427         data[2*i-first] = 1./PetscSqrtReal(2.);
1428         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1429       }
1430       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1431     }
1432     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1433   }
1434   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1435   for (i=0;i<nvecs;i++) { /* reset vectors */
1436     PetscInt first,last;
1437     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1438     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1439     if (i>=first && i < last) {
1440       PetscScalar *data;
1441       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1442       if (!has_const) {
1443         data[i-first] = 0.;
1444       } else {
1445         data[2*i-first] = 0.;
1446         data[2*i-first+1] = 0.;
1447       }
1448       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1449     }
1450     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1451     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1452   }
1453   PetscFunctionReturn(0);
1454 }
1455 
1456 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1457 {
1458   Mat                    loc_divudotp;
1459   Vec                    p,v,vins,quad_vec,*quad_vecs;
1460   ISLocalToGlobalMapping map;
1461   PetscScalar            *vals;
1462   const PetscScalar      *array;
1463   PetscInt               i,maxneighs,maxsize;
1464   PetscInt               n_neigh,*neigh,*n_shared,**shared;
1465   PetscMPIInt            rank;
1466   PetscErrorCode         ierr;
1467 
1468   PetscFunctionBegin;
1469   ierr = ISLocalToGlobalMappingGetInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1470   ierr = MPIU_Allreduce(&n_neigh,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1471   if (!maxneighs) {
1472     ierr  = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1473     *nnsp = NULL;
1474     PetscFunctionReturn(0);
1475   }
1476   maxsize = 0;
1477   for (i=0;i<n_neigh;i++) maxsize = PetscMax(n_shared[i],maxsize);
1478   ierr = PetscMalloc1(maxsize,&vals);CHKERRQ(ierr);
1479   /* create vectors to hold quadrature weights */
1480   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1481   if (!transpose) {
1482     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1483   } else {
1484     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1485   }
1486   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1487   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1488   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1489   for (i=0;i<maxneighs;i++) {
1490     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1491     ierr = VecSetLocalToGlobalMapping(quad_vecs[i],map);CHKERRQ(ierr);
1492   }
1493 
1494   /* compute local quad vec */
1495   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1496   if (!transpose) {
1497     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1498   } else {
1499     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1500   }
1501   ierr = VecSet(p,1.);CHKERRQ(ierr);
1502   if (!transpose) {
1503     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1504   } else {
1505     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1506   }
1507   if (vl2l) {
1508     Mat        lA;
1509     VecScatter sc;
1510 
1511     ierr = MatISGetLocalMat(A,&lA);CHKERRQ(ierr);
1512     ierr = MatCreateVecs(lA,&vins,NULL);CHKERRQ(ierr);
1513     ierr = VecScatterCreate(v,vl2l,vins,NULL,&sc);CHKERRQ(ierr);
1514     ierr = VecScatterBegin(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1515     ierr = VecScatterEnd(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1516     ierr = VecScatterDestroy(&sc);CHKERRQ(ierr);
1517   } else {
1518     vins = v;
1519   }
1520   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1521   ierr = VecDestroy(&p);CHKERRQ(ierr);
1522 
1523   /* insert in global quadrature vecs */
1524   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1525   for (i=0;i<n_neigh;i++) {
1526     const PetscInt    *idxs;
1527     PetscInt          idx,nn,j;
1528 
1529     idxs = shared[i];
1530     nn   = n_shared[i];
1531     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1532     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1533     idx  = -(idx+1);
1534     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1535   }
1536   ierr = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1537   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1538   if (vl2l) {
1539     ierr = VecDestroy(&vins);CHKERRQ(ierr);
1540   }
1541   ierr = VecDestroy(&v);CHKERRQ(ierr);
1542   ierr = PetscFree(vals);CHKERRQ(ierr);
1543 
1544   /* assemble near null space */
1545   for (i=0;i<maxneighs;i++) {
1546     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1547   }
1548   for (i=0;i<maxneighs;i++) {
1549     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1550     ierr = VecViewFromOptions(quad_vecs[i],NULL,"-pc_bddc_quad_vecs_view");CHKERRQ(ierr);
1551     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1552   }
1553   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1554   PetscFunctionReturn(0);
1555 }
1556 
1557 PetscErrorCode PCBDDCAddPrimalVerticesLocalIS(PC pc, IS primalv)
1558 {
1559   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1560   PetscErrorCode ierr;
1561 
1562   PetscFunctionBegin;
1563   if (primalv) {
1564     if (pcbddc->user_primal_vertices_local) {
1565       IS list[2], newp;
1566 
1567       list[0] = primalv;
1568       list[1] = pcbddc->user_primal_vertices_local;
1569       ierr = ISConcatenate(PetscObjectComm((PetscObject)pc),2,list,&newp);CHKERRQ(ierr);
1570       ierr = ISSortRemoveDups(newp);CHKERRQ(ierr);
1571       ierr = ISDestroy(&list[1]);CHKERRQ(ierr);
1572       pcbddc->user_primal_vertices_local = newp;
1573     } else {
1574       ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1575     }
1576   }
1577   PetscFunctionReturn(0);
1578 }
1579 
1580 static PetscErrorCode func_coords_private(PetscInt dim, PetscReal t, const PetscReal X[], PetscInt Nf, PetscScalar *out, void *ctx)
1581 {
1582   PetscInt f, *comp  = (PetscInt *)ctx;
1583 
1584   PetscFunctionBegin;
1585   for (f=0;f<Nf;f++) out[f] = X[*comp];
1586   PetscFunctionReturn(0);
1587 }
1588 
1589 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1590 {
1591   PetscErrorCode ierr;
1592   Vec            local,global;
1593   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1594   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1595   PetscBool      monolithic = PETSC_FALSE;
1596 
1597   PetscFunctionBegin;
1598   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC topology options","PC");CHKERRQ(ierr);
1599   ierr = PetscOptionsBool("-pc_bddc_monolithic","Discard any information on dofs splitting",NULL,monolithic,&monolithic,NULL);CHKERRQ(ierr);
1600   ierr = PetscOptionsEnd();CHKERRQ(ierr);
1601   /* need to convert from global to local topology information and remove references to information in global ordering */
1602   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1603   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1604   if (monolithic) { /* just get block size to properly compute vertices */
1605     if (pcbddc->vertex_size == 1) {
1606       ierr = MatGetBlockSize(pc->pmat,&pcbddc->vertex_size);CHKERRQ(ierr);
1607     }
1608     goto boundary;
1609   }
1610 
1611   if (pcbddc->user_provided_isfordofs) {
1612     if (pcbddc->n_ISForDofs) {
1613       PetscInt i;
1614       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1615       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1616         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1617         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1618       }
1619       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1620       pcbddc->n_ISForDofs = 0;
1621       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1622     }
1623   } else {
1624     if (!pcbddc->n_ISForDofsLocal) { /* field split not present */
1625       DM dm;
1626 
1627       ierr = PCGetDM(pc, &dm);CHKERRQ(ierr);
1628       if (!dm) {
1629         ierr = MatGetDM(pc->pmat, &dm);CHKERRQ(ierr);
1630       }
1631       if (dm) {
1632         IS      *fields;
1633         PetscInt nf,i;
1634         ierr = DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL);CHKERRQ(ierr);
1635         ierr = PetscMalloc1(nf,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1636         for (i=0;i<nf;i++) {
1637           ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1638           ierr = ISDestroy(&fields[i]);CHKERRQ(ierr);
1639         }
1640         ierr = PetscFree(fields);CHKERRQ(ierr);
1641         pcbddc->n_ISForDofsLocal = nf;
1642       } else { /* See if MATIS has fields attached by the conversion from MatNest */
1643         PetscContainer   c;
1644 
1645         ierr = PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c);CHKERRQ(ierr);
1646         if (c) {
1647           MatISLocalFields lf;
1648           ierr = PetscContainerGetPointer(c,(void**)&lf);CHKERRQ(ierr);
1649           ierr = PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf);CHKERRQ(ierr);
1650         } else { /* fallback, create the default fields if bs > 1 */
1651           PetscInt i, n = matis->A->rmap->n;
1652           ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1653           if (i > 1) {
1654             pcbddc->n_ISForDofsLocal = i;
1655             ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1656             for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1657               ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1658             }
1659           }
1660         }
1661       }
1662     } else {
1663       PetscInt i;
1664       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1665         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1666       }
1667     }
1668   }
1669 
1670 boundary:
1671   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1672     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1673   } else if (pcbddc->DirichletBoundariesLocal) {
1674     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1675   }
1676   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1677     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1678   } else if (pcbddc->NeumannBoundariesLocal) {
1679     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1680   }
1681   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1682     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1683   }
1684   ierr = VecDestroy(&global);CHKERRQ(ierr);
1685   ierr = VecDestroy(&local);CHKERRQ(ierr);
1686   /* detect local disconnected subdomains if requested (use matis->A) */
1687   if (pcbddc->detect_disconnected) {
1688     IS        primalv = NULL;
1689     PetscInt  i;
1690     PetscBool filter = pcbddc->detect_disconnected_filter;
1691 
1692     for (i=0;i<pcbddc->n_local_subs;i++) {
1693       ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
1694     }
1695     ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
1696     ierr = PCBDDCDetectDisconnectedComponents(pc,filter,&pcbddc->n_local_subs,&pcbddc->local_subs,&primalv);CHKERRQ(ierr);
1697     ierr = PCBDDCAddPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1698     ierr = ISDestroy(&primalv);CHKERRQ(ierr);
1699   }
1700   /* early stage corner detection */
1701   {
1702     DM dm;
1703 
1704     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1705     if (dm) {
1706       PetscBool isda;
1707 
1708       ierr = PetscObjectTypeCompare((PetscObject)dm,DMDA,&isda);CHKERRQ(ierr);
1709       if (isda) {
1710         ISLocalToGlobalMapping l2l;
1711         IS                     corners;
1712         Mat                    lA;
1713 
1714         ierr = DMDAGetSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1715         ierr = MatISGetLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1716         ierr = MatGetLocalToGlobalMapping(lA,&l2l,NULL);CHKERRQ(ierr);
1717         ierr = MatISRestoreLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1718         if (l2l && corners) {
1719           const PetscInt *idx;
1720           PetscInt       bs,*idxout,n;
1721 
1722           ierr = ISLocalToGlobalMappingGetBlockSize(l2l,&bs);CHKERRQ(ierr);
1723           ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
1724           ierr = ISGetIndices(corners,&idx);CHKERRQ(ierr);
1725           ierr = PetscMalloc1(n,&idxout);CHKERRQ(ierr);
1726           ierr = ISLocalToGlobalMappingApplyBlock(l2l,n,idx,idxout);CHKERRQ(ierr);
1727           ierr = ISRestoreIndices(corners,&idx);CHKERRQ(ierr);
1728           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1729           ierr = ISCreateBlock(PetscObjectComm((PetscObject)pc),bs,n,idxout,PETSC_OWN_POINTER,&corners);CHKERRQ(ierr);
1730           ierr = PCBDDCAddPrimalVerticesLocalIS(pc,corners);CHKERRQ(ierr);
1731           ierr = ISDestroy(&corners);CHKERRQ(ierr);
1732           pcbddc->corner_selected = PETSC_TRUE;
1733         } else if (corners) { /* not from DMDA */
1734           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1735         }
1736       }
1737     }
1738   }
1739   if (pcbddc->corner_selection && !pcbddc->mat_graph->cdim) {
1740     DM dm;
1741 
1742     ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
1743     if (!dm) {
1744       ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1745     }
1746     if (dm) {
1747       Vec            vcoords;
1748       PetscSection   section;
1749       PetscReal      *coords;
1750       PetscInt       d,cdim,nl,nf,**ctxs;
1751       PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *);
1752 
1753       ierr = DMGetCoordinateDim(dm,&cdim);CHKERRQ(ierr);
1754       ierr = DMGetDefaultSection(dm,&section);CHKERRQ(ierr);
1755       ierr = PetscSectionGetNumFields(section,&nf);CHKERRQ(ierr);
1756       ierr = DMCreateGlobalVector(dm,&vcoords);CHKERRQ(ierr);
1757       ierr = VecGetLocalSize(vcoords,&nl);CHKERRQ(ierr);
1758       ierr = PetscMalloc1(nl*cdim,&coords);CHKERRQ(ierr);
1759       ierr = PetscMalloc2(nf,&funcs,nf,&ctxs);CHKERRQ(ierr);
1760       ierr = PetscMalloc1(nf,&ctxs[0]);CHKERRQ(ierr);
1761       for (d=0;d<nf;d++) funcs[d] = func_coords_private;
1762       for (d=1;d<nf;d++) ctxs[d] = ctxs[d-1] + 1;
1763       for (d=0;d<cdim;d++) {
1764         PetscInt          i;
1765         const PetscScalar *v;
1766 
1767         for (i=0;i<nf;i++) ctxs[i][0] = d;
1768         ierr = DMProjectFunction(dm,0.0,funcs,(void**)ctxs,INSERT_VALUES,vcoords);CHKERRQ(ierr);
1769         ierr = VecGetArrayRead(vcoords,&v);CHKERRQ(ierr);
1770         for (i=0;i<nl;i++) coords[i*cdim+d] = PetscRealPart(v[i]);
1771         ierr = VecRestoreArrayRead(vcoords,&v);CHKERRQ(ierr);
1772       }
1773       ierr = VecDestroy(&vcoords);CHKERRQ(ierr);
1774       ierr = PCSetCoordinates(pc,cdim,nl,coords);CHKERRQ(ierr);
1775       ierr = PetscFree(coords);CHKERRQ(ierr);
1776       ierr = PetscFree(ctxs[0]);CHKERRQ(ierr);
1777       ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr);
1778     }
1779   }
1780   PetscFunctionReturn(0);
1781 }
1782 
1783 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1784 {
1785   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1786   PetscErrorCode  ierr;
1787   IS              nis;
1788   const PetscInt  *idxs;
1789   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1790   PetscBool       *ld;
1791 
1792   PetscFunctionBegin;
1793   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1794   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
1795   if (mop == MPI_LAND) {
1796     /* init rootdata with true */
1797     ld   = (PetscBool*) matis->sf_rootdata;
1798     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1799   } else {
1800     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscBool));CHKERRQ(ierr);
1801   }
1802   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscBool));CHKERRQ(ierr);
1803   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1804   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1805   ld   = (PetscBool*) matis->sf_leafdata;
1806   for (i=0;i<nd;i++)
1807     if (-1 < idxs[i] && idxs[i] < n)
1808       ld[idxs[i]] = PETSC_TRUE;
1809   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1810   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1811   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1812   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1813   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1814   if (mop == MPI_LAND) {
1815     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1816   } else {
1817     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1818   }
1819   for (i=0,nnd=0;i<n;i++)
1820     if (ld[i])
1821       nidxs[nnd++] = i;
1822   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1823   ierr = ISDestroy(is);CHKERRQ(ierr);
1824   *is  = nis;
1825   PetscFunctionReturn(0);
1826 }
1827 
1828 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1829 {
1830   PC_IS             *pcis = (PC_IS*)(pc->data);
1831   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1832   PetscErrorCode    ierr;
1833 
1834   PetscFunctionBegin;
1835   if (!pcbddc->benign_have_null) {
1836     PetscFunctionReturn(0);
1837   }
1838   if (pcbddc->ChangeOfBasisMatrix) {
1839     Vec swap;
1840 
1841     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1842     swap = pcbddc->work_change;
1843     pcbddc->work_change = r;
1844     r = swap;
1845   }
1846   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1847   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1848   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1849   ierr = VecSet(z,0.);CHKERRQ(ierr);
1850   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1851   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1852   if (pcbddc->ChangeOfBasisMatrix) {
1853     pcbddc->work_change = r;
1854     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1855     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1856   }
1857   PetscFunctionReturn(0);
1858 }
1859 
1860 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1861 {
1862   PCBDDCBenignMatMult_ctx ctx;
1863   PetscErrorCode          ierr;
1864   PetscBool               apply_right,apply_left,reset_x;
1865 
1866   PetscFunctionBegin;
1867   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1868   if (transpose) {
1869     apply_right = ctx->apply_left;
1870     apply_left = ctx->apply_right;
1871   } else {
1872     apply_right = ctx->apply_right;
1873     apply_left = ctx->apply_left;
1874   }
1875   reset_x = PETSC_FALSE;
1876   if (apply_right) {
1877     const PetscScalar *ax;
1878     PetscInt          nl,i;
1879 
1880     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1881     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1882     ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr);
1883     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1884     for (i=0;i<ctx->benign_n;i++) {
1885       PetscScalar    sum,val;
1886       const PetscInt *idxs;
1887       PetscInt       nz,j;
1888       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1889       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1890       sum = 0.;
1891       if (ctx->apply_p0) {
1892         val = ctx->work[idxs[nz-1]];
1893         for (j=0;j<nz-1;j++) {
1894           sum += ctx->work[idxs[j]];
1895           ctx->work[idxs[j]] += val;
1896         }
1897       } else {
1898         for (j=0;j<nz-1;j++) {
1899           sum += ctx->work[idxs[j]];
1900         }
1901       }
1902       ctx->work[idxs[nz-1]] -= sum;
1903       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1904     }
1905     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1906     reset_x = PETSC_TRUE;
1907   }
1908   if (transpose) {
1909     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1910   } else {
1911     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1912   }
1913   if (reset_x) {
1914     ierr = VecResetArray(x);CHKERRQ(ierr);
1915   }
1916   if (apply_left) {
1917     PetscScalar *ay;
1918     PetscInt    i;
1919 
1920     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1921     for (i=0;i<ctx->benign_n;i++) {
1922       PetscScalar    sum,val;
1923       const PetscInt *idxs;
1924       PetscInt       nz,j;
1925       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1926       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1927       val = -ay[idxs[nz-1]];
1928       if (ctx->apply_p0) {
1929         sum = 0.;
1930         for (j=0;j<nz-1;j++) {
1931           sum += ay[idxs[j]];
1932           ay[idxs[j]] += val;
1933         }
1934         ay[idxs[nz-1]] += sum;
1935       } else {
1936         for (j=0;j<nz-1;j++) {
1937           ay[idxs[j]] += val;
1938         }
1939         ay[idxs[nz-1]] = 0.;
1940       }
1941       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1942     }
1943     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
1944   }
1945   PetscFunctionReturn(0);
1946 }
1947 
1948 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
1949 {
1950   PetscErrorCode ierr;
1951 
1952   PetscFunctionBegin;
1953   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
1954   PetscFunctionReturn(0);
1955 }
1956 
1957 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
1958 {
1959   PetscErrorCode ierr;
1960 
1961   PetscFunctionBegin;
1962   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
1963   PetscFunctionReturn(0);
1964 }
1965 
1966 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
1967 {
1968   PC_IS                   *pcis = (PC_IS*)pc->data;
1969   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
1970   PCBDDCBenignMatMult_ctx ctx;
1971   PetscErrorCode          ierr;
1972 
1973   PetscFunctionBegin;
1974   if (!restore) {
1975     Mat                A_IB,A_BI;
1976     PetscScalar        *work;
1977     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
1978 
1979     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
1980     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
1981     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
1982     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
1983     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
1984     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
1985     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
1986     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
1987     ierr = PetscNew(&ctx);CHKERRQ(ierr);
1988     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
1989     ctx->apply_left = PETSC_TRUE;
1990     ctx->apply_right = PETSC_FALSE;
1991     ctx->apply_p0 = PETSC_FALSE;
1992     ctx->benign_n = pcbddc->benign_n;
1993     if (reuse) {
1994       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
1995       ctx->free = PETSC_FALSE;
1996     } else { /* TODO: could be optimized for successive solves */
1997       ISLocalToGlobalMapping N_to_D;
1998       PetscInt               i;
1999 
2000       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
2001       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2002       for (i=0;i<pcbddc->benign_n;i++) {
2003         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2004       }
2005       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
2006       ctx->free = PETSC_TRUE;
2007     }
2008     ctx->A = pcis->A_IB;
2009     ctx->work = work;
2010     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
2011     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2012     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2013     pcis->A_IB = A_IB;
2014 
2015     /* A_BI as A_IB^T */
2016     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
2017     pcbddc->benign_original_mat = pcis->A_BI;
2018     pcis->A_BI = A_BI;
2019   } else {
2020     if (!pcbddc->benign_original_mat) {
2021       PetscFunctionReturn(0);
2022     }
2023     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
2024     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
2025     pcis->A_IB = ctx->A;
2026     ctx->A = NULL;
2027     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
2028     pcis->A_BI = pcbddc->benign_original_mat;
2029     pcbddc->benign_original_mat = NULL;
2030     if (ctx->free) {
2031       PetscInt i;
2032       for (i=0;i<ctx->benign_n;i++) {
2033         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2034       }
2035       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2036     }
2037     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
2038     ierr = PetscFree(ctx);CHKERRQ(ierr);
2039   }
2040   PetscFunctionReturn(0);
2041 }
2042 
2043 /* used just in bddc debug mode */
2044 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
2045 {
2046   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
2047   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
2048   Mat            An;
2049   PetscErrorCode ierr;
2050 
2051   PetscFunctionBegin;
2052   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
2053   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
2054   if (is1) {
2055     ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
2056     ierr = MatDestroy(&An);CHKERRQ(ierr);
2057   } else {
2058     *B = An;
2059   }
2060   PetscFunctionReturn(0);
2061 }
2062 
2063 /* TODO: add reuse flag */
2064 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2065 {
2066   Mat            Bt;
2067   PetscScalar    *a,*bdata;
2068   const PetscInt *ii,*ij;
2069   PetscInt       m,n,i,nnz,*bii,*bij;
2070   PetscBool      flg_row;
2071   PetscErrorCode ierr;
2072 
2073   PetscFunctionBegin;
2074   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2075   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2076   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2077   nnz = n;
2078   for (i=0;i<ii[n];i++) {
2079     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2080   }
2081   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2082   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2083   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2084   nnz = 0;
2085   bii[0] = 0;
2086   for (i=0;i<n;i++) {
2087     PetscInt j;
2088     for (j=ii[i];j<ii[i+1];j++) {
2089       PetscScalar entry = a[j];
2090       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || (n == m && ij[j] == i)) {
2091         bij[nnz] = ij[j];
2092         bdata[nnz] = entry;
2093         nnz++;
2094       }
2095     }
2096     bii[i+1] = nnz;
2097   }
2098   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2099   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2100   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2101   {
2102     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2103     b->free_a = PETSC_TRUE;
2104     b->free_ij = PETSC_TRUE;
2105   }
2106   if (*B == A) {
2107     ierr = MatDestroy(&A);CHKERRQ(ierr);
2108   }
2109   *B = Bt;
2110   PetscFunctionReturn(0);
2111 }
2112 
2113 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscBool filter, PetscInt *ncc, IS* cc[], IS* primalv)
2114 {
2115   Mat                    B = NULL;
2116   DM                     dm;
2117   IS                     is_dummy,*cc_n;
2118   ISLocalToGlobalMapping l2gmap_dummy;
2119   PCBDDCGraph            graph;
2120   PetscInt               *xadj_filtered = NULL,*adjncy_filtered = NULL;
2121   PetscInt               i,n;
2122   PetscInt               *xadj,*adjncy;
2123   PetscBool              isplex = PETSC_FALSE;
2124   PetscErrorCode         ierr;
2125 
2126   PetscFunctionBegin;
2127   if (ncc) *ncc = 0;
2128   if (cc) *cc = NULL;
2129   if (primalv) *primalv = NULL;
2130   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2131   ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
2132   if (!dm) {
2133     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
2134   }
2135   if (dm) {
2136     ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr);
2137   }
2138   if (filter) isplex = PETSC_FALSE;
2139 
2140   if (isplex) { /* this code has been modified from plexpartition.c */
2141     PetscInt       p, pStart, pEnd, a, adjSize, idx, size, nroots;
2142     PetscInt      *adj = NULL;
2143     IS             cellNumbering;
2144     const PetscInt *cellNum;
2145     PetscBool      useCone, useClosure;
2146     PetscSection   section;
2147     PetscSegBuffer adjBuffer;
2148     PetscSF        sfPoint;
2149     PetscErrorCode ierr;
2150 
2151     PetscFunctionBegin;
2152     ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
2153     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2154     ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
2155     /* Build adjacency graph via a section/segbuffer */
2156     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &section);CHKERRQ(ierr);
2157     ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
2158     ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr);
2159     /* Always use FVM adjacency to create partitioner graph */
2160     ierr = DMPlexGetAdjacencyUseCone(dm, &useCone);CHKERRQ(ierr);
2161     ierr = DMPlexGetAdjacencyUseClosure(dm, &useClosure);CHKERRQ(ierr);
2162     ierr = DMPlexSetAdjacencyUseCone(dm, PETSC_TRUE);CHKERRQ(ierr);
2163     ierr = DMPlexSetAdjacencyUseClosure(dm, PETSC_FALSE);CHKERRQ(ierr);
2164     ierr = DMPlexGetCellNumbering(dm, &cellNumbering);CHKERRQ(ierr);
2165     ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr);
2166     for (n = 0, p = pStart; p < pEnd; p++) {
2167       /* Skip non-owned cells in parallel (ParMetis expects no overlap) */
2168       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2169       adjSize = PETSC_DETERMINE;
2170       ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr);
2171       for (a = 0; a < adjSize; ++a) {
2172         const PetscInt point = adj[a];
2173         if (pStart <= point && point < pEnd) {
2174           PetscInt *PETSC_RESTRICT pBuf;
2175           ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr);
2176           ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr);
2177           *pBuf = point;
2178         }
2179       }
2180       n++;
2181     }
2182     ierr = DMPlexSetAdjacencyUseCone(dm, useCone);CHKERRQ(ierr);
2183     ierr = DMPlexSetAdjacencyUseClosure(dm, useClosure);CHKERRQ(ierr);
2184     /* Derive CSR graph from section/segbuffer */
2185     ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
2186     ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
2187     ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr);
2188     for (idx = 0, p = pStart; p < pEnd; p++) {
2189       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2190       ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr);
2191     }
2192     xadj[n] = size;
2193     ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr);
2194     /* Clean up */
2195     ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr);
2196     ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
2197     ierr = PetscFree(adj);CHKERRQ(ierr);
2198     graph->xadj = xadj;
2199     graph->adjncy = adjncy;
2200   } else {
2201     Mat       A;
2202     PetscBool isseqaij, flg_row;
2203 
2204     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2205     if (!A->rmap->N || !A->cmap->N) {
2206       ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2207       PetscFunctionReturn(0);
2208     }
2209     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2210     if (!isseqaij && filter) {
2211       PetscBool isseqdense;
2212 
2213       ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2214       if (!isseqdense) {
2215         ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2216       } else { /* TODO: rectangular case and LDA */
2217         PetscScalar *array;
2218         PetscReal   chop=1.e-6;
2219 
2220         ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2221         ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2222         ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2223         for (i=0;i<n;i++) {
2224           PetscInt j;
2225           for (j=i+1;j<n;j++) {
2226             PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2227             if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2228             if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2229           }
2230         }
2231         ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2232         ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2233       }
2234     } else {
2235       ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
2236       B = A;
2237     }
2238     ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2239 
2240     /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2241     if (filter) {
2242       PetscScalar *data;
2243       PetscInt    j,cum;
2244 
2245       ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2246       ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2247       cum = 0;
2248       for (i=0;i<n;i++) {
2249         PetscInt t;
2250 
2251         for (j=xadj[i];j<xadj[i+1];j++) {
2252           if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2253             continue;
2254           }
2255           adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2256         }
2257         t = xadj_filtered[i];
2258         xadj_filtered[i] = cum;
2259         cum += t;
2260       }
2261       ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2262       graph->xadj = xadj_filtered;
2263       graph->adjncy = adjncy_filtered;
2264     } else {
2265       graph->xadj = xadj;
2266       graph->adjncy = adjncy;
2267     }
2268   }
2269   /* compute local connected components using PCBDDCGraph */
2270   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2271   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2272   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2273   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2274   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2275   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2276   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2277 
2278   /* partial clean up */
2279   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2280   if (B) {
2281     PetscBool flg_row;
2282     ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2283     ierr = MatDestroy(&B);CHKERRQ(ierr);
2284   }
2285   if (isplex) {
2286     ierr = PetscFree(xadj);CHKERRQ(ierr);
2287     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2288   }
2289 
2290   /* get back data */
2291   if (isplex) {
2292     if (ncc) *ncc = graph->ncc;
2293     if (cc || primalv) {
2294       Mat          A;
2295       PetscBT      btv,btvt;
2296       PetscSection subSection;
2297       PetscInt     *ids,cum,cump,*cids,*pids;
2298 
2299       ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr);
2300       ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2301       ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr);
2302       ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr);
2303       ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr);
2304 
2305       cids[0] = 0;
2306       for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) {
2307         PetscInt j;
2308 
2309         ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr);
2310         for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) {
2311           PetscInt k, size, *closure = NULL, cell = graph->queue[j];
2312 
2313           ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2314           for (k = 0; k < 2*size; k += 2) {
2315             PetscInt s, p = closure[k], off, dof, cdof;
2316 
2317             ierr = PetscSectionGetConstraintDof(subSection, p, &cdof);CHKERRQ(ierr);
2318             ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr);
2319             ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr);
2320             for (s = 0; s < dof-cdof; s++) {
2321               if (PetscBTLookupSet(btvt,off+s)) continue;
2322               if (!PetscBTLookup(btv,off+s)) {
2323                 ids[cum++] = off+s;
2324               } else { /* cross-vertex */
2325                 pids[cump++] = off+s;
2326               }
2327             }
2328           }
2329           ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2330         }
2331         cids[i+1] = cum;
2332         /* mark dofs as already assigned */
2333         for (j = cids[i]; j < cids[i+1]; j++) {
2334           ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr);
2335         }
2336       }
2337       if (cc) {
2338         ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2339         for (i = 0; i < graph->ncc; i++) {
2340           ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2341         }
2342         *cc = cc_n;
2343       }
2344       if (primalv) {
2345         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr);
2346       }
2347       ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr);
2348       ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
2349       ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr);
2350     }
2351   } else {
2352     if (ncc) *ncc = graph->ncc;
2353     if (cc) {
2354       ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2355       for (i=0;i<graph->ncc;i++) {
2356         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);
2357       }
2358       *cc = cc_n;
2359     }
2360   }
2361   /* clean up graph */
2362   graph->xadj = 0;
2363   graph->adjncy = 0;
2364   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2365   PetscFunctionReturn(0);
2366 }
2367 
2368 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2369 {
2370   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2371   PC_IS*         pcis = (PC_IS*)(pc->data);
2372   IS             dirIS = NULL;
2373   PetscInt       i;
2374   PetscErrorCode ierr;
2375 
2376   PetscFunctionBegin;
2377   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2378   if (zerodiag) {
2379     Mat            A;
2380     Vec            vec3_N;
2381     PetscScalar    *vals;
2382     const PetscInt *idxs;
2383     PetscInt       nz,*count;
2384 
2385     /* p0 */
2386     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2387     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2388     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2389     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2390     for (i=0;i<nz;i++) vals[i] = 1.;
2391     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2392     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2393     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2394     /* v_I */
2395     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2396     for (i=0;i<nz;i++) vals[i] = 0.;
2397     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2398     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2399     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2400     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2401     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2402     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2403     if (dirIS) {
2404       PetscInt n;
2405 
2406       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2407       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2408       for (i=0;i<n;i++) vals[i] = 0.;
2409       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2410       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2411     }
2412     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2413     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2414     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2415     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2416     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2417     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2418     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2419     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]));
2420     ierr = PetscFree(vals);CHKERRQ(ierr);
2421     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2422 
2423     /* there should not be any pressure dofs lying on the interface */
2424     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2425     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2426     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2427     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2428     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2429     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]);
2430     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2431     ierr = PetscFree(count);CHKERRQ(ierr);
2432   }
2433   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2434 
2435   /* check PCBDDCBenignGetOrSetP0 */
2436   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2437   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2438   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2439   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2440   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2441   for (i=0;i<pcbddc->benign_n;i++) {
2442     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2443     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);
2444   }
2445   PetscFunctionReturn(0);
2446 }
2447 
2448 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, IS *zerodiaglocal)
2449 {
2450   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2451   IS             pressures,zerodiag,zerodiag_save,*zerodiag_subs;
2452   PetscInt       nz,n;
2453   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2454   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2455   PetscErrorCode ierr;
2456 
2457   PetscFunctionBegin;
2458   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2459   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2460   for (n=0;n<pcbddc->benign_n;n++) {
2461     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2462   }
2463   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2464   pcbddc->benign_n = 0;
2465 
2466   /* if a local info on dofs is present, uses the last field for "pressures" (or fid by command line)
2467      otherwise, it uses only zerodiagonal dofs (ok if the pressure block is all zero; it could fail if it is not)
2468      Checks if all the pressure dofs in each subdomain have a zero diagonal
2469      If not, a change of basis on pressures is not needed
2470      since the local Schur complements are already SPD
2471   */
2472   has_null_pressures = PETSC_TRUE;
2473   have_null = PETSC_TRUE;
2474   if (pcbddc->n_ISForDofsLocal) {
2475     IS       iP = NULL;
2476     PetscInt npl,*idxs,p = pcbddc->n_ISForDofsLocal-1;
2477 
2478     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2479     ierr = PetscOptionsInt("-pc_bddc_pressure_field","Field id for pressures",NULL,p,&p,NULL);CHKERRQ(ierr);
2480     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2481     if (p < 0 || p > pcbddc->n_ISForDofsLocal-1) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %D",p);
2482     /* Dofs splitting for BDDC cannot have PETSC_COMM_SELF, so create a sequential IS */
2483     ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[p],&npl);CHKERRQ(ierr);
2484     ierr = ISGetIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2485     ierr = ISCreateGeneral(PETSC_COMM_SELF,npl,idxs,PETSC_COPY_VALUES,&pressures);CHKERRQ(ierr);
2486     ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2487     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2488     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2489     if (iP) {
2490       IS newpressures;
2491 
2492       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2493       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2494       pressures = newpressures;
2495     }
2496     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2497     if (!sorted) {
2498       ierr = ISSort(pressures);CHKERRQ(ierr);
2499     }
2500   } else {
2501     pressures = NULL;
2502   }
2503   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2504   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2505   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2506   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2507   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2508   if (!sorted) {
2509     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2510   }
2511   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2512   zerodiag_save = zerodiag;
2513   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2514   if (!nz) {
2515     if (n) have_null = PETSC_FALSE;
2516     has_null_pressures = PETSC_FALSE;
2517     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2518   }
2519   recompute_zerodiag = PETSC_FALSE;
2520   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2521   zerodiag_subs    = NULL;
2522   pcbddc->benign_n = 0;
2523   n_interior_dofs  = 0;
2524   interior_dofs    = NULL;
2525   nneu             = 0;
2526   if (pcbddc->NeumannBoundariesLocal) {
2527     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2528   }
2529   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2530   if (checkb) { /* need to compute interior nodes */
2531     PetscInt n,i,j;
2532     PetscInt n_neigh,*neigh,*n_shared,**shared;
2533     PetscInt *iwork;
2534 
2535     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2536     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2537     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2538     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2539     for (i=1;i<n_neigh;i++)
2540       for (j=0;j<n_shared[i];j++)
2541           iwork[shared[i][j]] += 1;
2542     for (i=0;i<n;i++)
2543       if (!iwork[i])
2544         interior_dofs[n_interior_dofs++] = i;
2545     ierr = PetscFree(iwork);CHKERRQ(ierr);
2546     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2547   }
2548   if (has_null_pressures) {
2549     IS             *subs;
2550     PetscInt       nsubs,i,j,nl;
2551     const PetscInt *idxs;
2552     PetscScalar    *array;
2553     Vec            *work;
2554     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2555 
2556     subs  = pcbddc->local_subs;
2557     nsubs = pcbddc->n_local_subs;
2558     /* 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) */
2559     if (checkb) {
2560       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2561       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2562       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2563       /* work[0] = 1_p */
2564       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2565       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2566       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2567       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2568       /* work[0] = 1_v */
2569       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2570       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2571       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2572       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2573       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2574     }
2575     if (nsubs > 1) {
2576       ierr = PetscCalloc1(nsubs,&zerodiag_subs);CHKERRQ(ierr);
2577       for (i=0;i<nsubs;i++) {
2578         ISLocalToGlobalMapping l2g;
2579         IS                     t_zerodiag_subs;
2580         PetscInt               nl;
2581 
2582         ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2583         ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,zerodiag,&t_zerodiag_subs);CHKERRQ(ierr);
2584         ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2585         if (nl) {
2586           PetscBool valid = PETSC_TRUE;
2587 
2588           if (checkb) {
2589             ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2590             ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2591             ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2592             ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2593             for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2594             ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2595             ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2596             ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2597             ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2598             ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2599             ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2600             for (j=0;j<n_interior_dofs;j++) {
2601               if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2602                 valid = PETSC_FALSE;
2603                 break;
2604               }
2605             }
2606             ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2607           }
2608           if (valid && nneu) {
2609             const PetscInt *idxs;
2610             PetscInt       nzb;
2611 
2612             ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2613             ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2614             ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2615             if (nzb) valid = PETSC_FALSE;
2616           }
2617           if (valid && pressures) {
2618             IS t_pressure_subs;
2619             ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2620             ierr = ISEqual(t_pressure_subs,t_zerodiag_subs,&valid);CHKERRQ(ierr);
2621             ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2622           }
2623           if (valid) {
2624             ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[pcbddc->benign_n]);CHKERRQ(ierr);
2625             pcbddc->benign_n++;
2626           } else {
2627             recompute_zerodiag = PETSC_TRUE;
2628           }
2629         }
2630         ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2631         ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2632       }
2633     } else { /* there's just one subdomain (or zero if they have not been detected */
2634       PetscBool valid = PETSC_TRUE;
2635 
2636       if (nneu) valid = PETSC_FALSE;
2637       if (valid && pressures) {
2638         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2639       }
2640       if (valid && checkb) {
2641         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2642         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2643         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2644         for (j=0;j<n_interior_dofs;j++) {
2645           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2646             valid = PETSC_FALSE;
2647             break;
2648           }
2649         }
2650         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2651       }
2652       if (valid) {
2653         pcbddc->benign_n = 1;
2654         ierr = PetscMalloc1(pcbddc->benign_n,&zerodiag_subs);CHKERRQ(ierr);
2655         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2656         zerodiag_subs[0] = zerodiag;
2657       }
2658     }
2659     if (checkb) {
2660       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2661     }
2662   }
2663   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2664 
2665   if (!pcbddc->benign_n) {
2666     PetscInt n;
2667 
2668     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2669     recompute_zerodiag = PETSC_FALSE;
2670     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2671     if (n) {
2672       has_null_pressures = PETSC_FALSE;
2673       have_null = PETSC_FALSE;
2674     }
2675   }
2676 
2677   /* final check for null pressures */
2678   if (zerodiag && pressures) {
2679     PetscInt nz,np;
2680     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2681     ierr = ISGetLocalSize(pressures,&np);CHKERRQ(ierr);
2682     if (nz != np) have_null = PETSC_FALSE;
2683   }
2684 
2685   if (recompute_zerodiag) {
2686     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2687     if (pcbddc->benign_n == 1) {
2688       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2689       zerodiag = zerodiag_subs[0];
2690     } else {
2691       PetscInt i,nzn,*new_idxs;
2692 
2693       nzn = 0;
2694       for (i=0;i<pcbddc->benign_n;i++) {
2695         PetscInt ns;
2696         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2697         nzn += ns;
2698       }
2699       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2700       nzn = 0;
2701       for (i=0;i<pcbddc->benign_n;i++) {
2702         PetscInt ns,*idxs;
2703         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2704         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2705         ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr);
2706         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2707         nzn += ns;
2708       }
2709       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2710       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2711     }
2712     have_null = PETSC_FALSE;
2713   }
2714 
2715   /* Prepare matrix to compute no-net-flux */
2716   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2717     Mat                    A,loc_divudotp;
2718     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2719     IS                     row,col,isused = NULL;
2720     PetscInt               M,N,n,st,n_isused;
2721 
2722     if (pressures) {
2723       isused = pressures;
2724     } else {
2725       isused = zerodiag_save;
2726     }
2727     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2728     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2729     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2730     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");
2731     n_isused = 0;
2732     if (isused) {
2733       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2734     }
2735     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2736     st = st-n_isused;
2737     if (n) {
2738       const PetscInt *gidxs;
2739 
2740       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2741       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2742       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2743       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2744       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2745       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2746     } else {
2747       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2748       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2749       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2750     }
2751     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2752     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2753     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2754     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2755     ierr = ISDestroy(&row);CHKERRQ(ierr);
2756     ierr = ISDestroy(&col);CHKERRQ(ierr);
2757     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2758     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2759     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2760     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2761     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2762     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2763     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2764     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2765     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2766     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2767   }
2768   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2769 
2770   /* change of basis and p0 dofs */
2771   if (has_null_pressures) {
2772     IS             zerodiagc;
2773     const PetscInt *idxs,*idxsc;
2774     PetscInt       i,s,*nnz;
2775 
2776     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2777     ierr = ISComplement(zerodiag,0,n,&zerodiagc);CHKERRQ(ierr);
2778     ierr = ISGetIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2779     /* local change of basis for pressures */
2780     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2781     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2782     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2783     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2784     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2785     for (i=0;i<n-nz;i++) nnz[idxsc[i]] = 1; /* identity on velocities plus pressure dofs for non-singular subdomains */
2786     for (i=0;i<pcbddc->benign_n;i++) {
2787       PetscInt nzs,j;
2788 
2789       ierr = ISGetLocalSize(zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2790       ierr = ISGetIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2791       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2792       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2793       ierr = ISRestoreIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2794     }
2795     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2796     ierr = PetscFree(nnz);CHKERRQ(ierr);
2797     /* set identity on velocities */
2798     for (i=0;i<n-nz;i++) {
2799       ierr = MatSetValue(pcbddc->benign_change,idxsc[i],idxsc[i],1.,INSERT_VALUES);CHKERRQ(ierr);
2800     }
2801     ierr = ISRestoreIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2802     ierr = ISDestroy(&zerodiagc);CHKERRQ(ierr);
2803     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2804     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2805     /* set change on pressures */
2806     for (s=0;s<pcbddc->benign_n;s++) {
2807       PetscScalar *array;
2808       PetscInt    nzs;
2809 
2810       ierr = ISGetLocalSize(zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2811       ierr = ISGetIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2812       for (i=0;i<nzs-1;i++) {
2813         PetscScalar vals[2];
2814         PetscInt    cols[2];
2815 
2816         cols[0] = idxs[i];
2817         cols[1] = idxs[nzs-1];
2818         vals[0] = 1.;
2819         vals[1] = 1.;
2820         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2821       }
2822       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2823       for (i=0;i<nzs-1;i++) array[i] = -1.;
2824       array[nzs-1] = 1.;
2825       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2826       /* store local idxs for p0 */
2827       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2828       ierr = ISRestoreIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2829       ierr = PetscFree(array);CHKERRQ(ierr);
2830     }
2831     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2832     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2833     /* project if needed */
2834     if (pcbddc->benign_change_explicit) {
2835       Mat M;
2836 
2837       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2838       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2839       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2840       ierr = MatDestroy(&M);CHKERRQ(ierr);
2841     }
2842     /* store global idxs for p0 */
2843     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2844   }
2845   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2846   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2847 
2848   /* determines if the coarse solver will be singular or not */
2849   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2850   /* determines if the problem has subdomains with 0 pressure block */
2851   have_null = (PetscBool)(!!pcbddc->benign_n);
2852   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2853   *zerodiaglocal = zerodiag;
2854   PetscFunctionReturn(0);
2855 }
2856 
2857 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2858 {
2859   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2860   PetscScalar    *array;
2861   PetscErrorCode ierr;
2862 
2863   PetscFunctionBegin;
2864   if (!pcbddc->benign_sf) {
2865     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
2866     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2867   }
2868   if (get) {
2869     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2870     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2871     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2872     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2873   } else {
2874     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
2875     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2876     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2877     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
2878   }
2879   PetscFunctionReturn(0);
2880 }
2881 
2882 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
2883 {
2884   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2885   PetscErrorCode ierr;
2886 
2887   PetscFunctionBegin;
2888   /* TODO: add error checking
2889     - avoid nested pop (or push) calls.
2890     - cannot push before pop.
2891     - cannot call this if pcbddc->local_mat is NULL
2892   */
2893   if (!pcbddc->benign_n) {
2894     PetscFunctionReturn(0);
2895   }
2896   if (pop) {
2897     if (pcbddc->benign_change_explicit) {
2898       IS       is_p0;
2899       MatReuse reuse;
2900 
2901       /* extract B_0 */
2902       reuse = MAT_INITIAL_MATRIX;
2903       if (pcbddc->benign_B0) {
2904         reuse = MAT_REUSE_MATRIX;
2905       }
2906       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
2907       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
2908       /* remove rows and cols from local problem */
2909       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
2910       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
2911       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
2912       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
2913     } else {
2914       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
2915       PetscScalar *vals;
2916       PetscInt    i,n,*idxs_ins;
2917 
2918       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
2919       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
2920       if (!pcbddc->benign_B0) {
2921         PetscInt *nnz;
2922         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
2923         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
2924         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2925         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
2926         for (i=0;i<pcbddc->benign_n;i++) {
2927           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
2928           nnz[i] = n - nnz[i];
2929         }
2930         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
2931         ierr = PetscFree(nnz);CHKERRQ(ierr);
2932       }
2933 
2934       for (i=0;i<pcbddc->benign_n;i++) {
2935         PetscScalar *array;
2936         PetscInt    *idxs,j,nz,cum;
2937 
2938         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
2939         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
2940         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2941         for (j=0;j<nz;j++) vals[j] = 1.;
2942         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2943         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
2944         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
2945         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
2946         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2947         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2948         cum = 0;
2949         for (j=0;j<n;j++) {
2950           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
2951             vals[cum] = array[j];
2952             idxs_ins[cum] = j;
2953             cum++;
2954           }
2955         }
2956         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
2957         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2958         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2959       }
2960       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2961       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2962       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
2963     }
2964   } else { /* push */
2965     if (pcbddc->benign_change_explicit) {
2966       PetscInt i;
2967 
2968       for (i=0;i<pcbddc->benign_n;i++) {
2969         PetscScalar *B0_vals;
2970         PetscInt    *B0_cols,B0_ncol;
2971 
2972         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2973         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2974         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2975         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
2976         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2977       }
2978       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2979       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2980     } else {
2981       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!\n");
2982     }
2983   }
2984   PetscFunctionReturn(0);
2985 }
2986 
2987 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
2988 {
2989   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
2990   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
2991   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
2992   PetscBLASInt    *B_iwork,*B_ifail;
2993   PetscScalar     *work,lwork;
2994   PetscScalar     *St,*S,*eigv;
2995   PetscScalar     *Sarray,*Starray;
2996   PetscReal       *eigs,thresh,lthresh,uthresh;
2997   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
2998   PetscBool       allocated_S_St;
2999 #if defined(PETSC_USE_COMPLEX)
3000   PetscReal       *rwork;
3001 #endif
3002   PetscErrorCode  ierr;
3003 
3004   PetscFunctionBegin;
3005   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
3006   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
3007   if (sub_schurs->n_subs && (!sub_schurs->is_symmetric)) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_SUP,"Adaptive selection not yet implemented for this matrix pencil (herm %d, symm %d, posdef %d)",sub_schurs->is_hermitian,sub_schurs->is_symmetric,sub_schurs->is_posdef);
3008 
3009   if (pcbddc->dbg_flag) {
3010     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3011     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3012     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
3013     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
3014   }
3015 
3016   if (pcbddc->dbg_flag) {
3017     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %d (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);
3018   }
3019 
3020   /* max size of subsets */
3021   mss = 0;
3022   for (i=0;i<sub_schurs->n_subs;i++) {
3023     PetscInt subset_size;
3024 
3025     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3026     mss = PetscMax(mss,subset_size);
3027   }
3028 
3029   /* min/max and threshold */
3030   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
3031   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
3032   nmax = PetscMax(nmin,nmax);
3033   allocated_S_St = PETSC_FALSE;
3034   if (nmin || !sub_schurs->is_posdef) { /* XXX */
3035     allocated_S_St = PETSC_TRUE;
3036   }
3037 
3038   /* allocate lapack workspace */
3039   cum = cum2 = 0;
3040   maxneigs = 0;
3041   for (i=0;i<sub_schurs->n_subs;i++) {
3042     PetscInt n,subset_size;
3043 
3044     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3045     n = PetscMin(subset_size,nmax);
3046     cum += subset_size;
3047     cum2 += subset_size*n;
3048     maxneigs = PetscMax(maxneigs,n);
3049   }
3050   if (mss) {
3051     if (sub_schurs->is_symmetric) {
3052       PetscBLASInt B_itype = 1;
3053       PetscBLASInt B_N = mss;
3054       PetscReal    zero = 0.0;
3055       PetscReal    eps = 0.0; /* dlamch? */
3056 
3057       B_lwork = -1;
3058       S = NULL;
3059       St = NULL;
3060       eigs = NULL;
3061       eigv = NULL;
3062       B_iwork = NULL;
3063       B_ifail = NULL;
3064 #if defined(PETSC_USE_COMPLEX)
3065       rwork = NULL;
3066 #endif
3067       thresh = 1.0;
3068       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3069 #if defined(PETSC_USE_COMPLEX)
3070       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));
3071 #else
3072       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));
3073 #endif
3074       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3075       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3076     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3077   } else {
3078     lwork = 0;
3079   }
3080 
3081   nv = 0;
3082   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) */
3083     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
3084   }
3085   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
3086   if (allocated_S_St) {
3087     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
3088   }
3089   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
3090 #if defined(PETSC_USE_COMPLEX)
3091   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
3092 #endif
3093   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3094                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3095                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3096                       nv+cum,&pcbddc->adaptive_constraints_idxs,
3097                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
3098   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
3099 
3100   maxneigs = 0;
3101   cum = cumarray = 0;
3102   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3103   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3104   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3105     const PetscInt *idxs;
3106 
3107     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3108     for (cum=0;cum<nv;cum++) {
3109       pcbddc->adaptive_constraints_n[cum] = 1;
3110       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3111       pcbddc->adaptive_constraints_data[cum] = 1.0;
3112       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3113       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3114     }
3115     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3116   }
3117 
3118   if (mss) { /* multilevel */
3119     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3120     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3121   }
3122 
3123   lthresh = pcbddc->adaptive_threshold[0];
3124   uthresh = pcbddc->adaptive_threshold[1];
3125   for (i=0;i<sub_schurs->n_subs;i++) {
3126     const PetscInt *idxs;
3127     PetscReal      upper,lower;
3128     PetscInt       j,subset_size,eigs_start = 0;
3129     PetscBLASInt   B_N;
3130     PetscBool      same_data = PETSC_FALSE;
3131     PetscBool      scal = PETSC_FALSE;
3132 
3133     if (pcbddc->use_deluxe_scaling) {
3134       upper = PETSC_MAX_REAL;
3135       lower = uthresh;
3136     } else {
3137       if (!sub_schurs->is_posdef) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented without deluxe scaling");
3138       upper = 1./uthresh;
3139       lower = 0.;
3140     }
3141     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3142     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3143     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
3144     /* this is experimental: we assume the dofs have been properly grouped to have
3145        the diagonal blocks Schur complements either positive or negative definite (true for Stokes) */
3146     if (!sub_schurs->is_posdef) {
3147       Mat T;
3148 
3149       for (j=0;j<subset_size;j++) {
3150         if (PetscRealPart(*(Sarray+cumarray+j*(subset_size+1))) < 0.0) {
3151           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Sarray+cumarray,&T);CHKERRQ(ierr);
3152           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3153           ierr = MatDestroy(&T);CHKERRQ(ierr);
3154           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Starray+cumarray,&T);CHKERRQ(ierr);
3155           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3156           ierr = MatDestroy(&T);CHKERRQ(ierr);
3157           if (sub_schurs->change_primal_sub) {
3158             PetscInt       nz,k;
3159             const PetscInt *idxs;
3160 
3161             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nz);CHKERRQ(ierr);
3162             ierr = ISGetIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3163             for (k=0;k<nz;k++) {
3164               *( Sarray + cumarray + idxs[k]*(subset_size+1)) *= -1.0;
3165               *(Starray + cumarray + idxs[k]*(subset_size+1))  = 0.0;
3166             }
3167             ierr = ISRestoreIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3168           }
3169           scal = PETSC_TRUE;
3170           break;
3171         }
3172       }
3173     }
3174 
3175     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3176       if (sub_schurs->is_symmetric) {
3177         PetscInt j,k;
3178         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */
3179           ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3180           ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3181         }
3182         for (j=0;j<subset_size;j++) {
3183           for (k=j;k<subset_size;k++) {
3184             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3185             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3186           }
3187         }
3188       } else {
3189         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3190         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3191       }
3192     } else {
3193       S = Sarray + cumarray;
3194       St = Starray + cumarray;
3195     }
3196     /* see if we can save some work */
3197     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3198       ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr);
3199     }
3200 
3201     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3202       B_neigs = 0;
3203     } else {
3204       if (sub_schurs->is_symmetric) {
3205         PetscBLASInt B_itype = 1;
3206         PetscBLASInt B_IL, B_IU;
3207         PetscReal    eps = -1.0; /* dlamch? */
3208         PetscInt     nmin_s;
3209         PetscBool    compute_range;
3210 
3211         B_neigs = 0;
3212         compute_range = (PetscBool)!same_data;
3213         if (nmin >= subset_size) compute_range = PETSC_FALSE;
3214 
3215         if (pcbddc->dbg_flag) {
3216           PetscInt nc = 0;
3217 
3218           if (sub_schurs->change_primal_sub) {
3219             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nc);CHKERRQ(ierr);
3220           }
3221           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Computing for sub %d/%d size %d count %d fid %d (range %d) (change %d).\n",i,sub_schurs->n_subs,subset_size,pcbddc->mat_graph->count[idxs[0]]+1,pcbddc->mat_graph->which_dof[idxs[0]],compute_range,nc);CHKERRQ(ierr);
3222         }
3223 
3224         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3225         if (compute_range) {
3226 
3227           /* ask for eigenvalues larger than thresh */
3228           if (sub_schurs->is_posdef) {
3229 #if defined(PETSC_USE_COMPLEX)
3230             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));
3231 #else
3232             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));
3233 #endif
3234           } else { /* no theory so far, but it works nicely */
3235             PetscInt  recipe = 0,recipe_m = 1;
3236             PetscReal bb[2];
3237 
3238             ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe",&recipe,NULL);CHKERRQ(ierr);
3239             switch (recipe) {
3240             case 0:
3241               if (scal) { bb[0] = PETSC_MIN_REAL; bb[1] = lthresh; }
3242               else { bb[0] = uthresh; bb[1] = PETSC_MAX_REAL; }
3243 #if defined(PETSC_USE_COMPLEX)
3244               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3245 #else
3246               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3247 #endif
3248               break;
3249             case 1:
3250               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh*lthresh;
3251 #if defined(PETSC_USE_COMPLEX)
3252               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3253 #else
3254               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3255 #endif
3256               if (!scal) {
3257                 PetscBLASInt B_neigs2 = 0;
3258 
3259                 bb[0] = PetscMax(lthresh*lthresh,uthresh); bb[1] = PETSC_MAX_REAL;
3260                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3261                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3262 #if defined(PETSC_USE_COMPLEX)
3263                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3264 #else
3265                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3266 #endif
3267                 B_neigs += B_neigs2;
3268               }
3269               break;
3270             case 2:
3271               if (scal) {
3272                 bb[0] = PETSC_MIN_REAL;
3273                 bb[1] = 0;
3274 #if defined(PETSC_USE_COMPLEX)
3275                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3276 #else
3277                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3278 #endif
3279               } else {
3280                 PetscBLASInt B_neigs2 = 0;
3281                 PetscBool    import = PETSC_FALSE;
3282 
3283                 lthresh = PetscMax(lthresh,0.0);
3284                 if (lthresh > 0.0) {
3285                   bb[0] = PETSC_MIN_REAL;
3286                   bb[1] = lthresh*lthresh;
3287 
3288                   import = PETSC_TRUE;
3289 #if defined(PETSC_USE_COMPLEX)
3290                   PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3291 #else
3292                   PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3293 #endif
3294                 }
3295                 bb[0] = PetscMax(lthresh*lthresh,uthresh);
3296                 bb[1] = PETSC_MAX_REAL;
3297                 if (import) {
3298                   ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3299                   ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3300                 }
3301 #if defined(PETSC_USE_COMPLEX)
3302                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3303 #else
3304                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3305 #endif
3306                 B_neigs += B_neigs2;
3307               }
3308               break;
3309             case 3:
3310               if (scal) {
3311                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min_scal",&recipe_m,NULL);CHKERRQ(ierr);
3312               } else {
3313                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min",&recipe_m,NULL);CHKERRQ(ierr);
3314               }
3315               if (!scal) {
3316                 bb[0] = uthresh;
3317                 bb[1] = PETSC_MAX_REAL;
3318 #if defined(PETSC_USE_COMPLEX)
3319                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3320 #else
3321                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3322 #endif
3323               }
3324               if (recipe_m > 0 && B_N - B_neigs > 0) {
3325                 PetscBLASInt B_neigs2 = 0;
3326 
3327                 B_IL = 1;
3328                 ierr = PetscBLASIntCast(PetscMin(recipe_m,B_N - B_neigs),&B_IU);CHKERRQ(ierr);
3329                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3330                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3331 #if defined(PETSC_USE_COMPLEX)
3332                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3333 #else
3334                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3335 #endif
3336                 B_neigs += B_neigs2;
3337               }
3338               break;
3339             case 4:
3340               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh;
3341 #if defined(PETSC_USE_COMPLEX)
3342               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3343 #else
3344               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3345 #endif
3346               {
3347                 PetscBLASInt B_neigs2 = 0;
3348 
3349                 bb[0] = PetscMax(lthresh+PETSC_SMALL,uthresh); bb[1] = PETSC_MAX_REAL;
3350                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3351                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3352 #if defined(PETSC_USE_COMPLEX)
3353                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3354 #else
3355                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3356 #endif
3357                 B_neigs += B_neigs2;
3358               }
3359               break;
3360             case 5: /* same as before: first compute all eigenvalues, then filter */
3361 #if defined(PETSC_USE_COMPLEX)
3362               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","A","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3363 #else
3364               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","A","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3365 #endif
3366               {
3367                 PetscInt e,k,ne;
3368                 for (e=0,ne=0;e<B_neigs;e++) {
3369                   if (eigs[e] < lthresh || eigs[e] > uthresh) {
3370                     for (k=0;k<B_N;k++) S[ne*B_N+k] = eigv[e*B_N+k];
3371                     eigs[ne] = eigs[e];
3372                     ne++;
3373                   }
3374                 }
3375                 ierr = PetscMemcpy(eigv,S,B_N*ne*sizeof(PetscScalar));CHKERRQ(ierr);
3376                 B_neigs = ne;
3377               }
3378               break;
3379             default:
3380               SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Unknown recipe %D",recipe);
3381               break;
3382             }
3383           }
3384         } else if (!same_data) { /* this is just to see all the eigenvalues */
3385           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3386           B_IL = 1;
3387 #if defined(PETSC_USE_COMPLEX)
3388           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));
3389 #else
3390           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));
3391 #endif
3392         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3393           PetscInt k;
3394           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3395           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3396           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3397           nmin = nmax;
3398           ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr);
3399           for (k=0;k<nmax;k++) {
3400             eigs[k] = 1./PETSC_SMALL;
3401             eigv[k*(subset_size+1)] = 1.0;
3402           }
3403         }
3404         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3405         if (B_ierr) {
3406           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3407           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);
3408           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);
3409         }
3410 
3411         if (B_neigs > nmax) {
3412           if (pcbddc->dbg_flag) {
3413             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %d.\n",B_neigs,nmax);CHKERRQ(ierr);
3414           }
3415           if (pcbddc->use_deluxe_scaling) eigs_start = scal ? 0 : B_neigs-nmax;
3416           B_neigs = nmax;
3417         }
3418 
3419         nmin_s = PetscMin(nmin,B_N);
3420         if (B_neigs < nmin_s) {
3421           PetscBLASInt B_neigs2 = 0;
3422 
3423           if (pcbddc->use_deluxe_scaling) {
3424             if (scal) {
3425               B_IU = nmin_s;
3426               B_IL = B_neigs + 1;
3427             } else {
3428               B_IL = B_N - nmin_s + 1;
3429               B_IU = B_N - B_neigs;
3430             }
3431           } else {
3432             B_IL = B_neigs + 1;
3433             B_IU = nmin_s;
3434           }
3435           if (pcbddc->dbg_flag) {
3436             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);
3437           }
3438           if (sub_schurs->is_symmetric) {
3439             PetscInt j,k;
3440             for (j=0;j<subset_size;j++) {
3441               for (k=j;k<subset_size;k++) {
3442                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3443                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3444               }
3445             }
3446           } else {
3447             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3448             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3449           }
3450           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3451 #if defined(PETSC_USE_COMPLEX)
3452           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));
3453 #else
3454           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));
3455 #endif
3456           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3457           B_neigs += B_neigs2;
3458         }
3459         if (B_ierr) {
3460           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3461           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);
3462           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);
3463         }
3464         if (pcbddc->dbg_flag) {
3465           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3466           for (j=0;j<B_neigs;j++) {
3467             if (eigs[j] == 0.0) {
3468               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3469             } else {
3470               if (pcbddc->use_deluxe_scaling) {
3471                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3472               } else {
3473                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3474               }
3475             }
3476           }
3477         }
3478       } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3479     }
3480     /* change the basis back to the original one */
3481     if (sub_schurs->change) {
3482       Mat change,phi,phit;
3483 
3484       if (pcbddc->dbg_flag > 2) {
3485         PetscInt ii;
3486         for (ii=0;ii<B_neigs;ii++) {
3487           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3488           for (j=0;j<B_N;j++) {
3489 #if defined(PETSC_USE_COMPLEX)
3490             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3491             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3492             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3493 #else
3494             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3495 #endif
3496           }
3497         }
3498       }
3499       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3500       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3501       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3502       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3503       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3504       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3505     }
3506     maxneigs = PetscMax(B_neigs,maxneigs);
3507     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3508     if (B_neigs) {
3509       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);
3510 
3511       if (pcbddc->dbg_flag > 1) {
3512         PetscInt ii;
3513         for (ii=0;ii<B_neigs;ii++) {
3514           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3515           for (j=0;j<B_N;j++) {
3516 #if defined(PETSC_USE_COMPLEX)
3517             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3518             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3519             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3520 #else
3521             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3522 #endif
3523           }
3524         }
3525       }
3526       ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
3527       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3528       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3529       cum++;
3530     }
3531     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3532     /* shift for next computation */
3533     cumarray += subset_size*subset_size;
3534   }
3535   if (pcbddc->dbg_flag) {
3536     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3537   }
3538 
3539   if (mss) {
3540     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3541     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3542     /* destroy matrices (junk) */
3543     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3544     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3545   }
3546   if (allocated_S_St) {
3547     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3548   }
3549   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3550 #if defined(PETSC_USE_COMPLEX)
3551   ierr = PetscFree(rwork);CHKERRQ(ierr);
3552 #endif
3553   if (pcbddc->dbg_flag) {
3554     PetscInt maxneigs_r;
3555     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3556     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %d\n",maxneigs_r);CHKERRQ(ierr);
3557   }
3558   PetscFunctionReturn(0);
3559 }
3560 
3561 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3562 {
3563   PetscScalar    *coarse_submat_vals;
3564   PetscErrorCode ierr;
3565 
3566   PetscFunctionBegin;
3567   /* Setup local scatters R_to_B and (optionally) R_to_D */
3568   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3569   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3570 
3571   /* Setup local neumann solver ksp_R */
3572   /* PCBDDCSetUpLocalScatters should be called first! */
3573   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3574 
3575   /*
3576      Setup local correction and local part of coarse basis.
3577      Gives back the dense local part of the coarse matrix in column major ordering
3578   */
3579   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3580 
3581   /* Compute total number of coarse nodes and setup coarse solver */
3582   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3583 
3584   /* free */
3585   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3586   PetscFunctionReturn(0);
3587 }
3588 
3589 PetscErrorCode PCBDDCResetCustomization(PC pc)
3590 {
3591   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3592   PetscErrorCode ierr;
3593 
3594   PetscFunctionBegin;
3595   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3596   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3597   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3598   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3599   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3600   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3601   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3602   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3603   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3604   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3605   PetscFunctionReturn(0);
3606 }
3607 
3608 PetscErrorCode PCBDDCResetTopography(PC pc)
3609 {
3610   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3611   PetscInt       i;
3612   PetscErrorCode ierr;
3613 
3614   PetscFunctionBegin;
3615   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3616   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3617   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3618   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3619   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3620   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3621   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3622   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3623   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3624   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3625   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3626   for (i=0;i<pcbddc->n_local_subs;i++) {
3627     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3628   }
3629   pcbddc->n_local_subs = 0;
3630   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3631   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3632   pcbddc->graphanalyzed        = PETSC_FALSE;
3633   pcbddc->recompute_topography = PETSC_TRUE;
3634   pcbddc->corner_selected      = PETSC_FALSE;
3635   PetscFunctionReturn(0);
3636 }
3637 
3638 PetscErrorCode PCBDDCResetSolvers(PC pc)
3639 {
3640   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3641   PetscErrorCode ierr;
3642 
3643   PetscFunctionBegin;
3644   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3645   if (pcbddc->coarse_phi_B) {
3646     PetscScalar *array;
3647     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3648     ierr = PetscFree(array);CHKERRQ(ierr);
3649   }
3650   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3651   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3652   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3653   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3654   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3655   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3656   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3657   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3658   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3659   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3660   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3661   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3662   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3663   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3664   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3665   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3666   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3667   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3668   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3669   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3670   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3671   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3672   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3673   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3674   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3675   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3676   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3677   if (pcbddc->benign_zerodiag_subs) {
3678     PetscInt i;
3679     for (i=0;i<pcbddc->benign_n;i++) {
3680       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3681     }
3682     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3683   }
3684   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3685   PetscFunctionReturn(0);
3686 }
3687 
3688 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3689 {
3690   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3691   PC_IS          *pcis = (PC_IS*)pc->data;
3692   VecType        impVecType;
3693   PetscInt       n_constraints,n_R,old_size;
3694   PetscErrorCode ierr;
3695 
3696   PetscFunctionBegin;
3697   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3698   n_R = pcis->n - pcbddc->n_vertices;
3699   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3700   /* local work vectors (try to avoid unneeded work)*/
3701   /* R nodes */
3702   old_size = -1;
3703   if (pcbddc->vec1_R) {
3704     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3705   }
3706   if (n_R != old_size) {
3707     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3708     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3709     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3710     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3711     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3712     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3713   }
3714   /* local primal dofs */
3715   old_size = -1;
3716   if (pcbddc->vec1_P) {
3717     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3718   }
3719   if (pcbddc->local_primal_size != old_size) {
3720     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3721     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3722     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3723     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3724   }
3725   /* local explicit constraints */
3726   old_size = -1;
3727   if (pcbddc->vec1_C) {
3728     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3729   }
3730   if (n_constraints && n_constraints != old_size) {
3731     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3732     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3733     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3734     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3735   }
3736   PetscFunctionReturn(0);
3737 }
3738 
3739 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3740 {
3741   PetscErrorCode  ierr;
3742   /* pointers to pcis and pcbddc */
3743   PC_IS*          pcis = (PC_IS*)pc->data;
3744   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3745   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3746   /* submatrices of local problem */
3747   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3748   /* submatrices of local coarse problem */
3749   Mat             S_VV,S_CV,S_VC,S_CC;
3750   /* working matrices */
3751   Mat             C_CR;
3752   /* additional working stuff */
3753   PC              pc_R;
3754   Mat             F,Brhs = NULL;
3755   Vec             dummy_vec;
3756   PetscBool       isLU,isCHOL,isILU,need_benign_correction,sparserhs;
3757   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3758   PetscScalar     *work;
3759   PetscInt        *idx_V_B;
3760   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3761   PetscInt        i,n_R,n_D,n_B;
3762 
3763   /* some shortcuts to scalars */
3764   PetscScalar     one=1.0,m_one=-1.0;
3765 
3766   PetscFunctionBegin;
3767   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");
3768 
3769   /* Set Non-overlapping dimensions */
3770   n_vertices = pcbddc->n_vertices;
3771   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3772   n_B = pcis->n_B;
3773   n_D = pcis->n - n_B;
3774   n_R = pcis->n - n_vertices;
3775 
3776   /* vertices in boundary numbering */
3777   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3778   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3779   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",n_vertices,i);
3780 
3781   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3782   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3783   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3784   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3785   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3786   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3787   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3788   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3789   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3790   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3791 
3792   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3793   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3794   ierr = PCSetUp(pc_R);CHKERRQ(ierr);
3795   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3796   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3797   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3798   lda_rhs = n_R;
3799   need_benign_correction = PETSC_FALSE;
3800   if (isLU || isILU || isCHOL) {
3801     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3802   } else if (sub_schurs && sub_schurs->reuse_solver) {
3803     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3804     MatFactorType      type;
3805 
3806     F = reuse_solver->F;
3807     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3808     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3809     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3810     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3811   } else {
3812     F = NULL;
3813   }
3814 
3815   /* determine if we can use a sparse right-hand side */
3816   sparserhs = PETSC_FALSE;
3817   if (F) {
3818     MatSolverType solver;
3819 
3820     ierr = MatFactorGetSolverType(F,&solver);CHKERRQ(ierr);
3821     ierr = PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs);CHKERRQ(ierr);
3822   }
3823 
3824   /* allocate workspace */
3825   n = 0;
3826   if (n_constraints) {
3827     n += lda_rhs*n_constraints;
3828   }
3829   if (n_vertices) {
3830     n = PetscMax(2*lda_rhs*n_vertices,n);
3831     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3832   }
3833   if (!pcbddc->symmetric_primal) {
3834     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3835   }
3836   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3837 
3838   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3839   dummy_vec = NULL;
3840   if (need_benign_correction && lda_rhs != n_R && F) {
3841     ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,lda_rhs,work,&dummy_vec);CHKERRQ(ierr);
3842   }
3843 
3844   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3845   if (n_constraints) {
3846     Mat         M3,C_B;
3847     IS          is_aux;
3848     PetscScalar *array,*array2;
3849 
3850     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3851     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3852 
3853     /* Extract constraints on R nodes: C_{CR}  */
3854     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
3855     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
3856     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
3857 
3858     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
3859     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
3860     if (!sparserhs) {
3861       ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
3862       for (i=0;i<n_constraints;i++) {
3863         const PetscScalar *row_cmat_values;
3864         const PetscInt    *row_cmat_indices;
3865         PetscInt          size_of_constraint,j;
3866 
3867         ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3868         for (j=0;j<size_of_constraint;j++) {
3869           work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
3870         }
3871         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3872       }
3873       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs);CHKERRQ(ierr);
3874     } else {
3875       Mat tC_CR;
3876 
3877       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
3878       if (lda_rhs != n_R) {
3879         PetscScalar *aa;
3880         PetscInt    r,*ii,*jj;
3881         PetscBool   done;
3882 
3883         ierr = MatGetRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3884         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
3885         ierr = MatSeqAIJGetArray(C_CR,&aa);CHKERRQ(ierr);
3886         ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR);CHKERRQ(ierr);
3887         ierr = MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3888         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
3889       } else {
3890         ierr  = PetscObjectReference((PetscObject)C_CR);CHKERRQ(ierr);
3891         tC_CR = C_CR;
3892       }
3893       ierr = MatCreateTranspose(tC_CR,&Brhs);CHKERRQ(ierr);
3894       ierr = MatDestroy(&tC_CR);CHKERRQ(ierr);
3895     }
3896     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
3897     if (F) {
3898       if (need_benign_correction) {
3899         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3900 
3901         /* rhs is already zero on interior dofs, no need to change the rhs */
3902         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
3903       }
3904       ierr = MatMatSolve(F,Brhs,local_auxmat2_R);CHKERRQ(ierr);
3905       if (need_benign_correction) {
3906         PetscScalar        *marr;
3907         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3908 
3909         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3910         if (lda_rhs != n_R) {
3911           for (i=0;i<n_constraints;i++) {
3912             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3913             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3914             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3915           }
3916         } else {
3917           for (i=0;i<n_constraints;i++) {
3918             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3919             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3920             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3921           }
3922         }
3923         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3924       }
3925     } else {
3926       PetscScalar *marr;
3927 
3928       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3929       for (i=0;i<n_constraints;i++) {
3930         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3931         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
3932         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3933         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3934         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3935       }
3936       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3937     }
3938     if (sparserhs) {
3939       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
3940     }
3941     ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
3942     if (!pcbddc->switch_static) {
3943       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3944       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3945       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3946       for (i=0;i<n_constraints;i++) {
3947         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
3948         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
3949         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3950         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3951         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3952         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3953       }
3954       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3955       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3956       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3957     } else {
3958       if (lda_rhs != n_R) {
3959         IS dummy;
3960 
3961         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
3962         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3963         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
3964       } else {
3965         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
3966         pcbddc->local_auxmat2 = local_auxmat2_R;
3967       }
3968       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3969     }
3970     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3971     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
3972     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
3973     if (isCHOL) {
3974       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
3975     } else {
3976       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
3977     }
3978     ierr = MatSeqDenseInvertFactors_Private(M3);CHKERRQ(ierr);
3979     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
3980     ierr = MatMatMult(M3,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
3981     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
3982     ierr = MatCopy(M3,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
3983     ierr = MatDestroy(&M3);CHKERRQ(ierr);
3984   }
3985 
3986   /* Get submatrices from subdomain matrix */
3987   if (n_vertices) {
3988     IS        is_aux;
3989     PetscBool isseqaij;
3990 
3991     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
3992       IS tis;
3993 
3994       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
3995       ierr = ISSort(tis);CHKERRQ(ierr);
3996       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
3997       ierr = ISDestroy(&tis);CHKERRQ(ierr);
3998     } else {
3999       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
4000     }
4001     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
4002     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
4003     ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4004     if (!isseqaij) { /* MatMatMult(A_VR,A_RRmA_RV) below will raise an error */
4005       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4006     }
4007     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
4008     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4009   }
4010 
4011   /* Matrix of coarse basis functions (local) */
4012   if (pcbddc->coarse_phi_B) {
4013     PetscInt on_B,on_primal,on_D=n_D;
4014     if (pcbddc->coarse_phi_D) {
4015       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
4016     }
4017     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
4018     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
4019       PetscScalar *marray;
4020 
4021       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
4022       ierr = PetscFree(marray);CHKERRQ(ierr);
4023       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4024       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4025       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4026       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4027     }
4028   }
4029 
4030   if (!pcbddc->coarse_phi_B) {
4031     PetscScalar *marr;
4032 
4033     /* memory size */
4034     n = n_B*pcbddc->local_primal_size;
4035     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
4036     if (!pcbddc->symmetric_primal) n *= 2;
4037     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
4038     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4039     marr += n_B*pcbddc->local_primal_size;
4040     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4041       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4042       marr += n_D*pcbddc->local_primal_size;
4043     }
4044     if (!pcbddc->symmetric_primal) {
4045       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4046       marr += n_B*pcbddc->local_primal_size;
4047       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4048         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4049       }
4050     } else {
4051       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
4052       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
4053       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4054         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
4055         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
4056       }
4057     }
4058   }
4059 
4060   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
4061   p0_lidx_I = NULL;
4062   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
4063     const PetscInt *idxs;
4064 
4065     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4066     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
4067     for (i=0;i<pcbddc->benign_n;i++) {
4068       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
4069     }
4070     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4071   }
4072 
4073   /* vertices */
4074   if (n_vertices) {
4075     PetscBool restoreavr = PETSC_FALSE;
4076 
4077     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
4078 
4079     if (n_R) {
4080       Mat          A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
4081       PetscBLASInt B_N,B_one = 1;
4082       PetscScalar  *x,*y;
4083 
4084       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
4085       if (need_benign_correction) {
4086         ISLocalToGlobalMapping RtoN;
4087         IS                     is_p0;
4088         PetscInt               *idxs_p0,n;
4089 
4090         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
4091         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
4092         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
4093         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);
4094         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
4095         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
4096         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
4097         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
4098       }
4099 
4100       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4101       if (!sparserhs || need_benign_correction) {
4102         if (lda_rhs == n_R) {
4103           ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4104         } else {
4105           PetscScalar    *av,*array;
4106           const PetscInt *xadj,*adjncy;
4107           PetscInt       n;
4108           PetscBool      flg_row;
4109 
4110           array = work+lda_rhs*n_vertices;
4111           ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
4112           ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4113           ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4114           ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
4115           for (i=0;i<n;i++) {
4116             PetscInt j;
4117             for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
4118           }
4119           ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4120           ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4121           ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
4122         }
4123         if (need_benign_correction) {
4124           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4125           PetscScalar        *marr;
4126 
4127           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
4128           /* need \Phi^T A_RV = (I+L)A_RV, L given by
4129 
4130                  | 0 0  0 | (V)
4131              L = | 0 0 -1 | (P-p0)
4132                  | 0 0 -1 | (p0)
4133 
4134           */
4135           for (i=0;i<reuse_solver->benign_n;i++) {
4136             const PetscScalar *vals;
4137             const PetscInt    *idxs,*idxs_zero;
4138             PetscInt          n,j,nz;
4139 
4140             ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4141             ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4142             ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4143             for (j=0;j<n;j++) {
4144               PetscScalar val = vals[j];
4145               PetscInt    k,col = idxs[j];
4146               for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
4147             }
4148             ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4149             ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4150           }
4151           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
4152         }
4153         ierr = PetscObjectReference((PetscObject)A_RV);CHKERRQ(ierr);
4154         Brhs = A_RV;
4155       } else {
4156         Mat tA_RVT,A_RVT;
4157 
4158         if (!pcbddc->symmetric_primal) {
4159           /* A_RV already scaled by -1 */
4160           ierr = MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT);CHKERRQ(ierr);
4161         } else {
4162           restoreavr = PETSC_TRUE;
4163           ierr  = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4164           ierr  = PetscObjectReference((PetscObject)A_VR);CHKERRQ(ierr);
4165           A_RVT = A_VR;
4166         }
4167         if (lda_rhs != n_R) {
4168           PetscScalar *aa;
4169           PetscInt    r,*ii,*jj;
4170           PetscBool   done;
4171 
4172           ierr = MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4173           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4174           ierr = MatSeqAIJGetArray(A_RVT,&aa);CHKERRQ(ierr);
4175           ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT);CHKERRQ(ierr);
4176           ierr = MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4177           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4178         } else {
4179           ierr   = PetscObjectReference((PetscObject)A_RVT);CHKERRQ(ierr);
4180           tA_RVT = A_RVT;
4181         }
4182         ierr = MatCreateTranspose(tA_RVT,&Brhs);CHKERRQ(ierr);
4183         ierr = MatDestroy(&tA_RVT);CHKERRQ(ierr);
4184         ierr = MatDestroy(&A_RVT);CHKERRQ(ierr);
4185       }
4186       if (F) {
4187         /* need to correct the rhs */
4188         if (need_benign_correction) {
4189           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4190           PetscScalar        *marr;
4191 
4192           ierr = MatDenseGetArray(Brhs,&marr);CHKERRQ(ierr);
4193           if (lda_rhs != n_R) {
4194             for (i=0;i<n_vertices;i++) {
4195               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4196               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4197               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4198             }
4199           } else {
4200             for (i=0;i<n_vertices;i++) {
4201               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4202               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4203               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4204             }
4205           }
4206           ierr = MatDenseRestoreArray(Brhs,&marr);CHKERRQ(ierr);
4207         }
4208         ierr = MatMatSolve(F,Brhs,A_RRmA_RV);CHKERRQ(ierr);
4209         if (restoreavr) {
4210           ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4211         }
4212         /* need to correct the solution */
4213         if (need_benign_correction) {
4214           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4215           PetscScalar        *marr;
4216 
4217           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4218           if (lda_rhs != n_R) {
4219             for (i=0;i<n_vertices;i++) {
4220               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4221               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4222               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4223             }
4224           } else {
4225             for (i=0;i<n_vertices;i++) {
4226               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4227               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4228               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4229             }
4230           }
4231           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4232         }
4233       } else {
4234         ierr = MatDenseGetArray(Brhs,&y);CHKERRQ(ierr);
4235         for (i=0;i<n_vertices;i++) {
4236           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
4237           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
4238           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4239           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4240           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4241         }
4242         ierr = MatDenseRestoreArray(Brhs,&y);CHKERRQ(ierr);
4243       }
4244       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4245       ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4246       /* S_VV and S_CV */
4247       if (n_constraints) {
4248         Mat B;
4249 
4250         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
4251         for (i=0;i<n_vertices;i++) {
4252           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4253           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
4254           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4255           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4256           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4257           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4258         }
4259         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4260         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
4261         ierr = MatDestroy(&B);CHKERRQ(ierr);
4262         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4263         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4264         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
4265         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
4266         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
4267         ierr = MatDestroy(&B);CHKERRQ(ierr);
4268       }
4269       if (lda_rhs != n_R) {
4270         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4271         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4272         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
4273       }
4274       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
4275       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
4276       if (need_benign_correction) {
4277         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4278         PetscScalar      *marr,*sums;
4279 
4280         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
4281         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
4282         for (i=0;i<reuse_solver->benign_n;i++) {
4283           const PetscScalar *vals;
4284           const PetscInt    *idxs,*idxs_zero;
4285           PetscInt          n,j,nz;
4286 
4287           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4288           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4289           for (j=0;j<n_vertices;j++) {
4290             PetscInt k;
4291             sums[j] = 0.;
4292             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
4293           }
4294           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4295           for (j=0;j<n;j++) {
4296             PetscScalar val = vals[j];
4297             PetscInt k;
4298             for (k=0;k<n_vertices;k++) {
4299               marr[idxs[j]+k*n_vertices] += val*sums[k];
4300             }
4301           }
4302           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4303           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4304         }
4305         ierr = PetscFree(sums);CHKERRQ(ierr);
4306         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
4307         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
4308       }
4309       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4310       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
4311       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
4312       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
4313       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4314       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
4315       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
4316       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4317       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
4318     } else {
4319       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4320     }
4321     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
4322 
4323     /* coarse basis functions */
4324     for (i=0;i<n_vertices;i++) {
4325       PetscScalar *y;
4326 
4327       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4328       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4329       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4330       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4331       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4332       y[n_B*i+idx_V_B[i]] = 1.0;
4333       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4334       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4335 
4336       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4337         PetscInt j;
4338 
4339         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4340         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4341         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4342         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4343         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4344         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4345         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4346       }
4347       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4348     }
4349     /* if n_R == 0 the object is not destroyed */
4350     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4351   }
4352   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4353 
4354   if (n_constraints) {
4355     Mat B;
4356 
4357     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4358     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4359     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4360     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4361     if (n_vertices) {
4362       if (isCHOL || need_benign_correction) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4363         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4364       } else {
4365         Mat S_VCt;
4366 
4367         if (lda_rhs != n_R) {
4368           ierr = MatDestroy(&B);CHKERRQ(ierr);
4369           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4370           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4371         }
4372         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4373         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4374         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4375       }
4376     }
4377     ierr = MatDestroy(&B);CHKERRQ(ierr);
4378     /* coarse basis functions */
4379     for (i=0;i<n_constraints;i++) {
4380       PetscScalar *y;
4381 
4382       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4383       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4384       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4385       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4386       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4387       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4388       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4389       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4390         PetscInt j;
4391 
4392         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4393         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4394         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4395         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4396         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4397         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4398         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4399       }
4400       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4401     }
4402   }
4403   if (n_constraints) {
4404     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4405   }
4406   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4407 
4408   /* coarse matrix entries relative to B_0 */
4409   if (pcbddc->benign_n) {
4410     Mat         B0_B,B0_BPHI;
4411     IS          is_dummy;
4412     PetscScalar *data;
4413     PetscInt    j;
4414 
4415     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4416     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4417     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4418     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4419     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4420     ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr);
4421     for (j=0;j<pcbddc->benign_n;j++) {
4422       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4423       for (i=0;i<pcbddc->local_primal_size;i++) {
4424         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4425         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4426       }
4427     }
4428     ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr);
4429     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4430     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4431   }
4432 
4433   /* compute other basis functions for non-symmetric problems */
4434   if (!pcbddc->symmetric_primal) {
4435     Mat         B_V=NULL,B_C=NULL;
4436     PetscScalar *marray;
4437 
4438     if (n_constraints) {
4439       Mat S_CCT,C_CRT;
4440 
4441       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4442       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4443       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4444       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4445       if (n_vertices) {
4446         Mat S_VCT;
4447 
4448         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4449         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4450         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4451       }
4452       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4453     } else {
4454       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4455     }
4456     if (n_vertices && n_R) {
4457       PetscScalar    *av,*marray;
4458       const PetscInt *xadj,*adjncy;
4459       PetscInt       n;
4460       PetscBool      flg_row;
4461 
4462       /* B_V = B_V - A_VR^T */
4463       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4464       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4465       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4466       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4467       for (i=0;i<n;i++) {
4468         PetscInt j;
4469         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4470       }
4471       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4472       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4473       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4474     }
4475 
4476     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4477     if (n_vertices) {
4478       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4479       for (i=0;i<n_vertices;i++) {
4480         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4481         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4482         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4483         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4484         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4485       }
4486       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4487     }
4488     if (B_C) {
4489       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4490       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4491         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4492         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4493         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4494         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4495         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4496       }
4497       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4498     }
4499     /* coarse basis functions */
4500     for (i=0;i<pcbddc->local_primal_size;i++) {
4501       PetscScalar *y;
4502 
4503       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4504       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4505       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4506       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4507       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4508       if (i<n_vertices) {
4509         y[n_B*i+idx_V_B[i]] = 1.0;
4510       }
4511       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4512       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4513 
4514       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4515         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4516         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4517         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4518         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4519         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4520         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4521       }
4522       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4523     }
4524     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4525     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4526   }
4527 
4528   /* free memory */
4529   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4530   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4531   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4532   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4533   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4534   ierr = PetscFree(work);CHKERRQ(ierr);
4535   if (n_vertices) {
4536     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4537   }
4538   if (n_constraints) {
4539     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4540   }
4541   /* Checking coarse_sub_mat and coarse basis functios */
4542   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4543   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4544   if (pcbddc->dbg_flag) {
4545     Mat         coarse_sub_mat;
4546     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4547     Mat         coarse_phi_D,coarse_phi_B;
4548     Mat         coarse_psi_D,coarse_psi_B;
4549     Mat         A_II,A_BB,A_IB,A_BI;
4550     Mat         C_B,CPHI;
4551     IS          is_dummy;
4552     Vec         mones;
4553     MatType     checkmattype=MATSEQAIJ;
4554     PetscReal   real_value;
4555 
4556     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4557       Mat A;
4558       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4559       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4560       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4561       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4562       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4563       ierr = MatDestroy(&A);CHKERRQ(ierr);
4564     } else {
4565       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4566       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4567       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4568       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4569     }
4570     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4571     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4572     if (!pcbddc->symmetric_primal) {
4573       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4574       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4575     }
4576     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4577 
4578     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4579     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4580     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4581     if (!pcbddc->symmetric_primal) {
4582       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4583       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4584       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4585       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4586       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4587       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4588       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4589       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4590       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4591       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4592       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4593       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4594     } else {
4595       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4596       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4597       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4598       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4599       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4600       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4601       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4602       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4603     }
4604     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4605     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4606     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4607     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4608     if (pcbddc->benign_n) {
4609       Mat         B0_B,B0_BPHI;
4610       PetscScalar *data,*data2;
4611       PetscInt    j;
4612 
4613       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4614       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4615       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4616       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4617       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4618       ierr = MatDenseGetArray(B0_BPHI,&data2);CHKERRQ(ierr);
4619       for (j=0;j<pcbddc->benign_n;j++) {
4620         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4621         for (i=0;i<pcbddc->local_primal_size;i++) {
4622           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4623           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4624         }
4625       }
4626       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4627       ierr = MatDenseRestoreArray(B0_BPHI,&data2);CHKERRQ(ierr);
4628       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4629       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4630       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4631     }
4632 #if 0
4633   {
4634     PetscViewer viewer;
4635     char filename[256];
4636     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4637     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4638     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4639     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4640     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4641     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4642     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4643     if (pcbddc->coarse_phi_B) {
4644       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4645       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4646     }
4647     if (pcbddc->coarse_phi_D) {
4648       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4649       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4650     }
4651     if (pcbddc->coarse_psi_B) {
4652       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4653       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4654     }
4655     if (pcbddc->coarse_psi_D) {
4656       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4657       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4658     }
4659     ierr = PetscObjectSetName((PetscObject)pcbddc->local_mat,"A");CHKERRQ(ierr);
4660     ierr = MatView(pcbddc->local_mat,viewer);CHKERRQ(ierr);
4661     ierr = PetscObjectSetName((PetscObject)pcbddc->ConstraintMatrix,"C");CHKERRQ(ierr);
4662     ierr = MatView(pcbddc->ConstraintMatrix,viewer);CHKERRQ(ierr);
4663     ierr = PetscObjectSetName((PetscObject)pcis->is_I_local,"I");CHKERRQ(ierr);
4664     ierr = ISView(pcis->is_I_local,viewer);CHKERRQ(ierr);
4665     ierr = PetscObjectSetName((PetscObject)pcis->is_B_local,"B");CHKERRQ(ierr);
4666     ierr = ISView(pcis->is_B_local,viewer);CHKERRQ(ierr);
4667     ierr = PetscObjectSetName((PetscObject)pcbddc->is_R_local,"R");CHKERRQ(ierr);
4668     ierr = ISView(pcbddc->is_R_local,viewer);CHKERRQ(ierr);
4669     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4670   }
4671 #endif
4672     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4673     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4674     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4675     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4676 
4677     /* check constraints */
4678     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4679     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4680     if (!pcbddc->benign_n) { /* TODO: add benign case */
4681       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4682     } else {
4683       PetscScalar *data;
4684       Mat         tmat;
4685       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4686       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4687       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4688       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4689       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4690     }
4691     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4692     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4693     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4694     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4695     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4696     if (!pcbddc->symmetric_primal) {
4697       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4698       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4699       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4700       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4701       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4702     }
4703     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4704     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4705     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4706     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4707     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4708     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4709     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4710     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4711     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4712     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4713     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4714     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4715     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4716     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4717     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4718     if (!pcbddc->symmetric_primal) {
4719       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4720       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4721     }
4722     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4723   }
4724   /* get back data */
4725   *coarse_submat_vals_n = coarse_submat_vals;
4726   PetscFunctionReturn(0);
4727 }
4728 
4729 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4730 {
4731   Mat            *work_mat;
4732   IS             isrow_s,iscol_s;
4733   PetscBool      rsorted,csorted;
4734   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4735   PetscErrorCode ierr;
4736 
4737   PetscFunctionBegin;
4738   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4739   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4740   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4741   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4742 
4743   if (!rsorted) {
4744     const PetscInt *idxs;
4745     PetscInt *idxs_sorted,i;
4746 
4747     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4748     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4749     for (i=0;i<rsize;i++) {
4750       idxs_perm_r[i] = i;
4751     }
4752     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4753     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4754     for (i=0;i<rsize;i++) {
4755       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4756     }
4757     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4758     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4759   } else {
4760     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4761     isrow_s = isrow;
4762   }
4763 
4764   if (!csorted) {
4765     if (isrow == iscol) {
4766       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4767       iscol_s = isrow_s;
4768     } else {
4769       const PetscInt *idxs;
4770       PetscInt       *idxs_sorted,i;
4771 
4772       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4773       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4774       for (i=0;i<csize;i++) {
4775         idxs_perm_c[i] = i;
4776       }
4777       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4778       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4779       for (i=0;i<csize;i++) {
4780         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4781       }
4782       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4783       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4784     }
4785   } else {
4786     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4787     iscol_s = iscol;
4788   }
4789 
4790   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4791 
4792   if (!rsorted || !csorted) {
4793     Mat      new_mat;
4794     IS       is_perm_r,is_perm_c;
4795 
4796     if (!rsorted) {
4797       PetscInt *idxs_r,i;
4798       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4799       for (i=0;i<rsize;i++) {
4800         idxs_r[idxs_perm_r[i]] = i;
4801       }
4802       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4803       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4804     } else {
4805       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4806     }
4807     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4808 
4809     if (!csorted) {
4810       if (isrow_s == iscol_s) {
4811         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4812         is_perm_c = is_perm_r;
4813       } else {
4814         PetscInt *idxs_c,i;
4815         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4816         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4817         for (i=0;i<csize;i++) {
4818           idxs_c[idxs_perm_c[i]] = i;
4819         }
4820         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4821         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4822       }
4823     } else {
4824       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4825     }
4826     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4827 
4828     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4829     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4830     work_mat[0] = new_mat;
4831     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4832     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4833   }
4834 
4835   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4836   *B = work_mat[0];
4837   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4838   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4839   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4840   PetscFunctionReturn(0);
4841 }
4842 
4843 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
4844 {
4845   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
4846   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4847   Mat            new_mat,lA;
4848   IS             is_local,is_global;
4849   PetscInt       local_size;
4850   PetscBool      isseqaij;
4851   PetscErrorCode ierr;
4852 
4853   PetscFunctionBegin;
4854   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4855   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
4856   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
4857   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
4858   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
4859   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
4860   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
4861 
4862   /* check */
4863   if (pcbddc->dbg_flag) {
4864     Vec       x,x_change;
4865     PetscReal error;
4866 
4867     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
4868     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
4869     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
4870     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4871     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4872     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
4873     if (!pcbddc->change_interior) {
4874       const PetscScalar *x,*y,*v;
4875       PetscReal         lerror = 0.;
4876       PetscInt          i;
4877 
4878       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
4879       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
4880       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
4881       for (i=0;i<local_size;i++)
4882         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
4883           lerror = PetscAbsScalar(x[i]-y[i]);
4884       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
4885       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
4886       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
4887       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4888       if (error > PETSC_SMALL) {
4889         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4890           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e\n",error);
4891         } else {
4892           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e\n",error);
4893         }
4894       }
4895     }
4896     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4897     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4898     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
4899     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
4900     if (error > PETSC_SMALL) {
4901       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4902         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
4903       } else {
4904         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e\n",error);
4905       }
4906     }
4907     ierr = VecDestroy(&x);CHKERRQ(ierr);
4908     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
4909   }
4910 
4911   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
4912   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
4913 
4914   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
4915   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4916   if (isseqaij) {
4917     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4918     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4919     if (lA) {
4920       Mat work;
4921       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4922       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4923       ierr = MatDestroy(&work);CHKERRQ(ierr);
4924     }
4925   } else {
4926     Mat work_mat;
4927 
4928     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4929     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4930     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4931     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
4932     if (lA) {
4933       Mat work;
4934       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4935       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4936       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4937       ierr = MatDestroy(&work);CHKERRQ(ierr);
4938     }
4939   }
4940   if (matis->A->symmetric_set) {
4941     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
4942 #if !defined(PETSC_USE_COMPLEX)
4943     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
4944 #endif
4945   }
4946   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
4947   PetscFunctionReturn(0);
4948 }
4949 
4950 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
4951 {
4952   PC_IS*          pcis = (PC_IS*)(pc->data);
4953   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
4954   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4955   PetscInt        *idx_R_local=NULL;
4956   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
4957   PetscInt        vbs,bs;
4958   PetscBT         bitmask=NULL;
4959   PetscErrorCode  ierr;
4960 
4961   PetscFunctionBegin;
4962   /*
4963     No need to setup local scatters if
4964       - primal space is unchanged
4965         AND
4966       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
4967         AND
4968       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
4969   */
4970   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
4971     PetscFunctionReturn(0);
4972   }
4973   /* destroy old objects */
4974   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
4975   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
4976   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
4977   /* Set Non-overlapping dimensions */
4978   n_B = pcis->n_B;
4979   n_D = pcis->n - n_B;
4980   n_vertices = pcbddc->n_vertices;
4981 
4982   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
4983 
4984   /* create auxiliary bitmask and allocate workspace */
4985   if (!sub_schurs || !sub_schurs->reuse_solver) {
4986     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
4987     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
4988     for (i=0;i<n_vertices;i++) {
4989       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
4990     }
4991 
4992     for (i=0, n_R=0; i<pcis->n; i++) {
4993       if (!PetscBTLookup(bitmask,i)) {
4994         idx_R_local[n_R++] = i;
4995       }
4996     }
4997   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
4998     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4999 
5000     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5001     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
5002   }
5003 
5004   /* Block code */
5005   vbs = 1;
5006   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
5007   if (bs>1 && !(n_vertices%bs)) {
5008     PetscBool is_blocked = PETSC_TRUE;
5009     PetscInt  *vary;
5010     if (!sub_schurs || !sub_schurs->reuse_solver) {
5011       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
5012       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
5013       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
5014       /* 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 */
5015       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
5016       for (i=0; i<pcis->n/bs; i++) {
5017         if (vary[i]!=0 && vary[i]!=bs) {
5018           is_blocked = PETSC_FALSE;
5019           break;
5020         }
5021       }
5022       ierr = PetscFree(vary);CHKERRQ(ierr);
5023     } else {
5024       /* Verify directly the R set */
5025       for (i=0; i<n_R/bs; i++) {
5026         PetscInt j,node=idx_R_local[bs*i];
5027         for (j=1; j<bs; j++) {
5028           if (node != idx_R_local[bs*i+j]-j) {
5029             is_blocked = PETSC_FALSE;
5030             break;
5031           }
5032         }
5033       }
5034     }
5035     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
5036       vbs = bs;
5037       for (i=0;i<n_R/vbs;i++) {
5038         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
5039       }
5040     }
5041   }
5042   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
5043   if (sub_schurs && sub_schurs->reuse_solver) {
5044     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5045 
5046     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5047     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
5048     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
5049     reuse_solver->is_R = pcbddc->is_R_local;
5050   } else {
5051     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
5052   }
5053 
5054   /* print some info if requested */
5055   if (pcbddc->dbg_flag) {
5056     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5057     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5058     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5059     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
5060     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
5061     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);
5062     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5063   }
5064 
5065   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
5066   if (!sub_schurs || !sub_schurs->reuse_solver) {
5067     IS       is_aux1,is_aux2;
5068     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
5069 
5070     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5071     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
5072     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
5073     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5074     for (i=0; i<n_D; i++) {
5075       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
5076     }
5077     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5078     for (i=0, j=0; i<n_R; i++) {
5079       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
5080         aux_array1[j++] = i;
5081       }
5082     }
5083     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5084     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5085     for (i=0, j=0; i<n_B; i++) {
5086       if (!PetscBTLookup(bitmask,is_indices[i])) {
5087         aux_array2[j++] = i;
5088       }
5089     }
5090     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5091     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
5092     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
5093     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5094     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
5095 
5096     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5097       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
5098       for (i=0, j=0; i<n_R; i++) {
5099         if (PetscBTLookup(bitmask,idx_R_local[i])) {
5100           aux_array1[j++] = i;
5101         }
5102       }
5103       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5104       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5105       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5106     }
5107     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
5108     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5109   } else {
5110     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5111     IS                 tis;
5112     PetscInt           schur_size;
5113 
5114     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
5115     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
5116     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
5117     ierr = ISDestroy(&tis);CHKERRQ(ierr);
5118     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5119       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
5120       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5121       ierr = ISDestroy(&tis);CHKERRQ(ierr);
5122     }
5123   }
5124   PetscFunctionReturn(0);
5125 }
5126 
5127 
5128 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
5129 {
5130   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
5131   PC_IS          *pcis = (PC_IS*)pc->data;
5132   PC             pc_temp;
5133   Mat            A_RR;
5134   MatReuse       reuse;
5135   PetscScalar    m_one = -1.0;
5136   PetscReal      value;
5137   PetscInt       n_D,n_R;
5138   PetscBool      check_corr,issbaij;
5139   PetscErrorCode ierr;
5140   /* prefixes stuff */
5141   char           dir_prefix[256],neu_prefix[256],str_level[16];
5142   size_t         len;
5143 
5144   PetscFunctionBegin;
5145 
5146   /* compute prefixes */
5147   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
5148   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
5149   if (!pcbddc->current_level) {
5150     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,sizeof(dir_prefix));CHKERRQ(ierr);
5151     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,sizeof(neu_prefix));CHKERRQ(ierr);
5152     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5153     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5154   } else {
5155     ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
5156     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
5157     len -= 15; /* remove "pc_bddc_coarse_" */
5158     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
5159     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
5160     /* Nonstandard use of PetscStrncpy() to only copy a portion of the input string */
5161     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5162     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5163     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5164     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5165     ierr = PetscStrlcat(dir_prefix,str_level,sizeof(dir_prefix));CHKERRQ(ierr);
5166     ierr = PetscStrlcat(neu_prefix,str_level,sizeof(neu_prefix));CHKERRQ(ierr);
5167   }
5168 
5169   /* DIRICHLET PROBLEM */
5170   if (dirichlet) {
5171     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5172     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
5173       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented\n");
5174       if (pcbddc->dbg_flag) {
5175         Mat    A_IIn;
5176 
5177         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
5178         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
5179         pcis->A_II = A_IIn;
5180       }
5181     }
5182     if (pcbddc->local_mat->symmetric_set) {
5183       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
5184     }
5185     /* Matrix for Dirichlet problem is pcis->A_II */
5186     n_D = pcis->n - pcis->n_B;
5187     if (!pcbddc->ksp_D) { /* create object if not yet build */
5188       void (*f)(void) = 0;
5189 
5190       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
5191       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
5192       /* default */
5193       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
5194       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
5195       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5196       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5197       if (issbaij) {
5198         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5199       } else {
5200         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5201       }
5202       /* Allow user's customization */
5203       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
5204       ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5205       if (f && pcbddc->mat_graph->cloc) {
5206         PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5207         const PetscInt *idxs;
5208         PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5209 
5210         ierr = ISGetLocalSize(pcis->is_I_local,&nl);CHKERRQ(ierr);
5211         ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5212         ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5213         for (i=0;i<nl;i++) {
5214           for (d=0;d<cdim;d++) {
5215             scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5216           }
5217         }
5218         ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5219         ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5220         ierr = PetscFree(scoords);CHKERRQ(ierr);
5221       }
5222     }
5223     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
5224     if (sub_schurs && sub_schurs->reuse_solver) {
5225       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5226 
5227       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
5228     }
5229     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5230     if (!n_D) {
5231       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5232       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5233     }
5234     /* set ksp_D into pcis data */
5235     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
5236     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
5237     pcis->ksp_D = pcbddc->ksp_D;
5238   }
5239 
5240   /* NEUMANN PROBLEM */
5241   A_RR = 0;
5242   if (neumann) {
5243     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5244     PetscInt        ibs,mbs;
5245     PetscBool       issbaij, reuse_neumann_solver;
5246     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
5247 
5248     reuse_neumann_solver = PETSC_FALSE;
5249     if (sub_schurs && sub_schurs->reuse_solver) {
5250       IS iP;
5251 
5252       reuse_neumann_solver = PETSC_TRUE;
5253       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
5254       if (iP) reuse_neumann_solver = PETSC_FALSE;
5255     }
5256     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
5257     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
5258     if (pcbddc->ksp_R) { /* already created ksp */
5259       PetscInt nn_R;
5260       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
5261       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5262       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
5263       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
5264         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
5265         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5266         reuse = MAT_INITIAL_MATRIX;
5267       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5268         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5269           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5270           reuse = MAT_INITIAL_MATRIX;
5271         } else { /* safe to reuse the matrix */
5272           reuse = MAT_REUSE_MATRIX;
5273         }
5274       }
5275       /* last check */
5276       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5277         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5278         reuse = MAT_INITIAL_MATRIX;
5279       }
5280     } else { /* first time, so we need to create the matrix */
5281       reuse = MAT_INITIAL_MATRIX;
5282     }
5283     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
5284     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5285     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5286     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5287     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5288       if (matis->A == pcbddc->local_mat) {
5289         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5290         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5291       } else {
5292         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5293       }
5294     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5295       if (matis->A == pcbddc->local_mat) {
5296         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5297         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5298       } else {
5299         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5300       }
5301     }
5302     /* extract A_RR */
5303     if (reuse_neumann_solver) {
5304       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5305 
5306       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5307         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5308         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5309           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5310         } else {
5311           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5312         }
5313       } else {
5314         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5315         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5316         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5317       }
5318     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5319       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5320     }
5321     if (pcbddc->local_mat->symmetric_set) {
5322       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
5323     }
5324     if (!pcbddc->ksp_R) { /* create object if not present */
5325       void (*f)(void) = 0;
5326 
5327       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5328       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5329       /* default */
5330       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5331       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5332       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5333       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5334       if (issbaij) {
5335         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5336       } else {
5337         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5338       }
5339       /* Allow user's customization */
5340       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5341       ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5342       if (f && pcbddc->mat_graph->cloc) {
5343         PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5344         const PetscInt *idxs;
5345         PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5346 
5347         ierr = ISGetLocalSize(pcbddc->is_R_local,&nl);CHKERRQ(ierr);
5348         ierr = ISGetIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5349         ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5350         for (i=0;i<nl;i++) {
5351           for (d=0;d<cdim;d++) {
5352             scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5353           }
5354         }
5355         ierr = ISRestoreIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5356         ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5357         ierr = PetscFree(scoords);CHKERRQ(ierr);
5358       }
5359     }
5360     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5361     if (!n_R) {
5362       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5363       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5364     }
5365     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5366     /* Reuse solver if it is present */
5367     if (reuse_neumann_solver) {
5368       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5369 
5370       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5371     }
5372   }
5373 
5374   if (pcbddc->dbg_flag) {
5375     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5376     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5377     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5378   }
5379 
5380   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5381   check_corr = PETSC_FALSE;
5382   if (pcbddc->NullSpace_corr[0]) {
5383     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5384   }
5385   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5386     check_corr = PETSC_TRUE;
5387     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5388   }
5389   if (neumann && pcbddc->NullSpace_corr[2]) {
5390     check_corr = PETSC_TRUE;
5391     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5392   }
5393   /* check Dirichlet and Neumann solvers */
5394   if (pcbddc->dbg_flag) {
5395     if (dirichlet) { /* Dirichlet */
5396       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5397       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5398       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5399       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5400       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5401       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);
5402       if (check_corr) {
5403         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_TRUE);CHKERRQ(ierr);
5404       }
5405       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5406     }
5407     if (neumann) { /* Neumann */
5408       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5409       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5410       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5411       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5412       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5413       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);
5414       if (check_corr) {
5415         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_FALSE);CHKERRQ(ierr);
5416       }
5417       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5418     }
5419   }
5420   /* free Neumann problem's matrix */
5421   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5422   PetscFunctionReturn(0);
5423 }
5424 
5425 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5426 {
5427   PetscErrorCode  ierr;
5428   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5429   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5430   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5431 
5432   PetscFunctionBegin;
5433   if (!reuse_solver) {
5434     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5435   }
5436   if (!pcbddc->switch_static) {
5437     if (applytranspose && pcbddc->local_auxmat1) {
5438       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5439       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5440     }
5441     if (!reuse_solver) {
5442       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5443       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5444     } else {
5445       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5446 
5447       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5448       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5449     }
5450   } else {
5451     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5452     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5453     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5454     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5455     if (applytranspose && pcbddc->local_auxmat1) {
5456       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5457       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5458       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5459       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5460     }
5461   }
5462   if (!reuse_solver || pcbddc->switch_static) {
5463     if (applytranspose) {
5464       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5465     } else {
5466       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5467     }
5468   } else {
5469     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5470 
5471     if (applytranspose) {
5472       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5473     } else {
5474       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5475     }
5476   }
5477   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5478   if (!pcbddc->switch_static) {
5479     if (!reuse_solver) {
5480       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5481       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5482     } else {
5483       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5484 
5485       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5486       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5487     }
5488     if (!applytranspose && pcbddc->local_auxmat1) {
5489       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5490       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5491     }
5492   } else {
5493     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5494     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5495     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5496     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5497     if (!applytranspose && pcbddc->local_auxmat1) {
5498       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5499       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5500     }
5501     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5502     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5503     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5504     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5505   }
5506   PetscFunctionReturn(0);
5507 }
5508 
5509 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5510 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5511 {
5512   PetscErrorCode ierr;
5513   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5514   PC_IS*            pcis = (PC_IS*)  (pc->data);
5515   const PetscScalar zero = 0.0;
5516 
5517   PetscFunctionBegin;
5518   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5519   if (!pcbddc->benign_apply_coarse_only) {
5520     if (applytranspose) {
5521       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5522       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5523     } else {
5524       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5525       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5526     }
5527   } else {
5528     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5529   }
5530 
5531   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5532   if (pcbddc->benign_n) {
5533     PetscScalar *array;
5534     PetscInt    j;
5535 
5536     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5537     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5538     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5539   }
5540 
5541   /* start communications from local primal nodes to rhs of coarse solver */
5542   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5543   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5544   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5545 
5546   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5547   if (pcbddc->coarse_ksp) {
5548     Mat          coarse_mat;
5549     Vec          rhs,sol;
5550     MatNullSpace nullsp;
5551     PetscBool    isbddc = PETSC_FALSE;
5552 
5553     if (pcbddc->benign_have_null) {
5554       PC        coarse_pc;
5555 
5556       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5557       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5558       /* we need to propagate to coarser levels the need for a possible benign correction */
5559       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5560         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5561         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5562         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5563       }
5564     }
5565     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5566     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5567     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5568     ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5569     if (nullsp) {
5570       ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5571     }
5572     if (applytranspose) {
5573       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5574       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5575     } else {
5576       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5577         PC        coarse_pc;
5578 
5579         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5580         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5581         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5582         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5583       } else {
5584         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5585       }
5586     }
5587     /* we don't need the benign correction at coarser levels anymore */
5588     if (pcbddc->benign_have_null && isbddc) {
5589       PC        coarse_pc;
5590       PC_BDDC*  coarsepcbddc;
5591 
5592       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5593       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5594       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5595       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5596     }
5597     if (nullsp) {
5598       ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5599     }
5600   }
5601 
5602   /* Local solution on R nodes */
5603   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5604     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5605   }
5606   /* communications from coarse sol to local primal nodes */
5607   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5608   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5609 
5610   /* Sum contributions from the two levels */
5611   if (!pcbddc->benign_apply_coarse_only) {
5612     if (applytranspose) {
5613       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5614       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5615     } else {
5616       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5617       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5618     }
5619     /* store p0 */
5620     if (pcbddc->benign_n) {
5621       PetscScalar *array;
5622       PetscInt    j;
5623 
5624       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5625       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5626       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5627     }
5628   } else { /* expand the coarse solution */
5629     if (applytranspose) {
5630       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5631     } else {
5632       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5633     }
5634   }
5635   PetscFunctionReturn(0);
5636 }
5637 
5638 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5639 {
5640   PetscErrorCode ierr;
5641   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5642   PetscScalar    *array;
5643   Vec            from,to;
5644 
5645   PetscFunctionBegin;
5646   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5647     from = pcbddc->coarse_vec;
5648     to = pcbddc->vec1_P;
5649     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5650       Vec tvec;
5651 
5652       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5653       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5654       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5655       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5656       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5657       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5658     }
5659   } else { /* from local to global -> put data in coarse right hand side */
5660     from = pcbddc->vec1_P;
5661     to = pcbddc->coarse_vec;
5662   }
5663   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5664   PetscFunctionReturn(0);
5665 }
5666 
5667 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5668 {
5669   PetscErrorCode ierr;
5670   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5671   PetscScalar    *array;
5672   Vec            from,to;
5673 
5674   PetscFunctionBegin;
5675   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5676     from = pcbddc->coarse_vec;
5677     to = pcbddc->vec1_P;
5678   } else { /* from local to global -> put data in coarse right hand side */
5679     from = pcbddc->vec1_P;
5680     to = pcbddc->coarse_vec;
5681   }
5682   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5683   if (smode == SCATTER_FORWARD) {
5684     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5685       Vec tvec;
5686 
5687       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5688       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5689       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5690       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5691     }
5692   } else {
5693     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5694      ierr = VecResetArray(from);CHKERRQ(ierr);
5695     }
5696   }
5697   PetscFunctionReturn(0);
5698 }
5699 
5700 /* uncomment for testing purposes */
5701 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5702 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5703 {
5704   PetscErrorCode    ierr;
5705   PC_IS*            pcis = (PC_IS*)(pc->data);
5706   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5707   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5708   /* one and zero */
5709   PetscScalar       one=1.0,zero=0.0;
5710   /* space to store constraints and their local indices */
5711   PetscScalar       *constraints_data;
5712   PetscInt          *constraints_idxs,*constraints_idxs_B;
5713   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5714   PetscInt          *constraints_n;
5715   /* iterators */
5716   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5717   /* BLAS integers */
5718   PetscBLASInt      lwork,lierr;
5719   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5720   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5721   /* reuse */
5722   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5723   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5724   /* change of basis */
5725   PetscBool         qr_needed;
5726   PetscBT           change_basis,qr_needed_idx;
5727   /* auxiliary stuff */
5728   PetscInt          *nnz,*is_indices;
5729   PetscInt          ncc;
5730   /* some quantities */
5731   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5732   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5733   PetscReal         tol; /* tolerance for retaining eigenmodes */
5734 
5735   PetscFunctionBegin;
5736   tol  = PetscSqrtReal(PETSC_SMALL);
5737   /* Destroy Mat objects computed previously */
5738   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5739   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5740   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5741   /* save info on constraints from previous setup (if any) */
5742   olocal_primal_size = pcbddc->local_primal_size;
5743   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5744   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5745   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5746   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5747   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5748   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5749 
5750   if (!pcbddc->adaptive_selection) {
5751     IS           ISForVertices,*ISForFaces,*ISForEdges;
5752     MatNullSpace nearnullsp;
5753     const Vec    *nearnullvecs;
5754     Vec          *localnearnullsp;
5755     PetscScalar  *array;
5756     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5757     PetscBool    nnsp_has_cnst;
5758     /* LAPACK working arrays for SVD or POD */
5759     PetscBool    skip_lapack,boolforchange;
5760     PetscScalar  *work;
5761     PetscReal    *singular_vals;
5762 #if defined(PETSC_USE_COMPLEX)
5763     PetscReal    *rwork;
5764 #endif
5765 #if defined(PETSC_MISSING_LAPACK_GESVD)
5766     PetscScalar  *temp_basis,*correlation_mat;
5767 #else
5768     PetscBLASInt dummy_int=1;
5769     PetscScalar  dummy_scalar=1.;
5770 #endif
5771 
5772     /* Get index sets for faces, edges and vertices from graph */
5773     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
5774     /* print some info */
5775     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
5776       PetscInt nv;
5777 
5778       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
5779       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
5780       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5781       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5782       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
5783       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
5784       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
5785       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5786       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5787     }
5788 
5789     /* free unneeded index sets */
5790     if (!pcbddc->use_vertices) {
5791       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5792     }
5793     if (!pcbddc->use_edges) {
5794       for (i=0;i<n_ISForEdges;i++) {
5795         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5796       }
5797       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5798       n_ISForEdges = 0;
5799     }
5800     if (!pcbddc->use_faces) {
5801       for (i=0;i<n_ISForFaces;i++) {
5802         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5803       }
5804       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5805       n_ISForFaces = 0;
5806     }
5807 
5808     /* check if near null space is attached to global mat */
5809     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
5810     if (nearnullsp) {
5811       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
5812       /* remove any stored info */
5813       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
5814       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5815       /* store information for BDDC solver reuse */
5816       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
5817       pcbddc->onearnullspace = nearnullsp;
5818       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5819       for (i=0;i<nnsp_size;i++) {
5820         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
5821       }
5822     } else { /* if near null space is not provided BDDC uses constants by default */
5823       nnsp_size = 0;
5824       nnsp_has_cnst = PETSC_TRUE;
5825     }
5826     /* get max number of constraints on a single cc */
5827     max_constraints = nnsp_size;
5828     if (nnsp_has_cnst) max_constraints++;
5829 
5830     /*
5831          Evaluate maximum storage size needed by the procedure
5832          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
5833          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
5834          There can be multiple constraints per connected component
5835                                                                                                                                                            */
5836     n_vertices = 0;
5837     if (ISForVertices) {
5838       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
5839     }
5840     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
5841     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
5842 
5843     total_counts = n_ISForFaces+n_ISForEdges;
5844     total_counts *= max_constraints;
5845     total_counts += n_vertices;
5846     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
5847 
5848     total_counts = 0;
5849     max_size_of_constraint = 0;
5850     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
5851       IS used_is;
5852       if (i<n_ISForEdges) {
5853         used_is = ISForEdges[i];
5854       } else {
5855         used_is = ISForFaces[i-n_ISForEdges];
5856       }
5857       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
5858       total_counts += j;
5859       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
5860     }
5861     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);
5862 
5863     /* get local part of global near null space vectors */
5864     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
5865     for (k=0;k<nnsp_size;k++) {
5866       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
5867       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5868       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5869     }
5870 
5871     /* whether or not to skip lapack calls */
5872     skip_lapack = PETSC_TRUE;
5873     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
5874 
5875     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
5876     if (!skip_lapack) {
5877       PetscScalar temp_work;
5878 
5879 #if defined(PETSC_MISSING_LAPACK_GESVD)
5880       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
5881       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
5882       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
5883       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
5884 #if defined(PETSC_USE_COMPLEX)
5885       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
5886 #endif
5887       /* now we evaluate the optimal workspace using query with lwork=-1 */
5888       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5889       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
5890       lwork = -1;
5891       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5892 #if !defined(PETSC_USE_COMPLEX)
5893       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
5894 #else
5895       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
5896 #endif
5897       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5898       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
5899 #else /* on missing GESVD */
5900       /* SVD */
5901       PetscInt max_n,min_n;
5902       max_n = max_size_of_constraint;
5903       min_n = max_constraints;
5904       if (max_size_of_constraint < max_constraints) {
5905         min_n = max_size_of_constraint;
5906         max_n = max_constraints;
5907       }
5908       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
5909 #if defined(PETSC_USE_COMPLEX)
5910       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
5911 #endif
5912       /* now we evaluate the optimal workspace using query with lwork=-1 */
5913       lwork = -1;
5914       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
5915       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
5916       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
5917       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5918 #if !defined(PETSC_USE_COMPLEX)
5919       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));
5920 #else
5921       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));
5922 #endif
5923       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5924       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
5925 #endif /* on missing GESVD */
5926       /* Allocate optimal workspace */
5927       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
5928       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
5929     }
5930     /* Now we can loop on constraining sets */
5931     total_counts = 0;
5932     constraints_idxs_ptr[0] = 0;
5933     constraints_data_ptr[0] = 0;
5934     /* vertices */
5935     if (n_vertices) {
5936       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5937       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5938       for (i=0;i<n_vertices;i++) {
5939         constraints_n[total_counts] = 1;
5940         constraints_data[total_counts] = 1.0;
5941         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
5942         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
5943         total_counts++;
5944       }
5945       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5946       n_vertices = total_counts;
5947     }
5948 
5949     /* edges and faces */
5950     total_counts_cc = total_counts;
5951     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
5952       IS        used_is;
5953       PetscBool idxs_copied = PETSC_FALSE;
5954 
5955       if (ncc<n_ISForEdges) {
5956         used_is = ISForEdges[ncc];
5957         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
5958       } else {
5959         used_is = ISForFaces[ncc-n_ISForEdges];
5960         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
5961       }
5962       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
5963 
5964       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
5965       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5966       /* change of basis should not be performed on local periodic nodes */
5967       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
5968       if (nnsp_has_cnst) {
5969         PetscScalar quad_value;
5970 
5971         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5972         idxs_copied = PETSC_TRUE;
5973 
5974         if (!pcbddc->use_nnsp_true) {
5975           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
5976         } else {
5977           quad_value = 1.0;
5978         }
5979         for (j=0;j<size_of_constraint;j++) {
5980           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
5981         }
5982         temp_constraints++;
5983         total_counts++;
5984       }
5985       for (k=0;k<nnsp_size;k++) {
5986         PetscReal real_value;
5987         PetscScalar *ptr_to_data;
5988 
5989         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5990         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
5991         for (j=0;j<size_of_constraint;j++) {
5992           ptr_to_data[j] = array[is_indices[j]];
5993         }
5994         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5995         /* check if array is null on the connected component */
5996         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5997         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
5998         if (real_value > tol*size_of_constraint) { /* keep indices and values */
5999           temp_constraints++;
6000           total_counts++;
6001           if (!idxs_copied) {
6002             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
6003             idxs_copied = PETSC_TRUE;
6004           }
6005         }
6006       }
6007       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6008       valid_constraints = temp_constraints;
6009       if (!pcbddc->use_nnsp_true && temp_constraints) {
6010         if (temp_constraints == 1) { /* just normalize the constraint */
6011           PetscScalar norm,*ptr_to_data;
6012 
6013           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6014           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6015           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
6016           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
6017           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
6018         } else { /* perform SVD */
6019           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6020 
6021 #if defined(PETSC_MISSING_LAPACK_GESVD)
6022           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
6023              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
6024              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
6025                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
6026                 from that computed using LAPACKgesvd
6027              -> This is due to a different computation of eigenvectors in LAPACKheev
6028              -> The quality of the POD-computed basis will be the same */
6029           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
6030           /* Store upper triangular part of correlation matrix */
6031           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6032           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6033           for (j=0;j<temp_constraints;j++) {
6034             for (k=0;k<j+1;k++) {
6035               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));
6036             }
6037           }
6038           /* compute eigenvalues and eigenvectors of correlation matrix */
6039           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6040           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
6041 #if !defined(PETSC_USE_COMPLEX)
6042           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
6043 #else
6044           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
6045 #endif
6046           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6047           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
6048           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
6049           j = 0;
6050           while (j < temp_constraints && singular_vals[j] < tol) j++;
6051           total_counts = total_counts-j;
6052           valid_constraints = temp_constraints-j;
6053           /* scale and copy POD basis into used quadrature memory */
6054           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6055           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6056           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
6057           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6058           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
6059           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6060           if (j<temp_constraints) {
6061             PetscInt ii;
6062             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
6063             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6064             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));
6065             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6066             for (k=0;k<temp_constraints-j;k++) {
6067               for (ii=0;ii<size_of_constraint;ii++) {
6068                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
6069               }
6070             }
6071           }
6072 #else  /* on missing GESVD */
6073           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6074           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6075           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6076           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6077 #if !defined(PETSC_USE_COMPLEX)
6078           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));
6079 #else
6080           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));
6081 #endif
6082           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
6083           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6084           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
6085           k = temp_constraints;
6086           if (k > size_of_constraint) k = size_of_constraint;
6087           j = 0;
6088           while (j < k && singular_vals[k-j-1] < tol) j++;
6089           valid_constraints = k-j;
6090           total_counts = total_counts-temp_constraints+valid_constraints;
6091 #endif /* on missing GESVD */
6092         }
6093       }
6094       /* update pointers information */
6095       if (valid_constraints) {
6096         constraints_n[total_counts_cc] = valid_constraints;
6097         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
6098         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
6099         /* set change_of_basis flag */
6100         if (boolforchange) {
6101           PetscBTSet(change_basis,total_counts_cc);
6102         }
6103         total_counts_cc++;
6104       }
6105     }
6106     /* free workspace */
6107     if (!skip_lapack) {
6108       ierr = PetscFree(work);CHKERRQ(ierr);
6109 #if defined(PETSC_USE_COMPLEX)
6110       ierr = PetscFree(rwork);CHKERRQ(ierr);
6111 #endif
6112       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
6113 #if defined(PETSC_MISSING_LAPACK_GESVD)
6114       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
6115       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
6116 #endif
6117     }
6118     for (k=0;k<nnsp_size;k++) {
6119       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
6120     }
6121     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
6122     /* free index sets of faces, edges and vertices */
6123     for (i=0;i<n_ISForFaces;i++) {
6124       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6125     }
6126     if (n_ISForFaces) {
6127       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6128     }
6129     for (i=0;i<n_ISForEdges;i++) {
6130       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6131     }
6132     if (n_ISForEdges) {
6133       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6134     }
6135     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6136   } else {
6137     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
6138 
6139     total_counts = 0;
6140     n_vertices = 0;
6141     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
6142       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
6143     }
6144     max_constraints = 0;
6145     total_counts_cc = 0;
6146     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6147       total_counts += pcbddc->adaptive_constraints_n[i];
6148       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
6149       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
6150     }
6151     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
6152     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
6153     constraints_idxs = pcbddc->adaptive_constraints_idxs;
6154     constraints_data = pcbddc->adaptive_constraints_data;
6155     /* constraints_n differs from pcbddc->adaptive_constraints_n */
6156     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
6157     total_counts_cc = 0;
6158     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6159       if (pcbddc->adaptive_constraints_n[i]) {
6160         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
6161       }
6162     }
6163 #if 0
6164     printf("Found %d totals (%d)\n",total_counts_cc,total_counts);
6165     for (i=0;i<total_counts_cc;i++) {
6166       printf("const %d, start %d",i,constraints_idxs_ptr[i]);
6167       printf(" end %d:\n",constraints_idxs_ptr[i+1]);
6168       for (j=constraints_idxs_ptr[i];j<constraints_idxs_ptr[i+1];j++) {
6169         printf(" %d",constraints_idxs[j]);
6170       }
6171       printf("\n");
6172       printf("number of cc: %d\n",constraints_n[i]);
6173     }
6174     for (i=0;i<n_vertices;i++) {
6175       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i]);
6176     }
6177     for (i=0;i<sub_schurs->n_subs;i++) {
6178       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]);
6179     }
6180 #endif
6181 
6182     max_size_of_constraint = 0;
6183     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]);
6184     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
6185     /* Change of basis */
6186     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
6187     if (pcbddc->use_change_of_basis) {
6188       for (i=0;i<sub_schurs->n_subs;i++) {
6189         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
6190           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
6191         }
6192       }
6193     }
6194   }
6195   pcbddc->local_primal_size = total_counts;
6196   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6197 
6198   /* map constraints_idxs in boundary numbering */
6199   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
6200   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);
6201 
6202   /* Create constraint matrix */
6203   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6204   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
6205   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
6206 
6207   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
6208   /* determine if a QR strategy is needed for change of basis */
6209   qr_needed = PETSC_FALSE;
6210   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
6211   total_primal_vertices=0;
6212   pcbddc->local_primal_size_cc = 0;
6213   for (i=0;i<total_counts_cc;i++) {
6214     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6215     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
6216       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
6217       pcbddc->local_primal_size_cc += 1;
6218     } else if (PetscBTLookup(change_basis,i)) {
6219       for (k=0;k<constraints_n[i];k++) {
6220         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6221       }
6222       pcbddc->local_primal_size_cc += constraints_n[i];
6223       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
6224         PetscBTSet(qr_needed_idx,i);
6225         qr_needed = PETSC_TRUE;
6226       }
6227     } else {
6228       pcbddc->local_primal_size_cc += 1;
6229     }
6230   }
6231   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
6232   pcbddc->n_vertices = total_primal_vertices;
6233   /* permute indices in order to have a sorted set of vertices */
6234   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6235   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);
6236   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
6237   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
6238 
6239   /* nonzero structure of constraint matrix */
6240   /* and get reference dof for local constraints */
6241   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
6242   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
6243 
6244   j = total_primal_vertices;
6245   total_counts = total_primal_vertices;
6246   cum = total_primal_vertices;
6247   for (i=n_vertices;i<total_counts_cc;i++) {
6248     if (!PetscBTLookup(change_basis,i)) {
6249       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
6250       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
6251       cum++;
6252       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6253       for (k=0;k<constraints_n[i];k++) {
6254         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6255         nnz[j+k] = size_of_constraint;
6256       }
6257       j += constraints_n[i];
6258     }
6259   }
6260   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
6261   ierr = PetscFree(nnz);CHKERRQ(ierr);
6262 
6263   /* set values in constraint matrix */
6264   for (i=0;i<total_primal_vertices;i++) {
6265     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
6266   }
6267   total_counts = total_primal_vertices;
6268   for (i=n_vertices;i<total_counts_cc;i++) {
6269     if (!PetscBTLookup(change_basis,i)) {
6270       PetscInt *cols;
6271 
6272       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6273       cols = constraints_idxs+constraints_idxs_ptr[i];
6274       for (k=0;k<constraints_n[i];k++) {
6275         PetscInt    row = total_counts+k;
6276         PetscScalar *vals;
6277 
6278         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
6279         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6280       }
6281       total_counts += constraints_n[i];
6282     }
6283   }
6284   /* assembling */
6285   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6286   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6287   ierr = MatChop(pcbddc->ConstraintMatrix,PETSC_SMALL);CHKERRQ(ierr);
6288   ierr = MatSeqAIJCompress(pcbddc->ConstraintMatrix,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6289   ierr = MatViewFromOptions(pcbddc->ConstraintMatrix,NULL,"-pc_bddc_constraint_mat_view");CHKERRQ(ierr);
6290 
6291   /*
6292   ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
6293   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
6294   ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
6295   */
6296   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6297   if (pcbddc->use_change_of_basis) {
6298     /* dual and primal dofs on a single cc */
6299     PetscInt     dual_dofs,primal_dofs;
6300     /* working stuff for GEQRF */
6301     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
6302     PetscBLASInt lqr_work;
6303     /* working stuff for UNGQR */
6304     PetscScalar  *gqr_work,lgqr_work_t;
6305     PetscBLASInt lgqr_work;
6306     /* working stuff for TRTRS */
6307     PetscScalar  *trs_rhs;
6308     PetscBLASInt Blas_NRHS;
6309     /* pointers for values insertion into change of basis matrix */
6310     PetscInt     *start_rows,*start_cols;
6311     PetscScalar  *start_vals;
6312     /* working stuff for values insertion */
6313     PetscBT      is_primal;
6314     PetscInt     *aux_primal_numbering_B;
6315     /* matrix sizes */
6316     PetscInt     global_size,local_size;
6317     /* temporary change of basis */
6318     Mat          localChangeOfBasisMatrix;
6319     /* extra space for debugging */
6320     PetscScalar  *dbg_work;
6321 
6322     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6323     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6324     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6325     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6326     /* nonzeros for local mat */
6327     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6328     if (!pcbddc->benign_change || pcbddc->fake_change) {
6329       for (i=0;i<pcis->n;i++) nnz[i]=1;
6330     } else {
6331       const PetscInt *ii;
6332       PetscInt       n;
6333       PetscBool      flg_row;
6334       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6335       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6336       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6337     }
6338     for (i=n_vertices;i<total_counts_cc;i++) {
6339       if (PetscBTLookup(change_basis,i)) {
6340         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6341         if (PetscBTLookup(qr_needed_idx,i)) {
6342           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6343         } else {
6344           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6345           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6346         }
6347       }
6348     }
6349     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6350     ierr = PetscFree(nnz);CHKERRQ(ierr);
6351     /* Set interior change in the matrix */
6352     if (!pcbddc->benign_change || pcbddc->fake_change) {
6353       for (i=0;i<pcis->n;i++) {
6354         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6355       }
6356     } else {
6357       const PetscInt *ii,*jj;
6358       PetscScalar    *aa;
6359       PetscInt       n;
6360       PetscBool      flg_row;
6361       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6362       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6363       for (i=0;i<n;i++) {
6364         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6365       }
6366       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6367       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6368     }
6369 
6370     if (pcbddc->dbg_flag) {
6371       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6372       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6373     }
6374 
6375 
6376     /* Now we loop on the constraints which need a change of basis */
6377     /*
6378        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6379        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6380 
6381        Basic blocks of change of basis matrix T computed by
6382 
6383           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6384 
6385             | 1        0   ...        0         s_1/S |
6386             | 0        1   ...        0         s_2/S |
6387             |              ...                        |
6388             | 0        ...            1     s_{n-1}/S |
6389             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6390 
6391             with S = \sum_{i=1}^n s_i^2
6392             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6393                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6394 
6395           - QR decomposition of constraints otherwise
6396     */
6397     if (qr_needed) {
6398       /* space to store Q */
6399       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6400       /* array to store scaling factors for reflectors */
6401       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6402       /* first we issue queries for optimal work */
6403       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6404       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6405       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6406       lqr_work = -1;
6407       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6408       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6409       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6410       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6411       lgqr_work = -1;
6412       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6413       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6414       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6415       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6416       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6417       PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6418       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to ORGQR/UNGQR Lapack routine %d",(int)lierr);
6419       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6420       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6421       /* array to store rhs and solution of triangular solver */
6422       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6423       /* allocating workspace for check */
6424       if (pcbddc->dbg_flag) {
6425         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6426       }
6427     }
6428     /* array to store whether a node is primal or not */
6429     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6430     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6431     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6432     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);
6433     for (i=0;i<total_primal_vertices;i++) {
6434       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6435     }
6436     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6437 
6438     /* loop on constraints and see whether or not they need a change of basis and compute it */
6439     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6440       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6441       if (PetscBTLookup(change_basis,total_counts)) {
6442         /* get constraint info */
6443         primal_dofs = constraints_n[total_counts];
6444         dual_dofs = size_of_constraint-primal_dofs;
6445 
6446         if (pcbddc->dbg_flag) {
6447           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);
6448         }
6449 
6450         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6451 
6452           /* copy quadrature constraints for change of basis check */
6453           if (pcbddc->dbg_flag) {
6454             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6455           }
6456           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6457           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6458 
6459           /* compute QR decomposition of constraints */
6460           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6461           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6462           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6463           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6464           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6465           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6466           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6467 
6468           /* explictly compute R^-T */
6469           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
6470           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6471           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6472           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6473           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6474           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6475           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6476           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6477           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6478           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6479 
6480           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6481           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6482           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6483           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6484           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6485           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6486           PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6487           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in ORGQR/UNGQR Lapack routine %d",(int)lierr);
6488           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6489 
6490           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6491              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6492              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6493           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6494           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6495           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6496           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6497           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6498           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6499           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6500           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));
6501           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6502           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6503 
6504           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6505           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6506           /* insert cols for primal dofs */
6507           for (j=0;j<primal_dofs;j++) {
6508             start_vals = &qr_basis[j*size_of_constraint];
6509             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6510             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6511           }
6512           /* insert cols for dual dofs */
6513           for (j=0,k=0;j<dual_dofs;k++) {
6514             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6515               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6516               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6517               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6518               j++;
6519             }
6520           }
6521 
6522           /* check change of basis */
6523           if (pcbddc->dbg_flag) {
6524             PetscInt   ii,jj;
6525             PetscBool valid_qr=PETSC_TRUE;
6526             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6527             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6528             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6529             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6530             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6531             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6532             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6533             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));
6534             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6535             for (jj=0;jj<size_of_constraint;jj++) {
6536               for (ii=0;ii<primal_dofs;ii++) {
6537                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6538                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) valid_qr = PETSC_FALSE;
6539               }
6540             }
6541             if (!valid_qr) {
6542               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6543               for (jj=0;jj<size_of_constraint;jj++) {
6544                 for (ii=0;ii<primal_dofs;ii++) {
6545                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6546                     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]));
6547                   }
6548                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) {
6549                     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]));
6550                   }
6551                 }
6552               }
6553             } else {
6554               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6555             }
6556           }
6557         } else { /* simple transformation block */
6558           PetscInt    row,col;
6559           PetscScalar val,norm;
6560 
6561           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6562           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6563           for (j=0;j<size_of_constraint;j++) {
6564             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6565             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6566             if (!PetscBTLookup(is_primal,row_B)) {
6567               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6568               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6569               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6570             } else {
6571               for (k=0;k<size_of_constraint;k++) {
6572                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6573                 if (row != col) {
6574                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6575                 } else {
6576                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6577                 }
6578                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6579               }
6580             }
6581           }
6582           if (pcbddc->dbg_flag) {
6583             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6584           }
6585         }
6586       } else {
6587         if (pcbddc->dbg_flag) {
6588           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d does not need a change of basis (size %d)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6589         }
6590       }
6591     }
6592 
6593     /* free workspace */
6594     if (qr_needed) {
6595       if (pcbddc->dbg_flag) {
6596         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6597       }
6598       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6599       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6600       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6601       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6602       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6603     }
6604     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6605     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6606     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6607 
6608     /* assembling of global change of variable */
6609     if (!pcbddc->fake_change) {
6610       Mat      tmat;
6611       PetscInt bs;
6612 
6613       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6614       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6615       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6616       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6617       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6618       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6619       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6620       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6621       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6622       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6623       ierr = MatISGetMPIXAIJ(tmat,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6624       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6625       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6626       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6627       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6628       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6629       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6630       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6631 
6632       /* check */
6633       if (pcbddc->dbg_flag) {
6634         PetscReal error;
6635         Vec       x,x_change;
6636 
6637         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6638         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6639         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6640         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6641         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6642         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6643         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6644         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6645         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6646         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6647         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6648         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6649         if (error > PETSC_SMALL) {
6650           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
6651         }
6652         ierr = VecDestroy(&x);CHKERRQ(ierr);
6653         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6654       }
6655       /* adapt sub_schurs computed (if any) */
6656       if (pcbddc->use_deluxe_scaling) {
6657         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6658 
6659         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");
6660         if (sub_schurs && sub_schurs->S_Ej_all) {
6661           Mat                    S_new,tmat;
6662           IS                     is_all_N,is_V_Sall = NULL;
6663 
6664           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6665           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6666           if (pcbddc->deluxe_zerorows) {
6667             ISLocalToGlobalMapping NtoSall;
6668             IS                     is_V;
6669             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6670             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6671             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6672             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6673             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6674           }
6675           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6676           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6677           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6678           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6679           if (pcbddc->deluxe_zerorows) {
6680             const PetscScalar *array;
6681             const PetscInt    *idxs_V,*idxs_all;
6682             PetscInt          i,n_V;
6683 
6684             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6685             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6686             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6687             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6688             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6689             for (i=0;i<n_V;i++) {
6690               PetscScalar val;
6691               PetscInt    idx;
6692 
6693               idx = idxs_V[i];
6694               val = array[idxs_all[idxs_V[i]]];
6695               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6696             }
6697             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6698             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6699             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6700             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6701             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6702           }
6703           sub_schurs->S_Ej_all = S_new;
6704           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6705           if (sub_schurs->sum_S_Ej_all) {
6706             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6707             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6708             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6709             if (pcbddc->deluxe_zerorows) {
6710               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6711             }
6712             sub_schurs->sum_S_Ej_all = S_new;
6713             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6714           }
6715           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6716           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6717         }
6718         /* destroy any change of basis context in sub_schurs */
6719         if (sub_schurs && sub_schurs->change) {
6720           PetscInt i;
6721 
6722           for (i=0;i<sub_schurs->n_subs;i++) {
6723             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6724           }
6725           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6726         }
6727       }
6728       if (pcbddc->switch_static) { /* need to save the local change */
6729         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6730       } else {
6731         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6732       }
6733       /* determine if any process has changed the pressures locally */
6734       pcbddc->change_interior = pcbddc->benign_have_null;
6735     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6736       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6737       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6738       pcbddc->use_qr_single = qr_needed;
6739     }
6740   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6741     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6742       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6743       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6744     } else {
6745       Mat benign_global = NULL;
6746       if (pcbddc->benign_have_null) {
6747         Mat tmat;
6748 
6749         pcbddc->change_interior = PETSC_TRUE;
6750         ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6751         ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6752         ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6753         ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6754         ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6755         ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6756         ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6757         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6758         if (pcbddc->benign_change) {
6759           Mat M;
6760 
6761           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6762           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6763           ierr = MatISSetLocalMat(tmat,M);CHKERRQ(ierr);
6764           ierr = MatDestroy(&M);CHKERRQ(ierr);
6765         } else {
6766           Mat         eye;
6767           PetscScalar *array;
6768 
6769           ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6770           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&eye);CHKERRQ(ierr);
6771           for (i=0;i<pcis->n;i++) {
6772             ierr = MatSetValue(eye,i,i,array[i],INSERT_VALUES);CHKERRQ(ierr);
6773           }
6774           ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6775           ierr = MatAssemblyBegin(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6776           ierr = MatAssemblyEnd(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6777           ierr = MatISSetLocalMat(tmat,eye);CHKERRQ(ierr);
6778           ierr = MatDestroy(&eye);CHKERRQ(ierr);
6779         }
6780         ierr = MatISGetMPIXAIJ(tmat,MAT_INITIAL_MATRIX,&benign_global);CHKERRQ(ierr);
6781         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6782       }
6783       if (pcbddc->user_ChangeOfBasisMatrix) {
6784         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6785         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6786       } else if (pcbddc->benign_have_null) {
6787         pcbddc->ChangeOfBasisMatrix = benign_global;
6788       }
6789     }
6790     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6791       IS             is_global;
6792       const PetscInt *gidxs;
6793 
6794       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6795       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6796       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6797       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6798       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6799     }
6800   }
6801   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6802     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6803   }
6804 
6805   if (!pcbddc->fake_change) {
6806     /* add pressure dofs to set of primal nodes for numbering purposes */
6807     for (i=0;i<pcbddc->benign_n;i++) {
6808       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
6809       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
6810       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
6811       pcbddc->local_primal_size_cc++;
6812       pcbddc->local_primal_size++;
6813     }
6814 
6815     /* check if a new primal space has been introduced (also take into account benign trick) */
6816     pcbddc->new_primal_space_local = PETSC_TRUE;
6817     if (olocal_primal_size == pcbddc->local_primal_size) {
6818       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6819       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6820       if (!pcbddc->new_primal_space_local) {
6821         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6822         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6823       }
6824     }
6825     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
6826     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6827   }
6828   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
6829 
6830   /* flush dbg viewer */
6831   if (pcbddc->dbg_flag) {
6832     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6833   }
6834 
6835   /* free workspace */
6836   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
6837   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
6838   if (!pcbddc->adaptive_selection) {
6839     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
6840     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
6841   } else {
6842     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
6843                       pcbddc->adaptive_constraints_idxs_ptr,
6844                       pcbddc->adaptive_constraints_data_ptr,
6845                       pcbddc->adaptive_constraints_idxs,
6846                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
6847     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
6848     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
6849   }
6850   PetscFunctionReturn(0);
6851 }
6852 /* #undef PETSC_MISSING_LAPACK_GESVD */
6853 
6854 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
6855 {
6856   ISLocalToGlobalMapping map;
6857   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
6858   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
6859   PetscInt               i,N;
6860   PetscBool              rcsr = PETSC_FALSE;
6861   PetscErrorCode         ierr;
6862 
6863   PetscFunctionBegin;
6864   if (pcbddc->recompute_topography) {
6865     pcbddc->graphanalyzed = PETSC_FALSE;
6866     /* Reset previously computed graph */
6867     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
6868     /* Init local Graph struct */
6869     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
6870     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
6871     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
6872 
6873     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
6874       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6875     }
6876     /* Check validity of the csr graph passed in by the user */
6877     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);
6878 
6879     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
6880     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
6881       PetscInt  *xadj,*adjncy;
6882       PetscInt  nvtxs;
6883       PetscBool flg_row=PETSC_FALSE;
6884 
6885       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6886       if (flg_row) {
6887         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
6888         pcbddc->computed_rowadj = PETSC_TRUE;
6889       }
6890       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6891       rcsr = PETSC_TRUE;
6892     }
6893     if (pcbddc->dbg_flag) {
6894       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6895     }
6896 
6897     if (pcbddc->mat_graph->cdim && !pcbddc->mat_graph->cloc) {
6898       PetscReal    *lcoords;
6899       PetscInt     n;
6900       MPI_Datatype dimrealtype;
6901 
6902       if (pcbddc->mat_graph->cnloc != pc->pmat->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid number of local coordinates! Got %D, expected %D",pcbddc->mat_graph->cnloc,pc->pmat->rmap->n);
6903       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
6904       ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
6905       ierr = PetscMalloc1(pcbddc->mat_graph->cdim*n,&lcoords);CHKERRQ(ierr);
6906       ierr = MPI_Type_contiguous(pcbddc->mat_graph->cdim,MPIU_REAL,&dimrealtype);CHKERRQ(ierr);
6907       ierr = MPI_Type_commit(&dimrealtype);CHKERRQ(ierr);
6908       ierr = PetscSFBcastBegin(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
6909       ierr = PetscSFBcastEnd(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
6910       ierr = MPI_Type_free(&dimrealtype);CHKERRQ(ierr);
6911       ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
6912 
6913       pcbddc->mat_graph->coords = lcoords;
6914       pcbddc->mat_graph->cloc   = PETSC_TRUE;
6915       pcbddc->mat_graph->cnloc  = n;
6916     }
6917     if (pcbddc->mat_graph->cnloc && pcbddc->mat_graph->cnloc != pcbddc->mat_graph->nvtxs) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid number of local subdomain coordinates! Got %D, expected %D",pcbddc->mat_graph->cnloc,pcbddc->mat_graph->nvtxs);
6918     pcbddc->mat_graph->active_coords = (PetscBool)(pcbddc->corner_selection && !pcbddc->corner_selected);
6919 
6920     /* Setup of Graph */
6921     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
6922     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6923 
6924     /* attach info on disconnected subdomains if present */
6925     if (pcbddc->n_local_subs) {
6926       PetscInt *local_subs;
6927 
6928       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
6929       for (i=0;i<pcbddc->n_local_subs;i++) {
6930         const PetscInt *idxs;
6931         PetscInt       nl,j;
6932 
6933         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
6934         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6935         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
6936         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6937       }
6938       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
6939       pcbddc->mat_graph->local_subs = local_subs;
6940     }
6941   }
6942 
6943   if (!pcbddc->graphanalyzed) {
6944     /* Graph's connected components analysis */
6945     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
6946     pcbddc->graphanalyzed = PETSC_TRUE;
6947   }
6948   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
6949   PetscFunctionReturn(0);
6950 }
6951 
6952 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
6953 {
6954   PetscInt       i,j;
6955   PetscScalar    *alphas;
6956   PetscErrorCode ierr;
6957 
6958   PetscFunctionBegin;
6959   if (!n) PetscFunctionReturn(0);
6960   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
6961   ierr = VecNormalize(vecs[0],NULL);CHKERRQ(ierr);
6962   for (i=1;i<n;i++) {
6963     ierr = VecMDot(vecs[i],i,vecs,alphas);CHKERRQ(ierr);
6964     for (j=0;j<i;j++) alphas[j] = PetscConj(-alphas[j]);
6965     ierr = VecMAXPY(vecs[i],i,alphas,vecs);CHKERRQ(ierr);
6966     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
6967   }
6968   ierr = PetscFree(alphas);CHKERRQ(ierr);
6969   PetscFunctionReturn(0);
6970 }
6971 
6972 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
6973 {
6974   Mat            A;
6975   PetscInt       n_neighs,*neighs,*n_shared,**shared;
6976   PetscMPIInt    size,rank,color;
6977   PetscInt       *xadj,*adjncy;
6978   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
6979   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
6980   PetscInt       void_procs,*procs_candidates = NULL;
6981   PetscInt       xadj_count,*count;
6982   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
6983   PetscSubcomm   psubcomm;
6984   MPI_Comm       subcomm;
6985   PetscErrorCode ierr;
6986 
6987   PetscFunctionBegin;
6988   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6989   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6990   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);
6991   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
6992   PetscValidLogicalCollectiveInt(mat,redprocs,3);
6993   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %d\n",*n_subdomains);
6994 
6995   if (have_void) *have_void = PETSC_FALSE;
6996   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
6997   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
6998   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
6999   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
7000   im_active = !!n;
7001   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7002   void_procs = size - active_procs;
7003   /* get ranks of of non-active processes in mat communicator */
7004   if (void_procs) {
7005     PetscInt ncand;
7006 
7007     if (have_void) *have_void = PETSC_TRUE;
7008     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
7009     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7010     for (i=0,ncand=0;i<size;i++) {
7011       if (!procs_candidates[i]) {
7012         procs_candidates[ncand++] = i;
7013       }
7014     }
7015     /* force n_subdomains to be not greater that the number of non-active processes */
7016     *n_subdomains = PetscMin(void_procs,*n_subdomains);
7017   }
7018 
7019   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
7020      number of subdomains requested 1 -> send to master or first candidate in voids  */
7021   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
7022   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
7023     PetscInt issize,isidx,dest;
7024     if (*n_subdomains == 1) dest = 0;
7025     else dest = rank;
7026     if (im_active) {
7027       issize = 1;
7028       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7029         isidx = procs_candidates[dest];
7030       } else {
7031         isidx = dest;
7032       }
7033     } else {
7034       issize = 0;
7035       isidx = -1;
7036     }
7037     if (*n_subdomains != 1) *n_subdomains = active_procs;
7038     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
7039     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7040     PetscFunctionReturn(0);
7041   }
7042   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
7043   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
7044   threshold = PetscMax(threshold,2);
7045 
7046   /* Get info on mapping */
7047   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7048 
7049   /* build local CSR graph of subdomains' connectivity */
7050   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
7051   xadj[0] = 0;
7052   xadj[1] = PetscMax(n_neighs-1,0);
7053   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
7054   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
7055   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
7056   for (i=1;i<n_neighs;i++)
7057     for (j=0;j<n_shared[i];j++)
7058       count[shared[i][j]] += 1;
7059 
7060   xadj_count = 0;
7061   for (i=1;i<n_neighs;i++) {
7062     for (j=0;j<n_shared[i];j++) {
7063       if (count[shared[i][j]] < threshold) {
7064         adjncy[xadj_count] = neighs[i];
7065         adjncy_wgt[xadj_count] = n_shared[i];
7066         xadj_count++;
7067         break;
7068       }
7069     }
7070   }
7071   xadj[1] = xadj_count;
7072   ierr = PetscFree(count);CHKERRQ(ierr);
7073   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7074   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7075 
7076   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
7077 
7078   /* Restrict work on active processes only */
7079   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
7080   if (void_procs) {
7081     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
7082     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
7083     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
7084     subcomm = PetscSubcommChild(psubcomm);
7085   } else {
7086     psubcomm = NULL;
7087     subcomm = PetscObjectComm((PetscObject)mat);
7088   }
7089 
7090   v_wgt = NULL;
7091   if (!color) {
7092     ierr = PetscFree(xadj);CHKERRQ(ierr);
7093     ierr = PetscFree(adjncy);CHKERRQ(ierr);
7094     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7095   } else {
7096     Mat             subdomain_adj;
7097     IS              new_ranks,new_ranks_contig;
7098     MatPartitioning partitioner;
7099     PetscInt        rstart=0,rend=0;
7100     PetscInt        *is_indices,*oldranks;
7101     PetscMPIInt     size;
7102     PetscBool       aggregate;
7103 
7104     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
7105     if (void_procs) {
7106       PetscInt prank = rank;
7107       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
7108       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
7109       for (i=0;i<xadj[1];i++) {
7110         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
7111       }
7112       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7113     } else {
7114       oldranks = NULL;
7115     }
7116     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
7117     if (aggregate) { /* TODO: all this part could be made more efficient */
7118       PetscInt    lrows,row,ncols,*cols;
7119       PetscMPIInt nrank;
7120       PetscScalar *vals;
7121 
7122       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
7123       lrows = 0;
7124       if (nrank<redprocs) {
7125         lrows = size/redprocs;
7126         if (nrank<size%redprocs) lrows++;
7127       }
7128       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
7129       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
7130       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7131       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7132       row = nrank;
7133       ncols = xadj[1]-xadj[0];
7134       cols = adjncy;
7135       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
7136       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
7137       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
7138       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7139       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7140       ierr = PetscFree(xadj);CHKERRQ(ierr);
7141       ierr = PetscFree(adjncy);CHKERRQ(ierr);
7142       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7143       ierr = PetscFree(vals);CHKERRQ(ierr);
7144       if (use_vwgt) {
7145         Vec               v;
7146         const PetscScalar *array;
7147         PetscInt          nl;
7148 
7149         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
7150         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
7151         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
7152         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
7153         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
7154         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
7155         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
7156         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
7157         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
7158         ierr = VecDestroy(&v);CHKERRQ(ierr);
7159       }
7160     } else {
7161       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
7162       if (use_vwgt) {
7163         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
7164         v_wgt[0] = n;
7165       }
7166     }
7167     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
7168 
7169     /* Partition */
7170     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
7171     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
7172     if (v_wgt) {
7173       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
7174     }
7175     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
7176     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
7177     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
7178     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
7179     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
7180 
7181     /* renumber new_ranks to avoid "holes" in new set of processors */
7182     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
7183     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
7184     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7185     if (!aggregate) {
7186       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7187 #if defined(PETSC_USE_DEBUG)
7188         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7189 #endif
7190         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
7191       } else if (oldranks) {
7192         ranks_send_to_idx[0] = oldranks[is_indices[0]];
7193       } else {
7194         ranks_send_to_idx[0] = is_indices[0];
7195       }
7196     } else {
7197       PetscInt    idx = 0;
7198       PetscMPIInt tag;
7199       MPI_Request *reqs;
7200 
7201       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
7202       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
7203       for (i=rstart;i<rend;i++) {
7204         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
7205       }
7206       ierr = MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
7207       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7208       ierr = PetscFree(reqs);CHKERRQ(ierr);
7209       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7210 #if defined(PETSC_USE_DEBUG)
7211         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7212 #endif
7213         ranks_send_to_idx[0] = procs_candidates[oldranks[idx]];
7214       } else if (oldranks) {
7215         ranks_send_to_idx[0] = oldranks[idx];
7216       } else {
7217         ranks_send_to_idx[0] = idx;
7218       }
7219     }
7220     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7221     /* clean up */
7222     ierr = PetscFree(oldranks);CHKERRQ(ierr);
7223     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
7224     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
7225     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
7226   }
7227   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
7228   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7229 
7230   /* assemble parallel IS for sends */
7231   i = 1;
7232   if (!color) i=0;
7233   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
7234   PetscFunctionReturn(0);
7235 }
7236 
7237 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
7238 
7239 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[])
7240 {
7241   Mat                    local_mat;
7242   IS                     is_sends_internal;
7243   PetscInt               rows,cols,new_local_rows;
7244   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
7245   PetscBool              ismatis,isdense,newisdense,destroy_mat;
7246   ISLocalToGlobalMapping l2gmap;
7247   PetscInt*              l2gmap_indices;
7248   const PetscInt*        is_indices;
7249   MatType                new_local_type;
7250   /* buffers */
7251   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
7252   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
7253   PetscInt               *recv_buffer_idxs_local;
7254   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
7255   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
7256   /* MPI */
7257   MPI_Comm               comm,comm_n;
7258   PetscSubcomm           subcomm;
7259   PetscMPIInt            n_sends,n_recvs,commsize;
7260   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
7261   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
7262   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
7263   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
7264   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
7265   PetscErrorCode         ierr;
7266 
7267   PetscFunctionBegin;
7268   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7269   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7270   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);
7271   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
7272   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
7273   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
7274   PetscValidLogicalCollectiveBool(mat,reuse,6);
7275   PetscValidLogicalCollectiveInt(mat,nis,8);
7276   PetscValidLogicalCollectiveInt(mat,nvecs,10);
7277   if (nvecs) {
7278     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
7279     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
7280   }
7281   /* further checks */
7282   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7283   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
7284   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
7285   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
7286   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
7287   if (reuse && *mat_n) {
7288     PetscInt mrows,mcols,mnrows,mncols;
7289     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
7290     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
7291     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
7292     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
7293     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
7294     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
7295     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
7296   }
7297   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
7298   PetscValidLogicalCollectiveInt(mat,bs,0);
7299 
7300   /* prepare IS for sending if not provided */
7301   if (!is_sends) {
7302     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
7303     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
7304   } else {
7305     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
7306     is_sends_internal = is_sends;
7307   }
7308 
7309   /* get comm */
7310   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
7311 
7312   /* compute number of sends */
7313   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
7314   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7315 
7316   /* compute number of receives */
7317   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
7318   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
7319   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
7320   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7321   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7322   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7323   ierr = PetscFree(iflags);CHKERRQ(ierr);
7324 
7325   /* restrict comm if requested */
7326   subcomm = 0;
7327   destroy_mat = PETSC_FALSE;
7328   if (restrict_comm) {
7329     PetscMPIInt color,subcommsize;
7330 
7331     color = 0;
7332     if (restrict_full) {
7333       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7334     } else {
7335       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7336     }
7337     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
7338     subcommsize = commsize - subcommsize;
7339     /* check if reuse has been requested */
7340     if (reuse) {
7341       if (*mat_n) {
7342         PetscMPIInt subcommsize2;
7343         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
7344         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7345         comm_n = PetscObjectComm((PetscObject)*mat_n);
7346       } else {
7347         comm_n = PETSC_COMM_SELF;
7348       }
7349     } else { /* MAT_INITIAL_MATRIX */
7350       PetscMPIInt rank;
7351 
7352       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
7353       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7354       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7355       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7356       comm_n = PetscSubcommChild(subcomm);
7357     }
7358     /* flag to destroy *mat_n if not significative */
7359     if (color) destroy_mat = PETSC_TRUE;
7360   } else {
7361     comm_n = comm;
7362   }
7363 
7364   /* prepare send/receive buffers */
7365   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
7366   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
7367   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
7368   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
7369   if (nis) {
7370     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
7371   }
7372 
7373   /* Get data from local matrices */
7374   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7375     /* TODO: See below some guidelines on how to prepare the local buffers */
7376     /*
7377        send_buffer_vals should contain the raw values of the local matrix
7378        send_buffer_idxs should contain:
7379        - MatType_PRIVATE type
7380        - PetscInt        size_of_l2gmap
7381        - PetscInt        global_row_indices[size_of_l2gmap]
7382        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7383     */
7384   else {
7385     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7386     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7387     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7388     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7389     send_buffer_idxs[1] = i;
7390     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7391     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
7392     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7393     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7394     for (i=0;i<n_sends;i++) {
7395       ilengths_vals[is_indices[i]] = len*len;
7396       ilengths_idxs[is_indices[i]] = len+2;
7397     }
7398   }
7399   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7400   /* additional is (if any) */
7401   if (nis) {
7402     PetscMPIInt psum;
7403     PetscInt j;
7404     for (j=0,psum=0;j<nis;j++) {
7405       PetscInt plen;
7406       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7407       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7408       psum += len+1; /* indices + lenght */
7409     }
7410     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7411     for (j=0,psum=0;j<nis;j++) {
7412       PetscInt plen;
7413       const PetscInt *is_array_idxs;
7414       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7415       send_buffer_idxs_is[psum] = plen;
7416       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7417       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
7418       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7419       psum += plen+1; /* indices + lenght */
7420     }
7421     for (i=0;i<n_sends;i++) {
7422       ilengths_idxs_is[is_indices[i]] = psum;
7423     }
7424     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7425   }
7426   ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7427 
7428   buf_size_idxs = 0;
7429   buf_size_vals = 0;
7430   buf_size_idxs_is = 0;
7431   buf_size_vecs = 0;
7432   for (i=0;i<n_recvs;i++) {
7433     buf_size_idxs += (PetscInt)olengths_idxs[i];
7434     buf_size_vals += (PetscInt)olengths_vals[i];
7435     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7436     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7437   }
7438   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7439   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7440   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7441   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7442 
7443   /* get new tags for clean communications */
7444   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7445   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7446   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7447   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7448 
7449   /* allocate for requests */
7450   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7451   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7452   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7453   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7454   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7455   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7456   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7457   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7458 
7459   /* communications */
7460   ptr_idxs = recv_buffer_idxs;
7461   ptr_vals = recv_buffer_vals;
7462   ptr_idxs_is = recv_buffer_idxs_is;
7463   ptr_vecs = recv_buffer_vecs;
7464   for (i=0;i<n_recvs;i++) {
7465     source_dest = onodes[i];
7466     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7467     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7468     ptr_idxs += olengths_idxs[i];
7469     ptr_vals += olengths_vals[i];
7470     if (nis) {
7471       source_dest = onodes_is[i];
7472       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);
7473       ptr_idxs_is += olengths_idxs_is[i];
7474     }
7475     if (nvecs) {
7476       source_dest = onodes[i];
7477       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7478       ptr_vecs += olengths_idxs[i]-2;
7479     }
7480   }
7481   for (i=0;i<n_sends;i++) {
7482     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7483     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7484     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7485     if (nis) {
7486       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);
7487     }
7488     if (nvecs) {
7489       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7490       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7491     }
7492   }
7493   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7494   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7495 
7496   /* assemble new l2g map */
7497   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7498   ptr_idxs = recv_buffer_idxs;
7499   new_local_rows = 0;
7500   for (i=0;i<n_recvs;i++) {
7501     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7502     ptr_idxs += olengths_idxs[i];
7503   }
7504   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7505   ptr_idxs = recv_buffer_idxs;
7506   new_local_rows = 0;
7507   for (i=0;i<n_recvs;i++) {
7508     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
7509     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7510     ptr_idxs += olengths_idxs[i];
7511   }
7512   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7513   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7514   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7515 
7516   /* infer new local matrix type from received local matrices type */
7517   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7518   /* 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) */
7519   if (n_recvs) {
7520     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7521     ptr_idxs = recv_buffer_idxs;
7522     for (i=0;i<n_recvs;i++) {
7523       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7524         new_local_type_private = MATAIJ_PRIVATE;
7525         break;
7526       }
7527       ptr_idxs += olengths_idxs[i];
7528     }
7529     switch (new_local_type_private) {
7530       case MATDENSE_PRIVATE:
7531         new_local_type = MATSEQAIJ;
7532         bs = 1;
7533         break;
7534       case MATAIJ_PRIVATE:
7535         new_local_type = MATSEQAIJ;
7536         bs = 1;
7537         break;
7538       case MATBAIJ_PRIVATE:
7539         new_local_type = MATSEQBAIJ;
7540         break;
7541       case MATSBAIJ_PRIVATE:
7542         new_local_type = MATSEQSBAIJ;
7543         break;
7544       default:
7545         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7546         break;
7547     }
7548   } else { /* by default, new_local_type is seqaij */
7549     new_local_type = MATSEQAIJ;
7550     bs = 1;
7551   }
7552 
7553   /* create MATIS object if needed */
7554   if (!reuse) {
7555     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7556     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7557   } else {
7558     /* it also destroys the local matrices */
7559     if (*mat_n) {
7560       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7561     } else { /* this is a fake object */
7562       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7563     }
7564   }
7565   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7566   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7567 
7568   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7569 
7570   /* Global to local map of received indices */
7571   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7572   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7573   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7574 
7575   /* restore attributes -> type of incoming data and its size */
7576   buf_size_idxs = 0;
7577   for (i=0;i<n_recvs;i++) {
7578     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7579     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7580     buf_size_idxs += (PetscInt)olengths_idxs[i];
7581   }
7582   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7583 
7584   /* set preallocation */
7585   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7586   if (!newisdense) {
7587     PetscInt *new_local_nnz=0;
7588 
7589     ptr_idxs = recv_buffer_idxs_local;
7590     if (n_recvs) {
7591       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7592     }
7593     for (i=0;i<n_recvs;i++) {
7594       PetscInt j;
7595       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7596         for (j=0;j<*(ptr_idxs+1);j++) {
7597           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7598         }
7599       } else {
7600         /* TODO */
7601       }
7602       ptr_idxs += olengths_idxs[i];
7603     }
7604     if (new_local_nnz) {
7605       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7606       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7607       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7608       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7609       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7610       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7611     } else {
7612       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7613     }
7614     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7615   } else {
7616     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7617   }
7618 
7619   /* set values */
7620   ptr_vals = recv_buffer_vals;
7621   ptr_idxs = recv_buffer_idxs_local;
7622   for (i=0;i<n_recvs;i++) {
7623     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7624       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7625       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7626       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7627       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7628       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7629     } else {
7630       /* TODO */
7631     }
7632     ptr_idxs += olengths_idxs[i];
7633     ptr_vals += olengths_vals[i];
7634   }
7635   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7636   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7637   ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7638   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7639   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7640   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7641 
7642 #if 0
7643   if (!restrict_comm) { /* check */
7644     Vec       lvec,rvec;
7645     PetscReal infty_error;
7646 
7647     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7648     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7649     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7650     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7651     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7652     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7653     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7654     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7655     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7656   }
7657 #endif
7658 
7659   /* assemble new additional is (if any) */
7660   if (nis) {
7661     PetscInt **temp_idxs,*count_is,j,psum;
7662 
7663     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7664     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7665     ptr_idxs = recv_buffer_idxs_is;
7666     psum = 0;
7667     for (i=0;i<n_recvs;i++) {
7668       for (j=0;j<nis;j++) {
7669         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7670         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7671         psum += plen;
7672         ptr_idxs += plen+1; /* shift pointer to received data */
7673       }
7674     }
7675     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7676     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7677     for (i=1;i<nis;i++) {
7678       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7679     }
7680     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7681     ptr_idxs = recv_buffer_idxs_is;
7682     for (i=0;i<n_recvs;i++) {
7683       for (j=0;j<nis;j++) {
7684         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7685         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7686         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7687         ptr_idxs += plen+1; /* shift pointer to received data */
7688       }
7689     }
7690     for (i=0;i<nis;i++) {
7691       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7692       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7693       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7694     }
7695     ierr = PetscFree(count_is);CHKERRQ(ierr);
7696     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7697     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7698   }
7699   /* free workspace */
7700   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7701   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7702   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7703   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7704   if (isdense) {
7705     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7706     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7707     ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7708   } else {
7709     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7710   }
7711   if (nis) {
7712     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7713     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7714   }
7715 
7716   if (nvecs) {
7717     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7718     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7719     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7720     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7721     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7722     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7723     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7724     /* set values */
7725     ptr_vals = recv_buffer_vecs;
7726     ptr_idxs = recv_buffer_idxs_local;
7727     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7728     for (i=0;i<n_recvs;i++) {
7729       PetscInt j;
7730       for (j=0;j<*(ptr_idxs+1);j++) {
7731         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7732       }
7733       ptr_idxs += olengths_idxs[i];
7734       ptr_vals += olengths_idxs[i]-2;
7735     }
7736     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7737     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7738     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7739   }
7740 
7741   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7742   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7743   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7744   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7745   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7746   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7747   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7748   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7749   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7750   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7751   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7752   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7753   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7754   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7755   ierr = PetscFree(onodes);CHKERRQ(ierr);
7756   if (nis) {
7757     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7758     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7759     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7760   }
7761   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7762   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7763     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7764     for (i=0;i<nis;i++) {
7765       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7766     }
7767     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7768       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7769     }
7770     *mat_n = NULL;
7771   }
7772   PetscFunctionReturn(0);
7773 }
7774 
7775 /* temporary hack into ksp private data structure */
7776 #include <petsc/private/kspimpl.h>
7777 
7778 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7779 {
7780   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7781   PC_IS                  *pcis = (PC_IS*)pc->data;
7782   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7783   Mat                    coarsedivudotp = NULL;
7784   Mat                    coarseG,t_coarse_mat_is;
7785   MatNullSpace           CoarseNullSpace = NULL;
7786   ISLocalToGlobalMapping coarse_islg;
7787   IS                     coarse_is,*isarray;
7788   PetscInt               i,im_active=-1,active_procs=-1;
7789   PetscInt               nis,nisdofs,nisneu,nisvert;
7790   PC                     pc_temp;
7791   PCType                 coarse_pc_type;
7792   KSPType                coarse_ksp_type;
7793   PetscBool              multilevel_requested,multilevel_allowed;
7794   PetscBool              coarse_reuse;
7795   PetscInt               ncoarse,nedcfield;
7796   PetscBool              compute_vecs = PETSC_FALSE;
7797   PetscScalar            *array;
7798   MatReuse               coarse_mat_reuse;
7799   PetscBool              restr, full_restr, have_void;
7800   PetscMPIInt            commsize;
7801   PetscErrorCode         ierr;
7802 
7803   PetscFunctionBegin;
7804   /* Assign global numbering to coarse dofs */
7805   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 */
7806     PetscInt ocoarse_size;
7807     compute_vecs = PETSC_TRUE;
7808 
7809     pcbddc->new_primal_space = PETSC_TRUE;
7810     ocoarse_size = pcbddc->coarse_size;
7811     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
7812     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
7813     /* see if we can avoid some work */
7814     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
7815       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
7816       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
7817         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
7818         coarse_reuse = PETSC_FALSE;
7819       } else { /* we can safely reuse already computed coarse matrix */
7820         coarse_reuse = PETSC_TRUE;
7821       }
7822     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
7823       coarse_reuse = PETSC_FALSE;
7824     }
7825     /* reset any subassembling information */
7826     if (!coarse_reuse || pcbddc->recompute_topography) {
7827       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7828     }
7829   } else { /* primal space is unchanged, so we can reuse coarse matrix */
7830     coarse_reuse = PETSC_TRUE;
7831   }
7832   /* assemble coarse matrix */
7833   if (coarse_reuse && pcbddc->coarse_ksp) {
7834     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
7835     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
7836     coarse_mat_reuse = MAT_REUSE_MATRIX;
7837   } else {
7838     coarse_mat = NULL;
7839     coarse_mat_reuse = MAT_INITIAL_MATRIX;
7840   }
7841 
7842   /* creates temporary l2gmap and IS for coarse indexes */
7843   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
7844   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
7845 
7846   /* creates temporary MATIS object for coarse matrix */
7847   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
7848   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7849   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
7850   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7851   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);
7852   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
7853   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7854   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7855   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
7856 
7857   /* count "active" (i.e. with positive local size) and "void" processes */
7858   im_active = !!(pcis->n);
7859   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7860 
7861   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
7862   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
7863   /* full_restr : just use the receivers from the subassembling pattern */
7864   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&commsize);CHKERRQ(ierr);
7865   coarse_mat_is = NULL;
7866   multilevel_allowed = PETSC_FALSE;
7867   multilevel_requested = PETSC_FALSE;
7868   pcbddc->coarse_eqs_per_proc = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
7869   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
7870   if (multilevel_requested) {
7871     ncoarse = active_procs/pcbddc->coarsening_ratio;
7872     restr = PETSC_FALSE;
7873     full_restr = PETSC_FALSE;
7874   } else {
7875     ncoarse = pcbddc->coarse_size/pcbddc->coarse_eqs_per_proc;
7876     restr = PETSC_TRUE;
7877     full_restr = PETSC_TRUE;
7878   }
7879   if (!pcbddc->coarse_size || commsize == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
7880   ncoarse = PetscMax(1,ncoarse);
7881   if (!pcbddc->coarse_subassembling) {
7882     if (pcbddc->coarsening_ratio > 1) {
7883       if (multilevel_requested) {
7884         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7885       } else {
7886         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7887       }
7888     } else {
7889       PetscMPIInt rank;
7890       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
7891       have_void = (active_procs == (PetscInt)commsize) ? PETSC_FALSE : PETSC_TRUE;
7892       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7893     }
7894   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
7895     PetscInt    psum;
7896     if (pcbddc->coarse_ksp) psum = 1;
7897     else psum = 0;
7898     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7899     if (ncoarse < commsize) have_void = PETSC_TRUE;
7900   }
7901   /* determine if we can go multilevel */
7902   if (multilevel_requested) {
7903     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
7904     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
7905   }
7906   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
7907 
7908   /* dump subassembling pattern */
7909   if (pcbddc->dbg_flag && multilevel_allowed) {
7910     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
7911   }
7912 
7913   /* compute dofs splitting and neumann boundaries for coarse dofs */
7914   nedcfield = -1;
7915   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal)) { /* protects from unneded computations */
7916     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
7917     const PetscInt         *idxs;
7918     ISLocalToGlobalMapping tmap;
7919 
7920     /* create map between primal indices (in local representative ordering) and local primal numbering */
7921     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
7922     /* allocate space for temporary storage */
7923     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
7924     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
7925     /* allocate for IS array */
7926     nisdofs = pcbddc->n_ISForDofsLocal;
7927     if (pcbddc->nedclocal) {
7928       if (pcbddc->nedfield > -1) {
7929         nedcfield = pcbddc->nedfield;
7930       } else {
7931         nedcfield = 0;
7932         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%d)",nisdofs);
7933         nisdofs = 1;
7934       }
7935     }
7936     nisneu = !!pcbddc->NeumannBoundariesLocal;
7937     nisvert = 0; /* nisvert is not used */
7938     nis = nisdofs + nisneu + nisvert;
7939     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
7940     /* dofs splitting */
7941     for (i=0;i<nisdofs;i++) {
7942       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
7943       if (nedcfield != i) {
7944         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
7945         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7946         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7947         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7948       } else {
7949         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
7950         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7951         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7952         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %d != %d\n",tsize,nout);
7953         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7954       }
7955       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7956       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7957       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
7958     }
7959     /* neumann boundaries */
7960     if (pcbddc->NeumannBoundariesLocal) {
7961       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
7962       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
7963       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7964       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7965       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7966       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7967       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
7968       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
7969     }
7970     /* free memory */
7971     ierr = PetscFree(tidxs);CHKERRQ(ierr);
7972     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
7973     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
7974   } else {
7975     nis = 0;
7976     nisdofs = 0;
7977     nisneu = 0;
7978     nisvert = 0;
7979     isarray = NULL;
7980   }
7981   /* destroy no longer needed map */
7982   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
7983 
7984   /* subassemble */
7985   if (multilevel_allowed) {
7986     Vec       vp[1];
7987     PetscInt  nvecs = 0;
7988     PetscBool reuse,reuser;
7989 
7990     if (coarse_mat) reuse = PETSC_TRUE;
7991     else reuse = PETSC_FALSE;
7992     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7993     vp[0] = NULL;
7994     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
7995       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
7996       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
7997       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
7998       nvecs = 1;
7999 
8000       if (pcbddc->divudotp) {
8001         Mat      B,loc_divudotp;
8002         Vec      v,p;
8003         IS       dummy;
8004         PetscInt np;
8005 
8006         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
8007         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
8008         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
8009         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
8010         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
8011         ierr = VecSet(p,1.);CHKERRQ(ierr);
8012         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
8013         ierr = VecDestroy(&p);CHKERRQ(ierr);
8014         ierr = MatDestroy(&B);CHKERRQ(ierr);
8015         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
8016         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
8017         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
8018         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
8019         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
8020         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8021         ierr = VecDestroy(&v);CHKERRQ(ierr);
8022       }
8023     }
8024     if (reuser) {
8025       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8026     } else {
8027       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8028     }
8029     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
8030       PetscScalar *arraym,*arrayv;
8031       PetscInt    nl;
8032       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
8033       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
8034       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8035       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
8036       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
8037       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
8038       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8039       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
8040     } else {
8041       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
8042     }
8043   } else {
8044     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
8045   }
8046   if (coarse_mat_is || coarse_mat) {
8047     PetscMPIInt size;
8048     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)coarse_mat_is),&size);CHKERRQ(ierr);
8049     if (!multilevel_allowed) {
8050       ierr = MatISGetMPIXAIJ(coarse_mat_is,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
8051     } else {
8052       Mat A;
8053 
8054       /* if this matrix is present, it means we are not reusing the coarse matrix */
8055       if (coarse_mat_is) {
8056         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
8057         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
8058         coarse_mat = coarse_mat_is;
8059       }
8060       /* be sure we don't have MatSeqDENSE as local mat */
8061       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
8062       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
8063     }
8064   }
8065   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
8066   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
8067 
8068   /* create local to global scatters for coarse problem */
8069   if (compute_vecs) {
8070     PetscInt lrows;
8071     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
8072     if (coarse_mat) {
8073       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
8074     } else {
8075       lrows = 0;
8076     }
8077     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
8078     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
8079     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
8080     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8081     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8082   }
8083   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
8084 
8085   /* set defaults for coarse KSP and PC */
8086   if (multilevel_allowed) {
8087     coarse_ksp_type = KSPRICHARDSON;
8088     coarse_pc_type = PCBDDC;
8089   } else {
8090     coarse_ksp_type = KSPPREONLY;
8091     coarse_pc_type = PCREDUNDANT;
8092   }
8093 
8094   /* print some info if requested */
8095   if (pcbddc->dbg_flag) {
8096     if (!multilevel_allowed) {
8097       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8098       if (multilevel_requested) {
8099         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);
8100       } else if (pcbddc->max_levels) {
8101         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
8102       }
8103       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8104     }
8105   }
8106 
8107   /* communicate coarse discrete gradient */
8108   coarseG = NULL;
8109   if (pcbddc->nedcG && multilevel_allowed) {
8110     MPI_Comm ccomm;
8111     if (coarse_mat) {
8112       ccomm = PetscObjectComm((PetscObject)coarse_mat);
8113     } else {
8114       ccomm = MPI_COMM_NULL;
8115     }
8116     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
8117   }
8118 
8119   /* create the coarse KSP object only once with defaults */
8120   if (coarse_mat) {
8121     PetscBool   isredundant,isnn,isbddc;
8122     PetscViewer dbg_viewer = NULL;
8123 
8124     if (pcbddc->dbg_flag) {
8125       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
8126       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8127     }
8128     if (!pcbddc->coarse_ksp) {
8129       char   prefix[256],str_level[16];
8130       size_t len;
8131 
8132       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
8133       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8134       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
8135       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
8136       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8137       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
8138       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
8139       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8140       /* TODO is this logic correct? should check for coarse_mat type */
8141       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8142       /* prefix */
8143       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
8144       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
8145       if (!pcbddc->current_level) {
8146         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,sizeof(prefix));CHKERRQ(ierr);
8147         ierr = PetscStrlcat(prefix,"pc_bddc_coarse_",sizeof(prefix));CHKERRQ(ierr);
8148       } else {
8149         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
8150         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
8151         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
8152         /* Nonstandard use of PetscStrncpy() to copy only a portion of the string */
8153         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
8154         ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
8155         ierr = PetscStrlcat(prefix,str_level,sizeof(prefix));CHKERRQ(ierr);
8156       }
8157       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
8158       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8159       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8160       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8161       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8162       /* allow user customization */
8163       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
8164     }
8165     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8166     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8167     if (nisdofs) {
8168       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
8169       for (i=0;i<nisdofs;i++) {
8170         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8171       }
8172     }
8173     if (nisneu) {
8174       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
8175       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
8176     }
8177     if (nisvert) {
8178       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
8179       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
8180     }
8181     if (coarseG) {
8182       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
8183     }
8184 
8185     /* get some info after set from options */
8186     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8187     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
8188     if (isbddc && !multilevel_allowed) {
8189       ierr   = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8190       isbddc = PETSC_FALSE;
8191     }
8192     /* multilevel cannot be done with coarse PCs different from BDDC or NN */
8193     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
8194     if (multilevel_requested && multilevel_allowed && !isbddc && !isnn) {
8195       ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8196       isbddc = PETSC_TRUE;
8197     }
8198     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
8199     if (isredundant) {
8200       KSP inner_ksp;
8201       PC  inner_pc;
8202 
8203       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
8204       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
8205     }
8206 
8207     /* parameters which miss an API */
8208     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8209     if (isbddc) {
8210       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
8211 
8212       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
8213       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
8214       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
8215       if (pcbddc_coarse->benign_saddle_point) {
8216         Mat                    coarsedivudotp_is;
8217         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
8218         IS                     row,col;
8219         const PetscInt         *gidxs;
8220         PetscInt               n,st,M,N;
8221 
8222         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
8223         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
8224         st   = st-n;
8225         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
8226         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
8227         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
8228         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8229         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
8230         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8231         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
8232         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
8233         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
8234         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
8235         ierr = ISDestroy(&row);CHKERRQ(ierr);
8236         ierr = ISDestroy(&col);CHKERRQ(ierr);
8237         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
8238         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
8239         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
8240         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
8241         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
8242         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
8243         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
8244         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8245         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
8246         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
8247         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
8248         if (pcbddc->adaptive_threshold[0] == 0.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
8249       }
8250     }
8251 
8252     /* propagate symmetry info of coarse matrix */
8253     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
8254     if (pc->pmat->symmetric_set) {
8255       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
8256     }
8257     if (pc->pmat->hermitian_set) {
8258       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
8259     }
8260     if (pc->pmat->spd_set) {
8261       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
8262     }
8263     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
8264       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
8265     }
8266     /* set operators */
8267     ierr = MatViewFromOptions(coarse_mat,(PetscObject)pc,"-pc_bddc_coarse_mat_view");CHKERRQ(ierr);
8268     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8269     if (pcbddc->dbg_flag) {
8270       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8271     }
8272   }
8273   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
8274   ierr = PetscFree(isarray);CHKERRQ(ierr);
8275 #if 0
8276   {
8277     PetscViewer viewer;
8278     char filename[256];
8279     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
8280     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
8281     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
8282     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
8283     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
8284     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
8285   }
8286 #endif
8287 
8288   if (pcbddc->coarse_ksp) {
8289     Vec crhs,csol;
8290 
8291     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
8292     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
8293     if (!csol) {
8294       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
8295     }
8296     if (!crhs) {
8297       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
8298     }
8299   }
8300   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8301 
8302   /* compute null space for coarse solver if the benign trick has been requested */
8303   if (pcbddc->benign_null) {
8304 
8305     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
8306     for (i=0;i<pcbddc->benign_n;i++) {
8307       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
8308     }
8309     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
8310     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
8311     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8312     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8313     if (coarse_mat) {
8314       Vec         nullv;
8315       PetscScalar *array,*array2;
8316       PetscInt    nl;
8317 
8318       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
8319       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
8320       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8321       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
8322       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
8323       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
8324       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8325       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
8326       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
8327       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
8328     }
8329   }
8330 
8331   if (pcbddc->coarse_ksp) {
8332     PetscBool ispreonly;
8333 
8334     if (CoarseNullSpace) {
8335       PetscBool isnull;
8336       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
8337       if (isnull) {
8338         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
8339       }
8340       /* TODO: add local nullspaces (if any) */
8341     }
8342     /* setup coarse ksp */
8343     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
8344     /* Check coarse problem if in debug mode or if solving with an iterative method */
8345     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
8346     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
8347       KSP       check_ksp;
8348       KSPType   check_ksp_type;
8349       PC        check_pc;
8350       Vec       check_vec,coarse_vec;
8351       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8352       PetscInt  its;
8353       PetscBool compute_eigs;
8354       PetscReal *eigs_r,*eigs_c;
8355       PetscInt  neigs;
8356       const char *prefix;
8357 
8358       /* Create ksp object suitable for estimation of extreme eigenvalues */
8359       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
8360       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8361       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8362       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
8363       /* prevent from setup unneeded object */
8364       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
8365       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
8366       if (ispreonly) {
8367         check_ksp_type = KSPPREONLY;
8368         compute_eigs = PETSC_FALSE;
8369       } else {
8370         check_ksp_type = KSPGMRES;
8371         compute_eigs = PETSC_TRUE;
8372       }
8373       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
8374       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
8375       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
8376       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
8377       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
8378       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
8379       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
8380       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
8381       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
8382       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
8383       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
8384       /* create random vec */
8385       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
8386       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8387       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8388       /* solve coarse problem */
8389       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8390       /* set eigenvalue estimation if preonly has not been requested */
8391       if (compute_eigs) {
8392         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8393         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8394         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8395         if (neigs) {
8396           lambda_max = eigs_r[neigs-1];
8397           lambda_min = eigs_r[0];
8398           if (pcbddc->use_coarse_estimates) {
8399             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8400               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8401               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8402             }
8403           }
8404         }
8405       }
8406 
8407       /* check coarse problem residual error */
8408       if (pcbddc->dbg_flag) {
8409         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8410         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8411         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8412         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8413         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8414         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8415         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8416         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8417         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8418         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8419         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8420         if (CoarseNullSpace) {
8421           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8422         }
8423         if (compute_eigs) {
8424           PetscReal          lambda_max_s,lambda_min_s;
8425           KSPConvergedReason reason;
8426           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8427           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8428           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8429           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8430           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);
8431           for (i=0;i<neigs;i++) {
8432             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8433           }
8434         }
8435         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8436         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8437       }
8438       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8439       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8440       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8441       if (compute_eigs) {
8442         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8443         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8444       }
8445     }
8446   }
8447   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8448   /* print additional info */
8449   if (pcbddc->dbg_flag) {
8450     /* waits until all processes reaches this point */
8451     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8452     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
8453     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8454   }
8455 
8456   /* free memory */
8457   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8458   PetscFunctionReturn(0);
8459 }
8460 
8461 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8462 {
8463   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8464   PC_IS*         pcis = (PC_IS*)pc->data;
8465   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8466   IS             subset,subset_mult,subset_n;
8467   PetscInt       local_size,coarse_size=0;
8468   PetscInt       *local_primal_indices=NULL;
8469   const PetscInt *t_local_primal_indices;
8470   PetscErrorCode ierr;
8471 
8472   PetscFunctionBegin;
8473   /* Compute global number of coarse dofs */
8474   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8475   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8476   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8477   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8478   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8479   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8480   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8481   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8482   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8483   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);
8484   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8485   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8486   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
8487   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8488   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8489 
8490   /* check numbering */
8491   if (pcbddc->dbg_flag) {
8492     PetscScalar coarsesum,*array,*array2;
8493     PetscInt    i;
8494     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8495 
8496     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8497     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8498     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8499     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8500     /* counter */
8501     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8502     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8503     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8504     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8505     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8506     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8507     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8508     for (i=0;i<pcbddc->local_primal_size;i++) {
8509       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8510     }
8511     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8512     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8513     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8514     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8515     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8516     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8517     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8518     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8519     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8520     for (i=0;i<pcis->n;i++) {
8521       if (array[i] != 0.0 && array[i] != array2[i]) {
8522         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8523         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8524         set_error = PETSC_TRUE;
8525         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8526         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);
8527       }
8528     }
8529     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8530     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8531     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8532     for (i=0;i<pcis->n;i++) {
8533       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8534     }
8535     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8536     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8537     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8538     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8539     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8540     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8541     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8542       PetscInt *gidxs;
8543 
8544       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8545       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8546       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8547       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8548       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8549       for (i=0;i<pcbddc->local_primal_size;i++) {
8550         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);
8551       }
8552       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8553       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8554     }
8555     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8556     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8557     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8558   }
8559   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
8560   /* get back data */
8561   *coarse_size_n = coarse_size;
8562   *local_primal_indices_n = local_primal_indices;
8563   PetscFunctionReturn(0);
8564 }
8565 
8566 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8567 {
8568   IS             localis_t;
8569   PetscInt       i,lsize,*idxs,n;
8570   PetscScalar    *vals;
8571   PetscErrorCode ierr;
8572 
8573   PetscFunctionBegin;
8574   /* get indices in local ordering exploiting local to global map */
8575   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8576   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8577   for (i=0;i<lsize;i++) vals[i] = 1.0;
8578   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8579   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8580   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8581   if (idxs) { /* multilevel guard */
8582     ierr = VecSetOption(gwork,VEC_IGNORE_NEGATIVE_INDICES,PETSC_TRUE);CHKERRQ(ierr);
8583     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8584   }
8585   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8586   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8587   ierr = PetscFree(vals);CHKERRQ(ierr);
8588   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8589   /* now compute set in local ordering */
8590   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8591   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8592   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8593   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8594   for (i=0,lsize=0;i<n;i++) {
8595     if (PetscRealPart(vals[i]) > 0.5) {
8596       lsize++;
8597     }
8598   }
8599   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8600   for (i=0,lsize=0;i<n;i++) {
8601     if (PetscRealPart(vals[i]) > 0.5) {
8602       idxs[lsize++] = i;
8603     }
8604   }
8605   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8606   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8607   *localis = localis_t;
8608   PetscFunctionReturn(0);
8609 }
8610 
8611 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8612 {
8613   PC_IS               *pcis=(PC_IS*)pc->data;
8614   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8615   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8616   Mat                 S_j;
8617   PetscInt            *used_xadj,*used_adjncy;
8618   PetscBool           free_used_adj;
8619   PetscErrorCode      ierr;
8620 
8621   PetscFunctionBegin;
8622   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8623   free_used_adj = PETSC_FALSE;
8624   if (pcbddc->sub_schurs_layers == -1) {
8625     used_xadj = NULL;
8626     used_adjncy = NULL;
8627   } else {
8628     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8629       used_xadj = pcbddc->mat_graph->xadj;
8630       used_adjncy = pcbddc->mat_graph->adjncy;
8631     } else if (pcbddc->computed_rowadj) {
8632       used_xadj = pcbddc->mat_graph->xadj;
8633       used_adjncy = pcbddc->mat_graph->adjncy;
8634     } else {
8635       PetscBool      flg_row=PETSC_FALSE;
8636       const PetscInt *xadj,*adjncy;
8637       PetscInt       nvtxs;
8638 
8639       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8640       if (flg_row) {
8641         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8642         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8643         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8644         free_used_adj = PETSC_TRUE;
8645       } else {
8646         pcbddc->sub_schurs_layers = -1;
8647         used_xadj = NULL;
8648         used_adjncy = NULL;
8649       }
8650       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8651     }
8652   }
8653 
8654   /* setup sub_schurs data */
8655   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8656   if (!sub_schurs->schur_explicit) {
8657     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8658     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8659     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);
8660   } else {
8661     Mat       change = NULL;
8662     Vec       scaling = NULL;
8663     IS        change_primal = NULL, iP;
8664     PetscInt  benign_n;
8665     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8666     PetscBool isseqaij,need_change = PETSC_FALSE;
8667     PetscBool discrete_harmonic = PETSC_FALSE;
8668 
8669     if (!pcbddc->use_vertices && reuse_solvers) {
8670       PetscInt n_vertices;
8671 
8672       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8673       reuse_solvers = (PetscBool)!n_vertices;
8674     }
8675     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8676     if (!isseqaij) {
8677       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8678       if (matis->A == pcbddc->local_mat) {
8679         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8680         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8681       } else {
8682         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8683       }
8684     }
8685     if (!pcbddc->benign_change_explicit) {
8686       benign_n = pcbddc->benign_n;
8687     } else {
8688       benign_n = 0;
8689     }
8690     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
8691        We need a global reduction to avoid possible deadlocks.
8692        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
8693     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
8694       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
8695       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8696       need_change = (PetscBool)(!need_change);
8697     }
8698     /* If the user defines additional constraints, we import them here.
8699        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 */
8700     if (need_change) {
8701       PC_IS   *pcisf;
8702       PC_BDDC *pcbddcf;
8703       PC      pcf;
8704 
8705       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
8706       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
8707       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
8708       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
8709 
8710       /* hacks */
8711       pcisf                        = (PC_IS*)pcf->data;
8712       pcisf->is_B_local            = pcis->is_B_local;
8713       pcisf->vec1_N                = pcis->vec1_N;
8714       pcisf->BtoNmap               = pcis->BtoNmap;
8715       pcisf->n                     = pcis->n;
8716       pcisf->n_B                   = pcis->n_B;
8717       pcbddcf                      = (PC_BDDC*)pcf->data;
8718       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
8719       pcbddcf->mat_graph           = pcbddc->mat_graph;
8720       pcbddcf->use_faces           = PETSC_TRUE;
8721       pcbddcf->use_change_of_basis = PETSC_TRUE;
8722       pcbddcf->use_change_on_faces = PETSC_TRUE;
8723       pcbddcf->use_qr_single       = PETSC_TRUE;
8724       pcbddcf->fake_change         = PETSC_TRUE;
8725 
8726       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
8727       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
8728       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
8729       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
8730       change = pcbddcf->ConstraintMatrix;
8731       pcbddcf->ConstraintMatrix = NULL;
8732 
8733       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
8734       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
8735       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
8736       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
8737       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
8738       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
8739       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
8740       pcf->ops->destroy = NULL;
8741       pcf->ops->reset   = NULL;
8742       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
8743     }
8744     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
8745 
8746     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
8747     if (iP) {
8748       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
8749       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
8750       ierr = PetscOptionsEnd();CHKERRQ(ierr);
8751     }
8752     if (discrete_harmonic) {
8753       Mat A;
8754       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
8755       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
8756       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
8757       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);
8758       ierr = MatDestroy(&A);CHKERRQ(ierr);
8759     } else {
8760       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);
8761     }
8762     ierr = MatDestroy(&change);CHKERRQ(ierr);
8763     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
8764   }
8765   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8766 
8767   /* free adjacency */
8768   if (free_used_adj) {
8769     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
8770   }
8771   PetscFunctionReturn(0);
8772 }
8773 
8774 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
8775 {
8776   PC_IS               *pcis=(PC_IS*)pc->data;
8777   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8778   PCBDDCGraph         graph;
8779   PetscErrorCode      ierr;
8780 
8781   PetscFunctionBegin;
8782   /* attach interface graph for determining subsets */
8783   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
8784     IS       verticesIS,verticescomm;
8785     PetscInt vsize,*idxs;
8786 
8787     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8788     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
8789     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8790     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
8791     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8792     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8793     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
8794     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
8795     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
8796     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
8797     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
8798   } else {
8799     graph = pcbddc->mat_graph;
8800   }
8801   /* print some info */
8802   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
8803     IS       vertices;
8804     PetscInt nv,nedges,nfaces;
8805     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
8806     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8807     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
8808     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8809     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
8810     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
8811     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
8812     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
8813     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8814     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8815     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8816   }
8817 
8818   /* sub_schurs init */
8819   if (!pcbddc->sub_schurs) {
8820     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
8821   }
8822   ierr = PCBDDCSubSchursInit(pcbddc->sub_schurs,((PetscObject)pc)->prefix,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap,pcbddc->sub_schurs_rebuild);CHKERRQ(ierr);
8823 
8824   /* free graph struct */
8825   if (pcbddc->sub_schurs_rebuild) {
8826     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
8827   }
8828   PetscFunctionReturn(0);
8829 }
8830 
8831 PetscErrorCode PCBDDCCheckOperator(PC pc)
8832 {
8833   PC_IS               *pcis=(PC_IS*)pc->data;
8834   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8835   PetscErrorCode      ierr;
8836 
8837   PetscFunctionBegin;
8838   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
8839     IS             zerodiag = NULL;
8840     Mat            S_j,B0_B=NULL;
8841     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
8842     PetscScalar    *p0_check,*array,*array2;
8843     PetscReal      norm;
8844     PetscInt       i;
8845 
8846     /* B0 and B0_B */
8847     if (zerodiag) {
8848       IS       dummy;
8849 
8850       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
8851       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
8852       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
8853       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8854     }
8855     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
8856     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
8857     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
8858     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8859     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8860     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8861     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8862     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
8863     /* S_j */
8864     ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8865     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8866 
8867     /* mimic vector in \widetilde{W}_\Gamma */
8868     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
8869     /* continuous in primal space */
8870     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
8871     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8872     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8873     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8874     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
8875     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
8876     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8877     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8878     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8879     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8880     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8881     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8882     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
8883     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
8884 
8885     /* assemble rhs for coarse problem */
8886     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
8887     /* local with Schur */
8888     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
8889     if (zerodiag) {
8890       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8891       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
8892       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8893       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
8894     }
8895     /* sum on primal nodes the local contributions */
8896     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8897     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8898     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8899     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8900     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
8901     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8902     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8903     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
8904     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8905     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8906     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8907     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8908     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8909     /* scale primal nodes (BDDC sums contibutions) */
8910     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
8911     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8912     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8913     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8914     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8915     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8916     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8917     /* global: \widetilde{B0}_B w_\Gamma */
8918     if (zerodiag) {
8919       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
8920       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8921       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
8922       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8923     }
8924     /* BDDC */
8925     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
8926     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
8927 
8928     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
8929     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
8930     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
8931     PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);
8932     for (i=0;i<pcbddc->benign_n;i++) {
8933       PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%d] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));
8934     }
8935     ierr = PetscFree(p0_check);CHKERRQ(ierr);
8936     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
8937     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
8938     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
8939     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8940     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
8941   }
8942   PetscFunctionReturn(0);
8943 }
8944 
8945 #include <../src/mat/impls/aij/mpi/mpiaij.h>
8946 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
8947 {
8948   Mat            At;
8949   IS             rows;
8950   PetscInt       rst,ren;
8951   PetscErrorCode ierr;
8952   PetscLayout    rmap;
8953 
8954   PetscFunctionBegin;
8955   rst = ren = 0;
8956   if (ccomm != MPI_COMM_NULL) {
8957     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
8958     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
8959     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
8960     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
8961     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
8962   }
8963   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
8964   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
8965   ierr = ISDestroy(&rows);CHKERRQ(ierr);
8966 
8967   if (ccomm != MPI_COMM_NULL) {
8968     Mat_MPIAIJ *a,*b;
8969     IS         from,to;
8970     Vec        gvec;
8971     PetscInt   lsize;
8972 
8973     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
8974     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
8975     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
8976     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
8977     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
8978     a    = (Mat_MPIAIJ*)At->data;
8979     b    = (Mat_MPIAIJ*)(*B)->data;
8980     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
8981     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
8982     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
8983     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
8984     b->A = a->A;
8985     b->B = a->B;
8986 
8987     b->donotstash      = a->donotstash;
8988     b->roworiented     = a->roworiented;
8989     b->rowindices      = 0;
8990     b->rowvalues       = 0;
8991     b->getrowactive    = PETSC_FALSE;
8992 
8993     (*B)->rmap         = rmap;
8994     (*B)->factortype   = A->factortype;
8995     (*B)->assembled    = PETSC_TRUE;
8996     (*B)->insertmode   = NOT_SET_VALUES;
8997     (*B)->preallocated = PETSC_TRUE;
8998 
8999     if (a->colmap) {
9000 #if defined(PETSC_USE_CTABLE)
9001       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
9002 #else
9003       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
9004       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9005       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9006 #endif
9007     } else b->colmap = 0;
9008     if (a->garray) {
9009       PetscInt len;
9010       len  = a->B->cmap->n;
9011       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
9012       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
9013       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
9014     } else b->garray = 0;
9015 
9016     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
9017     b->lvec = a->lvec;
9018     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
9019 
9020     /* cannot use VecScatterCopy */
9021     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
9022     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
9023     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
9024     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
9025     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
9026     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
9027     ierr = ISDestroy(&from);CHKERRQ(ierr);
9028     ierr = ISDestroy(&to);CHKERRQ(ierr);
9029     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
9030   }
9031   ierr = MatDestroy(&At);CHKERRQ(ierr);
9032   PetscFunctionReturn(0);
9033 }
9034