xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision cd18cfedae68b4353acd988fda7a8748e202e151)
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 = PetscCalloc1(ne,&ecount);CHKERRQ(ierr);
458   ierr = PetscMalloc1(ne,&eneighs);CHKERRQ(ierr);
459   ierr = ISLocalToGlobalMappingGetInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
460   for (i=1,cum=0;i<n_neigh;i++) {
461     cum += n_shared[i];
462     for (j=0;j<n_shared[i];j++) {
463       ecount[shared[i][j]]++;
464     }
465   }
466   if (ne) {
467     ierr = PetscMalloc1(cum,&eneighs[0]);CHKERRQ(ierr);
468   }
469   for (i=1;i<ne;i++) eneighs[i] = eneighs[i-1] + ecount[i-1];
470   ierr = PetscMemzero(ecount,ne*sizeof(PetscInt));CHKERRQ(ierr);
471   for (i=1;i<n_neigh;i++) {
472     for (j=0;j<n_shared[i];j++) {
473       PetscInt k = shared[i][j];
474       eneighs[k][ecount[k]] = neigh[i];
475       ecount[k]++;
476     }
477   }
478   for (i=0;i<ne;i++) {
479     ierr = PetscSortRemoveDupsInt(&ecount[i],eneighs[i]);CHKERRQ(ierr);
480   }
481   ierr = ISLocalToGlobalMappingRestoreInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
482   ierr = PetscCalloc1(nv,&vcount);CHKERRQ(ierr);
483   ierr = PetscMalloc1(nv,&vneighs);CHKERRQ(ierr);
484   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
485   for (i=1,cum=0;i<n_neigh;i++) {
486     cum += n_shared[i];
487     for (j=0;j<n_shared[i];j++) {
488       vcount[shared[i][j]]++;
489     }
490   }
491   if (nv) {
492     ierr = PetscMalloc1(cum,&vneighs[0]);CHKERRQ(ierr);
493   }
494   for (i=1;i<nv;i++) vneighs[i] = vneighs[i-1] + vcount[i-1];
495   ierr = PetscMemzero(vcount,nv*sizeof(PetscInt));CHKERRQ(ierr);
496   for (i=1;i<n_neigh;i++) {
497     for (j=0;j<n_shared[i];j++) {
498       PetscInt k = shared[i][j];
499       vneighs[k][vcount[k]] = neigh[i];
500       vcount[k]++;
501     }
502   }
503   for (i=0;i<nv;i++) {
504     ierr = PetscSortRemoveDupsInt(&vcount[i],vneighs[i]);CHKERRQ(ierr);
505   }
506   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
507 
508   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
509      for proper detection of coarse edges' endpoints */
510   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
511   for (i=0;i<ne;i++) {
512     if ((ecount[i] > 1 && !PetscBTLookup(btbd,i)) || (ecount[i] == 1 && PetscBTLookup(btb,i))) {
513       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
514     }
515   }
516   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
517   if (!conforming) {
518     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
519     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
520   }
521   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
522   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
523   cum  = 0;
524   for (i=0;i<ne;i++) {
525     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
526     if (!PetscBTLookup(btee,i)) {
527       marks[cum++] = i;
528       continue;
529     }
530     /* set badly connected edge dofs as primal */
531     if (!conforming) {
532       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
533         marks[cum++] = i;
534         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
535         for (j=ii[i];j<ii[i+1];j++) {
536           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
537         }
538       } else {
539         /* every edge dofs should be connected trough a certain number of nodal dofs
540            to other edge dofs belonging to coarse edges
541            - at most 2 endpoints
542            - order-1 interior nodal dofs
543            - no undefined nodal dofs (nconn < order)
544         */
545         PetscInt ends = 0,ints = 0, undef = 0;
546         for (j=ii[i];j<ii[i+1];j++) {
547           PetscInt v = jj[j],k;
548           PetscInt nconn = iit[v+1]-iit[v];
549           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
550           if (nconn > order) ends++;
551           else if (nconn == order) ints++;
552           else undef++;
553         }
554         if (undef || ends > 2 || ints != order -1) {
555           marks[cum++] = i;
556           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
557           for (j=ii[i];j<ii[i+1];j++) {
558             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
559           }
560         }
561       }
562     }
563     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
564     if (!order && ii[i+1] != ii[i]) {
565       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
566       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
567     }
568   }
569   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
570   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
571   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
572   if (!conforming) {
573     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
574     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
575   }
576   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
577 
578   /* identify splitpoints and corner candidates */
579   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
580   if (print) {
581     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
582     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
583     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
584     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
585   }
586   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
587   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
588   for (i=0;i<nv;i++) {
589     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
590     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
591     if (!order) { /* variable order */
592       PetscReal vorder = 0.;
593 
594       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
595       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
596       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%d)",vorder,test);
597       ord  = 1;
598     }
599 #if defined(PETSC_USE_DEBUG)
600     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);
601 #endif
602     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
603       if (PetscBTLookup(btbd,jj[j])) {
604         bdir = PETSC_TRUE;
605         break;
606       }
607       if (vc != ecount[jj[j]]) {
608         sneighs = PETSC_FALSE;
609       } else {
610         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
611         for (k=0;k<vc;k++) {
612           if (vn[k] != en[k]) {
613             sneighs = PETSC_FALSE;
614             break;
615           }
616         }
617       }
618     }
619     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
620       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %d (%d %d %d)\n",i,!sneighs,test >= 3*ord,bdir);
621       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
622     } else if (test == ord) {
623       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
624         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %d\n",i);
625         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
626       } else {
627         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %d\n",i);
628         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
629       }
630     }
631   }
632   ierr = PetscFree(ecount);CHKERRQ(ierr);
633   ierr = PetscFree(vcount);CHKERRQ(ierr);
634   if (ne) {
635     ierr = PetscFree(eneighs[0]);CHKERRQ(ierr);
636   }
637   if (nv) {
638     ierr = PetscFree(vneighs[0]);CHKERRQ(ierr);
639   }
640   ierr = PetscFree(eneighs);CHKERRQ(ierr);
641   ierr = PetscFree(vneighs);CHKERRQ(ierr);
642   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
643 
644   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
645   if (order != 1) {
646     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
647     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
648     for (i=0;i<nv;i++) {
649       if (PetscBTLookup(btvcand,i)) {
650         PetscBool found = PETSC_FALSE;
651         for (j=ii[i];j<ii[i+1] && !found;j++) {
652           PetscInt k,e = jj[j];
653           if (PetscBTLookup(bte,e)) continue;
654           for (k=iit[e];k<iit[e+1];k++) {
655             PetscInt v = jjt[k];
656             if (v != i && PetscBTLookup(btvcand,v)) {
657               found = PETSC_TRUE;
658               break;
659             }
660           }
661         }
662         if (!found) {
663           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d CLEARED\n",i);
664           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
665         } else {
666           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d ACCEPTED\n",i);
667         }
668       }
669     }
670     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
671   }
672   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
673   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
674   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
675 
676   /* Get the local G^T explicitly */
677   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
678   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
679   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
680 
681   /* Mark interior nodal dofs */
682   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
683   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
684   for (i=1;i<n_neigh;i++) {
685     for (j=0;j<n_shared[i];j++) {
686       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
687     }
688   }
689   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
690 
691   /* communicate corners and splitpoints */
692   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
693   ierr = PetscMemzero(sfvleaves,nv*sizeof(PetscInt));CHKERRQ(ierr);
694   ierr = PetscMemzero(sfvroots,Lv*sizeof(PetscInt));CHKERRQ(ierr);
695   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
696 
697   if (print) {
698     IS tbz;
699 
700     cum = 0;
701     for (i=0;i<nv;i++)
702       if (sfvleaves[i])
703         vmarks[cum++] = i;
704 
705     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
706     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
707     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
708     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
709   }
710 
711   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
712   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
713   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
714   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
715 
716   /* Zero rows of lGt corresponding to identified corners
717      and interior nodal dofs */
718   cum = 0;
719   for (i=0;i<nv;i++) {
720     if (sfvleaves[i]) {
721       vmarks[cum++] = i;
722       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
723     }
724     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
725   }
726   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
727   if (print) {
728     IS tbz;
729 
730     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
731     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
732     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
733     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
734   }
735   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
736   ierr = PetscFree(vmarks);CHKERRQ(ierr);
737   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
738   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
739 
740   /* Recompute G */
741   ierr = MatDestroy(&lG);CHKERRQ(ierr);
742   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
743   if (print) {
744     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
745     ierr = MatView(lG,NULL);CHKERRQ(ierr);
746     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
747     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
748   }
749 
750   /* Get primal dofs (if any) */
751   cum = 0;
752   for (i=0;i<ne;i++) {
753     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
754   }
755   if (fl2g) {
756     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
757   }
758   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
759   if (print) {
760     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
761     ierr = ISView(primals,NULL);CHKERRQ(ierr);
762   }
763   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
764   /* TODO: what if the user passed in some of them ?  */
765   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
766   ierr = ISDestroy(&primals);CHKERRQ(ierr);
767 
768   /* Compute edge connectivity */
769   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
770   ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr);
771   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
772   if (fl2g) {
773     PetscBT   btf;
774     PetscInt  *iia,*jja,*iiu,*jju;
775     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
776 
777     /* create CSR for all local dofs */
778     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
779     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
780       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);
781       iiu = pcbddc->mat_graph->xadj;
782       jju = pcbddc->mat_graph->adjncy;
783     } else if (pcbddc->use_local_adj) {
784       rest = PETSC_TRUE;
785       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
786     } else {
787       free   = PETSC_TRUE;
788       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
789       iiu[0] = 0;
790       for (i=0;i<n;i++) {
791         iiu[i+1] = i+1;
792         jju[i]   = -1;
793       }
794     }
795 
796     /* import sizes of CSR */
797     iia[0] = 0;
798     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
799 
800     /* overwrite entries corresponding to the Nedelec field */
801     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
802     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
803     for (i=0;i<ne;i++) {
804       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
805       iia[idxs[i]+1] = ii[i+1]-ii[i];
806     }
807 
808     /* iia in CSR */
809     for (i=0;i<n;i++) iia[i+1] += iia[i];
810 
811     /* jja in CSR */
812     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
813     for (i=0;i<n;i++)
814       if (!PetscBTLookup(btf,i))
815         for (j=0;j<iiu[i+1]-iiu[i];j++)
816           jja[iia[i]+j] = jju[iiu[i]+j];
817 
818     /* map edge dofs connectivity */
819     if (jj) {
820       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
821       for (i=0;i<ne;i++) {
822         PetscInt e = idxs[i];
823         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
824       }
825     }
826     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
827     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
828     if (rest) {
829       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
830     }
831     if (free) {
832       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
833     }
834     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
835   } else {
836     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
837   }
838 
839   /* Analyze interface for edge dofs */
840   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
841   pcbddc->mat_graph->twodim = PETSC_FALSE;
842 
843   /* Get coarse edges in the edge space */
844   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
845   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
846 
847   if (fl2g) {
848     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
849     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
850     for (i=0;i<nee;i++) {
851       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
852     }
853   } else {
854     eedges  = alleedges;
855     primals = allprimals;
856   }
857 
858   /* Mark fine edge dofs with their coarse edge id */
859   ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
860   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
861   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
862   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
863   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
864   if (print) {
865     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
866     ierr = ISView(primals,NULL);CHKERRQ(ierr);
867   }
868 
869   maxsize = 0;
870   for (i=0;i<nee;i++) {
871     PetscInt size,mark = i+1;
872 
873     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
874     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
875     for (j=0;j<size;j++) marks[idxs[j]] = mark;
876     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
877     maxsize = PetscMax(maxsize,size);
878   }
879 
880   /* Find coarse edge endpoints */
881   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
882   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
883   for (i=0;i<nee;i++) {
884     PetscInt mark = i+1,size;
885 
886     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
887     if (!size && nedfieldlocal) continue;
888     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
889     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
890     if (print) {
891       PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %d\n",i);
892       ISView(eedges[i],NULL);
893     }
894     for (j=0;j<size;j++) {
895       PetscInt k, ee = idxs[j];
896       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %d\n",ee);
897       for (k=ii[ee];k<ii[ee+1];k++) {
898         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %d\n",jj[k]);
899         if (PetscBTLookup(btv,jj[k])) {
900           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %d\n",jj[k]);
901         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
902           PetscInt  k2;
903           PetscBool corner = PETSC_FALSE;
904           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
905             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]));
906             /* it's a corner if either is connected with an edge dof belonging to a different cc or
907                if the edge dof lie on the natural part of the boundary */
908             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
909               corner = PETSC_TRUE;
910               break;
911             }
912           }
913           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
914             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %d\n",jj[k]);
915             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
916           } else {
917             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
918           }
919         }
920       }
921     }
922     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
923   }
924   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
925   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
926   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
927 
928   /* Reset marked primal dofs */
929   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
930   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
931   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
932   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
933 
934   /* Now use the initial lG */
935   ierr = MatDestroy(&lG);CHKERRQ(ierr);
936   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
937   lG   = lGinit;
938   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
939 
940   /* Compute extended cols indices */
941   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
942   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
943   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
944   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
945   i   *= maxsize;
946   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
947   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
948   eerr = PETSC_FALSE;
949   for (i=0;i<nee;i++) {
950     PetscInt size,found = 0;
951 
952     cum  = 0;
953     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
954     if (!size && nedfieldlocal) continue;
955     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
956     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
957     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
958     for (j=0;j<size;j++) {
959       PetscInt k,ee = idxs[j];
960       for (k=ii[ee];k<ii[ee+1];k++) {
961         PetscInt vv = jj[k];
962         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
963         else if (!PetscBTLookupSet(btvc,vv)) found++;
964       }
965     }
966     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
967     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
968     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
969     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
970     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
971     /* it may happen that endpoints are not defined at this point
972        if it is the case, mark this edge for a second pass */
973     if (cum != size -1 || found != 2) {
974       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
975       if (print) {
976         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
977         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
978         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
979         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
980       }
981       eerr = PETSC_TRUE;
982     }
983   }
984   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
985   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
986   if (done) {
987     PetscInt *newprimals;
988 
989     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
990     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
991     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
992     ierr = PetscMemcpy(newprimals,idxs,cum*sizeof(PetscInt));CHKERRQ(ierr);
993     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
994     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
995     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %d)\n",eerr);
996     for (i=0;i<nee;i++) {
997       PetscBool has_candidates = PETSC_FALSE;
998       if (PetscBTLookup(bter,i)) {
999         PetscInt size,mark = i+1;
1000 
1001         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1002         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1003         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
1004         for (j=0;j<size;j++) {
1005           PetscInt k,ee = idxs[j];
1006           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %d [%d %d)\n",ee,ii[ee],ii[ee+1]);
1007           for (k=ii[ee];k<ii[ee+1];k++) {
1008             /* set all candidates located on the edge as corners */
1009             if (PetscBTLookup(btvcand,jj[k])) {
1010               PetscInt k2,vv = jj[k];
1011               has_candidates = PETSC_TRUE;
1012               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %d\n",vv);
1013               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
1014               /* set all edge dofs connected to candidate as primals */
1015               for (k2=iit[vv];k2<iit[vv+1];k2++) {
1016                 if (marks[jjt[k2]] == mark) {
1017                   PetscInt k3,ee2 = jjt[k2];
1018                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %d\n",ee2);
1019                   newprimals[cum++] = ee2;
1020                   /* finally set the new corners */
1021                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
1022                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %d\n",jj[k3]);
1023                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
1024                   }
1025                 }
1026               }
1027             } else {
1028               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %d\n",jj[k]);
1029             }
1030           }
1031         }
1032         if (!has_candidates) { /* circular edge */
1033           PetscInt k, ee = idxs[0],*tmarks;
1034 
1035           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
1036           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %d\n",i);
1037           for (k=ii[ee];k<ii[ee+1];k++) {
1038             PetscInt k2;
1039             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %d\n",jj[k]);
1040             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
1041             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
1042           }
1043           for (j=0;j<size;j++) {
1044             if (tmarks[idxs[j]] > 1) {
1045               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %d\n",idxs[j]);
1046               newprimals[cum++] = idxs[j];
1047             }
1048           }
1049           ierr = PetscFree(tmarks);CHKERRQ(ierr);
1050         }
1051         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1052       }
1053       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1054     }
1055     ierr = PetscFree(extcols);CHKERRQ(ierr);
1056     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1057     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1058     if (fl2g) {
1059       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1060       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1061       for (i=0;i<nee;i++) {
1062         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1063       }
1064       ierr = PetscFree(eedges);CHKERRQ(ierr);
1065     }
1066     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1067     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1068     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1069     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1070     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1071     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1072     pcbddc->mat_graph->twodim = PETSC_FALSE;
1073     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1074     if (fl2g) {
1075       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1076       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1077       for (i=0;i<nee;i++) {
1078         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1079       }
1080     } else {
1081       eedges  = alleedges;
1082       primals = allprimals;
1083     }
1084     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1085 
1086     /* Mark again */
1087     ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
1088     for (i=0;i<nee;i++) {
1089       PetscInt size,mark = i+1;
1090 
1091       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1092       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1093       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1094       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1095     }
1096     if (print) {
1097       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1098       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1099     }
1100 
1101     /* Recompute extended cols */
1102     eerr = PETSC_FALSE;
1103     for (i=0;i<nee;i++) {
1104       PetscInt size;
1105 
1106       cum  = 0;
1107       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1108       if (!size && nedfieldlocal) continue;
1109       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1110       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1111       for (j=0;j<size;j++) {
1112         PetscInt k,ee = idxs[j];
1113         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1114       }
1115       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1116       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1117       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1118       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1119       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1120       if (cum != size -1) {
1121         if (print) {
1122           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1123           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1124           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1125           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1126         }
1127         eerr = PETSC_TRUE;
1128       }
1129     }
1130   }
1131   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1132   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1133   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1134   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1135   /* an error should not occur at this point */
1136   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1137 
1138   /* Check the number of endpoints */
1139   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1140   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1141   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1142   for (i=0;i<nee;i++) {
1143     PetscInt size, found = 0, gc[2];
1144 
1145     /* init with defaults */
1146     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1147     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1148     if (!size && nedfieldlocal) continue;
1149     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1150     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1151     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1152     for (j=0;j<size;j++) {
1153       PetscInt k,ee = idxs[j];
1154       for (k=ii[ee];k<ii[ee+1];k++) {
1155         PetscInt vv = jj[k];
1156         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1157           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %d\n",i);
1158           corners[i*2+found++] = vv;
1159         }
1160       }
1161     }
1162     if (found != 2) {
1163       PetscInt e;
1164       if (fl2g) {
1165         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1166       } else {
1167         e = idxs[0];
1168       }
1169       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %d corners for edge %d (astart %d, estart %d)\n",found,i,e,idxs[0]);
1170     }
1171 
1172     /* get primal dof index on this coarse edge */
1173     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1174     if (gc[0] > gc[1]) {
1175       PetscInt swap  = corners[2*i];
1176       corners[2*i]   = corners[2*i+1];
1177       corners[2*i+1] = swap;
1178     }
1179     cedges[i] = idxs[size-1];
1180     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1181     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %d: ce %d, corners (%d,%d)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1182   }
1183   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1184   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1185 
1186 #if defined(PETSC_USE_DEBUG)
1187   /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1188      not interfere with neighbouring coarse edges */
1189   ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1190   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1191   for (i=0;i<nv;i++) {
1192     PetscInt emax = 0,eemax = 0;
1193 
1194     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1195     ierr = PetscMemzero(emarks,(nee+1)*sizeof(PetscInt));CHKERRQ(ierr);
1196     for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1197     for (j=1;j<nee+1;j++) {
1198       if (emax < emarks[j]) {
1199         emax = emarks[j];
1200         eemax = j;
1201       }
1202     }
1203     /* not relevant for edges */
1204     if (!eemax) continue;
1205 
1206     for (j=ii[i];j<ii[i+1];j++) {
1207       if (marks[jj[j]] && marks[jj[j]] != eemax) {
1208         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]);
1209       }
1210     }
1211   }
1212   ierr = PetscFree(emarks);CHKERRQ(ierr);
1213   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1214 #endif
1215 
1216   /* Compute extended rows indices for edge blocks of the change of basis */
1217   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1218   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1219   extmem *= maxsize;
1220   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1221   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1222   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1223   for (i=0;i<nv;i++) {
1224     PetscInt mark = 0,size,start;
1225 
1226     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1227     for (j=ii[i];j<ii[i+1];j++)
1228       if (marks[jj[j]] && !mark)
1229         mark = marks[jj[j]];
1230 
1231     /* not relevant */
1232     if (!mark) continue;
1233 
1234     /* import extended row */
1235     mark--;
1236     start = mark*extmem+extrowcum[mark];
1237     size = ii[i+1]-ii[i];
1238     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %d > %d",extrowcum[mark] + size,extmem);
1239     ierr = PetscMemcpy(extrow+start,jj+ii[i],size*sizeof(PetscInt));CHKERRQ(ierr);
1240     extrowcum[mark] += size;
1241   }
1242   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1243   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1244   ierr = PetscFree(marks);CHKERRQ(ierr);
1245 
1246   /* Compress extrows */
1247   cum  = 0;
1248   for (i=0;i<nee;i++) {
1249     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1250     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1251     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1252     cum  = PetscMax(cum,size);
1253   }
1254   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1255   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1256   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1257 
1258   /* Workspace for lapack inner calls and VecSetValues */
1259   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1260 
1261   /* Create change of basis matrix (preallocation can be improved) */
1262   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1263   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1264                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1265   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1266   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1267   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1268   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1269   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1270   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1271   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1272 
1273   /* Defaults to identity */
1274   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1275   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1276   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1277   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1278 
1279   /* Create discrete gradient for the coarser level if needed */
1280   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1281   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1282   if (pcbddc->current_level < pcbddc->max_levels) {
1283     ISLocalToGlobalMapping cel2g,cvl2g;
1284     IS                     wis,gwis;
1285     PetscInt               cnv,cne;
1286 
1287     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1288     if (fl2g) {
1289       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1290     } else {
1291       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1292       pcbddc->nedclocal = wis;
1293     }
1294     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1295     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1296     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1297     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1298     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1299     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1300 
1301     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1302     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1303     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1304     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1305     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1306     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1307     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1308 
1309     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1310     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1311     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1312     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1313     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1314     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1315     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1316     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1317   }
1318   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1319 
1320 #if defined(PRINT_GDET)
1321   inc = 0;
1322   lev = pcbddc->current_level;
1323 #endif
1324 
1325   /* Insert values in the change of basis matrix */
1326   for (i=0;i<nee;i++) {
1327     Mat         Gins = NULL, GKins = NULL;
1328     IS          cornersis = NULL;
1329     PetscScalar cvals[2];
1330 
1331     if (pcbddc->nedcG) {
1332       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1333     }
1334     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1335     if (Gins && GKins) {
1336       PetscScalar    *data;
1337       const PetscInt *rows,*cols;
1338       PetscInt       nrh,nch,nrc,ncc;
1339 
1340       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1341       /* H1 */
1342       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1343       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1344       ierr = MatDenseGetArray(Gins,&data);CHKERRQ(ierr);
1345       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1346       ierr = MatDenseRestoreArray(Gins,&data);CHKERRQ(ierr);
1347       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1348       /* complement */
1349       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1350       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %d",i);
1351       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);
1352       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);
1353       ierr = MatDenseGetArray(GKins,&data);CHKERRQ(ierr);
1354       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1355       ierr = MatDenseRestoreArray(GKins,&data);CHKERRQ(ierr);
1356 
1357       /* coarse discrete gradient */
1358       if (pcbddc->nedcG) {
1359         PetscInt cols[2];
1360 
1361         cols[0] = 2*i;
1362         cols[1] = 2*i+1;
1363         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1364       }
1365       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1366     }
1367     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1368     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1369     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1370     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1371     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1372   }
1373   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1374 
1375   /* Start assembling */
1376   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1377   if (pcbddc->nedcG) {
1378     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1379   }
1380 
1381   /* Free */
1382   if (fl2g) {
1383     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1384     for (i=0;i<nee;i++) {
1385       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1386     }
1387     ierr = PetscFree(eedges);CHKERRQ(ierr);
1388   }
1389 
1390   /* hack mat_graph with primal dofs on the coarse edges */
1391   {
1392     PCBDDCGraph graph   = pcbddc->mat_graph;
1393     PetscInt    *oqueue = graph->queue;
1394     PetscInt    *ocptr  = graph->cptr;
1395     PetscInt    ncc,*idxs;
1396 
1397     /* find first primal edge */
1398     if (pcbddc->nedclocal) {
1399       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1400     } else {
1401       if (fl2g) {
1402         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1403       }
1404       idxs = cedges;
1405     }
1406     cum = 0;
1407     while (cum < nee && cedges[cum] < 0) cum++;
1408 
1409     /* adapt connected components */
1410     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1411     graph->cptr[0] = 0;
1412     for (i=0,ncc=0;i<graph->ncc;i++) {
1413       PetscInt lc = ocptr[i+1]-ocptr[i];
1414       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1415         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1416         graph->queue[graph->cptr[ncc]] = cedges[cum];
1417         ncc++;
1418         lc--;
1419         cum++;
1420         while (cum < nee && cedges[cum] < 0) cum++;
1421       }
1422       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1423       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1424       ncc++;
1425     }
1426     graph->ncc = ncc;
1427     if (pcbddc->nedclocal) {
1428       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1429     }
1430     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1431   }
1432   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1433   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1434   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1435   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1436 
1437   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1438   ierr = PetscFree(extrow);CHKERRQ(ierr);
1439   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1440   ierr = PetscFree(corners);CHKERRQ(ierr);
1441   ierr = PetscFree(cedges);CHKERRQ(ierr);
1442   ierr = PetscFree(extrows);CHKERRQ(ierr);
1443   ierr = PetscFree(extcols);CHKERRQ(ierr);
1444   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1445 
1446   /* Complete assembling */
1447   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1448   if (pcbddc->nedcG) {
1449     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1450 #if 0
1451     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1452     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1453 #endif
1454   }
1455 
1456   /* set change of basis */
1457   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1458   ierr = MatDestroy(&T);CHKERRQ(ierr);
1459 
1460   PetscFunctionReturn(0);
1461 }
1462 
1463 /* the near-null space of BDDC carries information on quadrature weights,
1464    and these can be collinear -> so cheat with MatNullSpaceCreate
1465    and create a suitable set of basis vectors first */
1466 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1467 {
1468   PetscErrorCode ierr;
1469   PetscInt       i;
1470 
1471   PetscFunctionBegin;
1472   for (i=0;i<nvecs;i++) {
1473     PetscInt first,last;
1474 
1475     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1476     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1477     if (i>=first && i < last) {
1478       PetscScalar *data;
1479       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1480       if (!has_const) {
1481         data[i-first] = 1.;
1482       } else {
1483         data[2*i-first] = 1./PetscSqrtReal(2.);
1484         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1485       }
1486       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1487     }
1488     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1489   }
1490   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1491   for (i=0;i<nvecs;i++) { /* reset vectors */
1492     PetscInt first,last;
1493     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1494     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1495     if (i>=first && i < last) {
1496       PetscScalar *data;
1497       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1498       if (!has_const) {
1499         data[i-first] = 0.;
1500       } else {
1501         data[2*i-first] = 0.;
1502         data[2*i-first+1] = 0.;
1503       }
1504       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1505     }
1506     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1507     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1508   }
1509   PetscFunctionReturn(0);
1510 }
1511 
1512 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1513 {
1514   Mat                    loc_divudotp;
1515   Vec                    p,v,vins,quad_vec,*quad_vecs;
1516   ISLocalToGlobalMapping map;
1517   PetscScalar            *vals;
1518   const PetscScalar      *array;
1519   PetscInt               i,maxneighs,maxsize;
1520   PetscInt               n_neigh,*neigh,*n_shared,**shared;
1521   PetscMPIInt            rank;
1522   PetscErrorCode         ierr;
1523 
1524   PetscFunctionBegin;
1525   ierr = ISLocalToGlobalMappingGetInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1526   ierr = MPIU_Allreduce(&n_neigh,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1527   maxsize = 0;
1528   for (i=0;i<n_neigh;i++) maxsize = PetscMax(n_shared[i],maxsize);
1529   ierr = PetscMalloc1(maxsize,&vals);CHKERRQ(ierr);
1530   /* create vectors to hold quadrature weights */
1531   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1532   if (!transpose) {
1533     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1534   } else {
1535     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1536   }
1537   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1538   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1539   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1540   for (i=0;i<maxneighs;i++) {
1541     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1542     ierr = VecSetLocalToGlobalMapping(quad_vecs[i],map);CHKERRQ(ierr);
1543   }
1544 
1545   /* compute local quad vec */
1546   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1547   if (!transpose) {
1548     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1549   } else {
1550     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1551   }
1552   ierr = VecSet(p,1.);CHKERRQ(ierr);
1553   if (!transpose) {
1554     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1555   } else {
1556     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1557   }
1558   if (vl2l) {
1559     Mat        lA;
1560     VecScatter sc;
1561 
1562     ierr = MatISGetLocalMat(A,&lA);CHKERRQ(ierr);
1563     ierr = MatCreateVecs(lA,&vins,NULL);CHKERRQ(ierr);
1564     ierr = VecScatterCreate(v,vl2l,vins,NULL,&sc);CHKERRQ(ierr);
1565     ierr = VecScatterBegin(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1566     ierr = VecScatterEnd(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1567     ierr = VecScatterDestroy(&sc);CHKERRQ(ierr);
1568   } else {
1569     vins = v;
1570   }
1571   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1572   ierr = VecDestroy(&p);CHKERRQ(ierr);
1573 
1574   /* insert in global quadrature vecs */
1575   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1576   for (i=0;i<n_neigh;i++) {
1577     const PetscInt    *idxs;
1578     PetscInt          idx,nn,j;
1579 
1580     idxs = shared[i];
1581     nn   = n_shared[i];
1582     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1583     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1584     idx  = -(idx+1);
1585     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1586   }
1587   ierr = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1588   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1589   if (vl2l) {
1590     ierr = VecDestroy(&vins);CHKERRQ(ierr);
1591   }
1592   ierr = VecDestroy(&v);CHKERRQ(ierr);
1593   ierr = PetscFree(vals);CHKERRQ(ierr);
1594 
1595   /* assemble near null space */
1596   for (i=0;i<maxneighs;i++) {
1597     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1598   }
1599   for (i=0;i<maxneighs;i++) {
1600     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1601     ierr = VecViewFromOptions(quad_vecs[i],NULL,"-pc_bddc_quad_vecs_view");CHKERRQ(ierr);
1602     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1603   }
1604   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1605   PetscFunctionReturn(0);
1606 }
1607 
1608 PetscErrorCode PCBDDCAddPrimalVerticesLocalIS(PC pc, IS primalv)
1609 {
1610   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1611   PetscErrorCode ierr;
1612 
1613   PetscFunctionBegin;
1614   if (primalv) {
1615     if (pcbddc->user_primal_vertices_local) {
1616       IS list[2], newp;
1617 
1618       list[0] = primalv;
1619       list[1] = pcbddc->user_primal_vertices_local;
1620       ierr = ISConcatenate(PetscObjectComm((PetscObject)pc),2,list,&newp);CHKERRQ(ierr);
1621       ierr = ISSortRemoveDups(newp);CHKERRQ(ierr);
1622       ierr = ISDestroy(&list[1]);CHKERRQ(ierr);
1623       pcbddc->user_primal_vertices_local = newp;
1624     } else {
1625       ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1626     }
1627   }
1628   PetscFunctionReturn(0);
1629 }
1630 
1631 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1632 {
1633   PetscErrorCode ierr;
1634   Vec            local,global;
1635   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1636   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1637   PetscBool      monolithic = PETSC_FALSE;
1638 
1639   PetscFunctionBegin;
1640   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC topology options","PC");CHKERRQ(ierr);
1641   ierr = PetscOptionsBool("-pc_bddc_monolithic","Discard any information on dofs splitting",NULL,monolithic,&monolithic,NULL);CHKERRQ(ierr);
1642   ierr = PetscOptionsEnd();CHKERRQ(ierr);
1643   /* need to convert from global to local topology information and remove references to information in global ordering */
1644   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1645   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1646   if (monolithic) { /* just get block size to properly compute vertices */
1647     if (pcbddc->vertex_size == 1) {
1648       ierr = MatGetBlockSize(pc->pmat,&pcbddc->vertex_size);CHKERRQ(ierr);
1649     }
1650     goto boundary;
1651   }
1652 
1653   if (pcbddc->user_provided_isfordofs) {
1654     if (pcbddc->n_ISForDofs) {
1655       PetscInt i;
1656       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1657       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1658         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1659         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1660       }
1661       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1662       pcbddc->n_ISForDofs = 0;
1663       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1664     }
1665   } else {
1666     if (!pcbddc->n_ISForDofsLocal) { /* field split not present */
1667       DM dm;
1668 
1669       ierr = PCGetDM(pc, &dm);CHKERRQ(ierr);
1670       if (!dm) {
1671         ierr = MatGetDM(pc->pmat, &dm);CHKERRQ(ierr);
1672       }
1673       if (dm) {
1674         IS      *fields;
1675         PetscInt nf,i;
1676         ierr = DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL);CHKERRQ(ierr);
1677         ierr = PetscMalloc1(nf,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1678         for (i=0;i<nf;i++) {
1679           ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1680           ierr = ISDestroy(&fields[i]);CHKERRQ(ierr);
1681         }
1682         ierr = PetscFree(fields);CHKERRQ(ierr);
1683         pcbddc->n_ISForDofsLocal = nf;
1684       } else { /* See if MATIS has fields attached by the conversion from MatNest */
1685         PetscContainer   c;
1686 
1687         ierr = PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c);CHKERRQ(ierr);
1688         if (c) {
1689           MatISLocalFields lf;
1690           ierr = PetscContainerGetPointer(c,(void**)&lf);CHKERRQ(ierr);
1691           ierr = PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf);CHKERRQ(ierr);
1692         } else { /* fallback, create the default fields if bs > 1 */
1693           PetscInt i, n = matis->A->rmap->n;
1694           ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1695           if (i > 1) {
1696             pcbddc->n_ISForDofsLocal = i;
1697             ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1698             for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1699               ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1700             }
1701           }
1702         }
1703       }
1704     } else {
1705       PetscInt i;
1706       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1707         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1708       }
1709     }
1710   }
1711 
1712 boundary:
1713   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1714     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1715   } else if (pcbddc->DirichletBoundariesLocal) {
1716     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1717   }
1718   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1719     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1720   } else if (pcbddc->NeumannBoundariesLocal) {
1721     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1722   }
1723   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1724     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1725   }
1726   ierr = VecDestroy(&global);CHKERRQ(ierr);
1727   ierr = VecDestroy(&local);CHKERRQ(ierr);
1728   /* detect local disconnected subdomains if requested (use matis->A) */
1729   if (pcbddc->detect_disconnected) {
1730     IS       primalv = NULL;
1731     PetscInt i;
1732 
1733     for (i=0;i<pcbddc->n_local_subs;i++) {
1734       ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
1735     }
1736     ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
1737     ierr = PCBDDCDetectDisconnectedComponents(pc,&pcbddc->n_local_subs,&pcbddc->local_subs,&primalv);CHKERRQ(ierr);
1738     ierr = PCBDDCAddPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1739     ierr = ISDestroy(&primalv);CHKERRQ(ierr);
1740   }
1741   /* early stage corner detection */
1742   {
1743     DM dm;
1744 
1745     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1746     if (dm) {
1747       PetscBool isda;
1748 
1749       ierr = PetscObjectTypeCompare((PetscObject)dm,DMDA,&isda);CHKERRQ(ierr);
1750       if (isda) {
1751         ISLocalToGlobalMapping l2l;
1752         IS                     corners;
1753         Mat                    lA;
1754 
1755         ierr = DMDAGetSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1756         ierr = MatISGetLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1757         ierr = MatGetLocalToGlobalMapping(lA,&l2l,NULL);CHKERRQ(ierr);
1758         ierr = MatISRestoreLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1759         if (l2l) {
1760           const PetscInt *idx;
1761           PetscInt       bs,*idxout,n;
1762 
1763           ierr = ISLocalToGlobalMappingGetBlockSize(l2l,&bs);CHKERRQ(ierr);
1764           ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
1765           ierr = ISGetIndices(corners,&idx);CHKERRQ(ierr);
1766           ierr = PetscMalloc1(n,&idxout);CHKERRQ(ierr);
1767           ierr = ISLocalToGlobalMappingApplyBlock(l2l,n,idx,idxout);CHKERRQ(ierr);
1768           ierr = ISRestoreIndices(corners,&idx);CHKERRQ(ierr);
1769           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1770           ierr = ISCreateBlock(PetscObjectComm((PetscObject)pc),bs,n,idxout,PETSC_OWN_POINTER,&corners);CHKERRQ(ierr);
1771           ierr = PCBDDCAddPrimalVerticesLocalIS(pc,corners);CHKERRQ(ierr);
1772           ierr = ISDestroy(&corners);CHKERRQ(ierr);
1773         } else { /* not from DMDA */
1774           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1775         }
1776       }
1777     }
1778   }
1779   PetscFunctionReturn(0);
1780 }
1781 
1782 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1783 {
1784   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1785   PetscErrorCode  ierr;
1786   IS              nis;
1787   const PetscInt  *idxs;
1788   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1789   PetscBool       *ld;
1790 
1791   PetscFunctionBegin;
1792   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1793   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
1794   if (mop == MPI_LAND) {
1795     /* init rootdata with true */
1796     ld   = (PetscBool*) matis->sf_rootdata;
1797     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1798   } else {
1799     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscBool));CHKERRQ(ierr);
1800   }
1801   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscBool));CHKERRQ(ierr);
1802   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1803   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1804   ld   = (PetscBool*) matis->sf_leafdata;
1805   for (i=0;i<nd;i++)
1806     if (-1 < idxs[i] && idxs[i] < n)
1807       ld[idxs[i]] = PETSC_TRUE;
1808   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1809   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1810   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1811   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1812   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1813   if (mop == MPI_LAND) {
1814     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1815   } else {
1816     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1817   }
1818   for (i=0,nnd=0;i<n;i++)
1819     if (ld[i])
1820       nidxs[nnd++] = i;
1821   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1822   ierr = ISDestroy(is);CHKERRQ(ierr);
1823   *is  = nis;
1824   PetscFunctionReturn(0);
1825 }
1826 
1827 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1828 {
1829   PC_IS             *pcis = (PC_IS*)(pc->data);
1830   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1831   PetscErrorCode    ierr;
1832 
1833   PetscFunctionBegin;
1834   if (!pcbddc->benign_have_null) {
1835     PetscFunctionReturn(0);
1836   }
1837   if (pcbddc->ChangeOfBasisMatrix) {
1838     Vec swap;
1839 
1840     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1841     swap = pcbddc->work_change;
1842     pcbddc->work_change = r;
1843     r = swap;
1844   }
1845   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1846   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1847   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1848   ierr = VecSet(z,0.);CHKERRQ(ierr);
1849   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1850   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1851   if (pcbddc->ChangeOfBasisMatrix) {
1852     pcbddc->work_change = r;
1853     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1854     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1855   }
1856   PetscFunctionReturn(0);
1857 }
1858 
1859 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1860 {
1861   PCBDDCBenignMatMult_ctx ctx;
1862   PetscErrorCode          ierr;
1863   PetscBool               apply_right,apply_left,reset_x;
1864 
1865   PetscFunctionBegin;
1866   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1867   if (transpose) {
1868     apply_right = ctx->apply_left;
1869     apply_left = ctx->apply_right;
1870   } else {
1871     apply_right = ctx->apply_right;
1872     apply_left = ctx->apply_left;
1873   }
1874   reset_x = PETSC_FALSE;
1875   if (apply_right) {
1876     const PetscScalar *ax;
1877     PetscInt          nl,i;
1878 
1879     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1880     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1881     ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr);
1882     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1883     for (i=0;i<ctx->benign_n;i++) {
1884       PetscScalar    sum,val;
1885       const PetscInt *idxs;
1886       PetscInt       nz,j;
1887       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1888       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1889       sum = 0.;
1890       if (ctx->apply_p0) {
1891         val = ctx->work[idxs[nz-1]];
1892         for (j=0;j<nz-1;j++) {
1893           sum += ctx->work[idxs[j]];
1894           ctx->work[idxs[j]] += val;
1895         }
1896       } else {
1897         for (j=0;j<nz-1;j++) {
1898           sum += ctx->work[idxs[j]];
1899         }
1900       }
1901       ctx->work[idxs[nz-1]] -= sum;
1902       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1903     }
1904     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1905     reset_x = PETSC_TRUE;
1906   }
1907   if (transpose) {
1908     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1909   } else {
1910     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1911   }
1912   if (reset_x) {
1913     ierr = VecResetArray(x);CHKERRQ(ierr);
1914   }
1915   if (apply_left) {
1916     PetscScalar *ay;
1917     PetscInt    i;
1918 
1919     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1920     for (i=0;i<ctx->benign_n;i++) {
1921       PetscScalar    sum,val;
1922       const PetscInt *idxs;
1923       PetscInt       nz,j;
1924       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1925       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1926       val = -ay[idxs[nz-1]];
1927       if (ctx->apply_p0) {
1928         sum = 0.;
1929         for (j=0;j<nz-1;j++) {
1930           sum += ay[idxs[j]];
1931           ay[idxs[j]] += val;
1932         }
1933         ay[idxs[nz-1]] += sum;
1934       } else {
1935         for (j=0;j<nz-1;j++) {
1936           ay[idxs[j]] += val;
1937         }
1938         ay[idxs[nz-1]] = 0.;
1939       }
1940       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1941     }
1942     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
1943   }
1944   PetscFunctionReturn(0);
1945 }
1946 
1947 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
1948 {
1949   PetscErrorCode ierr;
1950 
1951   PetscFunctionBegin;
1952   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
1953   PetscFunctionReturn(0);
1954 }
1955 
1956 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
1957 {
1958   PetscErrorCode ierr;
1959 
1960   PetscFunctionBegin;
1961   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
1962   PetscFunctionReturn(0);
1963 }
1964 
1965 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
1966 {
1967   PC_IS                   *pcis = (PC_IS*)pc->data;
1968   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
1969   PCBDDCBenignMatMult_ctx ctx;
1970   PetscErrorCode          ierr;
1971 
1972   PetscFunctionBegin;
1973   if (!restore) {
1974     Mat                A_IB,A_BI;
1975     PetscScalar        *work;
1976     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
1977 
1978     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
1979     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
1980     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
1981     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
1982     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
1983     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
1984     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
1985     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
1986     ierr = PetscNew(&ctx);CHKERRQ(ierr);
1987     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
1988     ctx->apply_left = PETSC_TRUE;
1989     ctx->apply_right = PETSC_FALSE;
1990     ctx->apply_p0 = PETSC_FALSE;
1991     ctx->benign_n = pcbddc->benign_n;
1992     if (reuse) {
1993       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
1994       ctx->free = PETSC_FALSE;
1995     } else { /* TODO: could be optimized for successive solves */
1996       ISLocalToGlobalMapping N_to_D;
1997       PetscInt               i;
1998 
1999       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
2000       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2001       for (i=0;i<pcbddc->benign_n;i++) {
2002         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2003       }
2004       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
2005       ctx->free = PETSC_TRUE;
2006     }
2007     ctx->A = pcis->A_IB;
2008     ctx->work = work;
2009     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
2010     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2011     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2012     pcis->A_IB = A_IB;
2013 
2014     /* A_BI as A_IB^T */
2015     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
2016     pcbddc->benign_original_mat = pcis->A_BI;
2017     pcis->A_BI = A_BI;
2018   } else {
2019     if (!pcbddc->benign_original_mat) {
2020       PetscFunctionReturn(0);
2021     }
2022     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
2023     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
2024     pcis->A_IB = ctx->A;
2025     ctx->A = NULL;
2026     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
2027     pcis->A_BI = pcbddc->benign_original_mat;
2028     pcbddc->benign_original_mat = NULL;
2029     if (ctx->free) {
2030       PetscInt i;
2031       for (i=0;i<ctx->benign_n;i++) {
2032         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2033       }
2034       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2035     }
2036     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
2037     ierr = PetscFree(ctx);CHKERRQ(ierr);
2038   }
2039   PetscFunctionReturn(0);
2040 }
2041 
2042 /* used just in bddc debug mode */
2043 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
2044 {
2045   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
2046   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
2047   Mat            An;
2048   PetscErrorCode ierr;
2049 
2050   PetscFunctionBegin;
2051   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
2052   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
2053   if (is1) {
2054     ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
2055     ierr = MatDestroy(&An);CHKERRQ(ierr);
2056   } else {
2057     *B = An;
2058   }
2059   PetscFunctionReturn(0);
2060 }
2061 
2062 /* TODO: add reuse flag */
2063 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2064 {
2065   Mat            Bt;
2066   PetscScalar    *a,*bdata;
2067   const PetscInt *ii,*ij;
2068   PetscInt       m,n,i,nnz,*bii,*bij;
2069   PetscBool      flg_row;
2070   PetscErrorCode ierr;
2071 
2072   PetscFunctionBegin;
2073   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2074   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2075   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2076   nnz = n;
2077   for (i=0;i<ii[n];i++) {
2078     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2079   }
2080   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2081   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2082   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2083   nnz = 0;
2084   bii[0] = 0;
2085   for (i=0;i<n;i++) {
2086     PetscInt j;
2087     for (j=ii[i];j<ii[i+1];j++) {
2088       PetscScalar entry = a[j];
2089       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || (n == m && ij[j] == i)) {
2090         bij[nnz] = ij[j];
2091         bdata[nnz] = entry;
2092         nnz++;
2093       }
2094     }
2095     bii[i+1] = nnz;
2096   }
2097   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2098   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2099   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2100   {
2101     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2102     b->free_a = PETSC_TRUE;
2103     b->free_ij = PETSC_TRUE;
2104   }
2105   if (*B == A) {
2106     ierr = MatDestroy(&A);CHKERRQ(ierr);
2107   }
2108   *B = Bt;
2109   PetscFunctionReturn(0);
2110 }
2111 
2112 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscInt *ncc, IS* cc[], IS* primalv)
2113 {
2114   Mat                    B = NULL;
2115   DM                     dm;
2116   IS                     is_dummy,*cc_n;
2117   ISLocalToGlobalMapping l2gmap_dummy;
2118   PCBDDCGraph            graph;
2119   PetscInt               *xadj_filtered = NULL,*adjncy_filtered = NULL;
2120   PetscInt               i,n;
2121   PetscInt               *xadj,*adjncy;
2122   PetscBool              isplex = PETSC_FALSE;
2123   PetscErrorCode         ierr;
2124 
2125   PetscFunctionBegin;
2126   if (ncc) *ncc = 0;
2127   if (cc) *cc = NULL;
2128   if (primalv) *primalv = NULL;
2129   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2130   ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
2131   if (!dm) {
2132     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
2133   }
2134   if (dm) {
2135     ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr);
2136   }
2137   if (isplex) { /* this code has been modified from plexpartition.c */
2138     PetscInt       p, pStart, pEnd, a, adjSize, idx, size, nroots;
2139     PetscInt      *adj = NULL;
2140     IS             cellNumbering;
2141     const PetscInt *cellNum;
2142     PetscBool      useCone, useClosure;
2143     PetscSection   section;
2144     PetscSegBuffer adjBuffer;
2145     PetscSF        sfPoint;
2146     PetscErrorCode ierr;
2147 
2148     PetscFunctionBegin;
2149     ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
2150     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2151     ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
2152     /* Build adjacency graph via a section/segbuffer */
2153     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &section);CHKERRQ(ierr);
2154     ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
2155     ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr);
2156     /* Always use FVM adjacency to create partitioner graph */
2157     ierr = DMPlexGetAdjacencyUseCone(dm, &useCone);CHKERRQ(ierr);
2158     ierr = DMPlexGetAdjacencyUseClosure(dm, &useClosure);CHKERRQ(ierr);
2159     ierr = DMPlexSetAdjacencyUseCone(dm, PETSC_TRUE);CHKERRQ(ierr);
2160     ierr = DMPlexSetAdjacencyUseClosure(dm, PETSC_FALSE);CHKERRQ(ierr);
2161     ierr = DMPlexGetCellNumbering(dm, &cellNumbering);CHKERRQ(ierr);
2162     ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr);
2163     for (n = 0, p = pStart; p < pEnd; p++) {
2164       /* Skip non-owned cells in parallel (ParMetis expects no overlap) */
2165       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2166       adjSize = PETSC_DETERMINE;
2167       ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr);
2168       for (a = 0; a < adjSize; ++a) {
2169         const PetscInt point = adj[a];
2170         if (pStart <= point && point < pEnd) {
2171           PetscInt *PETSC_RESTRICT pBuf;
2172           ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr);
2173           ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr);
2174           *pBuf = point;
2175         }
2176       }
2177       n++;
2178     }
2179     ierr = DMPlexSetAdjacencyUseCone(dm, useCone);CHKERRQ(ierr);
2180     ierr = DMPlexSetAdjacencyUseClosure(dm, useClosure);CHKERRQ(ierr);
2181     /* Derive CSR graph from section/segbuffer */
2182     ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
2183     ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
2184     ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr);
2185     for (idx = 0, p = pStart; p < pEnd; p++) {
2186       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2187       ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr);
2188     }
2189     xadj[n] = size;
2190     ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr);
2191     /* Clean up */
2192     ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr);
2193     ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
2194     ierr = PetscFree(adj);CHKERRQ(ierr);
2195     graph->xadj = xadj;
2196     graph->adjncy = adjncy;
2197   } else {
2198     Mat       A;
2199     PetscBool filter = PETSC_FALSE, isseqaij, flg_row;
2200 
2201     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2202     if (!A->rmap->N || !A->cmap->N) {
2203       ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2204       PetscFunctionReturn(0);
2205     }
2206     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2207     if (!isseqaij && filter) {
2208       PetscBool isseqdense;
2209 
2210       ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2211       if (!isseqdense) {
2212         ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2213       } else { /* TODO: rectangular case and LDA */
2214         PetscScalar *array;
2215         PetscReal   chop=1.e-6;
2216 
2217         ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2218         ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2219         ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2220         for (i=0;i<n;i++) {
2221           PetscInt j;
2222           for (j=i+1;j<n;j++) {
2223             PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2224             if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2225             if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2226           }
2227         }
2228         ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2229         ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2230       }
2231     } else {
2232       ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
2233       B = A;
2234     }
2235     ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2236 
2237     /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2238     if (filter) {
2239       PetscScalar *data;
2240       PetscInt    j,cum;
2241 
2242       ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2243       ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2244       cum = 0;
2245       for (i=0;i<n;i++) {
2246         PetscInt t;
2247 
2248         for (j=xadj[i];j<xadj[i+1];j++) {
2249           if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2250             continue;
2251           }
2252           adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2253         }
2254         t = xadj_filtered[i];
2255         xadj_filtered[i] = cum;
2256         cum += t;
2257       }
2258       ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2259       graph->xadj = xadj_filtered;
2260       graph->adjncy = adjncy_filtered;
2261     } else {
2262       graph->xadj = xadj;
2263       graph->adjncy = adjncy;
2264     }
2265   }
2266   /* compute local connected components using PCBDDCGraph */
2267   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2268   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2269   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2270   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2271   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2272   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2273   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2274 
2275   /* partial clean up */
2276   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2277   if (B) {
2278     PetscBool flg_row;
2279     ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2280     ierr = MatDestroy(&B);CHKERRQ(ierr);
2281   }
2282   if (isplex) {
2283     ierr = PetscFree(xadj);CHKERRQ(ierr);
2284     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2285   }
2286 
2287   /* get back data */
2288   if (isplex) {
2289     if (ncc) *ncc = graph->ncc;
2290     if (cc || primalv) {
2291       Mat          A;
2292       PetscBT      btv,btvt;
2293       PetscSection subSection;
2294       PetscInt     *ids,cum,cump,*cids,*pids;
2295 
2296       ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr);
2297       ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2298       ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr);
2299       ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr);
2300       ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr);
2301 
2302       cids[0] = 0;
2303       for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) {
2304         PetscInt j;
2305 
2306         ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr);
2307         for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) {
2308           PetscInt k, size, *closure = NULL, cell = graph->queue[j];
2309 
2310           ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2311           for (k = 0; k < 2*size; k += 2) {
2312             PetscInt s, p = closure[k], off, dof, cdof;
2313 
2314             ierr = PetscSectionGetConstraintDof(subSection, p, &cdof);CHKERRQ(ierr);
2315             ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr);
2316             ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr);
2317             for (s = 0; s < dof-cdof; s++) {
2318               if (PetscBTLookupSet(btvt,off+s)) continue;
2319               if (!PetscBTLookup(btv,off+s)) {
2320                 ids[cum++] = off+s;
2321               } else { /* cross-vertex */
2322                 pids[cump++] = off+s;
2323               }
2324             }
2325           }
2326           ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2327         }
2328         cids[i+1] = cum;
2329         /* mark dofs as already assigned */
2330         for (j = cids[i]; j < cids[i+1]; j++) {
2331           ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr);
2332         }
2333       }
2334       if (cc) {
2335         ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2336         for (i = 0; i < graph->ncc; i++) {
2337           ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2338         }
2339         *cc = cc_n;
2340       }
2341       if (primalv) {
2342         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr);
2343       }
2344       ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr);
2345       ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
2346       ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr);
2347     }
2348   } else {
2349     if (ncc) *ncc = graph->ncc;
2350     if (cc) {
2351       ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2352       for (i=0;i<graph->ncc;i++) {
2353         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);
2354       }
2355       *cc = cc_n;
2356     }
2357   }
2358   /* clean up graph */
2359   graph->xadj = 0;
2360   graph->adjncy = 0;
2361   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2362   PetscFunctionReturn(0);
2363 }
2364 
2365 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2366 {
2367   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2368   PC_IS*         pcis = (PC_IS*)(pc->data);
2369   IS             dirIS = NULL;
2370   PetscInt       i;
2371   PetscErrorCode ierr;
2372 
2373   PetscFunctionBegin;
2374   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2375   if (zerodiag) {
2376     Mat            A;
2377     Vec            vec3_N;
2378     PetscScalar    *vals;
2379     const PetscInt *idxs;
2380     PetscInt       nz,*count;
2381 
2382     /* p0 */
2383     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2384     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2385     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2386     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2387     for (i=0;i<nz;i++) vals[i] = 1.;
2388     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2389     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2390     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2391     /* v_I */
2392     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2393     for (i=0;i<nz;i++) vals[i] = 0.;
2394     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2395     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2396     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2397     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2398     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2399     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2400     if (dirIS) {
2401       PetscInt n;
2402 
2403       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2404       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2405       for (i=0;i<n;i++) vals[i] = 0.;
2406       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2407       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2408     }
2409     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2410     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2411     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2412     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2413     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2414     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2415     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2416     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]));
2417     ierr = PetscFree(vals);CHKERRQ(ierr);
2418     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2419 
2420     /* there should not be any pressure dofs lying on the interface */
2421     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2422     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2423     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2424     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2425     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2426     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]);
2427     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2428     ierr = PetscFree(count);CHKERRQ(ierr);
2429   }
2430   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2431 
2432   /* check PCBDDCBenignGetOrSetP0 */
2433   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2434   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2435   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2436   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2437   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2438   for (i=0;i<pcbddc->benign_n;i++) {
2439     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2440     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);
2441   }
2442   PetscFunctionReturn(0);
2443 }
2444 
2445 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, IS *zerodiaglocal)
2446 {
2447   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2448   IS             pressures,zerodiag,zerodiag_save,*zerodiag_subs;
2449   PetscInt       nz,n;
2450   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2451   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2452   PetscErrorCode ierr;
2453 
2454   PetscFunctionBegin;
2455   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2456   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2457   for (n=0;n<pcbddc->benign_n;n++) {
2458     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2459   }
2460   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2461   pcbddc->benign_n = 0;
2462 
2463   /* if a local info on dofs is present, uses the last field for "pressures" (or fid by command line)
2464      otherwise, it uses only zerodiagonal dofs (ok if the pressure block is all zero; it could fail if it is not)
2465      Checks if all the pressure dofs in each subdomain have a zero diagonal
2466      If not, a change of basis on pressures is not needed
2467      since the local Schur complements are already SPD
2468   */
2469   has_null_pressures = PETSC_TRUE;
2470   have_null = PETSC_TRUE;
2471   if (pcbddc->n_ISForDofsLocal) {
2472     IS       iP = NULL;
2473     PetscInt npl,*idxs,p = pcbddc->n_ISForDofsLocal-1;
2474 
2475     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2476     ierr = PetscOptionsInt("-pc_bddc_pressure_field","Field id for pressures",NULL,p,&p,NULL);CHKERRQ(ierr);
2477     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2478     if (p < 0 || p > pcbddc->n_ISForDofsLocal-1) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %D",p);
2479     /* Dofs splitting for BDDC cannot have PETSC_COMM_SELF, so create a sequential IS */
2480     ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[p],&npl);CHKERRQ(ierr);
2481     ierr = ISGetIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2482     ierr = ISCreateGeneral(PETSC_COMM_SELF,npl,idxs,PETSC_COPY_VALUES,&pressures);CHKERRQ(ierr);
2483     ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2484     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2485     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2486     if (iP) {
2487       IS newpressures;
2488 
2489       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2490       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2491       pressures = newpressures;
2492     }
2493     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2494     if (!sorted) {
2495       ierr = ISSort(pressures);CHKERRQ(ierr);
2496     }
2497   } else {
2498     pressures = NULL;
2499   }
2500   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2501   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2502   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2503   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2504   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2505   if (!sorted) {
2506     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2507   }
2508   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2509   zerodiag_save = zerodiag;
2510   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2511   if (!nz) {
2512     if (n) have_null = PETSC_FALSE;
2513     has_null_pressures = PETSC_FALSE;
2514     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2515   }
2516   recompute_zerodiag = PETSC_FALSE;
2517   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2518   zerodiag_subs    = NULL;
2519   pcbddc->benign_n = 0;
2520   n_interior_dofs  = 0;
2521   interior_dofs    = NULL;
2522   nneu             = 0;
2523   if (pcbddc->NeumannBoundariesLocal) {
2524     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2525   }
2526   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2527   if (checkb) { /* need to compute interior nodes */
2528     PetscInt n,i,j;
2529     PetscInt n_neigh,*neigh,*n_shared,**shared;
2530     PetscInt *iwork;
2531 
2532     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2533     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2534     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2535     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2536     for (i=1;i<n_neigh;i++)
2537       for (j=0;j<n_shared[i];j++)
2538           iwork[shared[i][j]] += 1;
2539     for (i=0;i<n;i++)
2540       if (!iwork[i])
2541         interior_dofs[n_interior_dofs++] = i;
2542     ierr = PetscFree(iwork);CHKERRQ(ierr);
2543     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2544   }
2545   if (has_null_pressures) {
2546     IS             *subs;
2547     PetscInt       nsubs,i,j,nl;
2548     const PetscInt *idxs;
2549     PetscScalar    *array;
2550     Vec            *work;
2551     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2552 
2553     subs  = pcbddc->local_subs;
2554     nsubs = pcbddc->n_local_subs;
2555     /* 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) */
2556     if (checkb) {
2557       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2558       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2559       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2560       /* work[0] = 1_p */
2561       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2562       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2563       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2564       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2565       /* work[0] = 1_v */
2566       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2567       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2568       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2569       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2570       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2571     }
2572     if (nsubs > 1) {
2573       ierr = PetscCalloc1(nsubs,&zerodiag_subs);CHKERRQ(ierr);
2574       for (i=0;i<nsubs;i++) {
2575         ISLocalToGlobalMapping l2g;
2576         IS                     t_zerodiag_subs;
2577         PetscInt               nl;
2578 
2579         ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2580         ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,zerodiag,&t_zerodiag_subs);CHKERRQ(ierr);
2581         ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2582         if (nl) {
2583           PetscBool valid = PETSC_TRUE;
2584 
2585           if (checkb) {
2586             ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2587             ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2588             ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2589             ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2590             for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2591             ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2592             ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2593             ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2594             ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2595             ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2596             ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2597             for (j=0;j<n_interior_dofs;j++) {
2598               if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2599                 valid = PETSC_FALSE;
2600                 break;
2601               }
2602             }
2603             ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2604           }
2605           if (valid && nneu) {
2606             const PetscInt *idxs;
2607             PetscInt       nzb;
2608 
2609             ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2610             ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2611             ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2612             if (nzb) valid = PETSC_FALSE;
2613           }
2614           if (valid && pressures) {
2615             IS t_pressure_subs;
2616             ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2617             ierr = ISEqual(t_pressure_subs,t_zerodiag_subs,&valid);CHKERRQ(ierr);
2618             ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2619           }
2620           if (valid) {
2621             ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[pcbddc->benign_n]);CHKERRQ(ierr);
2622             pcbddc->benign_n++;
2623           } else {
2624             recompute_zerodiag = PETSC_TRUE;
2625           }
2626         }
2627         ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2628         ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2629       }
2630     } else { /* there's just one subdomain (or zero if they have not been detected */
2631       PetscBool valid = PETSC_TRUE;
2632 
2633       if (nneu) valid = PETSC_FALSE;
2634       if (valid && pressures) {
2635         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2636       }
2637       if (valid && checkb) {
2638         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2639         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2640         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2641         for (j=0;j<n_interior_dofs;j++) {
2642           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2643             valid = PETSC_FALSE;
2644             break;
2645           }
2646         }
2647         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2648       }
2649       if (valid) {
2650         pcbddc->benign_n = 1;
2651         ierr = PetscMalloc1(pcbddc->benign_n,&zerodiag_subs);CHKERRQ(ierr);
2652         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2653         zerodiag_subs[0] = zerodiag;
2654       }
2655     }
2656     if (checkb) {
2657       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2658     }
2659   }
2660   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2661 
2662   if (!pcbddc->benign_n) {
2663     PetscInt n;
2664 
2665     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2666     recompute_zerodiag = PETSC_FALSE;
2667     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2668     if (n) {
2669       has_null_pressures = PETSC_FALSE;
2670       have_null = PETSC_FALSE;
2671     }
2672   }
2673 
2674   /* final check for null pressures */
2675   if (zerodiag && pressures) {
2676     PetscInt nz,np;
2677     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2678     ierr = ISGetLocalSize(pressures,&np);CHKERRQ(ierr);
2679     if (nz != np) have_null = PETSC_FALSE;
2680   }
2681 
2682   if (recompute_zerodiag) {
2683     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2684     if (pcbddc->benign_n == 1) {
2685       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2686       zerodiag = zerodiag_subs[0];
2687     } else {
2688       PetscInt i,nzn,*new_idxs;
2689 
2690       nzn = 0;
2691       for (i=0;i<pcbddc->benign_n;i++) {
2692         PetscInt ns;
2693         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2694         nzn += ns;
2695       }
2696       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2697       nzn = 0;
2698       for (i=0;i<pcbddc->benign_n;i++) {
2699         PetscInt ns,*idxs;
2700         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2701         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2702         ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr);
2703         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2704         nzn += ns;
2705       }
2706       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2707       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2708     }
2709     have_null = PETSC_FALSE;
2710   }
2711 
2712   /* Prepare matrix to compute no-net-flux */
2713   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2714     Mat                    A,loc_divudotp;
2715     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2716     IS                     row,col,isused = NULL;
2717     PetscInt               M,N,n,st,n_isused;
2718 
2719     if (pressures) {
2720       isused = pressures;
2721     } else {
2722       isused = zerodiag_save;
2723     }
2724     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2725     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2726     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2727     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");
2728     n_isused = 0;
2729     if (isused) {
2730       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2731     }
2732     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2733     st = st-n_isused;
2734     if (n) {
2735       const PetscInt *gidxs;
2736 
2737       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2738       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2739       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2740       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2741       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2742       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2743     } else {
2744       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2745       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2746       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2747     }
2748     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2749     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2750     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2751     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2752     ierr = ISDestroy(&row);CHKERRQ(ierr);
2753     ierr = ISDestroy(&col);CHKERRQ(ierr);
2754     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2755     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2756     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2757     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2758     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2759     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2760     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2761     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2762     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2763     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2764   }
2765   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2766 
2767   /* change of basis and p0 dofs */
2768   if (has_null_pressures) {
2769     IS             zerodiagc;
2770     const PetscInt *idxs,*idxsc;
2771     PetscInt       i,s,*nnz;
2772 
2773     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2774     ierr = ISComplement(zerodiag,0,n,&zerodiagc);CHKERRQ(ierr);
2775     ierr = ISGetIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2776     /* local change of basis for pressures */
2777     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2778     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2779     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2780     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2781     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2782     for (i=0;i<n-nz;i++) nnz[idxsc[i]] = 1; /* identity on velocities plus pressure dofs for non-singular subdomains */
2783     for (i=0;i<pcbddc->benign_n;i++) {
2784       PetscInt nzs,j;
2785 
2786       ierr = ISGetLocalSize(zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2787       ierr = ISGetIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2788       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2789       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2790       ierr = ISRestoreIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2791     }
2792     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2793     ierr = PetscFree(nnz);CHKERRQ(ierr);
2794     /* set identity on velocities */
2795     for (i=0;i<n-nz;i++) {
2796       ierr = MatSetValue(pcbddc->benign_change,idxsc[i],idxsc[i],1.,INSERT_VALUES);CHKERRQ(ierr);
2797     }
2798     ierr = ISRestoreIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2799     ierr = ISDestroy(&zerodiagc);CHKERRQ(ierr);
2800     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2801     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2802     /* set change on pressures */
2803     for (s=0;s<pcbddc->benign_n;s++) {
2804       PetscScalar *array;
2805       PetscInt    nzs;
2806 
2807       ierr = ISGetLocalSize(zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2808       ierr = ISGetIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2809       for (i=0;i<nzs-1;i++) {
2810         PetscScalar vals[2];
2811         PetscInt    cols[2];
2812 
2813         cols[0] = idxs[i];
2814         cols[1] = idxs[nzs-1];
2815         vals[0] = 1.;
2816         vals[1] = 1.;
2817         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2818       }
2819       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2820       for (i=0;i<nzs-1;i++) array[i] = -1.;
2821       array[nzs-1] = 1.;
2822       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2823       /* store local idxs for p0 */
2824       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2825       ierr = ISRestoreIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2826       ierr = PetscFree(array);CHKERRQ(ierr);
2827     }
2828     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2829     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2830     /* project if needed */
2831     if (pcbddc->benign_change_explicit) {
2832       Mat M;
2833 
2834       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2835       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2836       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2837       ierr = MatDestroy(&M);CHKERRQ(ierr);
2838     }
2839     /* store global idxs for p0 */
2840     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2841   }
2842   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2843   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2844 
2845   /* determines if the coarse solver will be singular or not */
2846   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2847   /* determines if the problem has subdomains with 0 pressure block */
2848   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2849   *zerodiaglocal = zerodiag;
2850   PetscFunctionReturn(0);
2851 }
2852 
2853 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2854 {
2855   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2856   PetscScalar    *array;
2857   PetscErrorCode ierr;
2858 
2859   PetscFunctionBegin;
2860   if (!pcbddc->benign_sf) {
2861     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
2862     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2863   }
2864   if (get) {
2865     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2866     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2867     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2868     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2869   } else {
2870     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
2871     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2872     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2873     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
2874   }
2875   PetscFunctionReturn(0);
2876 }
2877 
2878 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
2879 {
2880   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2881   PetscErrorCode ierr;
2882 
2883   PetscFunctionBegin;
2884   /* TODO: add error checking
2885     - avoid nested pop (or push) calls.
2886     - cannot push before pop.
2887     - cannot call this if pcbddc->local_mat is NULL
2888   */
2889   if (!pcbddc->benign_n) {
2890     PetscFunctionReturn(0);
2891   }
2892   if (pop) {
2893     if (pcbddc->benign_change_explicit) {
2894       IS       is_p0;
2895       MatReuse reuse;
2896 
2897       /* extract B_0 */
2898       reuse = MAT_INITIAL_MATRIX;
2899       if (pcbddc->benign_B0) {
2900         reuse = MAT_REUSE_MATRIX;
2901       }
2902       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
2903       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
2904       /* remove rows and cols from local problem */
2905       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
2906       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
2907       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
2908       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
2909     } else {
2910       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
2911       PetscScalar *vals;
2912       PetscInt    i,n,*idxs_ins;
2913 
2914       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
2915       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
2916       if (!pcbddc->benign_B0) {
2917         PetscInt *nnz;
2918         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
2919         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
2920         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2921         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
2922         for (i=0;i<pcbddc->benign_n;i++) {
2923           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
2924           nnz[i] = n - nnz[i];
2925         }
2926         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
2927         ierr = PetscFree(nnz);CHKERRQ(ierr);
2928       }
2929 
2930       for (i=0;i<pcbddc->benign_n;i++) {
2931         PetscScalar *array;
2932         PetscInt    *idxs,j,nz,cum;
2933 
2934         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
2935         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
2936         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2937         for (j=0;j<nz;j++) vals[j] = 1.;
2938         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2939         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
2940         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
2941         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
2942         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2943         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2944         cum = 0;
2945         for (j=0;j<n;j++) {
2946           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
2947             vals[cum] = array[j];
2948             idxs_ins[cum] = j;
2949             cum++;
2950           }
2951         }
2952         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
2953         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2954         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2955       }
2956       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2957       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2958       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
2959     }
2960   } else { /* push */
2961     if (pcbddc->benign_change_explicit) {
2962       PetscInt i;
2963 
2964       for (i=0;i<pcbddc->benign_n;i++) {
2965         PetscScalar *B0_vals;
2966         PetscInt    *B0_cols,B0_ncol;
2967 
2968         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2969         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2970         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2971         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
2972         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2973       }
2974       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2975       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2976     } else {
2977       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!\n");
2978     }
2979   }
2980   PetscFunctionReturn(0);
2981 }
2982 
2983 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
2984 {
2985   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
2986   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
2987   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
2988   PetscBLASInt    *B_iwork,*B_ifail;
2989   PetscScalar     *work,lwork;
2990   PetscScalar     *St,*S,*eigv;
2991   PetscScalar     *Sarray,*Starray;
2992   PetscReal       *eigs,thresh,lthresh,uthresh;
2993   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
2994   PetscBool       allocated_S_St;
2995 #if defined(PETSC_USE_COMPLEX)
2996   PetscReal       *rwork;
2997 #endif
2998   PetscErrorCode  ierr;
2999 
3000   PetscFunctionBegin;
3001   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
3002   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
3003   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);
3004 
3005   if (pcbddc->dbg_flag) {
3006     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3007     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3008     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
3009     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
3010   }
3011 
3012   if (pcbddc->dbg_flag) {
3013     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %d (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);
3014   }
3015 
3016   /* max size of subsets */
3017   mss = 0;
3018   for (i=0;i<sub_schurs->n_subs;i++) {
3019     PetscInt subset_size;
3020 
3021     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3022     mss = PetscMax(mss,subset_size);
3023   }
3024 
3025   /* min/max and threshold */
3026   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
3027   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
3028   nmax = PetscMax(nmin,nmax);
3029   allocated_S_St = PETSC_FALSE;
3030   if (nmin || !sub_schurs->is_posdef) { /* XXX */
3031     allocated_S_St = PETSC_TRUE;
3032   }
3033 
3034   /* allocate lapack workspace */
3035   cum = cum2 = 0;
3036   maxneigs = 0;
3037   for (i=0;i<sub_schurs->n_subs;i++) {
3038     PetscInt n,subset_size;
3039 
3040     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3041     n = PetscMin(subset_size,nmax);
3042     cum += subset_size;
3043     cum2 += subset_size*n;
3044     maxneigs = PetscMax(maxneigs,n);
3045   }
3046   if (mss) {
3047     if (sub_schurs->is_symmetric) {
3048       PetscBLASInt B_itype = 1;
3049       PetscBLASInt B_N = mss;
3050       PetscReal    zero = 0.0;
3051       PetscReal    eps = 0.0; /* dlamch? */
3052 
3053       B_lwork = -1;
3054       S = NULL;
3055       St = NULL;
3056       eigs = NULL;
3057       eigv = NULL;
3058       B_iwork = NULL;
3059       B_ifail = NULL;
3060 #if defined(PETSC_USE_COMPLEX)
3061       rwork = NULL;
3062 #endif
3063       thresh = 1.0;
3064       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3065 #if defined(PETSC_USE_COMPLEX)
3066       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));
3067 #else
3068       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));
3069 #endif
3070       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3071       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3072     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3073   } else {
3074     lwork = 0;
3075   }
3076 
3077   nv = 0;
3078   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) */
3079     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
3080   }
3081   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
3082   if (allocated_S_St) {
3083     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
3084   }
3085   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
3086 #if defined(PETSC_USE_COMPLEX)
3087   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
3088 #endif
3089   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3090                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3091                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3092                       nv+cum,&pcbddc->adaptive_constraints_idxs,
3093                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
3094   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
3095 
3096   maxneigs = 0;
3097   cum = cumarray = 0;
3098   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3099   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3100   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3101     const PetscInt *idxs;
3102 
3103     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3104     for (cum=0;cum<nv;cum++) {
3105       pcbddc->adaptive_constraints_n[cum] = 1;
3106       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3107       pcbddc->adaptive_constraints_data[cum] = 1.0;
3108       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3109       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3110     }
3111     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3112   }
3113 
3114   if (mss) { /* multilevel */
3115     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3116     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3117   }
3118 
3119   lthresh = pcbddc->adaptive_threshold[0];
3120   uthresh = pcbddc->adaptive_threshold[1];
3121   for (i=0;i<sub_schurs->n_subs;i++) {
3122     const PetscInt *idxs;
3123     PetscReal      upper,lower;
3124     PetscInt       j,subset_size,eigs_start = 0;
3125     PetscBLASInt   B_N;
3126     PetscBool      same_data = PETSC_FALSE;
3127     PetscBool      scal = PETSC_FALSE;
3128 
3129     if (pcbddc->use_deluxe_scaling) {
3130       upper = PETSC_MAX_REAL;
3131       lower = uthresh;
3132     } else {
3133       if (!sub_schurs->is_posdef) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented without deluxe scaling");
3134       upper = 1./uthresh;
3135       lower = 0.;
3136     }
3137     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3138     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3139     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
3140     /* this is experimental: we assume the dofs have been properly grouped to have
3141        the diagonal blocks Schur complements either positive or negative definite (true for Stokes) */
3142     if (!sub_schurs->is_posdef) {
3143       Mat T;
3144 
3145       for (j=0;j<subset_size;j++) {
3146         if (PetscRealPart(*(Sarray+cumarray+j*(subset_size+1))) < 0.0) {
3147           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Sarray+cumarray,&T);CHKERRQ(ierr);
3148           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3149           ierr = MatDestroy(&T);CHKERRQ(ierr);
3150           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Starray+cumarray,&T);CHKERRQ(ierr);
3151           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3152           ierr = MatDestroy(&T);CHKERRQ(ierr);
3153           if (sub_schurs->change_primal_sub) {
3154             PetscInt       nz,k;
3155             const PetscInt *idxs;
3156 
3157             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nz);CHKERRQ(ierr);
3158             ierr = ISGetIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3159             for (k=0;k<nz;k++) {
3160               *( Sarray + cumarray + idxs[k]*(subset_size+1)) *= -1.0;
3161               *(Starray + cumarray + idxs[k]*(subset_size+1))  = 0.0;
3162             }
3163             ierr = ISRestoreIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3164           }
3165           scal = PETSC_TRUE;
3166           break;
3167         }
3168       }
3169     }
3170 
3171     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3172       if (sub_schurs->is_symmetric) {
3173         PetscInt j,k;
3174         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */
3175           ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3176           ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3177         }
3178         for (j=0;j<subset_size;j++) {
3179           for (k=j;k<subset_size;k++) {
3180             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3181             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3182           }
3183         }
3184       } else {
3185         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3186         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3187       }
3188     } else {
3189       S = Sarray + cumarray;
3190       St = Starray + cumarray;
3191     }
3192     /* see if we can save some work */
3193     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3194       ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr);
3195     }
3196 
3197     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3198       B_neigs = 0;
3199     } else {
3200       if (sub_schurs->is_symmetric) {
3201         PetscBLASInt B_itype = 1;
3202         PetscBLASInt B_IL, B_IU;
3203         PetscReal    eps = -1.0; /* dlamch? */
3204         PetscInt     nmin_s;
3205         PetscBool    compute_range;
3206 
3207         compute_range = (PetscBool)!same_data;
3208         if (nmin >= subset_size) compute_range = PETSC_FALSE;
3209 
3210         if (pcbddc->dbg_flag) {
3211           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Computing for sub %d/%d size %d count %d fid %d (range %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);CHKERRQ(ierr);
3212         }
3213 
3214         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3215         if (compute_range) {
3216 
3217           /* ask for eigenvalues larger than thresh */
3218           if (sub_schurs->is_posdef) {
3219 #if defined(PETSC_USE_COMPLEX)
3220             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));
3221 #else
3222             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));
3223 #endif
3224           } else { /* no theory so far, but it works nicely */
3225             PetscInt  recipe = 0;
3226             PetscReal bb[2];
3227 
3228             ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe",&recipe,NULL);CHKERRQ(ierr);
3229             switch (recipe) {
3230             case 0:
3231               if (scal) { bb[0] = PETSC_MIN_REAL; bb[1] = lthresh; }
3232               else { bb[0] = uthresh; bb[1] = PETSC_MAX_REAL; }
3233 #if defined(PETSC_USE_COMPLEX)
3234               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));
3235 #else
3236               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));
3237 #endif
3238               break;
3239             case 1:
3240               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh*lthresh;
3241 #if defined(PETSC_USE_COMPLEX)
3242               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));
3243 #else
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,B_iwork,B_ifail,&B_ierr));
3245 #endif
3246               if (!scal) {
3247                 PetscBLASInt B_neigs2;
3248 
3249                 bb[0] = uthresh; bb[1] = PETSC_MAX_REAL;
3250                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3251                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3252 #if defined(PETSC_USE_COMPLEX)
3253                 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));
3254 #else
3255                 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));
3256 #endif
3257                 B_neigs += B_neigs2;
3258               }
3259               break;
3260             default:
3261               SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Unknown recipe %D",recipe);
3262               break;
3263             }
3264           }
3265         } else if (!same_data) { /* this is just to see all the eigenvalues */
3266           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3267           B_IL = 1;
3268 #if defined(PETSC_USE_COMPLEX)
3269           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));
3270 #else
3271           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));
3272 #endif
3273         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3274           PetscInt k;
3275           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3276           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3277           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3278           nmin = nmax;
3279           ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr);
3280           for (k=0;k<nmax;k++) {
3281             eigs[k] = 1./PETSC_SMALL;
3282             eigv[k*(subset_size+1)] = 1.0;
3283           }
3284         }
3285         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3286         if (B_ierr) {
3287           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3288           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);
3289           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);
3290         }
3291 
3292         if (B_neigs > nmax) {
3293           if (pcbddc->dbg_flag) {
3294             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %d.\n",B_neigs,nmax);CHKERRQ(ierr);
3295           }
3296           if (pcbddc->use_deluxe_scaling) eigs_start = scal ? 0 : B_neigs-nmax;
3297           B_neigs = nmax;
3298         }
3299 
3300         nmin_s = PetscMin(nmin,B_N);
3301         if (B_neigs < nmin_s) {
3302           PetscBLASInt B_neigs2;
3303 
3304           if (pcbddc->use_deluxe_scaling) {
3305             if (scal) {
3306               B_IU = nmin_s;
3307               B_IL = B_neigs + 1;
3308             } else {
3309               B_IL = B_N - nmin_s + 1;
3310               B_IU = B_N - B_neigs;
3311             }
3312           } else {
3313             B_IL = B_neigs + 1;
3314             B_IU = nmin_s;
3315           }
3316           if (pcbddc->dbg_flag) {
3317             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);
3318           }
3319           if (sub_schurs->is_symmetric) {
3320             PetscInt j,k;
3321             for (j=0;j<subset_size;j++) {
3322               for (k=j;k<subset_size;k++) {
3323                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3324                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3325               }
3326             }
3327           } else {
3328             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3329             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3330           }
3331           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3332 #if defined(PETSC_USE_COMPLEX)
3333           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));
3334 #else
3335           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));
3336 #endif
3337           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3338           B_neigs += B_neigs2;
3339         }
3340         if (B_ierr) {
3341           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3342           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);
3343           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);
3344         }
3345         if (pcbddc->dbg_flag) {
3346           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3347           for (j=0;j<B_neigs;j++) {
3348             if (eigs[j] == 0.0) {
3349               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3350             } else {
3351               if (pcbddc->use_deluxe_scaling) {
3352                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3353               } else {
3354                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3355               }
3356             }
3357           }
3358         }
3359       } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3360     }
3361     /* change the basis back to the original one */
3362     if (sub_schurs->change) {
3363       Mat change,phi,phit;
3364 
3365       if (pcbddc->dbg_flag > 2) {
3366         PetscInt ii;
3367         for (ii=0;ii<B_neigs;ii++) {
3368           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3369           for (j=0;j<B_N;j++) {
3370 #if defined(PETSC_USE_COMPLEX)
3371             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3372             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3373             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3374 #else
3375             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3376 #endif
3377           }
3378         }
3379       }
3380       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3381       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3382       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3383       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3384       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3385       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3386     }
3387     maxneigs = PetscMax(B_neigs,maxneigs);
3388     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3389     if (B_neigs) {
3390       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);
3391 
3392       if (pcbddc->dbg_flag > 1) {
3393         PetscInt ii;
3394         for (ii=0;ii<B_neigs;ii++) {
3395           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3396           for (j=0;j<B_N;j++) {
3397 #if defined(PETSC_USE_COMPLEX)
3398             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3399             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3400             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3401 #else
3402             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3403 #endif
3404           }
3405         }
3406       }
3407       ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
3408       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3409       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3410       cum++;
3411     }
3412     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3413     /* shift for next computation */
3414     cumarray += subset_size*subset_size;
3415   }
3416   if (pcbddc->dbg_flag) {
3417     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3418   }
3419 
3420   if (mss) {
3421     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3422     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3423     /* destroy matrices (junk) */
3424     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3425     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3426   }
3427   if (allocated_S_St) {
3428     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3429   }
3430   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3431 #if defined(PETSC_USE_COMPLEX)
3432   ierr = PetscFree(rwork);CHKERRQ(ierr);
3433 #endif
3434   if (pcbddc->dbg_flag) {
3435     PetscInt maxneigs_r;
3436     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3437     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %d\n",maxneigs_r);CHKERRQ(ierr);
3438   }
3439   PetscFunctionReturn(0);
3440 }
3441 
3442 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3443 {
3444   PetscScalar    *coarse_submat_vals;
3445   PetscErrorCode ierr;
3446 
3447   PetscFunctionBegin;
3448   /* Setup local scatters R_to_B and (optionally) R_to_D */
3449   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3450   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3451 
3452   /* Setup local neumann solver ksp_R */
3453   /* PCBDDCSetUpLocalScatters should be called first! */
3454   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3455 
3456   /*
3457      Setup local correction and local part of coarse basis.
3458      Gives back the dense local part of the coarse matrix in column major ordering
3459   */
3460   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3461 
3462   /* Compute total number of coarse nodes and setup coarse solver */
3463   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3464 
3465   /* free */
3466   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3467   PetscFunctionReturn(0);
3468 }
3469 
3470 PetscErrorCode PCBDDCResetCustomization(PC pc)
3471 {
3472   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3473   PetscErrorCode ierr;
3474 
3475   PetscFunctionBegin;
3476   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3477   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3478   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3479   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3480   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3481   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3482   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3483   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3484   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3485   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3486   PetscFunctionReturn(0);
3487 }
3488 
3489 PetscErrorCode PCBDDCResetTopography(PC pc)
3490 {
3491   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3492   PetscInt       i;
3493   PetscErrorCode ierr;
3494 
3495   PetscFunctionBegin;
3496   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3497   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3498   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3499   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3500   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3501   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3502   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3503   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3504   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3505   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3506   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3507   for (i=0;i<pcbddc->n_local_subs;i++) {
3508     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3509   }
3510   pcbddc->n_local_subs = 0;
3511   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3512   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3513   pcbddc->graphanalyzed        = PETSC_FALSE;
3514   pcbddc->recompute_topography = PETSC_TRUE;
3515   PetscFunctionReturn(0);
3516 }
3517 
3518 PetscErrorCode PCBDDCResetSolvers(PC pc)
3519 {
3520   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3521   PetscErrorCode ierr;
3522 
3523   PetscFunctionBegin;
3524   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3525   if (pcbddc->coarse_phi_B) {
3526     PetscScalar *array;
3527     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3528     ierr = PetscFree(array);CHKERRQ(ierr);
3529   }
3530   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3531   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3532   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3533   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3534   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3535   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3536   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3537   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3538   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3539   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3540   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3541   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3542   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3543   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3544   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3545   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3546   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3547   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3548   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3549   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3550   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3551   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3552   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3553   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3554   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3555   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3556   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3557   if (pcbddc->benign_zerodiag_subs) {
3558     PetscInt i;
3559     for (i=0;i<pcbddc->benign_n;i++) {
3560       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3561     }
3562     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3563   }
3564   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3565   PetscFunctionReturn(0);
3566 }
3567 
3568 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3569 {
3570   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3571   PC_IS          *pcis = (PC_IS*)pc->data;
3572   VecType        impVecType;
3573   PetscInt       n_constraints,n_R,old_size;
3574   PetscErrorCode ierr;
3575 
3576   PetscFunctionBegin;
3577   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3578   n_R = pcis->n - pcbddc->n_vertices;
3579   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3580   /* local work vectors (try to avoid unneeded work)*/
3581   /* R nodes */
3582   old_size = -1;
3583   if (pcbddc->vec1_R) {
3584     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3585   }
3586   if (n_R != old_size) {
3587     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3588     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3589     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3590     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3591     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3592     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3593   }
3594   /* local primal dofs */
3595   old_size = -1;
3596   if (pcbddc->vec1_P) {
3597     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3598   }
3599   if (pcbddc->local_primal_size != old_size) {
3600     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3601     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3602     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3603     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3604   }
3605   /* local explicit constraints */
3606   old_size = -1;
3607   if (pcbddc->vec1_C) {
3608     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3609   }
3610   if (n_constraints && n_constraints != old_size) {
3611     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3612     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3613     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3614     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3615   }
3616   PetscFunctionReturn(0);
3617 }
3618 
3619 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3620 {
3621   PetscErrorCode  ierr;
3622   /* pointers to pcis and pcbddc */
3623   PC_IS*          pcis = (PC_IS*)pc->data;
3624   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3625   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3626   /* submatrices of local problem */
3627   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3628   /* submatrices of local coarse problem */
3629   Mat             S_VV,S_CV,S_VC,S_CC;
3630   /* working matrices */
3631   Mat             C_CR;
3632   /* additional working stuff */
3633   PC              pc_R;
3634   Mat             F,Brhs = NULL;
3635   Vec             dummy_vec;
3636   PetscBool       isLU,isCHOL,isILU,need_benign_correction,sparserhs;
3637   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3638   PetscScalar     *work;
3639   PetscInt        *idx_V_B;
3640   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3641   PetscInt        i,n_R,n_D,n_B;
3642 
3643   /* some shortcuts to scalars */
3644   PetscScalar     one=1.0,m_one=-1.0;
3645 
3646   PetscFunctionBegin;
3647   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");
3648 
3649   /* Set Non-overlapping dimensions */
3650   n_vertices = pcbddc->n_vertices;
3651   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3652   n_B = pcis->n_B;
3653   n_D = pcis->n - n_B;
3654   n_R = pcis->n - n_vertices;
3655 
3656   /* vertices in boundary numbering */
3657   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3658   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3659   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",n_vertices,i);
3660 
3661   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3662   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3663   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3664   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3665   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3666   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3667   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3668   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3669   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3670   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3671 
3672   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3673   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3674   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3675   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3676   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3677   lda_rhs = n_R;
3678   need_benign_correction = PETSC_FALSE;
3679   if (isLU || isILU || isCHOL) {
3680     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3681   } else if (sub_schurs && sub_schurs->reuse_solver) {
3682     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3683     MatFactorType      type;
3684 
3685     F = reuse_solver->F;
3686     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3687     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3688     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3689     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3690   } else {
3691     F = NULL;
3692   }
3693 
3694   /* determine if we can use a sparse right-hand side */
3695   sparserhs = PETSC_FALSE;
3696   if (F) {
3697     MatSolverType solver;
3698 
3699     ierr = MatFactorGetSolverType(F,&solver);CHKERRQ(ierr);
3700     ierr = PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs);CHKERRQ(ierr);
3701   }
3702 
3703   /* allocate workspace */
3704   n = 0;
3705   if (n_constraints) {
3706     n += lda_rhs*n_constraints;
3707   }
3708   if (n_vertices) {
3709     n = PetscMax(2*lda_rhs*n_vertices,n);
3710     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3711   }
3712   if (!pcbddc->symmetric_primal) {
3713     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3714   }
3715   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3716 
3717   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3718   dummy_vec = NULL;
3719   if (need_benign_correction && lda_rhs != n_R && F) {
3720     ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,lda_rhs,work,&dummy_vec);CHKERRQ(ierr);
3721   }
3722 
3723   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3724   if (n_constraints) {
3725     Mat         M3,C_B;
3726     IS          is_aux;
3727     PetscScalar *array,*array2;
3728 
3729     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3730     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3731 
3732     /* Extract constraints on R nodes: C_{CR}  */
3733     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
3734     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
3735     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
3736 
3737     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
3738     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
3739     if (!sparserhs) {
3740       ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
3741       for (i=0;i<n_constraints;i++) {
3742         const PetscScalar *row_cmat_values;
3743         const PetscInt    *row_cmat_indices;
3744         PetscInt          size_of_constraint,j;
3745 
3746         ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3747         for (j=0;j<size_of_constraint;j++) {
3748           work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
3749         }
3750         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3751       }
3752       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs);CHKERRQ(ierr);
3753     } else {
3754       Mat tC_CR;
3755 
3756       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
3757       if (lda_rhs != n_R) {
3758         PetscScalar *aa;
3759         PetscInt    r,*ii,*jj;
3760         PetscBool   done;
3761 
3762         ierr = MatGetRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3763         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
3764         ierr = MatSeqAIJGetArray(C_CR,&aa);CHKERRQ(ierr);
3765         ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR);CHKERRQ(ierr);
3766         ierr = MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3767         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
3768       } else {
3769         ierr  = PetscObjectReference((PetscObject)C_CR);CHKERRQ(ierr);
3770         tC_CR = C_CR;
3771       }
3772       ierr = MatCreateTranspose(tC_CR,&Brhs);CHKERRQ(ierr);
3773       ierr = MatDestroy(&tC_CR);CHKERRQ(ierr);
3774     }
3775     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
3776     if (F) {
3777       if (need_benign_correction) {
3778         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3779 
3780         /* rhs is already zero on interior dofs, no need to change the rhs */
3781         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
3782       }
3783       ierr = MatMatSolve(F,Brhs,local_auxmat2_R);CHKERRQ(ierr);
3784       if (need_benign_correction) {
3785         PetscScalar        *marr;
3786         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3787 
3788         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3789         if (lda_rhs != n_R) {
3790           for (i=0;i<n_constraints;i++) {
3791             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3792             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3793             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3794           }
3795         } else {
3796           for (i=0;i<n_constraints;i++) {
3797             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3798             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3799             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3800           }
3801         }
3802         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3803       }
3804     } else {
3805       PetscScalar *marr;
3806 
3807       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3808       for (i=0;i<n_constraints;i++) {
3809         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3810         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
3811         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3812         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3813         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3814       }
3815       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3816     }
3817     if (sparserhs) {
3818       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
3819     }
3820     ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
3821     if (!pcbddc->switch_static) {
3822       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3823       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3824       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3825       for (i=0;i<n_constraints;i++) {
3826         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
3827         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
3828         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3829         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3830         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3831         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3832       }
3833       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3834       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3835       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3836     } else {
3837       if (lda_rhs != n_R) {
3838         IS dummy;
3839 
3840         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
3841         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3842         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
3843       } else {
3844         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
3845         pcbddc->local_auxmat2 = local_auxmat2_R;
3846       }
3847       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3848     }
3849     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3850     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
3851     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
3852     if (isCHOL) {
3853       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
3854     } else {
3855       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
3856     }
3857     ierr = MatSeqDenseInvertFactors_Private(M3);CHKERRQ(ierr);
3858     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
3859     ierr = MatMatMult(M3,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
3860     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
3861     ierr = MatCopy(M3,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
3862     ierr = MatDestroy(&M3);CHKERRQ(ierr);
3863   }
3864 
3865   /* Get submatrices from subdomain matrix */
3866   if (n_vertices) {
3867     IS        is_aux;
3868     PetscBool isseqaij;
3869 
3870     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
3871       IS tis;
3872 
3873       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
3874       ierr = ISSort(tis);CHKERRQ(ierr);
3875       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
3876       ierr = ISDestroy(&tis);CHKERRQ(ierr);
3877     } else {
3878       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
3879     }
3880     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3881     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3882     ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
3883     if (!isseqaij) { /* MatMatMult(A_VR,A_RRmA_RV) below will raise an error */
3884       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
3885     }
3886     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3887     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3888   }
3889 
3890   /* Matrix of coarse basis functions (local) */
3891   if (pcbddc->coarse_phi_B) {
3892     PetscInt on_B,on_primal,on_D=n_D;
3893     if (pcbddc->coarse_phi_D) {
3894       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
3895     }
3896     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
3897     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
3898       PetscScalar *marray;
3899 
3900       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
3901       ierr = PetscFree(marray);CHKERRQ(ierr);
3902       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3903       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3904       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3905       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3906     }
3907   }
3908 
3909   if (!pcbddc->coarse_phi_B) {
3910     PetscScalar *marr;
3911 
3912     /* memory size */
3913     n = n_B*pcbddc->local_primal_size;
3914     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
3915     if (!pcbddc->symmetric_primal) n *= 2;
3916     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
3917     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3918     marr += n_B*pcbddc->local_primal_size;
3919     if (pcbddc->switch_static || pcbddc->dbg_flag) {
3920       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3921       marr += n_D*pcbddc->local_primal_size;
3922     }
3923     if (!pcbddc->symmetric_primal) {
3924       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3925       marr += n_B*pcbddc->local_primal_size;
3926       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3927         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3928       }
3929     } else {
3930       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
3931       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
3932       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3933         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
3934         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
3935       }
3936     }
3937   }
3938 
3939   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
3940   p0_lidx_I = NULL;
3941   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
3942     const PetscInt *idxs;
3943 
3944     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3945     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
3946     for (i=0;i<pcbddc->benign_n;i++) {
3947       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
3948     }
3949     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3950   }
3951 
3952   /* vertices */
3953   if (n_vertices) {
3954     PetscBool restoreavr = PETSC_FALSE;
3955 
3956     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
3957 
3958     if (n_R) {
3959       Mat          A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
3960       PetscBLASInt B_N,B_one = 1;
3961       PetscScalar  *x,*y;
3962 
3963       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
3964       if (need_benign_correction) {
3965         ISLocalToGlobalMapping RtoN;
3966         IS                     is_p0;
3967         PetscInt               *idxs_p0,n;
3968 
3969         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
3970         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
3971         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
3972         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);
3973         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
3974         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
3975         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
3976         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3977       }
3978 
3979       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3980       if (!sparserhs || need_benign_correction) {
3981         if (lda_rhs == n_R) {
3982           ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3983         } else {
3984           PetscScalar    *av,*array;
3985           const PetscInt *xadj,*adjncy;
3986           PetscInt       n;
3987           PetscBool      flg_row;
3988 
3989           array = work+lda_rhs*n_vertices;
3990           ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3991           ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3992           ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3993           ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
3994           for (i=0;i<n;i++) {
3995             PetscInt j;
3996             for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
3997           }
3998           ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3999           ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4000           ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
4001         }
4002         if (need_benign_correction) {
4003           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4004           PetscScalar        *marr;
4005 
4006           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
4007           /* need \Phi^T A_RV = (I+L)A_RV, L given by
4008 
4009                  | 0 0  0 | (V)
4010              L = | 0 0 -1 | (P-p0)
4011                  | 0 0 -1 | (p0)
4012 
4013           */
4014           for (i=0;i<reuse_solver->benign_n;i++) {
4015             const PetscScalar *vals;
4016             const PetscInt    *idxs,*idxs_zero;
4017             PetscInt          n,j,nz;
4018 
4019             ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4020             ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4021             ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4022             for (j=0;j<n;j++) {
4023               PetscScalar val = vals[j];
4024               PetscInt    k,col = idxs[j];
4025               for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
4026             }
4027             ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4028             ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4029           }
4030           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
4031         }
4032         ierr = PetscObjectReference((PetscObject)A_RV);CHKERRQ(ierr);
4033         Brhs = A_RV;
4034       } else {
4035         Mat tA_RVT,A_RVT;
4036 
4037         if (!pcbddc->symmetric_primal) {
4038           /* A_RV already scaled by -1 */
4039           ierr = MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT);CHKERRQ(ierr);
4040         } else {
4041           restoreavr = PETSC_TRUE;
4042           ierr  = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4043           ierr  = PetscObjectReference((PetscObject)A_VR);CHKERRQ(ierr);
4044           A_RVT = A_VR;
4045         }
4046         if (lda_rhs != n_R) {
4047           PetscScalar *aa;
4048           PetscInt    r,*ii,*jj;
4049           PetscBool   done;
4050 
4051           ierr = MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4052           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4053           ierr = MatSeqAIJGetArray(A_RVT,&aa);CHKERRQ(ierr);
4054           ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT);CHKERRQ(ierr);
4055           ierr = MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4056           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4057         } else {
4058           ierr   = PetscObjectReference((PetscObject)A_RVT);CHKERRQ(ierr);
4059           tA_RVT = A_RVT;
4060         }
4061         ierr = MatCreateTranspose(tA_RVT,&Brhs);CHKERRQ(ierr);
4062         ierr = MatDestroy(&tA_RVT);CHKERRQ(ierr);
4063         ierr = MatDestroy(&A_RVT);CHKERRQ(ierr);
4064       }
4065       if (F) {
4066         /* need to correct the rhs */
4067         if (need_benign_correction) {
4068           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4069           PetscScalar        *marr;
4070 
4071           ierr = MatDenseGetArray(Brhs,&marr);CHKERRQ(ierr);
4072           if (lda_rhs != n_R) {
4073             for (i=0;i<n_vertices;i++) {
4074               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4075               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4076               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4077             }
4078           } else {
4079             for (i=0;i<n_vertices;i++) {
4080               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4081               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4082               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4083             }
4084           }
4085           ierr = MatDenseRestoreArray(Brhs,&marr);CHKERRQ(ierr);
4086         }
4087         ierr = MatMatSolve(F,Brhs,A_RRmA_RV);CHKERRQ(ierr);
4088         if (restoreavr) {
4089           ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4090         }
4091         /* need to correct the solution */
4092         if (need_benign_correction) {
4093           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4094           PetscScalar        *marr;
4095 
4096           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4097           if (lda_rhs != n_R) {
4098             for (i=0;i<n_vertices;i++) {
4099               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4100               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4101               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4102             }
4103           } else {
4104             for (i=0;i<n_vertices;i++) {
4105               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4106               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4107               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4108             }
4109           }
4110           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4111         }
4112       } else {
4113         ierr = MatDenseGetArray(Brhs,&y);CHKERRQ(ierr);
4114         for (i=0;i<n_vertices;i++) {
4115           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
4116           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
4117           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4118           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4119           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4120         }
4121         ierr = MatDenseRestoreArray(Brhs,&y);CHKERRQ(ierr);
4122       }
4123       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4124       ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4125       /* S_VV and S_CV */
4126       if (n_constraints) {
4127         Mat B;
4128 
4129         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
4130         for (i=0;i<n_vertices;i++) {
4131           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4132           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
4133           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4134           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4135           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4136           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4137         }
4138         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4139         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
4140         ierr = MatDestroy(&B);CHKERRQ(ierr);
4141         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4142         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4143         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
4144         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
4145         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
4146         ierr = MatDestroy(&B);CHKERRQ(ierr);
4147       }
4148       if (lda_rhs != n_R) {
4149         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4150         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4151         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
4152       }
4153       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
4154       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
4155       if (need_benign_correction) {
4156         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4157         PetscScalar      *marr,*sums;
4158 
4159         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
4160         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
4161         for (i=0;i<reuse_solver->benign_n;i++) {
4162           const PetscScalar *vals;
4163           const PetscInt    *idxs,*idxs_zero;
4164           PetscInt          n,j,nz;
4165 
4166           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4167           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4168           for (j=0;j<n_vertices;j++) {
4169             PetscInt k;
4170             sums[j] = 0.;
4171             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
4172           }
4173           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4174           for (j=0;j<n;j++) {
4175             PetscScalar val = vals[j];
4176             PetscInt k;
4177             for (k=0;k<n_vertices;k++) {
4178               marr[idxs[j]+k*n_vertices] += val*sums[k];
4179             }
4180           }
4181           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4182           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4183         }
4184         ierr = PetscFree(sums);CHKERRQ(ierr);
4185         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
4186         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
4187       }
4188       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4189       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
4190       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
4191       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
4192       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4193       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
4194       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
4195       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4196       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
4197     } else {
4198       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4199     }
4200     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
4201 
4202     /* coarse basis functions */
4203     for (i=0;i<n_vertices;i++) {
4204       PetscScalar *y;
4205 
4206       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4207       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4208       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4209       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4210       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4211       y[n_B*i+idx_V_B[i]] = 1.0;
4212       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4213       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4214 
4215       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4216         PetscInt j;
4217 
4218         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4219         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4220         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4221         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4222         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4223         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4224         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4225       }
4226       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4227     }
4228     /* if n_R == 0 the object is not destroyed */
4229     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4230   }
4231   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4232 
4233   if (n_constraints) {
4234     Mat B;
4235 
4236     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4237     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4238     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4239     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4240     if (n_vertices) {
4241       if (isCHOL || need_benign_correction) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4242         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4243       } else {
4244         Mat S_VCt;
4245 
4246         if (lda_rhs != n_R) {
4247           ierr = MatDestroy(&B);CHKERRQ(ierr);
4248           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4249           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4250         }
4251         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4252         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4253         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4254       }
4255     }
4256     ierr = MatDestroy(&B);CHKERRQ(ierr);
4257     /* coarse basis functions */
4258     for (i=0;i<n_constraints;i++) {
4259       PetscScalar *y;
4260 
4261       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4262       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4263       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4264       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4265       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4266       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4267       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4268       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4269         PetscInt j;
4270 
4271         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4272         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4273         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4274         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4275         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4276         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4277         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4278       }
4279       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4280     }
4281   }
4282   if (n_constraints) {
4283     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4284   }
4285   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4286 
4287   /* coarse matrix entries relative to B_0 */
4288   if (pcbddc->benign_n) {
4289     Mat         B0_B,B0_BPHI;
4290     IS          is_dummy;
4291     PetscScalar *data;
4292     PetscInt    j;
4293 
4294     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4295     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4296     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4297     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4298     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4299     ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr);
4300     for (j=0;j<pcbddc->benign_n;j++) {
4301       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4302       for (i=0;i<pcbddc->local_primal_size;i++) {
4303         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4304         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4305       }
4306     }
4307     ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr);
4308     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4309     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4310   }
4311 
4312   /* compute other basis functions for non-symmetric problems */
4313   if (!pcbddc->symmetric_primal) {
4314     Mat         B_V=NULL,B_C=NULL;
4315     PetscScalar *marray;
4316 
4317     if (n_constraints) {
4318       Mat S_CCT,C_CRT;
4319 
4320       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4321       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4322       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4323       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4324       if (n_vertices) {
4325         Mat S_VCT;
4326 
4327         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4328         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4329         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4330       }
4331       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4332     } else {
4333       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4334     }
4335     if (n_vertices && n_R) {
4336       PetscScalar    *av,*marray;
4337       const PetscInt *xadj,*adjncy;
4338       PetscInt       n;
4339       PetscBool      flg_row;
4340 
4341       /* B_V = B_V - A_VR^T */
4342       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4343       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4344       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4345       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4346       for (i=0;i<n;i++) {
4347         PetscInt j;
4348         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4349       }
4350       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4351       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4352       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4353     }
4354 
4355     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4356     if (n_vertices) {
4357       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4358       for (i=0;i<n_vertices;i++) {
4359         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4360         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4361         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4362         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4363         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4364       }
4365       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4366     }
4367     if (B_C) {
4368       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4369       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4370         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4371         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4372         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4373         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4374         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4375       }
4376       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4377     }
4378     /* coarse basis functions */
4379     for (i=0;i<pcbddc->local_primal_size;i++) {
4380       PetscScalar *y;
4381 
4382       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4383       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4384       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);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       if (i<n_vertices) {
4388         y[n_B*i+idx_V_B[i]] = 1.0;
4389       }
4390       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4391       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4392 
4393       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4394         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4395         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4396         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4397         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4398         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4399         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4400       }
4401       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4402     }
4403     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4404     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4405   }
4406 
4407   /* free memory */
4408   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4409   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4410   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4411   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4412   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4413   ierr = PetscFree(work);CHKERRQ(ierr);
4414   if (n_vertices) {
4415     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4416   }
4417   if (n_constraints) {
4418     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4419   }
4420   /* Checking coarse_sub_mat and coarse basis functios */
4421   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4422   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4423   if (pcbddc->dbg_flag) {
4424     Mat         coarse_sub_mat;
4425     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4426     Mat         coarse_phi_D,coarse_phi_B;
4427     Mat         coarse_psi_D,coarse_psi_B;
4428     Mat         A_II,A_BB,A_IB,A_BI;
4429     Mat         C_B,CPHI;
4430     IS          is_dummy;
4431     Vec         mones;
4432     MatType     checkmattype=MATSEQAIJ;
4433     PetscReal   real_value;
4434 
4435     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4436       Mat A;
4437       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4438       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4439       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4440       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4441       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4442       ierr = MatDestroy(&A);CHKERRQ(ierr);
4443     } else {
4444       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4445       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4446       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4447       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4448     }
4449     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4450     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4451     if (!pcbddc->symmetric_primal) {
4452       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4453       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4454     }
4455     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4456 
4457     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4458     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4459     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4460     if (!pcbddc->symmetric_primal) {
4461       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4462       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4463       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4464       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4465       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4466       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4467       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4468       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4469       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4470       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4471       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4472       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4473     } else {
4474       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4475       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4476       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4477       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4478       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4479       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4480       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4481       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4482     }
4483     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4484     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4485     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4486     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4487     if (pcbddc->benign_n) {
4488       Mat         B0_B,B0_BPHI;
4489       PetscScalar *data,*data2;
4490       PetscInt    j;
4491 
4492       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4493       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4494       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4495       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4496       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4497       ierr = MatDenseGetArray(B0_BPHI,&data2);CHKERRQ(ierr);
4498       for (j=0;j<pcbddc->benign_n;j++) {
4499         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4500         for (i=0;i<pcbddc->local_primal_size;i++) {
4501           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4502           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4503         }
4504       }
4505       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4506       ierr = MatDenseRestoreArray(B0_BPHI,&data2);CHKERRQ(ierr);
4507       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4508       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4509       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4510     }
4511 #if 0
4512   {
4513     PetscViewer viewer;
4514     char filename[256];
4515     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4516     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4517     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4518     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4519     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4520     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4521     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4522     if (pcbddc->coarse_phi_B) {
4523       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4524       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4525     }
4526     if (pcbddc->coarse_phi_D) {
4527       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4528       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4529     }
4530     if (pcbddc->coarse_psi_B) {
4531       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4532       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4533     }
4534     if (pcbddc->coarse_psi_D) {
4535       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4536       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4537     }
4538     ierr = PetscObjectSetName((PetscObject)pcbddc->local_mat,"A");CHKERRQ(ierr);
4539     ierr = MatView(pcbddc->local_mat,viewer);CHKERRQ(ierr);
4540     ierr = PetscObjectSetName((PetscObject)pcbddc->ConstraintMatrix,"C");CHKERRQ(ierr);
4541     ierr = MatView(pcbddc->ConstraintMatrix,viewer);CHKERRQ(ierr);
4542     ierr = PetscObjectSetName((PetscObject)pcis->is_I_local,"I");CHKERRQ(ierr);
4543     ierr = ISView(pcis->is_I_local,viewer);CHKERRQ(ierr);
4544     ierr = PetscObjectSetName((PetscObject)pcis->is_B_local,"B");CHKERRQ(ierr);
4545     ierr = ISView(pcis->is_B_local,viewer);CHKERRQ(ierr);
4546     ierr = PetscObjectSetName((PetscObject)pcbddc->is_R_local,"R");CHKERRQ(ierr);
4547     ierr = ISView(pcbddc->is_R_local,viewer);CHKERRQ(ierr);
4548     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4549   }
4550 #endif
4551     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4552     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4553     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4554     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4555 
4556     /* check constraints */
4557     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4558     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4559     if (!pcbddc->benign_n) { /* TODO: add benign case */
4560       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4561     } else {
4562       PetscScalar *data;
4563       Mat         tmat;
4564       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4565       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4566       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4567       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4568       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4569     }
4570     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4571     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4572     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4573     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4574     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4575     if (!pcbddc->symmetric_primal) {
4576       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4577       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4578       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4579       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4580       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4581     }
4582     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4583     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4584     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4585     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4586     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4587     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4588     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4589     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4590     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4591     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4592     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4593     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4594     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4595     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4596     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4597     if (!pcbddc->symmetric_primal) {
4598       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4599       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4600     }
4601     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4602   }
4603   /* get back data */
4604   *coarse_submat_vals_n = coarse_submat_vals;
4605   PetscFunctionReturn(0);
4606 }
4607 
4608 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4609 {
4610   Mat            *work_mat;
4611   IS             isrow_s,iscol_s;
4612   PetscBool      rsorted,csorted;
4613   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4614   PetscErrorCode ierr;
4615 
4616   PetscFunctionBegin;
4617   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4618   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4619   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4620   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4621 
4622   if (!rsorted) {
4623     const PetscInt *idxs;
4624     PetscInt *idxs_sorted,i;
4625 
4626     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4627     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4628     for (i=0;i<rsize;i++) {
4629       idxs_perm_r[i] = i;
4630     }
4631     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4632     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4633     for (i=0;i<rsize;i++) {
4634       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4635     }
4636     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4637     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4638   } else {
4639     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4640     isrow_s = isrow;
4641   }
4642 
4643   if (!csorted) {
4644     if (isrow == iscol) {
4645       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4646       iscol_s = isrow_s;
4647     } else {
4648       const PetscInt *idxs;
4649       PetscInt       *idxs_sorted,i;
4650 
4651       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4652       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4653       for (i=0;i<csize;i++) {
4654         idxs_perm_c[i] = i;
4655       }
4656       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4657       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4658       for (i=0;i<csize;i++) {
4659         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4660       }
4661       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4662       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4663     }
4664   } else {
4665     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4666     iscol_s = iscol;
4667   }
4668 
4669   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4670 
4671   if (!rsorted || !csorted) {
4672     Mat      new_mat;
4673     IS       is_perm_r,is_perm_c;
4674 
4675     if (!rsorted) {
4676       PetscInt *idxs_r,i;
4677       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4678       for (i=0;i<rsize;i++) {
4679         idxs_r[idxs_perm_r[i]] = i;
4680       }
4681       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4682       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4683     } else {
4684       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4685     }
4686     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4687 
4688     if (!csorted) {
4689       if (isrow_s == iscol_s) {
4690         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4691         is_perm_c = is_perm_r;
4692       } else {
4693         PetscInt *idxs_c,i;
4694         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4695         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4696         for (i=0;i<csize;i++) {
4697           idxs_c[idxs_perm_c[i]] = i;
4698         }
4699         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4700         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4701       }
4702     } else {
4703       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4704     }
4705     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4706 
4707     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4708     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4709     work_mat[0] = new_mat;
4710     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4711     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4712   }
4713 
4714   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4715   *B = work_mat[0];
4716   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4717   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4718   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4719   PetscFunctionReturn(0);
4720 }
4721 
4722 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
4723 {
4724   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
4725   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4726   Mat            new_mat,lA;
4727   IS             is_local,is_global;
4728   PetscInt       local_size;
4729   PetscBool      isseqaij;
4730   PetscErrorCode ierr;
4731 
4732   PetscFunctionBegin;
4733   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4734   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
4735   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
4736   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
4737   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
4738   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
4739   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
4740 
4741   /* check */
4742   if (pcbddc->dbg_flag) {
4743     Vec       x,x_change;
4744     PetscReal error;
4745 
4746     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
4747     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
4748     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
4749     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4750     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4751     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
4752     if (!pcbddc->change_interior) {
4753       const PetscScalar *x,*y,*v;
4754       PetscReal         lerror = 0.;
4755       PetscInt          i;
4756 
4757       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
4758       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
4759       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
4760       for (i=0;i<local_size;i++)
4761         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
4762           lerror = PetscAbsScalar(x[i]-y[i]);
4763       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
4764       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
4765       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
4766       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4767       if (error > PETSC_SMALL) {
4768         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4769           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e\n",error);
4770         } else {
4771           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e\n",error);
4772         }
4773       }
4774     }
4775     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4776     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4777     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
4778     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
4779     if (error > PETSC_SMALL) {
4780       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4781         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
4782       } else {
4783         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e\n",error);
4784       }
4785     }
4786     ierr = VecDestroy(&x);CHKERRQ(ierr);
4787     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
4788   }
4789 
4790   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
4791   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
4792 
4793   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
4794   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4795   if (isseqaij) {
4796     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4797     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4798     if (lA) {
4799       Mat work;
4800       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4801       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4802       ierr = MatDestroy(&work);CHKERRQ(ierr);
4803     }
4804   } else {
4805     Mat work_mat;
4806 
4807     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4808     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4809     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4810     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
4811     if (lA) {
4812       Mat work;
4813       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4814       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4815       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4816       ierr = MatDestroy(&work);CHKERRQ(ierr);
4817     }
4818   }
4819   if (matis->A->symmetric_set) {
4820     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
4821 #if !defined(PETSC_USE_COMPLEX)
4822     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
4823 #endif
4824   }
4825   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
4826   PetscFunctionReturn(0);
4827 }
4828 
4829 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
4830 {
4831   PC_IS*          pcis = (PC_IS*)(pc->data);
4832   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
4833   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4834   PetscInt        *idx_R_local=NULL;
4835   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
4836   PetscInt        vbs,bs;
4837   PetscBT         bitmask=NULL;
4838   PetscErrorCode  ierr;
4839 
4840   PetscFunctionBegin;
4841   /*
4842     No need to setup local scatters if
4843       - primal space is unchanged
4844         AND
4845       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
4846         AND
4847       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
4848   */
4849   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
4850     PetscFunctionReturn(0);
4851   }
4852   /* destroy old objects */
4853   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
4854   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
4855   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
4856   /* Set Non-overlapping dimensions */
4857   n_B = pcis->n_B;
4858   n_D = pcis->n - n_B;
4859   n_vertices = pcbddc->n_vertices;
4860 
4861   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
4862 
4863   /* create auxiliary bitmask and allocate workspace */
4864   if (!sub_schurs || !sub_schurs->reuse_solver) {
4865     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
4866     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
4867     for (i=0;i<n_vertices;i++) {
4868       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
4869     }
4870 
4871     for (i=0, n_R=0; i<pcis->n; i++) {
4872       if (!PetscBTLookup(bitmask,i)) {
4873         idx_R_local[n_R++] = i;
4874       }
4875     }
4876   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
4877     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4878 
4879     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4880     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
4881   }
4882 
4883   /* Block code */
4884   vbs = 1;
4885   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
4886   if (bs>1 && !(n_vertices%bs)) {
4887     PetscBool is_blocked = PETSC_TRUE;
4888     PetscInt  *vary;
4889     if (!sub_schurs || !sub_schurs->reuse_solver) {
4890       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
4891       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
4892       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
4893       /* 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 */
4894       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
4895       for (i=0; i<pcis->n/bs; i++) {
4896         if (vary[i]!=0 && vary[i]!=bs) {
4897           is_blocked = PETSC_FALSE;
4898           break;
4899         }
4900       }
4901       ierr = PetscFree(vary);CHKERRQ(ierr);
4902     } else {
4903       /* Verify directly the R set */
4904       for (i=0; i<n_R/bs; i++) {
4905         PetscInt j,node=idx_R_local[bs*i];
4906         for (j=1; j<bs; j++) {
4907           if (node != idx_R_local[bs*i+j]-j) {
4908             is_blocked = PETSC_FALSE;
4909             break;
4910           }
4911         }
4912       }
4913     }
4914     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
4915       vbs = bs;
4916       for (i=0;i<n_R/vbs;i++) {
4917         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
4918       }
4919     }
4920   }
4921   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
4922   if (sub_schurs && sub_schurs->reuse_solver) {
4923     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4924 
4925     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4926     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
4927     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
4928     reuse_solver->is_R = pcbddc->is_R_local;
4929   } else {
4930     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
4931   }
4932 
4933   /* print some info if requested */
4934   if (pcbddc->dbg_flag) {
4935     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4936     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4937     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4938     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
4939     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
4940     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);
4941     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4942   }
4943 
4944   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
4945   if (!sub_schurs || !sub_schurs->reuse_solver) {
4946     IS       is_aux1,is_aux2;
4947     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
4948 
4949     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4950     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
4951     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
4952     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4953     for (i=0; i<n_D; i++) {
4954       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
4955     }
4956     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4957     for (i=0, j=0; i<n_R; i++) {
4958       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
4959         aux_array1[j++] = i;
4960       }
4961     }
4962     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4963     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4964     for (i=0, j=0; i<n_B; i++) {
4965       if (!PetscBTLookup(bitmask,is_indices[i])) {
4966         aux_array2[j++] = i;
4967       }
4968     }
4969     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4970     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
4971     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
4972     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4973     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
4974 
4975     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4976       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
4977       for (i=0, j=0; i<n_R; i++) {
4978         if (PetscBTLookup(bitmask,idx_R_local[i])) {
4979           aux_array1[j++] = i;
4980         }
4981       }
4982       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4983       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4984       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4985     }
4986     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
4987     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4988   } else {
4989     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4990     IS                 tis;
4991     PetscInt           schur_size;
4992 
4993     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
4994     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
4995     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
4996     ierr = ISDestroy(&tis);CHKERRQ(ierr);
4997     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4998       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
4999       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5000       ierr = ISDestroy(&tis);CHKERRQ(ierr);
5001     }
5002   }
5003   PetscFunctionReturn(0);
5004 }
5005 
5006 
5007 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
5008 {
5009   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
5010   PC_IS          *pcis = (PC_IS*)pc->data;
5011   PC             pc_temp;
5012   Mat            A_RR;
5013   MatReuse       reuse;
5014   PetscScalar    m_one = -1.0;
5015   PetscReal      value;
5016   PetscInt       n_D,n_R;
5017   PetscBool      check_corr,issbaij;
5018   PetscErrorCode ierr;
5019   /* prefixes stuff */
5020   char           dir_prefix[256],neu_prefix[256],str_level[16];
5021   size_t         len;
5022 
5023   PetscFunctionBegin;
5024 
5025   /* compute prefixes */
5026   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
5027   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
5028   if (!pcbddc->current_level) {
5029     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
5030     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
5031     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
5032     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
5033   } else {
5034     ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
5035     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
5036     len -= 15; /* remove "pc_bddc_coarse_" */
5037     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
5038     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
5039     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5040     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5041     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
5042     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
5043     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
5044     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
5045   }
5046 
5047   /* DIRICHLET PROBLEM */
5048   if (dirichlet) {
5049     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5050     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
5051       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented\n");
5052       if (pcbddc->dbg_flag) {
5053         Mat    A_IIn;
5054 
5055         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
5056         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
5057         pcis->A_II = A_IIn;
5058       }
5059     }
5060     if (pcbddc->local_mat->symmetric_set) {
5061       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
5062     }
5063     /* Matrix for Dirichlet problem is pcis->A_II */
5064     n_D = pcis->n - pcis->n_B;
5065     if (!pcbddc->ksp_D) { /* create object if not yet build */
5066       void (*f)(void) = 0;
5067 
5068       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
5069       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
5070       /* default */
5071       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
5072       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
5073       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5074       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5075       if (issbaij) {
5076         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5077       } else {
5078         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5079       }
5080       /* Allow user's customization */
5081       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
5082       ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5083       if (f && pcbddc->mat_graph->cloc) {
5084         PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5085         const PetscInt *idxs;
5086         PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5087 
5088         ierr = ISGetLocalSize(pcis->is_I_local,&nl);CHKERRQ(ierr);
5089         ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5090         ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5091         for (i=0;i<nl;i++) {
5092           for (d=0;d<cdim;d++) {
5093             scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5094           }
5095         }
5096         ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5097         ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5098         ierr = PetscFree(scoords);CHKERRQ(ierr);
5099       }
5100     }
5101     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
5102     if (sub_schurs && sub_schurs->reuse_solver) {
5103       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5104 
5105       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
5106     }
5107     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5108     if (!n_D) {
5109       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5110       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5111     }
5112     /* Set Up KSP for Dirichlet problem of BDDC */
5113     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
5114     /* set ksp_D into pcis data */
5115     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
5116     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
5117     pcis->ksp_D = pcbddc->ksp_D;
5118   }
5119 
5120   /* NEUMANN PROBLEM */
5121   A_RR = 0;
5122   if (neumann) {
5123     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5124     PetscInt        ibs,mbs;
5125     PetscBool       issbaij, reuse_neumann_solver;
5126     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
5127 
5128     reuse_neumann_solver = PETSC_FALSE;
5129     if (sub_schurs && sub_schurs->reuse_solver) {
5130       IS iP;
5131 
5132       reuse_neumann_solver = PETSC_TRUE;
5133       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
5134       if (iP) reuse_neumann_solver = PETSC_FALSE;
5135     }
5136     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
5137     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
5138     if (pcbddc->ksp_R) { /* already created ksp */
5139       PetscInt nn_R;
5140       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
5141       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5142       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
5143       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
5144         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
5145         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5146         reuse = MAT_INITIAL_MATRIX;
5147       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5148         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5149           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5150           reuse = MAT_INITIAL_MATRIX;
5151         } else { /* safe to reuse the matrix */
5152           reuse = MAT_REUSE_MATRIX;
5153         }
5154       }
5155       /* last check */
5156       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5157         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5158         reuse = MAT_INITIAL_MATRIX;
5159       }
5160     } else { /* first time, so we need to create the matrix */
5161       reuse = MAT_INITIAL_MATRIX;
5162     }
5163     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
5164     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5165     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5166     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5167     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5168       if (matis->A == pcbddc->local_mat) {
5169         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5170         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5171       } else {
5172         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5173       }
5174     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5175       if (matis->A == pcbddc->local_mat) {
5176         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5177         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5178       } else {
5179         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5180       }
5181     }
5182     /* extract A_RR */
5183     if (reuse_neumann_solver) {
5184       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5185 
5186       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5187         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5188         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5189           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5190         } else {
5191           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5192         }
5193       } else {
5194         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5195         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5196         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5197       }
5198     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5199       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5200     }
5201     if (pcbddc->local_mat->symmetric_set) {
5202       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
5203     }
5204     if (!pcbddc->ksp_R) { /* create object if not present */
5205       void (*f)(void) = 0;
5206 
5207       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5208       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5209       /* default */
5210       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5211       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5212       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5213       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5214       if (issbaij) {
5215         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5216       } else {
5217         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5218       }
5219       /* Allow user's customization */
5220       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5221       ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5222       if (f && pcbddc->mat_graph->cloc) {
5223         PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5224         const PetscInt *idxs;
5225         PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5226 
5227         ierr = ISGetLocalSize(pcbddc->is_R_local,&nl);CHKERRQ(ierr);
5228         ierr = ISGetIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5229         ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5230         for (i=0;i<nl;i++) {
5231           for (d=0;d<cdim;d++) {
5232             scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5233           }
5234         }
5235         ierr = ISRestoreIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5236         ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5237         ierr = PetscFree(scoords);CHKERRQ(ierr);
5238       }
5239     }
5240     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5241     if (!n_R) {
5242       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5243       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5244     }
5245     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5246     /* Reuse solver if it is present */
5247     if (reuse_neumann_solver) {
5248       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5249 
5250       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5251     }
5252     /* Set Up KSP for Neumann problem of BDDC */
5253     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
5254   }
5255 
5256   if (pcbddc->dbg_flag) {
5257     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5258     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5259     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5260   }
5261 
5262   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5263   check_corr = PETSC_FALSE;
5264   if (pcbddc->NullSpace_corr[0]) {
5265     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5266   }
5267   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5268     check_corr = PETSC_TRUE;
5269     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5270   }
5271   if (neumann && pcbddc->NullSpace_corr[2]) {
5272     check_corr = PETSC_TRUE;
5273     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5274   }
5275   /* check Dirichlet and Neumann solvers */
5276   if (pcbddc->dbg_flag) {
5277     if (dirichlet) { /* Dirichlet */
5278       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5279       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5280       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5281       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5282       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5283       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);
5284       if (check_corr) {
5285         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_TRUE);CHKERRQ(ierr);
5286       }
5287       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5288     }
5289     if (neumann) { /* Neumann */
5290       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5291       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5292       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5293       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5294       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5295       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);
5296       if (check_corr) {
5297         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_FALSE);CHKERRQ(ierr);
5298       }
5299       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5300     }
5301   }
5302   /* free Neumann problem's matrix */
5303   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5304   PetscFunctionReturn(0);
5305 }
5306 
5307 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5308 {
5309   PetscErrorCode  ierr;
5310   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5311   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5312   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5313 
5314   PetscFunctionBegin;
5315   if (!reuse_solver) {
5316     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5317   }
5318   if (!pcbddc->switch_static) {
5319     if (applytranspose && pcbddc->local_auxmat1) {
5320       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5321       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5322     }
5323     if (!reuse_solver) {
5324       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5325       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5326     } else {
5327       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5328 
5329       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5330       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5331     }
5332   } else {
5333     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5334     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5335     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5336     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5337     if (applytranspose && pcbddc->local_auxmat1) {
5338       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5339       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5340       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5341       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5342     }
5343   }
5344   if (!reuse_solver || pcbddc->switch_static) {
5345     if (applytranspose) {
5346       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5347     } else {
5348       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5349     }
5350   } else {
5351     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5352 
5353     if (applytranspose) {
5354       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5355     } else {
5356       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5357     }
5358   }
5359   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5360   if (!pcbddc->switch_static) {
5361     if (!reuse_solver) {
5362       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5363       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5364     } else {
5365       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5366 
5367       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5368       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5369     }
5370     if (!applytranspose && pcbddc->local_auxmat1) {
5371       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5372       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5373     }
5374   } else {
5375     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5376     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5377     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5378     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5379     if (!applytranspose && pcbddc->local_auxmat1) {
5380       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5381       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5382     }
5383     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5384     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5385     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5386     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5387   }
5388   PetscFunctionReturn(0);
5389 }
5390 
5391 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5392 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5393 {
5394   PetscErrorCode ierr;
5395   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5396   PC_IS*            pcis = (PC_IS*)  (pc->data);
5397   const PetscScalar zero = 0.0;
5398 
5399   PetscFunctionBegin;
5400   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5401   if (!pcbddc->benign_apply_coarse_only) {
5402     if (applytranspose) {
5403       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5404       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5405     } else {
5406       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5407       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5408     }
5409   } else {
5410     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5411   }
5412 
5413   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5414   if (pcbddc->benign_n) {
5415     PetscScalar *array;
5416     PetscInt    j;
5417 
5418     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5419     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5420     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5421   }
5422 
5423   /* start communications from local primal nodes to rhs of coarse solver */
5424   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5425   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5426   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5427 
5428   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5429   if (pcbddc->coarse_ksp) {
5430     Mat          coarse_mat;
5431     Vec          rhs,sol;
5432     MatNullSpace nullsp;
5433     PetscBool    isbddc = PETSC_FALSE;
5434 
5435     if (pcbddc->benign_have_null) {
5436       PC        coarse_pc;
5437 
5438       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5439       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5440       /* we need to propagate to coarser levels the need for a possible benign correction */
5441       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5442         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5443         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5444         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5445       }
5446     }
5447     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5448     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5449     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5450     ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5451     if (nullsp) {
5452       ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5453     }
5454     if (applytranspose) {
5455       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5456       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5457     } else {
5458       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5459         PC        coarse_pc;
5460 
5461         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5462         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5463         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5464         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5465       } else {
5466         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5467       }
5468     }
5469     /* we don't need the benign correction at coarser levels anymore */
5470     if (pcbddc->benign_have_null && isbddc) {
5471       PC        coarse_pc;
5472       PC_BDDC*  coarsepcbddc;
5473 
5474       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5475       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5476       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5477       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5478     }
5479     if (nullsp) {
5480       ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5481     }
5482   }
5483 
5484   /* Local solution on R nodes */
5485   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5486     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5487   }
5488   /* communications from coarse sol to local primal nodes */
5489   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5490   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5491 
5492   /* Sum contributions from the two levels */
5493   if (!pcbddc->benign_apply_coarse_only) {
5494     if (applytranspose) {
5495       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5496       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5497     } else {
5498       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5499       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5500     }
5501     /* store p0 */
5502     if (pcbddc->benign_n) {
5503       PetscScalar *array;
5504       PetscInt    j;
5505 
5506       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5507       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5508       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5509     }
5510   } else { /* expand the coarse solution */
5511     if (applytranspose) {
5512       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5513     } else {
5514       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5515     }
5516   }
5517   PetscFunctionReturn(0);
5518 }
5519 
5520 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5521 {
5522   PetscErrorCode ierr;
5523   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5524   PetscScalar    *array;
5525   Vec            from,to;
5526 
5527   PetscFunctionBegin;
5528   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5529     from = pcbddc->coarse_vec;
5530     to = pcbddc->vec1_P;
5531     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5532       Vec tvec;
5533 
5534       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5535       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5536       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5537       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5538       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5539       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5540     }
5541   } else { /* from local to global -> put data in coarse right hand side */
5542     from = pcbddc->vec1_P;
5543     to = pcbddc->coarse_vec;
5544   }
5545   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5546   PetscFunctionReturn(0);
5547 }
5548 
5549 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5550 {
5551   PetscErrorCode ierr;
5552   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5553   PetscScalar    *array;
5554   Vec            from,to;
5555 
5556   PetscFunctionBegin;
5557   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5558     from = pcbddc->coarse_vec;
5559     to = pcbddc->vec1_P;
5560   } else { /* from local to global -> put data in coarse right hand side */
5561     from = pcbddc->vec1_P;
5562     to = pcbddc->coarse_vec;
5563   }
5564   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5565   if (smode == SCATTER_FORWARD) {
5566     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5567       Vec tvec;
5568 
5569       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5570       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5571       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5572       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5573     }
5574   } else {
5575     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5576      ierr = VecResetArray(from);CHKERRQ(ierr);
5577     }
5578   }
5579   PetscFunctionReturn(0);
5580 }
5581 
5582 /* uncomment for testing purposes */
5583 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5584 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5585 {
5586   PetscErrorCode    ierr;
5587   PC_IS*            pcis = (PC_IS*)(pc->data);
5588   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5589   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5590   /* one and zero */
5591   PetscScalar       one=1.0,zero=0.0;
5592   /* space to store constraints and their local indices */
5593   PetscScalar       *constraints_data;
5594   PetscInt          *constraints_idxs,*constraints_idxs_B;
5595   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5596   PetscInt          *constraints_n;
5597   /* iterators */
5598   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5599   /* BLAS integers */
5600   PetscBLASInt      lwork,lierr;
5601   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5602   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5603   /* reuse */
5604   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5605   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5606   /* change of basis */
5607   PetscBool         qr_needed;
5608   PetscBT           change_basis,qr_needed_idx;
5609   /* auxiliary stuff */
5610   PetscInt          *nnz,*is_indices;
5611   PetscInt          ncc;
5612   /* some quantities */
5613   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5614   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5615   PetscReal         tol; /* tolerance for retaining eigenmodes */
5616 
5617   PetscFunctionBegin;
5618   tol  = PetscSqrtReal(PETSC_SMALL);
5619   /* Destroy Mat objects computed previously */
5620   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5621   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5622   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5623   /* save info on constraints from previous setup (if any) */
5624   olocal_primal_size = pcbddc->local_primal_size;
5625   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5626   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5627   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5628   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5629   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5630   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5631 
5632   if (!pcbddc->adaptive_selection) {
5633     IS           ISForVertices,*ISForFaces,*ISForEdges;
5634     MatNullSpace nearnullsp;
5635     const Vec    *nearnullvecs;
5636     Vec          *localnearnullsp;
5637     PetscScalar  *array;
5638     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5639     PetscBool    nnsp_has_cnst;
5640     /* LAPACK working arrays for SVD or POD */
5641     PetscBool    skip_lapack,boolforchange;
5642     PetscScalar  *work;
5643     PetscReal    *singular_vals;
5644 #if defined(PETSC_USE_COMPLEX)
5645     PetscReal    *rwork;
5646 #endif
5647 #if defined(PETSC_MISSING_LAPACK_GESVD)
5648     PetscScalar  *temp_basis,*correlation_mat;
5649 #else
5650     PetscBLASInt dummy_int=1;
5651     PetscScalar  dummy_scalar=1.;
5652 #endif
5653 
5654     /* Get index sets for faces, edges and vertices from graph */
5655     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
5656     /* print some info */
5657     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
5658       PetscInt nv;
5659 
5660       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
5661       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
5662       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5663       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5664       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
5665       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
5666       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
5667       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5668       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5669     }
5670 
5671     /* free unneeded index sets */
5672     if (!pcbddc->use_vertices) {
5673       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5674     }
5675     if (!pcbddc->use_edges) {
5676       for (i=0;i<n_ISForEdges;i++) {
5677         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5678       }
5679       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5680       n_ISForEdges = 0;
5681     }
5682     if (!pcbddc->use_faces) {
5683       for (i=0;i<n_ISForFaces;i++) {
5684         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5685       }
5686       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5687       n_ISForFaces = 0;
5688     }
5689 
5690     /* check if near null space is attached to global mat */
5691     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
5692     if (nearnullsp) {
5693       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
5694       /* remove any stored info */
5695       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
5696       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5697       /* store information for BDDC solver reuse */
5698       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
5699       pcbddc->onearnullspace = nearnullsp;
5700       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5701       for (i=0;i<nnsp_size;i++) {
5702         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
5703       }
5704     } else { /* if near null space is not provided BDDC uses constants by default */
5705       nnsp_size = 0;
5706       nnsp_has_cnst = PETSC_TRUE;
5707     }
5708     /* get max number of constraints on a single cc */
5709     max_constraints = nnsp_size;
5710     if (nnsp_has_cnst) max_constraints++;
5711 
5712     /*
5713          Evaluate maximum storage size needed by the procedure
5714          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
5715          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
5716          There can be multiple constraints per connected component
5717                                                                                                                                                            */
5718     n_vertices = 0;
5719     if (ISForVertices) {
5720       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
5721     }
5722     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
5723     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
5724 
5725     total_counts = n_ISForFaces+n_ISForEdges;
5726     total_counts *= max_constraints;
5727     total_counts += n_vertices;
5728     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
5729 
5730     total_counts = 0;
5731     max_size_of_constraint = 0;
5732     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
5733       IS used_is;
5734       if (i<n_ISForEdges) {
5735         used_is = ISForEdges[i];
5736       } else {
5737         used_is = ISForFaces[i-n_ISForEdges];
5738       }
5739       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
5740       total_counts += j;
5741       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
5742     }
5743     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);
5744 
5745     /* get local part of global near null space vectors */
5746     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
5747     for (k=0;k<nnsp_size;k++) {
5748       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
5749       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5750       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5751     }
5752 
5753     /* whether or not to skip lapack calls */
5754     skip_lapack = PETSC_TRUE;
5755     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
5756 
5757     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
5758     if (!skip_lapack) {
5759       PetscScalar temp_work;
5760 
5761 #if defined(PETSC_MISSING_LAPACK_GESVD)
5762       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
5763       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
5764       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
5765       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
5766 #if defined(PETSC_USE_COMPLEX)
5767       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
5768 #endif
5769       /* now we evaluate the optimal workspace using query with lwork=-1 */
5770       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5771       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
5772       lwork = -1;
5773       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5774 #if !defined(PETSC_USE_COMPLEX)
5775       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
5776 #else
5777       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
5778 #endif
5779       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5780       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
5781 #else /* on missing GESVD */
5782       /* SVD */
5783       PetscInt max_n,min_n;
5784       max_n = max_size_of_constraint;
5785       min_n = max_constraints;
5786       if (max_size_of_constraint < max_constraints) {
5787         min_n = max_size_of_constraint;
5788         max_n = max_constraints;
5789       }
5790       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
5791 #if defined(PETSC_USE_COMPLEX)
5792       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
5793 #endif
5794       /* now we evaluate the optimal workspace using query with lwork=-1 */
5795       lwork = -1;
5796       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
5797       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
5798       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
5799       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5800 #if !defined(PETSC_USE_COMPLEX)
5801       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));
5802 #else
5803       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));
5804 #endif
5805       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5806       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
5807 #endif /* on missing GESVD */
5808       /* Allocate optimal workspace */
5809       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
5810       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
5811     }
5812     /* Now we can loop on constraining sets */
5813     total_counts = 0;
5814     constraints_idxs_ptr[0] = 0;
5815     constraints_data_ptr[0] = 0;
5816     /* vertices */
5817     if (n_vertices) {
5818       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5819       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5820       for (i=0;i<n_vertices;i++) {
5821         constraints_n[total_counts] = 1;
5822         constraints_data[total_counts] = 1.0;
5823         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
5824         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
5825         total_counts++;
5826       }
5827       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5828       n_vertices = total_counts;
5829     }
5830 
5831     /* edges and faces */
5832     total_counts_cc = total_counts;
5833     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
5834       IS        used_is;
5835       PetscBool idxs_copied = PETSC_FALSE;
5836 
5837       if (ncc<n_ISForEdges) {
5838         used_is = ISForEdges[ncc];
5839         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
5840       } else {
5841         used_is = ISForFaces[ncc-n_ISForEdges];
5842         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
5843       }
5844       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
5845 
5846       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
5847       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5848       /* change of basis should not be performed on local periodic nodes */
5849       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
5850       if (nnsp_has_cnst) {
5851         PetscScalar quad_value;
5852 
5853         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5854         idxs_copied = PETSC_TRUE;
5855 
5856         if (!pcbddc->use_nnsp_true) {
5857           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
5858         } else {
5859           quad_value = 1.0;
5860         }
5861         for (j=0;j<size_of_constraint;j++) {
5862           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
5863         }
5864         temp_constraints++;
5865         total_counts++;
5866       }
5867       for (k=0;k<nnsp_size;k++) {
5868         PetscReal real_value;
5869         PetscScalar *ptr_to_data;
5870 
5871         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5872         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
5873         for (j=0;j<size_of_constraint;j++) {
5874           ptr_to_data[j] = array[is_indices[j]];
5875         }
5876         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5877         /* check if array is null on the connected component */
5878         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5879         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
5880         if (real_value > tol*size_of_constraint) { /* keep indices and values */
5881           temp_constraints++;
5882           total_counts++;
5883           if (!idxs_copied) {
5884             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5885             idxs_copied = PETSC_TRUE;
5886           }
5887         }
5888       }
5889       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5890       valid_constraints = temp_constraints;
5891       if (!pcbddc->use_nnsp_true && temp_constraints) {
5892         if (temp_constraints == 1) { /* just normalize the constraint */
5893           PetscScalar norm,*ptr_to_data;
5894 
5895           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5896           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5897           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
5898           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
5899           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
5900         } else { /* perform SVD */
5901           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5902 
5903 #if defined(PETSC_MISSING_LAPACK_GESVD)
5904           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
5905              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
5906              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
5907                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
5908                 from that computed using LAPACKgesvd
5909              -> This is due to a different computation of eigenvectors in LAPACKheev
5910              -> The quality of the POD-computed basis will be the same */
5911           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
5912           /* Store upper triangular part of correlation matrix */
5913           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5914           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5915           for (j=0;j<temp_constraints;j++) {
5916             for (k=0;k<j+1;k++) {
5917               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));
5918             }
5919           }
5920           /* compute eigenvalues and eigenvectors of correlation matrix */
5921           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5922           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
5923 #if !defined(PETSC_USE_COMPLEX)
5924           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
5925 #else
5926           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
5927 #endif
5928           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5929           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
5930           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
5931           j = 0;
5932           while (j < temp_constraints && singular_vals[j] < tol) j++;
5933           total_counts = total_counts-j;
5934           valid_constraints = temp_constraints-j;
5935           /* scale and copy POD basis into used quadrature memory */
5936           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5937           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5938           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
5939           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5940           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
5941           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
5942           if (j<temp_constraints) {
5943             PetscInt ii;
5944             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
5945             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5946             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));
5947             ierr = PetscFPTrapPop();CHKERRQ(ierr);
5948             for (k=0;k<temp_constraints-j;k++) {
5949               for (ii=0;ii<size_of_constraint;ii++) {
5950                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
5951               }
5952             }
5953           }
5954 #else  /* on missing GESVD */
5955           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5956           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5957           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5958           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5959 #if !defined(PETSC_USE_COMPLEX)
5960           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));
5961 #else
5962           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));
5963 #endif
5964           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
5965           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5966           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
5967           k = temp_constraints;
5968           if (k > size_of_constraint) k = size_of_constraint;
5969           j = 0;
5970           while (j < k && singular_vals[k-j-1] < tol) j++;
5971           valid_constraints = k-j;
5972           total_counts = total_counts-temp_constraints+valid_constraints;
5973 #endif /* on missing GESVD */
5974         }
5975       }
5976       /* update pointers information */
5977       if (valid_constraints) {
5978         constraints_n[total_counts_cc] = valid_constraints;
5979         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
5980         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
5981         /* set change_of_basis flag */
5982         if (boolforchange) {
5983           PetscBTSet(change_basis,total_counts_cc);
5984         }
5985         total_counts_cc++;
5986       }
5987     }
5988     /* free workspace */
5989     if (!skip_lapack) {
5990       ierr = PetscFree(work);CHKERRQ(ierr);
5991 #if defined(PETSC_USE_COMPLEX)
5992       ierr = PetscFree(rwork);CHKERRQ(ierr);
5993 #endif
5994       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
5995 #if defined(PETSC_MISSING_LAPACK_GESVD)
5996       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
5997       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
5998 #endif
5999     }
6000     for (k=0;k<nnsp_size;k++) {
6001       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
6002     }
6003     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
6004     /* free index sets of faces, edges and vertices */
6005     for (i=0;i<n_ISForFaces;i++) {
6006       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6007     }
6008     if (n_ISForFaces) {
6009       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6010     }
6011     for (i=0;i<n_ISForEdges;i++) {
6012       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6013     }
6014     if (n_ISForEdges) {
6015       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6016     }
6017     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6018   } else {
6019     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
6020 
6021     total_counts = 0;
6022     n_vertices = 0;
6023     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
6024       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
6025     }
6026     max_constraints = 0;
6027     total_counts_cc = 0;
6028     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6029       total_counts += pcbddc->adaptive_constraints_n[i];
6030       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
6031       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
6032     }
6033     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
6034     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
6035     constraints_idxs = pcbddc->adaptive_constraints_idxs;
6036     constraints_data = pcbddc->adaptive_constraints_data;
6037     /* constraints_n differs from pcbddc->adaptive_constraints_n */
6038     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
6039     total_counts_cc = 0;
6040     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6041       if (pcbddc->adaptive_constraints_n[i]) {
6042         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
6043       }
6044     }
6045 #if 0
6046     printf("Found %d totals (%d)\n",total_counts_cc,total_counts);
6047     for (i=0;i<total_counts_cc;i++) {
6048       printf("const %d, start %d",i,constraints_idxs_ptr[i]);
6049       printf(" end %d:\n",constraints_idxs_ptr[i+1]);
6050       for (j=constraints_idxs_ptr[i];j<constraints_idxs_ptr[i+1];j++) {
6051         printf(" %d",constraints_idxs[j]);
6052       }
6053       printf("\n");
6054       printf("number of cc: %d\n",constraints_n[i]);
6055     }
6056     for (i=0;i<n_vertices;i++) {
6057       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i]);
6058     }
6059     for (i=0;i<sub_schurs->n_subs;i++) {
6060       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]);
6061     }
6062 #endif
6063 
6064     max_size_of_constraint = 0;
6065     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]);
6066     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
6067     /* Change of basis */
6068     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
6069     if (pcbddc->use_change_of_basis) {
6070       for (i=0;i<sub_schurs->n_subs;i++) {
6071         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
6072           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
6073         }
6074       }
6075     }
6076   }
6077   pcbddc->local_primal_size = total_counts;
6078   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6079 
6080   /* map constraints_idxs in boundary numbering */
6081   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
6082   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);
6083 
6084   /* Create constraint matrix */
6085   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6086   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
6087   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
6088 
6089   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
6090   /* determine if a QR strategy is needed for change of basis */
6091   qr_needed = PETSC_FALSE;
6092   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
6093   total_primal_vertices=0;
6094   pcbddc->local_primal_size_cc = 0;
6095   for (i=0;i<total_counts_cc;i++) {
6096     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6097     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
6098       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
6099       pcbddc->local_primal_size_cc += 1;
6100     } else if (PetscBTLookup(change_basis,i)) {
6101       for (k=0;k<constraints_n[i];k++) {
6102         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6103       }
6104       pcbddc->local_primal_size_cc += constraints_n[i];
6105       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
6106         PetscBTSet(qr_needed_idx,i);
6107         qr_needed = PETSC_TRUE;
6108       }
6109     } else {
6110       pcbddc->local_primal_size_cc += 1;
6111     }
6112   }
6113   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
6114   pcbddc->n_vertices = total_primal_vertices;
6115   /* permute indices in order to have a sorted set of vertices */
6116   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6117   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);
6118   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
6119   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
6120 
6121   /* nonzero structure of constraint matrix */
6122   /* and get reference dof for local constraints */
6123   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
6124   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
6125 
6126   j = total_primal_vertices;
6127   total_counts = total_primal_vertices;
6128   cum = total_primal_vertices;
6129   for (i=n_vertices;i<total_counts_cc;i++) {
6130     if (!PetscBTLookup(change_basis,i)) {
6131       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
6132       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
6133       cum++;
6134       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6135       for (k=0;k<constraints_n[i];k++) {
6136         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6137         nnz[j+k] = size_of_constraint;
6138       }
6139       j += constraints_n[i];
6140     }
6141   }
6142   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
6143   ierr = PetscFree(nnz);CHKERRQ(ierr);
6144 
6145   /* set values in constraint matrix */
6146   for (i=0;i<total_primal_vertices;i++) {
6147     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
6148   }
6149   total_counts = total_primal_vertices;
6150   for (i=n_vertices;i<total_counts_cc;i++) {
6151     if (!PetscBTLookup(change_basis,i)) {
6152       PetscInt *cols;
6153 
6154       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6155       cols = constraints_idxs+constraints_idxs_ptr[i];
6156       for (k=0;k<constraints_n[i];k++) {
6157         PetscInt    row = total_counts+k;
6158         PetscScalar *vals;
6159 
6160         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
6161         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6162       }
6163       total_counts += constraints_n[i];
6164     }
6165   }
6166   /* assembling */
6167   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6168   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6169   ierr = MatChop(pcbddc->ConstraintMatrix,PETSC_SMALL);CHKERRQ(ierr);
6170   ierr = MatSeqAIJCompress(pcbddc->ConstraintMatrix,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6171   ierr = MatViewFromOptions(pcbddc->ConstraintMatrix,NULL,"-pc_bddc_constraint_mat_view");CHKERRQ(ierr);
6172 
6173   /*
6174   ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
6175   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
6176   ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
6177   */
6178   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6179   if (pcbddc->use_change_of_basis) {
6180     /* dual and primal dofs on a single cc */
6181     PetscInt     dual_dofs,primal_dofs;
6182     /* working stuff for GEQRF */
6183     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
6184     PetscBLASInt lqr_work;
6185     /* working stuff for UNGQR */
6186     PetscScalar  *gqr_work,lgqr_work_t;
6187     PetscBLASInt lgqr_work;
6188     /* working stuff for TRTRS */
6189     PetscScalar  *trs_rhs;
6190     PetscBLASInt Blas_NRHS;
6191     /* pointers for values insertion into change of basis matrix */
6192     PetscInt     *start_rows,*start_cols;
6193     PetscScalar  *start_vals;
6194     /* working stuff for values insertion */
6195     PetscBT      is_primal;
6196     PetscInt     *aux_primal_numbering_B;
6197     /* matrix sizes */
6198     PetscInt     global_size,local_size;
6199     /* temporary change of basis */
6200     Mat          localChangeOfBasisMatrix;
6201     /* extra space for debugging */
6202     PetscScalar  *dbg_work;
6203 
6204     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6205     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6206     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6207     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6208     /* nonzeros for local mat */
6209     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6210     if (!pcbddc->benign_change || pcbddc->fake_change) {
6211       for (i=0;i<pcis->n;i++) nnz[i]=1;
6212     } else {
6213       const PetscInt *ii;
6214       PetscInt       n;
6215       PetscBool      flg_row;
6216       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6217       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6218       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6219     }
6220     for (i=n_vertices;i<total_counts_cc;i++) {
6221       if (PetscBTLookup(change_basis,i)) {
6222         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6223         if (PetscBTLookup(qr_needed_idx,i)) {
6224           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6225         } else {
6226           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6227           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6228         }
6229       }
6230     }
6231     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6232     ierr = PetscFree(nnz);CHKERRQ(ierr);
6233     /* Set interior change in the matrix */
6234     if (!pcbddc->benign_change || pcbddc->fake_change) {
6235       for (i=0;i<pcis->n;i++) {
6236         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6237       }
6238     } else {
6239       const PetscInt *ii,*jj;
6240       PetscScalar    *aa;
6241       PetscInt       n;
6242       PetscBool      flg_row;
6243       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6244       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6245       for (i=0;i<n;i++) {
6246         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6247       }
6248       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6249       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6250     }
6251 
6252     if (pcbddc->dbg_flag) {
6253       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6254       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6255     }
6256 
6257 
6258     /* Now we loop on the constraints which need a change of basis */
6259     /*
6260        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6261        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6262 
6263        Basic blocks of change of basis matrix T computed by
6264 
6265           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6266 
6267             | 1        0   ...        0         s_1/S |
6268             | 0        1   ...        0         s_2/S |
6269             |              ...                        |
6270             | 0        ...            1     s_{n-1}/S |
6271             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6272 
6273             with S = \sum_{i=1}^n s_i^2
6274             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6275                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6276 
6277           - QR decomposition of constraints otherwise
6278     */
6279     if (qr_needed) {
6280       /* space to store Q */
6281       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6282       /* array to store scaling factors for reflectors */
6283       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6284       /* first we issue queries for optimal work */
6285       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6286       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6287       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6288       lqr_work = -1;
6289       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6290       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6291       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6292       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6293       lgqr_work = -1;
6294       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6295       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6296       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6297       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6298       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6299       PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6300       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to ORGQR/UNGQR Lapack routine %d",(int)lierr);
6301       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6302       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6303       /* array to store rhs and solution of triangular solver */
6304       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6305       /* allocating workspace for check */
6306       if (pcbddc->dbg_flag) {
6307         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6308       }
6309     }
6310     /* array to store whether a node is primal or not */
6311     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6312     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6313     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6314     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);
6315     for (i=0;i<total_primal_vertices;i++) {
6316       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6317     }
6318     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6319 
6320     /* loop on constraints and see whether or not they need a change of basis and compute it */
6321     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6322       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6323       if (PetscBTLookup(change_basis,total_counts)) {
6324         /* get constraint info */
6325         primal_dofs = constraints_n[total_counts];
6326         dual_dofs = size_of_constraint-primal_dofs;
6327 
6328         if (pcbddc->dbg_flag) {
6329           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);
6330         }
6331 
6332         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6333 
6334           /* copy quadrature constraints for change of basis check */
6335           if (pcbddc->dbg_flag) {
6336             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6337           }
6338           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6339           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6340 
6341           /* compute QR decomposition of constraints */
6342           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6343           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6344           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6345           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6346           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6347           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6348           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6349 
6350           /* explictly compute R^-T */
6351           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
6352           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6353           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6354           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6355           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6356           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6357           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6358           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6359           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6360           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6361 
6362           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6363           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6364           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6365           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6366           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6367           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6368           PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6369           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in ORGQR/UNGQR Lapack routine %d",(int)lierr);
6370           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6371 
6372           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6373              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6374              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6375           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6376           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6377           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6378           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6379           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6380           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6381           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6382           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));
6383           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6384           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6385 
6386           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6387           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6388           /* insert cols for primal dofs */
6389           for (j=0;j<primal_dofs;j++) {
6390             start_vals = &qr_basis[j*size_of_constraint];
6391             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6392             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6393           }
6394           /* insert cols for dual dofs */
6395           for (j=0,k=0;j<dual_dofs;k++) {
6396             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6397               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6398               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6399               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6400               j++;
6401             }
6402           }
6403 
6404           /* check change of basis */
6405           if (pcbddc->dbg_flag) {
6406             PetscInt   ii,jj;
6407             PetscBool valid_qr=PETSC_TRUE;
6408             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6409             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6410             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6411             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6412             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6413             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6414             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6415             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));
6416             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6417             for (jj=0;jj<size_of_constraint;jj++) {
6418               for (ii=0;ii<primal_dofs;ii++) {
6419                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6420                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) valid_qr = PETSC_FALSE;
6421               }
6422             }
6423             if (!valid_qr) {
6424               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6425               for (jj=0;jj<size_of_constraint;jj++) {
6426                 for (ii=0;ii<primal_dofs;ii++) {
6427                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6428                     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]));
6429                   }
6430                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) {
6431                     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]));
6432                   }
6433                 }
6434               }
6435             } else {
6436               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6437             }
6438           }
6439         } else { /* simple transformation block */
6440           PetscInt    row,col;
6441           PetscScalar val,norm;
6442 
6443           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6444           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6445           for (j=0;j<size_of_constraint;j++) {
6446             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6447             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6448             if (!PetscBTLookup(is_primal,row_B)) {
6449               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6450               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6451               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6452             } else {
6453               for (k=0;k<size_of_constraint;k++) {
6454                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6455                 if (row != col) {
6456                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6457                 } else {
6458                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6459                 }
6460                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6461               }
6462             }
6463           }
6464           if (pcbddc->dbg_flag) {
6465             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6466           }
6467         }
6468       } else {
6469         if (pcbddc->dbg_flag) {
6470           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d does not need a change of basis (size %d)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6471         }
6472       }
6473     }
6474 
6475     /* free workspace */
6476     if (qr_needed) {
6477       if (pcbddc->dbg_flag) {
6478         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6479       }
6480       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6481       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6482       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6483       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6484       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6485     }
6486     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6487     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6488     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6489 
6490     /* assembling of global change of variable */
6491     if (!pcbddc->fake_change) {
6492       Mat      tmat;
6493       PetscInt bs;
6494 
6495       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6496       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6497       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6498       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6499       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6500       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6501       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6502       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6503       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6504       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6505       ierr = MatISGetMPIXAIJ(tmat,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6506       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6507       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6508       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6509       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6510       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6511       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6512       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6513 
6514       /* check */
6515       if (pcbddc->dbg_flag) {
6516         PetscReal error;
6517         Vec       x,x_change;
6518 
6519         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6520         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6521         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6522         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6523         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6524         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6525         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6526         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6527         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6528         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6529         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6530         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6531         if (error > PETSC_SMALL) {
6532           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
6533         }
6534         ierr = VecDestroy(&x);CHKERRQ(ierr);
6535         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6536       }
6537       /* adapt sub_schurs computed (if any) */
6538       if (pcbddc->use_deluxe_scaling) {
6539         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6540 
6541         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");
6542         if (sub_schurs && sub_schurs->S_Ej_all) {
6543           Mat                    S_new,tmat;
6544           IS                     is_all_N,is_V_Sall = NULL;
6545 
6546           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6547           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6548           if (pcbddc->deluxe_zerorows) {
6549             ISLocalToGlobalMapping NtoSall;
6550             IS                     is_V;
6551             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6552             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6553             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6554             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6555             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6556           }
6557           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6558           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6559           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6560           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6561           if (pcbddc->deluxe_zerorows) {
6562             const PetscScalar *array;
6563             const PetscInt    *idxs_V,*idxs_all;
6564             PetscInt          i,n_V;
6565 
6566             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6567             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6568             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6569             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6570             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6571             for (i=0;i<n_V;i++) {
6572               PetscScalar val;
6573               PetscInt    idx;
6574 
6575               idx = idxs_V[i];
6576               val = array[idxs_all[idxs_V[i]]];
6577               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6578             }
6579             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6580             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6581             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6582             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6583             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6584           }
6585           sub_schurs->S_Ej_all = S_new;
6586           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6587           if (sub_schurs->sum_S_Ej_all) {
6588             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6589             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6590             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6591             if (pcbddc->deluxe_zerorows) {
6592               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6593             }
6594             sub_schurs->sum_S_Ej_all = S_new;
6595             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6596           }
6597           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6598           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6599         }
6600         /* destroy any change of basis context in sub_schurs */
6601         if (sub_schurs && sub_schurs->change) {
6602           PetscInt i;
6603 
6604           for (i=0;i<sub_schurs->n_subs;i++) {
6605             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6606           }
6607           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6608         }
6609       }
6610       if (pcbddc->switch_static) { /* need to save the local change */
6611         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6612       } else {
6613         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6614       }
6615       /* determine if any process has changed the pressures locally */
6616       pcbddc->change_interior = pcbddc->benign_have_null;
6617     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6618       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6619       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6620       pcbddc->use_qr_single = qr_needed;
6621     }
6622   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6623     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6624       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6625       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6626     } else {
6627       Mat benign_global = NULL;
6628       if (pcbddc->benign_have_null) {
6629         Mat tmat;
6630 
6631         pcbddc->change_interior = PETSC_TRUE;
6632         ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6633         ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6634         ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6635         ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6636         ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6637         ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6638         ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6639         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6640         if (pcbddc->benign_change) {
6641           Mat M;
6642 
6643           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6644           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6645           ierr = MatISSetLocalMat(tmat,M);CHKERRQ(ierr);
6646           ierr = MatDestroy(&M);CHKERRQ(ierr);
6647         } else {
6648           Mat         eye;
6649           PetscScalar *array;
6650 
6651           ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6652           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&eye);CHKERRQ(ierr);
6653           for (i=0;i<pcis->n;i++) {
6654             ierr = MatSetValue(eye,i,i,array[i],INSERT_VALUES);CHKERRQ(ierr);
6655           }
6656           ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6657           ierr = MatAssemblyBegin(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6658           ierr = MatAssemblyEnd(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6659           ierr = MatISSetLocalMat(tmat,eye);CHKERRQ(ierr);
6660           ierr = MatDestroy(&eye);CHKERRQ(ierr);
6661         }
6662         ierr = MatISGetMPIXAIJ(tmat,MAT_INITIAL_MATRIX,&benign_global);CHKERRQ(ierr);
6663         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6664       }
6665       if (pcbddc->user_ChangeOfBasisMatrix) {
6666         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6667         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6668       } else if (pcbddc->benign_have_null) {
6669         pcbddc->ChangeOfBasisMatrix = benign_global;
6670       }
6671     }
6672     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6673       IS             is_global;
6674       const PetscInt *gidxs;
6675 
6676       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6677       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6678       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6679       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6680       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6681     }
6682   }
6683   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6684     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6685   }
6686 
6687   if (!pcbddc->fake_change) {
6688     /* add pressure dofs to set of primal nodes for numbering purposes */
6689     for (i=0;i<pcbddc->benign_n;i++) {
6690       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
6691       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
6692       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
6693       pcbddc->local_primal_size_cc++;
6694       pcbddc->local_primal_size++;
6695     }
6696 
6697     /* check if a new primal space has been introduced (also take into account benign trick) */
6698     pcbddc->new_primal_space_local = PETSC_TRUE;
6699     if (olocal_primal_size == pcbddc->local_primal_size) {
6700       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6701       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6702       if (!pcbddc->new_primal_space_local) {
6703         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6704         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6705       }
6706     }
6707     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
6708     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6709   }
6710   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
6711 
6712   /* flush dbg viewer */
6713   if (pcbddc->dbg_flag) {
6714     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6715   }
6716 
6717   /* free workspace */
6718   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
6719   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
6720   if (!pcbddc->adaptive_selection) {
6721     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
6722     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
6723   } else {
6724     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
6725                       pcbddc->adaptive_constraints_idxs_ptr,
6726                       pcbddc->adaptive_constraints_data_ptr,
6727                       pcbddc->adaptive_constraints_idxs,
6728                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
6729     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
6730     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
6731   }
6732   PetscFunctionReturn(0);
6733 }
6734 /* #undef PETSC_MISSING_LAPACK_GESVD */
6735 
6736 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
6737 {
6738   ISLocalToGlobalMapping map;
6739   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
6740   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
6741   PetscInt               i,N;
6742   PetscBool              rcsr = PETSC_FALSE;
6743   PetscErrorCode         ierr;
6744 
6745   PetscFunctionBegin;
6746   if (pcbddc->recompute_topography) {
6747     pcbddc->graphanalyzed = PETSC_FALSE;
6748     /* Reset previously computed graph */
6749     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
6750     /* Init local Graph struct */
6751     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
6752     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
6753     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
6754 
6755     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
6756       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6757     }
6758     /* Check validity of the csr graph passed in by the user */
6759     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);
6760 
6761     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
6762     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
6763       PetscInt  *xadj,*adjncy;
6764       PetscInt  nvtxs;
6765       PetscBool flg_row=PETSC_FALSE;
6766 
6767       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6768       if (flg_row) {
6769         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
6770         pcbddc->computed_rowadj = PETSC_TRUE;
6771       }
6772       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6773       rcsr = PETSC_TRUE;
6774     }
6775     if (pcbddc->dbg_flag) {
6776       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6777     }
6778 
6779     if (pcbddc->mat_graph->cdim && !pcbddc->mat_graph->cloc) {
6780       PetscReal    *lcoords;
6781       PetscInt     n;
6782       MPI_Datatype dimrealtype;
6783 
6784       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);
6785       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
6786       ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
6787       ierr = PetscMalloc1(pcbddc->mat_graph->cdim*n,&lcoords);CHKERRQ(ierr);
6788       ierr = MPI_Type_contiguous(pcbddc->mat_graph->cdim,MPIU_REAL,&dimrealtype);CHKERRQ(ierr);
6789       ierr = MPI_Type_commit(&dimrealtype);CHKERRQ(ierr);
6790       ierr = PetscSFBcastBegin(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
6791       ierr = PetscSFBcastEnd(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
6792       ierr = MPI_Type_free(&dimrealtype);CHKERRQ(ierr);
6793       ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
6794 
6795       pcbddc->mat_graph->coords = lcoords;
6796       pcbddc->mat_graph->cloc   = PETSC_TRUE;
6797       pcbddc->mat_graph->cnloc  = n;
6798     }
6799     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);
6800 
6801     /* Setup of Graph */
6802     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
6803     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6804 
6805     /* attach info on disconnected subdomains if present */
6806     if (pcbddc->n_local_subs) {
6807       PetscInt *local_subs;
6808 
6809       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
6810       for (i=0;i<pcbddc->n_local_subs;i++) {
6811         const PetscInt *idxs;
6812         PetscInt       nl,j;
6813 
6814         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
6815         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6816         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
6817         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6818       }
6819       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
6820       pcbddc->mat_graph->local_subs = local_subs;
6821     }
6822   }
6823 
6824   if (!pcbddc->graphanalyzed) {
6825     /* Graph's connected components analysis */
6826     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
6827     pcbddc->graphanalyzed = PETSC_TRUE;
6828   }
6829   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
6830   PetscFunctionReturn(0);
6831 }
6832 
6833 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
6834 {
6835   PetscInt       i,j;
6836   PetscScalar    *alphas;
6837   PetscErrorCode ierr;
6838 
6839   PetscFunctionBegin;
6840   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
6841   for (i=0;i<n;i++) {
6842     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
6843     ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],alphas);CHKERRQ(ierr);
6844     for (j=0;j<n-i-1;j++) alphas[j] = PetscConj(-alphas[j]);
6845     ierr = VecMAXPY(vecs[j],n-i-1,alphas,vecs+i);CHKERRQ(ierr);
6846   }
6847   ierr = PetscFree(alphas);CHKERRQ(ierr);
6848   PetscFunctionReturn(0);
6849 }
6850 
6851 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
6852 {
6853   Mat            A;
6854   PetscInt       n_neighs,*neighs,*n_shared,**shared;
6855   PetscMPIInt    size,rank,color;
6856   PetscInt       *xadj,*adjncy;
6857   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
6858   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
6859   PetscInt       void_procs,*procs_candidates = NULL;
6860   PetscInt       xadj_count,*count;
6861   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
6862   PetscSubcomm   psubcomm;
6863   MPI_Comm       subcomm;
6864   PetscErrorCode ierr;
6865 
6866   PetscFunctionBegin;
6867   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6868   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6869   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);
6870   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
6871   PetscValidLogicalCollectiveInt(mat,redprocs,3);
6872   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %d\n",*n_subdomains);
6873 
6874   if (have_void) *have_void = PETSC_FALSE;
6875   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
6876   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
6877   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
6878   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
6879   im_active = !!n;
6880   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6881   void_procs = size - active_procs;
6882   /* get ranks of of non-active processes in mat communicator */
6883   if (void_procs) {
6884     PetscInt ncand;
6885 
6886     if (have_void) *have_void = PETSC_TRUE;
6887     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
6888     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6889     for (i=0,ncand=0;i<size;i++) {
6890       if (!procs_candidates[i]) {
6891         procs_candidates[ncand++] = i;
6892       }
6893     }
6894     /* force n_subdomains to be not greater that the number of non-active processes */
6895     *n_subdomains = PetscMin(void_procs,*n_subdomains);
6896   }
6897 
6898   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
6899      number of subdomains requested 1 -> send to master or first candidate in voids  */
6900   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
6901   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
6902     PetscInt issize,isidx,dest;
6903     if (*n_subdomains == 1) dest = 0;
6904     else dest = rank;
6905     if (im_active) {
6906       issize = 1;
6907       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6908         isidx = procs_candidates[dest];
6909       } else {
6910         isidx = dest;
6911       }
6912     } else {
6913       issize = 0;
6914       isidx = -1;
6915     }
6916     if (*n_subdomains != 1) *n_subdomains = active_procs;
6917     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
6918     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6919     PetscFunctionReturn(0);
6920   }
6921   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
6922   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
6923   threshold = PetscMax(threshold,2);
6924 
6925   /* Get info on mapping */
6926   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6927 
6928   /* build local CSR graph of subdomains' connectivity */
6929   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
6930   xadj[0] = 0;
6931   xadj[1] = PetscMax(n_neighs-1,0);
6932   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
6933   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
6934   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
6935   for (i=1;i<n_neighs;i++)
6936     for (j=0;j<n_shared[i];j++)
6937       count[shared[i][j]] += 1;
6938 
6939   xadj_count = 0;
6940   for (i=1;i<n_neighs;i++) {
6941     for (j=0;j<n_shared[i];j++) {
6942       if (count[shared[i][j]] < threshold) {
6943         adjncy[xadj_count] = neighs[i];
6944         adjncy_wgt[xadj_count] = n_shared[i];
6945         xadj_count++;
6946         break;
6947       }
6948     }
6949   }
6950   xadj[1] = xadj_count;
6951   ierr = PetscFree(count);CHKERRQ(ierr);
6952   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6953   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6954 
6955   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
6956 
6957   /* Restrict work on active processes only */
6958   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
6959   if (void_procs) {
6960     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
6961     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
6962     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
6963     subcomm = PetscSubcommChild(psubcomm);
6964   } else {
6965     psubcomm = NULL;
6966     subcomm = PetscObjectComm((PetscObject)mat);
6967   }
6968 
6969   v_wgt = NULL;
6970   if (!color) {
6971     ierr = PetscFree(xadj);CHKERRQ(ierr);
6972     ierr = PetscFree(adjncy);CHKERRQ(ierr);
6973     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6974   } else {
6975     Mat             subdomain_adj;
6976     IS              new_ranks,new_ranks_contig;
6977     MatPartitioning partitioner;
6978     PetscInt        rstart=0,rend=0;
6979     PetscInt        *is_indices,*oldranks;
6980     PetscMPIInt     size;
6981     PetscBool       aggregate;
6982 
6983     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
6984     if (void_procs) {
6985       PetscInt prank = rank;
6986       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
6987       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
6988       for (i=0;i<xadj[1];i++) {
6989         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
6990       }
6991       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6992     } else {
6993       oldranks = NULL;
6994     }
6995     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
6996     if (aggregate) { /* TODO: all this part could be made more efficient */
6997       PetscInt    lrows,row,ncols,*cols;
6998       PetscMPIInt nrank;
6999       PetscScalar *vals;
7000 
7001       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
7002       lrows = 0;
7003       if (nrank<redprocs) {
7004         lrows = size/redprocs;
7005         if (nrank<size%redprocs) lrows++;
7006       }
7007       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
7008       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
7009       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7010       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7011       row = nrank;
7012       ncols = xadj[1]-xadj[0];
7013       cols = adjncy;
7014       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
7015       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
7016       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
7017       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7018       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7019       ierr = PetscFree(xadj);CHKERRQ(ierr);
7020       ierr = PetscFree(adjncy);CHKERRQ(ierr);
7021       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7022       ierr = PetscFree(vals);CHKERRQ(ierr);
7023       if (use_vwgt) {
7024         Vec               v;
7025         const PetscScalar *array;
7026         PetscInt          nl;
7027 
7028         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
7029         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
7030         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
7031         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
7032         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
7033         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
7034         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
7035         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
7036         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
7037         ierr = VecDestroy(&v);CHKERRQ(ierr);
7038       }
7039     } else {
7040       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
7041       if (use_vwgt) {
7042         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
7043         v_wgt[0] = n;
7044       }
7045     }
7046     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
7047 
7048     /* Partition */
7049     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
7050     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
7051     if (v_wgt) {
7052       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
7053     }
7054     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
7055     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
7056     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
7057     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
7058     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
7059 
7060     /* renumber new_ranks to avoid "holes" in new set of processors */
7061     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
7062     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
7063     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7064     if (!aggregate) {
7065       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7066 #if defined(PETSC_USE_DEBUG)
7067         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7068 #endif
7069         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
7070       } else if (oldranks) {
7071         ranks_send_to_idx[0] = oldranks[is_indices[0]];
7072       } else {
7073         ranks_send_to_idx[0] = is_indices[0];
7074       }
7075     } else {
7076       PetscInt    idx = 0;
7077       PetscMPIInt tag;
7078       MPI_Request *reqs;
7079 
7080       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
7081       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
7082       for (i=rstart;i<rend;i++) {
7083         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
7084       }
7085       ierr = MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
7086       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7087       ierr = PetscFree(reqs);CHKERRQ(ierr);
7088       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7089 #if defined(PETSC_USE_DEBUG)
7090         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7091 #endif
7092         ranks_send_to_idx[0] = procs_candidates[oldranks[idx]];
7093       } else if (oldranks) {
7094         ranks_send_to_idx[0] = oldranks[idx];
7095       } else {
7096         ranks_send_to_idx[0] = idx;
7097       }
7098     }
7099     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7100     /* clean up */
7101     ierr = PetscFree(oldranks);CHKERRQ(ierr);
7102     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
7103     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
7104     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
7105   }
7106   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
7107   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7108 
7109   /* assemble parallel IS for sends */
7110   i = 1;
7111   if (!color) i=0;
7112   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
7113   PetscFunctionReturn(0);
7114 }
7115 
7116 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
7117 
7118 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[])
7119 {
7120   Mat                    local_mat;
7121   IS                     is_sends_internal;
7122   PetscInt               rows,cols,new_local_rows;
7123   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
7124   PetscBool              ismatis,isdense,newisdense,destroy_mat;
7125   ISLocalToGlobalMapping l2gmap;
7126   PetscInt*              l2gmap_indices;
7127   const PetscInt*        is_indices;
7128   MatType                new_local_type;
7129   /* buffers */
7130   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
7131   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
7132   PetscInt               *recv_buffer_idxs_local;
7133   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
7134   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
7135   /* MPI */
7136   MPI_Comm               comm,comm_n;
7137   PetscSubcomm           subcomm;
7138   PetscMPIInt            n_sends,n_recvs,commsize;
7139   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
7140   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
7141   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
7142   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
7143   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
7144   PetscErrorCode         ierr;
7145 
7146   PetscFunctionBegin;
7147   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7148   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7149   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);
7150   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
7151   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
7152   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
7153   PetscValidLogicalCollectiveBool(mat,reuse,6);
7154   PetscValidLogicalCollectiveInt(mat,nis,8);
7155   PetscValidLogicalCollectiveInt(mat,nvecs,10);
7156   if (nvecs) {
7157     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
7158     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
7159   }
7160   /* further checks */
7161   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7162   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
7163   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
7164   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
7165   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
7166   if (reuse && *mat_n) {
7167     PetscInt mrows,mcols,mnrows,mncols;
7168     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
7169     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
7170     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
7171     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
7172     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
7173     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
7174     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
7175   }
7176   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
7177   PetscValidLogicalCollectiveInt(mat,bs,0);
7178 
7179   /* prepare IS for sending if not provided */
7180   if (!is_sends) {
7181     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
7182     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
7183   } else {
7184     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
7185     is_sends_internal = is_sends;
7186   }
7187 
7188   /* get comm */
7189   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
7190 
7191   /* compute number of sends */
7192   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
7193   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7194 
7195   /* compute number of receives */
7196   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
7197   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
7198   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
7199   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7200   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7201   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7202   ierr = PetscFree(iflags);CHKERRQ(ierr);
7203 
7204   /* restrict comm if requested */
7205   subcomm = 0;
7206   destroy_mat = PETSC_FALSE;
7207   if (restrict_comm) {
7208     PetscMPIInt color,subcommsize;
7209 
7210     color = 0;
7211     if (restrict_full) {
7212       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7213     } else {
7214       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7215     }
7216     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
7217     subcommsize = commsize - subcommsize;
7218     /* check if reuse has been requested */
7219     if (reuse) {
7220       if (*mat_n) {
7221         PetscMPIInt subcommsize2;
7222         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
7223         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7224         comm_n = PetscObjectComm((PetscObject)*mat_n);
7225       } else {
7226         comm_n = PETSC_COMM_SELF;
7227       }
7228     } else { /* MAT_INITIAL_MATRIX */
7229       PetscMPIInt rank;
7230 
7231       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
7232       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7233       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7234       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7235       comm_n = PetscSubcommChild(subcomm);
7236     }
7237     /* flag to destroy *mat_n if not significative */
7238     if (color) destroy_mat = PETSC_TRUE;
7239   } else {
7240     comm_n = comm;
7241   }
7242 
7243   /* prepare send/receive buffers */
7244   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
7245   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
7246   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
7247   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
7248   if (nis) {
7249     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
7250   }
7251 
7252   /* Get data from local matrices */
7253   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7254     /* TODO: See below some guidelines on how to prepare the local buffers */
7255     /*
7256        send_buffer_vals should contain the raw values of the local matrix
7257        send_buffer_idxs should contain:
7258        - MatType_PRIVATE type
7259        - PetscInt        size_of_l2gmap
7260        - PetscInt        global_row_indices[size_of_l2gmap]
7261        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7262     */
7263   else {
7264     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7265     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7266     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7267     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7268     send_buffer_idxs[1] = i;
7269     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7270     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
7271     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7272     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7273     for (i=0;i<n_sends;i++) {
7274       ilengths_vals[is_indices[i]] = len*len;
7275       ilengths_idxs[is_indices[i]] = len+2;
7276     }
7277   }
7278   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7279   /* additional is (if any) */
7280   if (nis) {
7281     PetscMPIInt psum;
7282     PetscInt j;
7283     for (j=0,psum=0;j<nis;j++) {
7284       PetscInt plen;
7285       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7286       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7287       psum += len+1; /* indices + lenght */
7288     }
7289     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7290     for (j=0,psum=0;j<nis;j++) {
7291       PetscInt plen;
7292       const PetscInt *is_array_idxs;
7293       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7294       send_buffer_idxs_is[psum] = plen;
7295       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7296       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
7297       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7298       psum += plen+1; /* indices + lenght */
7299     }
7300     for (i=0;i<n_sends;i++) {
7301       ilengths_idxs_is[is_indices[i]] = psum;
7302     }
7303     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7304   }
7305   ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7306 
7307   buf_size_idxs = 0;
7308   buf_size_vals = 0;
7309   buf_size_idxs_is = 0;
7310   buf_size_vecs = 0;
7311   for (i=0;i<n_recvs;i++) {
7312     buf_size_idxs += (PetscInt)olengths_idxs[i];
7313     buf_size_vals += (PetscInt)olengths_vals[i];
7314     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7315     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7316   }
7317   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7318   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7319   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7320   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7321 
7322   /* get new tags for clean communications */
7323   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7324   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7325   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7326   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7327 
7328   /* allocate for requests */
7329   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7330   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7331   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7332   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7333   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7334   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7335   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7336   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7337 
7338   /* communications */
7339   ptr_idxs = recv_buffer_idxs;
7340   ptr_vals = recv_buffer_vals;
7341   ptr_idxs_is = recv_buffer_idxs_is;
7342   ptr_vecs = recv_buffer_vecs;
7343   for (i=0;i<n_recvs;i++) {
7344     source_dest = onodes[i];
7345     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7346     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7347     ptr_idxs += olengths_idxs[i];
7348     ptr_vals += olengths_vals[i];
7349     if (nis) {
7350       source_dest = onodes_is[i];
7351       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);
7352       ptr_idxs_is += olengths_idxs_is[i];
7353     }
7354     if (nvecs) {
7355       source_dest = onodes[i];
7356       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7357       ptr_vecs += olengths_idxs[i]-2;
7358     }
7359   }
7360   for (i=0;i<n_sends;i++) {
7361     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7362     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7363     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7364     if (nis) {
7365       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);
7366     }
7367     if (nvecs) {
7368       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7369       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7370     }
7371   }
7372   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7373   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7374 
7375   /* assemble new l2g map */
7376   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7377   ptr_idxs = recv_buffer_idxs;
7378   new_local_rows = 0;
7379   for (i=0;i<n_recvs;i++) {
7380     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7381     ptr_idxs += olengths_idxs[i];
7382   }
7383   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7384   ptr_idxs = recv_buffer_idxs;
7385   new_local_rows = 0;
7386   for (i=0;i<n_recvs;i++) {
7387     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
7388     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7389     ptr_idxs += olengths_idxs[i];
7390   }
7391   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7392   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7393   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7394 
7395   /* infer new local matrix type from received local matrices type */
7396   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7397   /* 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) */
7398   if (n_recvs) {
7399     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7400     ptr_idxs = recv_buffer_idxs;
7401     for (i=0;i<n_recvs;i++) {
7402       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7403         new_local_type_private = MATAIJ_PRIVATE;
7404         break;
7405       }
7406       ptr_idxs += olengths_idxs[i];
7407     }
7408     switch (new_local_type_private) {
7409       case MATDENSE_PRIVATE:
7410         new_local_type = MATSEQAIJ;
7411         bs = 1;
7412         break;
7413       case MATAIJ_PRIVATE:
7414         new_local_type = MATSEQAIJ;
7415         bs = 1;
7416         break;
7417       case MATBAIJ_PRIVATE:
7418         new_local_type = MATSEQBAIJ;
7419         break;
7420       case MATSBAIJ_PRIVATE:
7421         new_local_type = MATSEQSBAIJ;
7422         break;
7423       default:
7424         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7425         break;
7426     }
7427   } else { /* by default, new_local_type is seqaij */
7428     new_local_type = MATSEQAIJ;
7429     bs = 1;
7430   }
7431 
7432   /* create MATIS object if needed */
7433   if (!reuse) {
7434     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7435     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7436   } else {
7437     /* it also destroys the local matrices */
7438     if (*mat_n) {
7439       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7440     } else { /* this is a fake object */
7441       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7442     }
7443   }
7444   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7445   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7446 
7447   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7448 
7449   /* Global to local map of received indices */
7450   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7451   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7452   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7453 
7454   /* restore attributes -> type of incoming data and its size */
7455   buf_size_idxs = 0;
7456   for (i=0;i<n_recvs;i++) {
7457     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7458     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7459     buf_size_idxs += (PetscInt)olengths_idxs[i];
7460   }
7461   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7462 
7463   /* set preallocation */
7464   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7465   if (!newisdense) {
7466     PetscInt *new_local_nnz=0;
7467 
7468     ptr_idxs = recv_buffer_idxs_local;
7469     if (n_recvs) {
7470       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7471     }
7472     for (i=0;i<n_recvs;i++) {
7473       PetscInt j;
7474       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7475         for (j=0;j<*(ptr_idxs+1);j++) {
7476           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7477         }
7478       } else {
7479         /* TODO */
7480       }
7481       ptr_idxs += olengths_idxs[i];
7482     }
7483     if (new_local_nnz) {
7484       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7485       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7486       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7487       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7488       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7489       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7490     } else {
7491       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7492     }
7493     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7494   } else {
7495     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7496   }
7497 
7498   /* set values */
7499   ptr_vals = recv_buffer_vals;
7500   ptr_idxs = recv_buffer_idxs_local;
7501   for (i=0;i<n_recvs;i++) {
7502     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7503       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7504       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7505       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7506       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7507       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7508     } else {
7509       /* TODO */
7510     }
7511     ptr_idxs += olengths_idxs[i];
7512     ptr_vals += olengths_vals[i];
7513   }
7514   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7515   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7516   ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7517   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7518   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7519   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7520 
7521 #if 0
7522   if (!restrict_comm) { /* check */
7523     Vec       lvec,rvec;
7524     PetscReal infty_error;
7525 
7526     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7527     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7528     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7529     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7530     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7531     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7532     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7533     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7534     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7535   }
7536 #endif
7537 
7538   /* assemble new additional is (if any) */
7539   if (nis) {
7540     PetscInt **temp_idxs,*count_is,j,psum;
7541 
7542     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7543     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7544     ptr_idxs = recv_buffer_idxs_is;
7545     psum = 0;
7546     for (i=0;i<n_recvs;i++) {
7547       for (j=0;j<nis;j++) {
7548         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7549         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7550         psum += plen;
7551         ptr_idxs += plen+1; /* shift pointer to received data */
7552       }
7553     }
7554     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7555     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7556     for (i=1;i<nis;i++) {
7557       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7558     }
7559     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7560     ptr_idxs = recv_buffer_idxs_is;
7561     for (i=0;i<n_recvs;i++) {
7562       for (j=0;j<nis;j++) {
7563         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7564         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7565         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7566         ptr_idxs += plen+1; /* shift pointer to received data */
7567       }
7568     }
7569     for (i=0;i<nis;i++) {
7570       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7571       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7572       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7573     }
7574     ierr = PetscFree(count_is);CHKERRQ(ierr);
7575     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7576     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7577   }
7578   /* free workspace */
7579   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7580   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7581   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7582   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7583   if (isdense) {
7584     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7585     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7586     ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7587   } else {
7588     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7589   }
7590   if (nis) {
7591     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7592     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7593   }
7594 
7595   if (nvecs) {
7596     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7597     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7598     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7599     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7600     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7601     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7602     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7603     /* set values */
7604     ptr_vals = recv_buffer_vecs;
7605     ptr_idxs = recv_buffer_idxs_local;
7606     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7607     for (i=0;i<n_recvs;i++) {
7608       PetscInt j;
7609       for (j=0;j<*(ptr_idxs+1);j++) {
7610         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7611       }
7612       ptr_idxs += olengths_idxs[i];
7613       ptr_vals += olengths_idxs[i]-2;
7614     }
7615     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7616     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7617     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7618   }
7619 
7620   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7621   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7622   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7623   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7624   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7625   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7626   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7627   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7628   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7629   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7630   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7631   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7632   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7633   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7634   ierr = PetscFree(onodes);CHKERRQ(ierr);
7635   if (nis) {
7636     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7637     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7638     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7639   }
7640   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7641   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7642     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7643     for (i=0;i<nis;i++) {
7644       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7645     }
7646     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7647       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7648     }
7649     *mat_n = NULL;
7650   }
7651   PetscFunctionReturn(0);
7652 }
7653 
7654 /* temporary hack into ksp private data structure */
7655 #include <petsc/private/kspimpl.h>
7656 
7657 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7658 {
7659   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7660   PC_IS                  *pcis = (PC_IS*)pc->data;
7661   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7662   Mat                    coarsedivudotp = NULL;
7663   Mat                    coarseG,t_coarse_mat_is;
7664   MatNullSpace           CoarseNullSpace = NULL;
7665   ISLocalToGlobalMapping coarse_islg;
7666   IS                     coarse_is,*isarray;
7667   PetscInt               i,im_active=-1,active_procs=-1;
7668   PetscInt               nis,nisdofs,nisneu,nisvert;
7669   PC                     pc_temp;
7670   PCType                 coarse_pc_type;
7671   KSPType                coarse_ksp_type;
7672   PetscBool              multilevel_requested,multilevel_allowed;
7673   PetscBool              coarse_reuse;
7674   PetscInt               ncoarse,nedcfield;
7675   PetscBool              compute_vecs = PETSC_FALSE;
7676   PetscScalar            *array;
7677   MatReuse               coarse_mat_reuse;
7678   PetscBool              restr, full_restr, have_void;
7679   PetscMPIInt            commsize;
7680   PetscErrorCode         ierr;
7681 
7682   PetscFunctionBegin;
7683   /* Assign global numbering to coarse dofs */
7684   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 */
7685     PetscInt ocoarse_size;
7686     compute_vecs = PETSC_TRUE;
7687 
7688     pcbddc->new_primal_space = PETSC_TRUE;
7689     ocoarse_size = pcbddc->coarse_size;
7690     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
7691     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
7692     /* see if we can avoid some work */
7693     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
7694       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
7695       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
7696         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
7697         coarse_reuse = PETSC_FALSE;
7698       } else { /* we can safely reuse already computed coarse matrix */
7699         coarse_reuse = PETSC_TRUE;
7700       }
7701     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
7702       coarse_reuse = PETSC_FALSE;
7703     }
7704     /* reset any subassembling information */
7705     if (!coarse_reuse || pcbddc->recompute_topography) {
7706       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7707     }
7708   } else { /* primal space is unchanged, so we can reuse coarse matrix */
7709     coarse_reuse = PETSC_TRUE;
7710   }
7711   /* assemble coarse matrix */
7712   if (coarse_reuse && pcbddc->coarse_ksp) {
7713     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
7714     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
7715     coarse_mat_reuse = MAT_REUSE_MATRIX;
7716   } else {
7717     coarse_mat = NULL;
7718     coarse_mat_reuse = MAT_INITIAL_MATRIX;
7719   }
7720 
7721   /* creates temporary l2gmap and IS for coarse indexes */
7722   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
7723   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
7724 
7725   /* creates temporary MATIS object for coarse matrix */
7726   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
7727   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7728   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
7729   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7730   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);
7731   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
7732   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7733   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7734   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
7735 
7736   /* count "active" (i.e. with positive local size) and "void" processes */
7737   im_active = !!(pcis->n);
7738   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7739 
7740   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
7741   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
7742   /* full_restr : just use the receivers from the subassembling pattern */
7743   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&commsize);CHKERRQ(ierr);
7744   coarse_mat_is = NULL;
7745   multilevel_allowed = PETSC_FALSE;
7746   multilevel_requested = PETSC_FALSE;
7747   pcbddc->coarse_eqs_per_proc = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
7748   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
7749   if (multilevel_requested) {
7750     ncoarse = active_procs/pcbddc->coarsening_ratio;
7751     restr = PETSC_FALSE;
7752     full_restr = PETSC_FALSE;
7753   } else {
7754     ncoarse = pcbddc->coarse_size/pcbddc->coarse_eqs_per_proc;
7755     restr = PETSC_TRUE;
7756     full_restr = PETSC_TRUE;
7757   }
7758   if (!pcbddc->coarse_size || commsize == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
7759   ncoarse = PetscMax(1,ncoarse);
7760   if (!pcbddc->coarse_subassembling) {
7761     if (pcbddc->coarsening_ratio > 1) {
7762       if (multilevel_requested) {
7763         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7764       } else {
7765         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7766       }
7767     } else {
7768       PetscMPIInt rank;
7769       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
7770       have_void = (active_procs == (PetscInt)commsize) ? PETSC_FALSE : PETSC_TRUE;
7771       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7772     }
7773   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
7774     PetscInt    psum;
7775     if (pcbddc->coarse_ksp) psum = 1;
7776     else psum = 0;
7777     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7778     if (ncoarse < commsize) have_void = PETSC_TRUE;
7779   }
7780   /* determine if we can go multilevel */
7781   if (multilevel_requested) {
7782     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
7783     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
7784   }
7785   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
7786 
7787   /* dump subassembling pattern */
7788   if (pcbddc->dbg_flag && multilevel_allowed) {
7789     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
7790   }
7791 
7792   /* compute dofs splitting and neumann boundaries for coarse dofs */
7793   nedcfield = -1;
7794   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal)) { /* protects from unneded computations */
7795     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
7796     const PetscInt         *idxs;
7797     ISLocalToGlobalMapping tmap;
7798 
7799     /* create map between primal indices (in local representative ordering) and local primal numbering */
7800     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
7801     /* allocate space for temporary storage */
7802     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
7803     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
7804     /* allocate for IS array */
7805     nisdofs = pcbddc->n_ISForDofsLocal;
7806     if (pcbddc->nedclocal) {
7807       if (pcbddc->nedfield > -1) {
7808         nedcfield = pcbddc->nedfield;
7809       } else {
7810         nedcfield = 0;
7811         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%d)",nisdofs);
7812         nisdofs = 1;
7813       }
7814     }
7815     nisneu = !!pcbddc->NeumannBoundariesLocal;
7816     nisvert = 0; /* nisvert is not used */
7817     nis = nisdofs + nisneu + nisvert;
7818     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
7819     /* dofs splitting */
7820     for (i=0;i<nisdofs;i++) {
7821       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
7822       if (nedcfield != i) {
7823         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
7824         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7825         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7826         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7827       } else {
7828         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
7829         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7830         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7831         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %d != %d\n",tsize,nout);
7832         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7833       }
7834       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7835       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7836       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
7837     }
7838     /* neumann boundaries */
7839     if (pcbddc->NeumannBoundariesLocal) {
7840       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
7841       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
7842       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7843       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7844       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7845       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7846       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
7847       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
7848     }
7849     /* free memory */
7850     ierr = PetscFree(tidxs);CHKERRQ(ierr);
7851     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
7852     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
7853   } else {
7854     nis = 0;
7855     nisdofs = 0;
7856     nisneu = 0;
7857     nisvert = 0;
7858     isarray = NULL;
7859   }
7860   /* destroy no longer needed map */
7861   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
7862 
7863   /* subassemble */
7864   if (multilevel_allowed) {
7865     Vec       vp[1];
7866     PetscInt  nvecs = 0;
7867     PetscBool reuse,reuser;
7868 
7869     if (coarse_mat) reuse = PETSC_TRUE;
7870     else reuse = PETSC_FALSE;
7871     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7872     vp[0] = NULL;
7873     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
7874       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
7875       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
7876       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
7877       nvecs = 1;
7878 
7879       if (pcbddc->divudotp) {
7880         Mat      B,loc_divudotp;
7881         Vec      v,p;
7882         IS       dummy;
7883         PetscInt np;
7884 
7885         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
7886         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
7887         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
7888         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
7889         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
7890         ierr = VecSet(p,1.);CHKERRQ(ierr);
7891         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
7892         ierr = VecDestroy(&p);CHKERRQ(ierr);
7893         ierr = MatDestroy(&B);CHKERRQ(ierr);
7894         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
7895         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
7896         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
7897         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
7898         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
7899         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
7900         ierr = VecDestroy(&v);CHKERRQ(ierr);
7901       }
7902     }
7903     if (reuser) {
7904       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7905     } else {
7906       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7907     }
7908     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
7909       PetscScalar *arraym,*arrayv;
7910       PetscInt    nl;
7911       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
7912       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
7913       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7914       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
7915       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
7916       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
7917       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7918       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
7919     } else {
7920       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
7921     }
7922   } else {
7923     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
7924   }
7925   if (coarse_mat_is || coarse_mat) {
7926     PetscMPIInt size;
7927     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)coarse_mat_is),&size);CHKERRQ(ierr);
7928     if (!multilevel_allowed) {
7929       ierr = MatISGetMPIXAIJ(coarse_mat_is,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
7930     } else {
7931       Mat A;
7932 
7933       /* if this matrix is present, it means we are not reusing the coarse matrix */
7934       if (coarse_mat_is) {
7935         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
7936         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
7937         coarse_mat = coarse_mat_is;
7938       }
7939       /* be sure we don't have MatSeqDENSE as local mat */
7940       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
7941       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
7942     }
7943   }
7944   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
7945   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
7946 
7947   /* create local to global scatters for coarse problem */
7948   if (compute_vecs) {
7949     PetscInt lrows;
7950     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
7951     if (coarse_mat) {
7952       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
7953     } else {
7954       lrows = 0;
7955     }
7956     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
7957     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
7958     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
7959     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7960     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7961   }
7962   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
7963 
7964   /* set defaults for coarse KSP and PC */
7965   if (multilevel_allowed) {
7966     coarse_ksp_type = KSPRICHARDSON;
7967     coarse_pc_type = PCBDDC;
7968   } else {
7969     coarse_ksp_type = KSPPREONLY;
7970     coarse_pc_type = PCREDUNDANT;
7971   }
7972 
7973   /* print some info if requested */
7974   if (pcbddc->dbg_flag) {
7975     if (!multilevel_allowed) {
7976       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
7977       if (multilevel_requested) {
7978         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);
7979       } else if (pcbddc->max_levels) {
7980         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
7981       }
7982       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7983     }
7984   }
7985 
7986   /* communicate coarse discrete gradient */
7987   coarseG = NULL;
7988   if (pcbddc->nedcG && multilevel_allowed) {
7989     MPI_Comm ccomm;
7990     if (coarse_mat) {
7991       ccomm = PetscObjectComm((PetscObject)coarse_mat);
7992     } else {
7993       ccomm = MPI_COMM_NULL;
7994     }
7995     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
7996   }
7997 
7998   /* create the coarse KSP object only once with defaults */
7999   if (coarse_mat) {
8000     PetscBool   isredundant,isnn,isbddc;
8001     PetscViewer dbg_viewer = NULL;
8002 
8003     if (pcbddc->dbg_flag) {
8004       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
8005       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8006     }
8007     if (!pcbddc->coarse_ksp) {
8008       char prefix[256],str_level[16];
8009       size_t len;
8010 
8011       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
8012       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8013       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
8014       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
8015       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8016       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
8017       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
8018       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8019       /* TODO is this logic correct? should check for coarse_mat type */
8020       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8021       /* prefix */
8022       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
8023       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
8024       if (!pcbddc->current_level) {
8025         ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
8026         ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
8027       } else {
8028         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
8029         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
8030         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
8031         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
8032         ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
8033         ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
8034       }
8035       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
8036       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8037       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8038       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8039       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8040       /* allow user customization */
8041       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
8042     }
8043     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8044     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8045     if (nisdofs) {
8046       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
8047       for (i=0;i<nisdofs;i++) {
8048         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8049       }
8050     }
8051     if (nisneu) {
8052       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
8053       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
8054     }
8055     if (nisvert) {
8056       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
8057       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
8058     }
8059     if (coarseG) {
8060       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
8061     }
8062 
8063     /* get some info after set from options */
8064     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8065     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
8066     if (isbddc && !multilevel_allowed) {
8067       ierr   = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8068       isbddc = PETSC_FALSE;
8069     }
8070     /* multilevel cannot be done with coarse PCs different from BDDC or NN */
8071     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
8072     if (multilevel_requested && multilevel_allowed && !isbddc && !isnn) {
8073       ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8074       isbddc = PETSC_TRUE;
8075     }
8076     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
8077     if (isredundant) {
8078       KSP inner_ksp;
8079       PC  inner_pc;
8080 
8081       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
8082       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
8083     }
8084 
8085     /* parameters which miss an API */
8086     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8087     if (isbddc) {
8088       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
8089 
8090       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
8091       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
8092       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
8093       if (pcbddc_coarse->benign_saddle_point) {
8094         Mat                    coarsedivudotp_is;
8095         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
8096         IS                     row,col;
8097         const PetscInt         *gidxs;
8098         PetscInt               n,st,M,N;
8099 
8100         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
8101         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
8102         st   = st-n;
8103         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
8104         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
8105         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
8106         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8107         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
8108         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8109         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
8110         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
8111         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
8112         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
8113         ierr = ISDestroy(&row);CHKERRQ(ierr);
8114         ierr = ISDestroy(&col);CHKERRQ(ierr);
8115         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
8116         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
8117         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
8118         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
8119         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
8120         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
8121         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
8122         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8123         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
8124         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
8125         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
8126         if (pcbddc->adaptive_threshold[0] == 0.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
8127       }
8128     }
8129 
8130     /* propagate symmetry info of coarse matrix */
8131     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
8132     if (pc->pmat->symmetric_set) {
8133       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
8134     }
8135     if (pc->pmat->hermitian_set) {
8136       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
8137     }
8138     if (pc->pmat->spd_set) {
8139       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
8140     }
8141     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
8142       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
8143     }
8144     /* set operators */
8145     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8146     if (pcbddc->dbg_flag) {
8147       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8148     }
8149   }
8150   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
8151   ierr = PetscFree(isarray);CHKERRQ(ierr);
8152 #if 0
8153   {
8154     PetscViewer viewer;
8155     char filename[256];
8156     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
8157     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
8158     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
8159     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
8160     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
8161     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
8162   }
8163 #endif
8164 
8165   if (pcbddc->coarse_ksp) {
8166     Vec crhs,csol;
8167 
8168     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
8169     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
8170     if (!csol) {
8171       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
8172     }
8173     if (!crhs) {
8174       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
8175     }
8176   }
8177   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8178 
8179   /* compute null space for coarse solver if the benign trick has been requested */
8180   if (pcbddc->benign_null) {
8181 
8182     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
8183     for (i=0;i<pcbddc->benign_n;i++) {
8184       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
8185     }
8186     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
8187     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
8188     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8189     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8190     if (coarse_mat) {
8191       Vec         nullv;
8192       PetscScalar *array,*array2;
8193       PetscInt    nl;
8194 
8195       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
8196       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
8197       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8198       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
8199       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
8200       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
8201       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8202       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
8203       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
8204       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
8205     }
8206   }
8207 
8208   if (pcbddc->coarse_ksp) {
8209     PetscBool ispreonly;
8210 
8211     if (CoarseNullSpace) {
8212       PetscBool isnull;
8213       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
8214       if (isnull) {
8215         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
8216       }
8217       /* TODO: add local nullspaces (if any) */
8218     }
8219     /* setup coarse ksp */
8220     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
8221     /* Check coarse problem if in debug mode or if solving with an iterative method */
8222     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
8223     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
8224       KSP       check_ksp;
8225       KSPType   check_ksp_type;
8226       PC        check_pc;
8227       Vec       check_vec,coarse_vec;
8228       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8229       PetscInt  its;
8230       PetscBool compute_eigs;
8231       PetscReal *eigs_r,*eigs_c;
8232       PetscInt  neigs;
8233       const char *prefix;
8234 
8235       /* Create ksp object suitable for estimation of extreme eigenvalues */
8236       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
8237       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8238       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8239       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
8240       /* prevent from setup unneeded object */
8241       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
8242       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
8243       if (ispreonly) {
8244         check_ksp_type = KSPPREONLY;
8245         compute_eigs = PETSC_FALSE;
8246       } else {
8247         check_ksp_type = KSPGMRES;
8248         compute_eigs = PETSC_TRUE;
8249       }
8250       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
8251       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
8252       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
8253       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
8254       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
8255       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
8256       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
8257       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
8258       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
8259       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
8260       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
8261       /* create random vec */
8262       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
8263       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8264       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8265       /* solve coarse problem */
8266       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8267       /* set eigenvalue estimation if preonly has not been requested */
8268       if (compute_eigs) {
8269         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8270         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8271         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8272         if (neigs) {
8273           lambda_max = eigs_r[neigs-1];
8274           lambda_min = eigs_r[0];
8275           if (pcbddc->use_coarse_estimates) {
8276             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8277               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8278               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8279             }
8280           }
8281         }
8282       }
8283 
8284       /* check coarse problem residual error */
8285       if (pcbddc->dbg_flag) {
8286         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8287         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8288         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8289         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8290         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8291         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8292         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8293         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8294         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8295         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8296         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8297         if (CoarseNullSpace) {
8298           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8299         }
8300         if (compute_eigs) {
8301           PetscReal          lambda_max_s,lambda_min_s;
8302           KSPConvergedReason reason;
8303           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8304           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8305           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8306           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8307           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);
8308           for (i=0;i<neigs;i++) {
8309             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8310           }
8311         }
8312         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8313         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8314       }
8315       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8316       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8317       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8318       if (compute_eigs) {
8319         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8320         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8321       }
8322     }
8323   }
8324   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8325   /* print additional info */
8326   if (pcbddc->dbg_flag) {
8327     /* waits until all processes reaches this point */
8328     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8329     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
8330     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8331   }
8332 
8333   /* free memory */
8334   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8335   PetscFunctionReturn(0);
8336 }
8337 
8338 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8339 {
8340   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8341   PC_IS*         pcis = (PC_IS*)pc->data;
8342   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8343   IS             subset,subset_mult,subset_n;
8344   PetscInt       local_size,coarse_size=0;
8345   PetscInt       *local_primal_indices=NULL;
8346   const PetscInt *t_local_primal_indices;
8347   PetscErrorCode ierr;
8348 
8349   PetscFunctionBegin;
8350   /* Compute global number of coarse dofs */
8351   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8352   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8353   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8354   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8355   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8356   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8357   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8358   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8359   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8360   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);
8361   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8362   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8363   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
8364   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8365   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8366 
8367   /* check numbering */
8368   if (pcbddc->dbg_flag) {
8369     PetscScalar coarsesum,*array,*array2;
8370     PetscInt    i;
8371     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8372 
8373     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8374     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8375     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8376     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8377     /* counter */
8378     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8379     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8380     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8381     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8382     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8383     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8384     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8385     for (i=0;i<pcbddc->local_primal_size;i++) {
8386       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8387     }
8388     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8389     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8390     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8391     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8392     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8393     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8394     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8395     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8396     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8397     for (i=0;i<pcis->n;i++) {
8398       if (array[i] != 0.0 && array[i] != array2[i]) {
8399         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8400         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8401         set_error = PETSC_TRUE;
8402         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8403         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);
8404       }
8405     }
8406     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8407     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8408     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8409     for (i=0;i<pcis->n;i++) {
8410       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8411     }
8412     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8413     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8414     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8415     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8416     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8417     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8418     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8419       PetscInt *gidxs;
8420 
8421       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8422       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8423       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8424       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8425       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8426       for (i=0;i<pcbddc->local_primal_size;i++) {
8427         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);
8428       }
8429       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8430       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8431     }
8432     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8433     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8434     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8435   }
8436   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
8437   /* get back data */
8438   *coarse_size_n = coarse_size;
8439   *local_primal_indices_n = local_primal_indices;
8440   PetscFunctionReturn(0);
8441 }
8442 
8443 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8444 {
8445   IS             localis_t;
8446   PetscInt       i,lsize,*idxs,n;
8447   PetscScalar    *vals;
8448   PetscErrorCode ierr;
8449 
8450   PetscFunctionBegin;
8451   /* get indices in local ordering exploiting local to global map */
8452   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8453   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8454   for (i=0;i<lsize;i++) vals[i] = 1.0;
8455   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8456   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8457   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8458   if (idxs) { /* multilevel guard */
8459     ierr = VecSetOption(gwork,VEC_IGNORE_NEGATIVE_INDICES,PETSC_TRUE);CHKERRQ(ierr);
8460     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8461   }
8462   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8463   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8464   ierr = PetscFree(vals);CHKERRQ(ierr);
8465   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8466   /* now compute set in local ordering */
8467   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8468   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8469   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8470   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8471   for (i=0,lsize=0;i<n;i++) {
8472     if (PetscRealPart(vals[i]) > 0.5) {
8473       lsize++;
8474     }
8475   }
8476   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8477   for (i=0,lsize=0;i<n;i++) {
8478     if (PetscRealPart(vals[i]) > 0.5) {
8479       idxs[lsize++] = i;
8480     }
8481   }
8482   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8483   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8484   *localis = localis_t;
8485   PetscFunctionReturn(0);
8486 }
8487 
8488 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8489 {
8490   PC_IS               *pcis=(PC_IS*)pc->data;
8491   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8492   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8493   Mat                 S_j;
8494   PetscInt            *used_xadj,*used_adjncy;
8495   PetscBool           free_used_adj;
8496   PetscErrorCode      ierr;
8497 
8498   PetscFunctionBegin;
8499   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8500   free_used_adj = PETSC_FALSE;
8501   if (pcbddc->sub_schurs_layers == -1) {
8502     used_xadj = NULL;
8503     used_adjncy = NULL;
8504   } else {
8505     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8506       used_xadj = pcbddc->mat_graph->xadj;
8507       used_adjncy = pcbddc->mat_graph->adjncy;
8508     } else if (pcbddc->computed_rowadj) {
8509       used_xadj = pcbddc->mat_graph->xadj;
8510       used_adjncy = pcbddc->mat_graph->adjncy;
8511     } else {
8512       PetscBool      flg_row=PETSC_FALSE;
8513       const PetscInt *xadj,*adjncy;
8514       PetscInt       nvtxs;
8515 
8516       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8517       if (flg_row) {
8518         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8519         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8520         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8521         free_used_adj = PETSC_TRUE;
8522       } else {
8523         pcbddc->sub_schurs_layers = -1;
8524         used_xadj = NULL;
8525         used_adjncy = NULL;
8526       }
8527       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8528     }
8529   }
8530 
8531   /* setup sub_schurs data */
8532   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8533   if (!sub_schurs->schur_explicit) {
8534     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8535     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8536     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);
8537   } else {
8538     Mat       change = NULL;
8539     Vec       scaling = NULL;
8540     IS        change_primal = NULL, iP;
8541     PetscInt  benign_n;
8542     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8543     PetscBool isseqaij,need_change = PETSC_FALSE;
8544     PetscBool discrete_harmonic = PETSC_FALSE;
8545 
8546     if (!pcbddc->use_vertices && reuse_solvers) {
8547       PetscInt n_vertices;
8548 
8549       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8550       reuse_solvers = (PetscBool)!n_vertices;
8551     }
8552     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8553     if (!isseqaij) {
8554       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8555       if (matis->A == pcbddc->local_mat) {
8556         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8557         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8558       } else {
8559         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8560       }
8561     }
8562     if (!pcbddc->benign_change_explicit) {
8563       benign_n = pcbddc->benign_n;
8564     } else {
8565       benign_n = 0;
8566     }
8567     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
8568        We need a global reduction to avoid possible deadlocks.
8569        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
8570     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
8571       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
8572       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8573       need_change = (PetscBool)(!need_change);
8574     }
8575     /* If the user defines additional constraints, we import them here.
8576        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 */
8577     if (need_change) {
8578       PC_IS   *pcisf;
8579       PC_BDDC *pcbddcf;
8580       PC      pcf;
8581 
8582       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
8583       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
8584       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
8585       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
8586 
8587       /* hacks */
8588       pcisf                        = (PC_IS*)pcf->data;
8589       pcisf->is_B_local            = pcis->is_B_local;
8590       pcisf->vec1_N                = pcis->vec1_N;
8591       pcisf->BtoNmap               = pcis->BtoNmap;
8592       pcisf->n                     = pcis->n;
8593       pcisf->n_B                   = pcis->n_B;
8594       pcbddcf                      = (PC_BDDC*)pcf->data;
8595       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
8596       pcbddcf->mat_graph           = pcbddc->mat_graph;
8597       pcbddcf->use_faces           = PETSC_TRUE;
8598       pcbddcf->use_change_of_basis = PETSC_TRUE;
8599       pcbddcf->use_change_on_faces = PETSC_TRUE;
8600       pcbddcf->use_qr_single       = PETSC_TRUE;
8601       pcbddcf->fake_change         = PETSC_TRUE;
8602 
8603       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
8604       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
8605       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
8606       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
8607       change = pcbddcf->ConstraintMatrix;
8608       pcbddcf->ConstraintMatrix = NULL;
8609 
8610       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
8611       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
8612       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
8613       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
8614       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
8615       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
8616       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
8617       pcf->ops->destroy = NULL;
8618       pcf->ops->reset   = NULL;
8619       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
8620     }
8621     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
8622 
8623     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
8624     if (iP) {
8625       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
8626       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
8627       ierr = PetscOptionsEnd();CHKERRQ(ierr);
8628     }
8629     if (discrete_harmonic) {
8630       Mat A;
8631       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
8632       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
8633       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
8634       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);
8635       ierr = MatDestroy(&A);CHKERRQ(ierr);
8636     } else {
8637       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);
8638     }
8639     ierr = MatDestroy(&change);CHKERRQ(ierr);
8640     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
8641   }
8642   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8643 
8644   /* free adjacency */
8645   if (free_used_adj) {
8646     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
8647   }
8648   PetscFunctionReturn(0);
8649 }
8650 
8651 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
8652 {
8653   PC_IS               *pcis=(PC_IS*)pc->data;
8654   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8655   PCBDDCGraph         graph;
8656   PetscErrorCode      ierr;
8657 
8658   PetscFunctionBegin;
8659   /* attach interface graph for determining subsets */
8660   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
8661     IS       verticesIS,verticescomm;
8662     PetscInt vsize,*idxs;
8663 
8664     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8665     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
8666     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8667     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
8668     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8669     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8670     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
8671     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
8672     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
8673     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
8674     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
8675   } else {
8676     graph = pcbddc->mat_graph;
8677   }
8678   /* print some info */
8679   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
8680     IS       vertices;
8681     PetscInt nv,nedges,nfaces;
8682     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
8683     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8684     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
8685     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8686     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
8687     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
8688     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
8689     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
8690     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8691     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8692     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8693   }
8694 
8695   /* sub_schurs init */
8696   if (!pcbddc->sub_schurs) {
8697     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
8698   }
8699   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);
8700 
8701   /* free graph struct */
8702   if (pcbddc->sub_schurs_rebuild) {
8703     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
8704   }
8705   PetscFunctionReturn(0);
8706 }
8707 
8708 PetscErrorCode PCBDDCCheckOperator(PC pc)
8709 {
8710   PC_IS               *pcis=(PC_IS*)pc->data;
8711   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8712   PetscErrorCode      ierr;
8713 
8714   PetscFunctionBegin;
8715   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
8716     IS             zerodiag = NULL;
8717     Mat            S_j,B0_B=NULL;
8718     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
8719     PetscScalar    *p0_check,*array,*array2;
8720     PetscReal      norm;
8721     PetscInt       i;
8722 
8723     /* B0 and B0_B */
8724     if (zerodiag) {
8725       IS       dummy;
8726 
8727       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
8728       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
8729       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
8730       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8731     }
8732     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
8733     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
8734     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
8735     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8736     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8737     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8738     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8739     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
8740     /* S_j */
8741     ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8742     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8743 
8744     /* mimic vector in \widetilde{W}_\Gamma */
8745     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
8746     /* continuous in primal space */
8747     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
8748     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8749     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8750     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8751     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
8752     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
8753     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8754     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8755     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8756     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8757     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8758     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8759     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
8760     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
8761 
8762     /* assemble rhs for coarse problem */
8763     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
8764     /* local with Schur */
8765     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
8766     if (zerodiag) {
8767       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8768       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
8769       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8770       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
8771     }
8772     /* sum on primal nodes the local contributions */
8773     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8774     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8775     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8776     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8777     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
8778     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8779     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8780     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
8781     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8782     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8783     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8784     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8785     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8786     /* scale primal nodes (BDDC sums contibutions) */
8787     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
8788     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8789     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8790     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8791     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8792     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8793     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8794     /* global: \widetilde{B0}_B w_\Gamma */
8795     if (zerodiag) {
8796       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
8797       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8798       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
8799       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8800     }
8801     /* BDDC */
8802     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
8803     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
8804 
8805     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
8806     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
8807     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
8808     PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);
8809     for (i=0;i<pcbddc->benign_n;i++) {
8810       PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%d] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));
8811     }
8812     ierr = PetscFree(p0_check);CHKERRQ(ierr);
8813     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
8814     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
8815     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
8816     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8817     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
8818   }
8819   PetscFunctionReturn(0);
8820 }
8821 
8822 #include <../src/mat/impls/aij/mpi/mpiaij.h>
8823 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
8824 {
8825   Mat            At;
8826   IS             rows;
8827   PetscInt       rst,ren;
8828   PetscErrorCode ierr;
8829   PetscLayout    rmap;
8830 
8831   PetscFunctionBegin;
8832   rst = ren = 0;
8833   if (ccomm != MPI_COMM_NULL) {
8834     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
8835     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
8836     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
8837     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
8838     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
8839   }
8840   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
8841   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
8842   ierr = ISDestroy(&rows);CHKERRQ(ierr);
8843 
8844   if (ccomm != MPI_COMM_NULL) {
8845     Mat_MPIAIJ *a,*b;
8846     IS         from,to;
8847     Vec        gvec;
8848     PetscInt   lsize;
8849 
8850     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
8851     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
8852     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
8853     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
8854     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
8855     a    = (Mat_MPIAIJ*)At->data;
8856     b    = (Mat_MPIAIJ*)(*B)->data;
8857     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
8858     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
8859     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
8860     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
8861     b->A = a->A;
8862     b->B = a->B;
8863 
8864     b->donotstash      = a->donotstash;
8865     b->roworiented     = a->roworiented;
8866     b->rowindices      = 0;
8867     b->rowvalues       = 0;
8868     b->getrowactive    = PETSC_FALSE;
8869 
8870     (*B)->rmap         = rmap;
8871     (*B)->factortype   = A->factortype;
8872     (*B)->assembled    = PETSC_TRUE;
8873     (*B)->insertmode   = NOT_SET_VALUES;
8874     (*B)->preallocated = PETSC_TRUE;
8875 
8876     if (a->colmap) {
8877 #if defined(PETSC_USE_CTABLE)
8878       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
8879 #else
8880       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
8881       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8882       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8883 #endif
8884     } else b->colmap = 0;
8885     if (a->garray) {
8886       PetscInt len;
8887       len  = a->B->cmap->n;
8888       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
8889       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
8890       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
8891     } else b->garray = 0;
8892 
8893     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
8894     b->lvec = a->lvec;
8895     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
8896 
8897     /* cannot use VecScatterCopy */
8898     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
8899     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
8900     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
8901     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
8902     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
8903     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
8904     ierr = ISDestroy(&from);CHKERRQ(ierr);
8905     ierr = ISDestroy(&to);CHKERRQ(ierr);
8906     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
8907   }
8908   ierr = MatDestroy(&At);CHKERRQ(ierr);
8909   PetscFunctionReturn(0);
8910 }
8911