xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision ab8c8b98ef300a0031b373b0ef229024b50c2526)
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       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
5067       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
5068       /* default */
5069       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
5070       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
5071       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5072       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5073       if (issbaij) {
5074         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5075       } else {
5076         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5077       }
5078       /* Allow user's customization */
5079       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
5080     }
5081     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
5082     if (sub_schurs && sub_schurs->reuse_solver) {
5083       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5084 
5085       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
5086     }
5087     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5088     if (!n_D) {
5089       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5090       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5091     }
5092     /* Set Up KSP for Dirichlet problem of BDDC */
5093     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
5094     /* set ksp_D into pcis data */
5095     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
5096     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
5097     pcis->ksp_D = pcbddc->ksp_D;
5098   }
5099 
5100   /* NEUMANN PROBLEM */
5101   A_RR = 0;
5102   if (neumann) {
5103     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5104     PetscInt        ibs,mbs;
5105     PetscBool       issbaij, reuse_neumann_solver;
5106     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
5107 
5108     reuse_neumann_solver = PETSC_FALSE;
5109     if (sub_schurs && sub_schurs->reuse_solver) {
5110       IS iP;
5111 
5112       reuse_neumann_solver = PETSC_TRUE;
5113       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
5114       if (iP) reuse_neumann_solver = PETSC_FALSE;
5115     }
5116     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
5117     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
5118     if (pcbddc->ksp_R) { /* already created ksp */
5119       PetscInt nn_R;
5120       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
5121       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5122       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
5123       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
5124         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
5125         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5126         reuse = MAT_INITIAL_MATRIX;
5127       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5128         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5129           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5130           reuse = MAT_INITIAL_MATRIX;
5131         } else { /* safe to reuse the matrix */
5132           reuse = MAT_REUSE_MATRIX;
5133         }
5134       }
5135       /* last check */
5136       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5137         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5138         reuse = MAT_INITIAL_MATRIX;
5139       }
5140     } else { /* first time, so we need to create the matrix */
5141       reuse = MAT_INITIAL_MATRIX;
5142     }
5143     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
5144     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5145     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5146     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5147     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5148       if (matis->A == pcbddc->local_mat) {
5149         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5150         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5151       } else {
5152         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5153       }
5154     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5155       if (matis->A == pcbddc->local_mat) {
5156         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5157         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5158       } else {
5159         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5160       }
5161     }
5162     /* extract A_RR */
5163     if (reuse_neumann_solver) {
5164       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5165 
5166       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5167         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5168         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5169           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5170         } else {
5171           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5172         }
5173       } else {
5174         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5175         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5176         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5177       }
5178     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5179       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5180     }
5181     if (pcbddc->local_mat->symmetric_set) {
5182       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
5183     }
5184     if (!pcbddc->ksp_R) { /* create object if not present */
5185       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5186       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5187       /* default */
5188       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5189       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5190       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5191       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5192       if (issbaij) {
5193         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5194       } else {
5195         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5196       }
5197       /* Allow user's customization */
5198       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5199     }
5200     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5201     if (!n_R) {
5202       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5203       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5204     }
5205     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5206     /* Reuse solver if it is present */
5207     if (reuse_neumann_solver) {
5208       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5209 
5210       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5211     }
5212     /* Set Up KSP for Neumann problem of BDDC */
5213     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
5214   }
5215 
5216   if (pcbddc->dbg_flag) {
5217     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5218     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5219     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5220   }
5221 
5222   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5223   check_corr = PETSC_FALSE;
5224   if (pcbddc->NullSpace_corr[0]) {
5225     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5226   }
5227   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5228     check_corr = PETSC_TRUE;
5229     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5230   }
5231   if (neumann && pcbddc->NullSpace_corr[2]) {
5232     check_corr = PETSC_TRUE;
5233     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5234   }
5235   /* check Dirichlet and Neumann solvers */
5236   if (pcbddc->dbg_flag) {
5237     if (dirichlet) { /* Dirichlet */
5238       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5239       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5240       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5241       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5242       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5243       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);
5244       if (check_corr) {
5245         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_TRUE);CHKERRQ(ierr);
5246       }
5247       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5248     }
5249     if (neumann) { /* Neumann */
5250       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5251       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5252       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5253       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5254       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5255       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);
5256       if (check_corr) {
5257         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_FALSE);CHKERRQ(ierr);
5258       }
5259       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5260     }
5261   }
5262   /* free Neumann problem's matrix */
5263   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5264   PetscFunctionReturn(0);
5265 }
5266 
5267 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5268 {
5269   PetscErrorCode  ierr;
5270   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5271   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5272   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5273 
5274   PetscFunctionBegin;
5275   if (!reuse_solver) {
5276     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5277   }
5278   if (!pcbddc->switch_static) {
5279     if (applytranspose && pcbddc->local_auxmat1) {
5280       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5281       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5282     }
5283     if (!reuse_solver) {
5284       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5285       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5286     } else {
5287       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5288 
5289       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5290       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5291     }
5292   } else {
5293     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5294     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5295     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5296     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5297     if (applytranspose && pcbddc->local_auxmat1) {
5298       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5299       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5300       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5301       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5302     }
5303   }
5304   if (!reuse_solver || pcbddc->switch_static) {
5305     if (applytranspose) {
5306       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5307     } else {
5308       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5309     }
5310   } else {
5311     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5312 
5313     if (applytranspose) {
5314       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5315     } else {
5316       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5317     }
5318   }
5319   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5320   if (!pcbddc->switch_static) {
5321     if (!reuse_solver) {
5322       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5323       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5324     } else {
5325       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5326 
5327       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5328       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5329     }
5330     if (!applytranspose && pcbddc->local_auxmat1) {
5331       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5332       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5333     }
5334   } else {
5335     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5336     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5337     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5338     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5339     if (!applytranspose && pcbddc->local_auxmat1) {
5340       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5341       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5342     }
5343     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5344     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5345     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5346     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5347   }
5348   PetscFunctionReturn(0);
5349 }
5350 
5351 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5352 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5353 {
5354   PetscErrorCode ierr;
5355   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5356   PC_IS*            pcis = (PC_IS*)  (pc->data);
5357   const PetscScalar zero = 0.0;
5358 
5359   PetscFunctionBegin;
5360   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5361   if (!pcbddc->benign_apply_coarse_only) {
5362     if (applytranspose) {
5363       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5364       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5365     } else {
5366       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5367       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5368     }
5369   } else {
5370     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5371   }
5372 
5373   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5374   if (pcbddc->benign_n) {
5375     PetscScalar *array;
5376     PetscInt    j;
5377 
5378     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5379     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5380     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5381   }
5382 
5383   /* start communications from local primal nodes to rhs of coarse solver */
5384   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5385   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5386   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5387 
5388   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5389   if (pcbddc->coarse_ksp) {
5390     Mat          coarse_mat;
5391     Vec          rhs,sol;
5392     MatNullSpace nullsp;
5393     PetscBool    isbddc = PETSC_FALSE;
5394 
5395     if (pcbddc->benign_have_null) {
5396       PC        coarse_pc;
5397 
5398       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5399       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5400       /* we need to propagate to coarser levels the need for a possible benign correction */
5401       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5402         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5403         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5404         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5405       }
5406     }
5407     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5408     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5409     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5410     ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5411     if (nullsp) {
5412       ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5413     }
5414     if (applytranspose) {
5415       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5416       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5417     } else {
5418       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5419         PC        coarse_pc;
5420 
5421         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5422         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5423         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5424         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5425       } else {
5426         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5427       }
5428     }
5429     /* we don't need the benign correction at coarser levels anymore */
5430     if (pcbddc->benign_have_null && isbddc) {
5431       PC        coarse_pc;
5432       PC_BDDC*  coarsepcbddc;
5433 
5434       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5435       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5436       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5437       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5438     }
5439     if (nullsp) {
5440       ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5441     }
5442   }
5443 
5444   /* Local solution on R nodes */
5445   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5446     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5447   }
5448   /* communications from coarse sol to local primal nodes */
5449   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5450   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5451 
5452   /* Sum contributions from the two levels */
5453   if (!pcbddc->benign_apply_coarse_only) {
5454     if (applytranspose) {
5455       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5456       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5457     } else {
5458       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5459       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5460     }
5461     /* store p0 */
5462     if (pcbddc->benign_n) {
5463       PetscScalar *array;
5464       PetscInt    j;
5465 
5466       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5467       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5468       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5469     }
5470   } else { /* expand the coarse solution */
5471     if (applytranspose) {
5472       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5473     } else {
5474       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5475     }
5476   }
5477   PetscFunctionReturn(0);
5478 }
5479 
5480 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5481 {
5482   PetscErrorCode ierr;
5483   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5484   PetscScalar    *array;
5485   Vec            from,to;
5486 
5487   PetscFunctionBegin;
5488   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5489     from = pcbddc->coarse_vec;
5490     to = pcbddc->vec1_P;
5491     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5492       Vec tvec;
5493 
5494       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5495       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5496       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5497       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5498       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5499       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5500     }
5501   } else { /* from local to global -> put data in coarse right hand side */
5502     from = pcbddc->vec1_P;
5503     to = pcbddc->coarse_vec;
5504   }
5505   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5506   PetscFunctionReturn(0);
5507 }
5508 
5509 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5510 {
5511   PetscErrorCode ierr;
5512   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5513   PetscScalar    *array;
5514   Vec            from,to;
5515 
5516   PetscFunctionBegin;
5517   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5518     from = pcbddc->coarse_vec;
5519     to = pcbddc->vec1_P;
5520   } else { /* from local to global -> put data in coarse right hand side */
5521     from = pcbddc->vec1_P;
5522     to = pcbddc->coarse_vec;
5523   }
5524   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5525   if (smode == SCATTER_FORWARD) {
5526     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5527       Vec tvec;
5528 
5529       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5530       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5531       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5532       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5533     }
5534   } else {
5535     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5536      ierr = VecResetArray(from);CHKERRQ(ierr);
5537     }
5538   }
5539   PetscFunctionReturn(0);
5540 }
5541 
5542 /* uncomment for testing purposes */
5543 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5544 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5545 {
5546   PetscErrorCode    ierr;
5547   PC_IS*            pcis = (PC_IS*)(pc->data);
5548   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5549   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5550   /* one and zero */
5551   PetscScalar       one=1.0,zero=0.0;
5552   /* space to store constraints and their local indices */
5553   PetscScalar       *constraints_data;
5554   PetscInt          *constraints_idxs,*constraints_idxs_B;
5555   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5556   PetscInt          *constraints_n;
5557   /* iterators */
5558   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5559   /* BLAS integers */
5560   PetscBLASInt      lwork,lierr;
5561   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5562   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5563   /* reuse */
5564   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5565   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5566   /* change of basis */
5567   PetscBool         qr_needed;
5568   PetscBT           change_basis,qr_needed_idx;
5569   /* auxiliary stuff */
5570   PetscInt          *nnz,*is_indices;
5571   PetscInt          ncc;
5572   /* some quantities */
5573   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5574   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5575   PetscReal         tol; /* tolerance for retaining eigenmodes */
5576 
5577   PetscFunctionBegin;
5578   tol  = PetscSqrtReal(PETSC_SMALL);
5579   /* Destroy Mat objects computed previously */
5580   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5581   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5582   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5583   /* save info on constraints from previous setup (if any) */
5584   olocal_primal_size = pcbddc->local_primal_size;
5585   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5586   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5587   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5588   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5589   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5590   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5591 
5592   if (!pcbddc->adaptive_selection) {
5593     IS           ISForVertices,*ISForFaces,*ISForEdges;
5594     MatNullSpace nearnullsp;
5595     const Vec    *nearnullvecs;
5596     Vec          *localnearnullsp;
5597     PetscScalar  *array;
5598     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5599     PetscBool    nnsp_has_cnst;
5600     /* LAPACK working arrays for SVD or POD */
5601     PetscBool    skip_lapack,boolforchange;
5602     PetscScalar  *work;
5603     PetscReal    *singular_vals;
5604 #if defined(PETSC_USE_COMPLEX)
5605     PetscReal    *rwork;
5606 #endif
5607 #if defined(PETSC_MISSING_LAPACK_GESVD)
5608     PetscScalar  *temp_basis,*correlation_mat;
5609 #else
5610     PetscBLASInt dummy_int=1;
5611     PetscScalar  dummy_scalar=1.;
5612 #endif
5613 
5614     /* Get index sets for faces, edges and vertices from graph */
5615     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
5616     /* print some info */
5617     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
5618       PetscInt nv;
5619 
5620       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
5621       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
5622       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5623       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5624       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
5625       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
5626       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
5627       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5628       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5629     }
5630 
5631     /* free unneeded index sets */
5632     if (!pcbddc->use_vertices) {
5633       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5634     }
5635     if (!pcbddc->use_edges) {
5636       for (i=0;i<n_ISForEdges;i++) {
5637         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5638       }
5639       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5640       n_ISForEdges = 0;
5641     }
5642     if (!pcbddc->use_faces) {
5643       for (i=0;i<n_ISForFaces;i++) {
5644         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5645       }
5646       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5647       n_ISForFaces = 0;
5648     }
5649 
5650     /* check if near null space is attached to global mat */
5651     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
5652     if (nearnullsp) {
5653       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
5654       /* remove any stored info */
5655       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
5656       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5657       /* store information for BDDC solver reuse */
5658       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
5659       pcbddc->onearnullspace = nearnullsp;
5660       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5661       for (i=0;i<nnsp_size;i++) {
5662         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
5663       }
5664     } else { /* if near null space is not provided BDDC uses constants by default */
5665       nnsp_size = 0;
5666       nnsp_has_cnst = PETSC_TRUE;
5667     }
5668     /* get max number of constraints on a single cc */
5669     max_constraints = nnsp_size;
5670     if (nnsp_has_cnst) max_constraints++;
5671 
5672     /*
5673          Evaluate maximum storage size needed by the procedure
5674          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
5675          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
5676          There can be multiple constraints per connected component
5677                                                                                                                                                            */
5678     n_vertices = 0;
5679     if (ISForVertices) {
5680       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
5681     }
5682     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
5683     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
5684 
5685     total_counts = n_ISForFaces+n_ISForEdges;
5686     total_counts *= max_constraints;
5687     total_counts += n_vertices;
5688     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
5689 
5690     total_counts = 0;
5691     max_size_of_constraint = 0;
5692     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
5693       IS used_is;
5694       if (i<n_ISForEdges) {
5695         used_is = ISForEdges[i];
5696       } else {
5697         used_is = ISForFaces[i-n_ISForEdges];
5698       }
5699       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
5700       total_counts += j;
5701       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
5702     }
5703     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);
5704 
5705     /* get local part of global near null space vectors */
5706     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
5707     for (k=0;k<nnsp_size;k++) {
5708       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
5709       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5710       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5711     }
5712 
5713     /* whether or not to skip lapack calls */
5714     skip_lapack = PETSC_TRUE;
5715     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
5716 
5717     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
5718     if (!skip_lapack) {
5719       PetscScalar temp_work;
5720 
5721 #if defined(PETSC_MISSING_LAPACK_GESVD)
5722       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
5723       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
5724       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
5725       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
5726 #if defined(PETSC_USE_COMPLEX)
5727       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
5728 #endif
5729       /* now we evaluate the optimal workspace using query with lwork=-1 */
5730       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5731       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
5732       lwork = -1;
5733       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5734 #if !defined(PETSC_USE_COMPLEX)
5735       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
5736 #else
5737       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
5738 #endif
5739       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5740       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
5741 #else /* on missing GESVD */
5742       /* SVD */
5743       PetscInt max_n,min_n;
5744       max_n = max_size_of_constraint;
5745       min_n = max_constraints;
5746       if (max_size_of_constraint < max_constraints) {
5747         min_n = max_size_of_constraint;
5748         max_n = max_constraints;
5749       }
5750       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
5751 #if defined(PETSC_USE_COMPLEX)
5752       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
5753 #endif
5754       /* now we evaluate the optimal workspace using query with lwork=-1 */
5755       lwork = -1;
5756       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
5757       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
5758       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
5759       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5760 #if !defined(PETSC_USE_COMPLEX)
5761       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));
5762 #else
5763       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));
5764 #endif
5765       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5766       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
5767 #endif /* on missing GESVD */
5768       /* Allocate optimal workspace */
5769       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
5770       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
5771     }
5772     /* Now we can loop on constraining sets */
5773     total_counts = 0;
5774     constraints_idxs_ptr[0] = 0;
5775     constraints_data_ptr[0] = 0;
5776     /* vertices */
5777     if (n_vertices) {
5778       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5779       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5780       for (i=0;i<n_vertices;i++) {
5781         constraints_n[total_counts] = 1;
5782         constraints_data[total_counts] = 1.0;
5783         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
5784         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
5785         total_counts++;
5786       }
5787       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5788       n_vertices = total_counts;
5789     }
5790 
5791     /* edges and faces */
5792     total_counts_cc = total_counts;
5793     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
5794       IS        used_is;
5795       PetscBool idxs_copied = PETSC_FALSE;
5796 
5797       if (ncc<n_ISForEdges) {
5798         used_is = ISForEdges[ncc];
5799         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
5800       } else {
5801         used_is = ISForFaces[ncc-n_ISForEdges];
5802         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
5803       }
5804       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
5805 
5806       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
5807       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5808       /* change of basis should not be performed on local periodic nodes */
5809       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
5810       if (nnsp_has_cnst) {
5811         PetscScalar quad_value;
5812 
5813         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5814         idxs_copied = PETSC_TRUE;
5815 
5816         if (!pcbddc->use_nnsp_true) {
5817           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
5818         } else {
5819           quad_value = 1.0;
5820         }
5821         for (j=0;j<size_of_constraint;j++) {
5822           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
5823         }
5824         temp_constraints++;
5825         total_counts++;
5826       }
5827       for (k=0;k<nnsp_size;k++) {
5828         PetscReal real_value;
5829         PetscScalar *ptr_to_data;
5830 
5831         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5832         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
5833         for (j=0;j<size_of_constraint;j++) {
5834           ptr_to_data[j] = array[is_indices[j]];
5835         }
5836         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5837         /* check if array is null on the connected component */
5838         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5839         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
5840         if (real_value > tol*size_of_constraint) { /* keep indices and values */
5841           temp_constraints++;
5842           total_counts++;
5843           if (!idxs_copied) {
5844             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5845             idxs_copied = PETSC_TRUE;
5846           }
5847         }
5848       }
5849       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5850       valid_constraints = temp_constraints;
5851       if (!pcbddc->use_nnsp_true && temp_constraints) {
5852         if (temp_constraints == 1) { /* just normalize the constraint */
5853           PetscScalar norm,*ptr_to_data;
5854 
5855           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5856           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5857           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
5858           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
5859           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
5860         } else { /* perform SVD */
5861           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5862 
5863 #if defined(PETSC_MISSING_LAPACK_GESVD)
5864           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
5865              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
5866              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
5867                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
5868                 from that computed using LAPACKgesvd
5869              -> This is due to a different computation of eigenvectors in LAPACKheev
5870              -> The quality of the POD-computed basis will be the same */
5871           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
5872           /* Store upper triangular part of correlation matrix */
5873           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5874           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5875           for (j=0;j<temp_constraints;j++) {
5876             for (k=0;k<j+1;k++) {
5877               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));
5878             }
5879           }
5880           /* compute eigenvalues and eigenvectors of correlation matrix */
5881           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5882           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
5883 #if !defined(PETSC_USE_COMPLEX)
5884           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
5885 #else
5886           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
5887 #endif
5888           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5889           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
5890           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
5891           j = 0;
5892           while (j < temp_constraints && singular_vals[j] < tol) j++;
5893           total_counts = total_counts-j;
5894           valid_constraints = temp_constraints-j;
5895           /* scale and copy POD basis into used quadrature memory */
5896           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5897           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5898           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
5899           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5900           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
5901           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
5902           if (j<temp_constraints) {
5903             PetscInt ii;
5904             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
5905             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5906             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));
5907             ierr = PetscFPTrapPop();CHKERRQ(ierr);
5908             for (k=0;k<temp_constraints-j;k++) {
5909               for (ii=0;ii<size_of_constraint;ii++) {
5910                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
5911               }
5912             }
5913           }
5914 #else  /* on missing GESVD */
5915           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5916           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5917           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5918           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5919 #if !defined(PETSC_USE_COMPLEX)
5920           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));
5921 #else
5922           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));
5923 #endif
5924           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
5925           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5926           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
5927           k = temp_constraints;
5928           if (k > size_of_constraint) k = size_of_constraint;
5929           j = 0;
5930           while (j < k && singular_vals[k-j-1] < tol) j++;
5931           valid_constraints = k-j;
5932           total_counts = total_counts-temp_constraints+valid_constraints;
5933 #endif /* on missing GESVD */
5934         }
5935       }
5936       /* update pointers information */
5937       if (valid_constraints) {
5938         constraints_n[total_counts_cc] = valid_constraints;
5939         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
5940         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
5941         /* set change_of_basis flag */
5942         if (boolforchange) {
5943           PetscBTSet(change_basis,total_counts_cc);
5944         }
5945         total_counts_cc++;
5946       }
5947     }
5948     /* free workspace */
5949     if (!skip_lapack) {
5950       ierr = PetscFree(work);CHKERRQ(ierr);
5951 #if defined(PETSC_USE_COMPLEX)
5952       ierr = PetscFree(rwork);CHKERRQ(ierr);
5953 #endif
5954       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
5955 #if defined(PETSC_MISSING_LAPACK_GESVD)
5956       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
5957       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
5958 #endif
5959     }
5960     for (k=0;k<nnsp_size;k++) {
5961       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
5962     }
5963     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
5964     /* free index sets of faces, edges and vertices */
5965     for (i=0;i<n_ISForFaces;i++) {
5966       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5967     }
5968     if (n_ISForFaces) {
5969       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5970     }
5971     for (i=0;i<n_ISForEdges;i++) {
5972       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5973     }
5974     if (n_ISForEdges) {
5975       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5976     }
5977     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5978   } else {
5979     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5980 
5981     total_counts = 0;
5982     n_vertices = 0;
5983     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
5984       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
5985     }
5986     max_constraints = 0;
5987     total_counts_cc = 0;
5988     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5989       total_counts += pcbddc->adaptive_constraints_n[i];
5990       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
5991       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
5992     }
5993     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
5994     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
5995     constraints_idxs = pcbddc->adaptive_constraints_idxs;
5996     constraints_data = pcbddc->adaptive_constraints_data;
5997     /* constraints_n differs from pcbddc->adaptive_constraints_n */
5998     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
5999     total_counts_cc = 0;
6000     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6001       if (pcbddc->adaptive_constraints_n[i]) {
6002         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
6003       }
6004     }
6005 #if 0
6006     printf("Found %d totals (%d)\n",total_counts_cc,total_counts);
6007     for (i=0;i<total_counts_cc;i++) {
6008       printf("const %d, start %d",i,constraints_idxs_ptr[i]);
6009       printf(" end %d:\n",constraints_idxs_ptr[i+1]);
6010       for (j=constraints_idxs_ptr[i];j<constraints_idxs_ptr[i+1];j++) {
6011         printf(" %d",constraints_idxs[j]);
6012       }
6013       printf("\n");
6014       printf("number of cc: %d\n",constraints_n[i]);
6015     }
6016     for (i=0;i<n_vertices;i++) {
6017       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i]);
6018     }
6019     for (i=0;i<sub_schurs->n_subs;i++) {
6020       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]);
6021     }
6022 #endif
6023 
6024     max_size_of_constraint = 0;
6025     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]);
6026     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
6027     /* Change of basis */
6028     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
6029     if (pcbddc->use_change_of_basis) {
6030       for (i=0;i<sub_schurs->n_subs;i++) {
6031         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
6032           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
6033         }
6034       }
6035     }
6036   }
6037   pcbddc->local_primal_size = total_counts;
6038   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6039 
6040   /* map constraints_idxs in boundary numbering */
6041   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
6042   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);
6043 
6044   /* Create constraint matrix */
6045   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6046   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
6047   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
6048 
6049   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
6050   /* determine if a QR strategy is needed for change of basis */
6051   qr_needed = PETSC_FALSE;
6052   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
6053   total_primal_vertices=0;
6054   pcbddc->local_primal_size_cc = 0;
6055   for (i=0;i<total_counts_cc;i++) {
6056     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6057     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
6058       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
6059       pcbddc->local_primal_size_cc += 1;
6060     } else if (PetscBTLookup(change_basis,i)) {
6061       for (k=0;k<constraints_n[i];k++) {
6062         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6063       }
6064       pcbddc->local_primal_size_cc += constraints_n[i];
6065       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
6066         PetscBTSet(qr_needed_idx,i);
6067         qr_needed = PETSC_TRUE;
6068       }
6069     } else {
6070       pcbddc->local_primal_size_cc += 1;
6071     }
6072   }
6073   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
6074   pcbddc->n_vertices = total_primal_vertices;
6075   /* permute indices in order to have a sorted set of vertices */
6076   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6077   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);
6078   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
6079   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
6080 
6081   /* nonzero structure of constraint matrix */
6082   /* and get reference dof for local constraints */
6083   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
6084   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
6085 
6086   j = total_primal_vertices;
6087   total_counts = total_primal_vertices;
6088   cum = total_primal_vertices;
6089   for (i=n_vertices;i<total_counts_cc;i++) {
6090     if (!PetscBTLookup(change_basis,i)) {
6091       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
6092       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
6093       cum++;
6094       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6095       for (k=0;k<constraints_n[i];k++) {
6096         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6097         nnz[j+k] = size_of_constraint;
6098       }
6099       j += constraints_n[i];
6100     }
6101   }
6102   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
6103   ierr = PetscFree(nnz);CHKERRQ(ierr);
6104 
6105   /* set values in constraint matrix */
6106   for (i=0;i<total_primal_vertices;i++) {
6107     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
6108   }
6109   total_counts = total_primal_vertices;
6110   for (i=n_vertices;i<total_counts_cc;i++) {
6111     if (!PetscBTLookup(change_basis,i)) {
6112       PetscInt *cols;
6113 
6114       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6115       cols = constraints_idxs+constraints_idxs_ptr[i];
6116       for (k=0;k<constraints_n[i];k++) {
6117         PetscInt    row = total_counts+k;
6118         PetscScalar *vals;
6119 
6120         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
6121         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6122       }
6123       total_counts += constraints_n[i];
6124     }
6125   }
6126   /* assembling */
6127   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6128   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6129   ierr = MatChop(pcbddc->ConstraintMatrix,PETSC_SMALL);CHKERRQ(ierr);
6130   ierr = MatSeqAIJCompress(pcbddc->ConstraintMatrix,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6131   ierr = MatViewFromOptions(pcbddc->ConstraintMatrix,NULL,"-pc_bddc_constraint_mat_view");CHKERRQ(ierr);
6132 
6133   /*
6134   ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
6135   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
6136   ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
6137   */
6138   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6139   if (pcbddc->use_change_of_basis) {
6140     /* dual and primal dofs on a single cc */
6141     PetscInt     dual_dofs,primal_dofs;
6142     /* working stuff for GEQRF */
6143     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
6144     PetscBLASInt lqr_work;
6145     /* working stuff for UNGQR */
6146     PetscScalar  *gqr_work,lgqr_work_t;
6147     PetscBLASInt lgqr_work;
6148     /* working stuff for TRTRS */
6149     PetscScalar  *trs_rhs;
6150     PetscBLASInt Blas_NRHS;
6151     /* pointers for values insertion into change of basis matrix */
6152     PetscInt     *start_rows,*start_cols;
6153     PetscScalar  *start_vals;
6154     /* working stuff for values insertion */
6155     PetscBT      is_primal;
6156     PetscInt     *aux_primal_numbering_B;
6157     /* matrix sizes */
6158     PetscInt     global_size,local_size;
6159     /* temporary change of basis */
6160     Mat          localChangeOfBasisMatrix;
6161     /* extra space for debugging */
6162     PetscScalar  *dbg_work;
6163 
6164     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6165     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6166     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6167     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6168     /* nonzeros for local mat */
6169     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6170     if (!pcbddc->benign_change || pcbddc->fake_change) {
6171       for (i=0;i<pcis->n;i++) nnz[i]=1;
6172     } else {
6173       const PetscInt *ii;
6174       PetscInt       n;
6175       PetscBool      flg_row;
6176       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6177       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6178       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6179     }
6180     for (i=n_vertices;i<total_counts_cc;i++) {
6181       if (PetscBTLookup(change_basis,i)) {
6182         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6183         if (PetscBTLookup(qr_needed_idx,i)) {
6184           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6185         } else {
6186           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6187           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6188         }
6189       }
6190     }
6191     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6192     ierr = PetscFree(nnz);CHKERRQ(ierr);
6193     /* Set interior change in the matrix */
6194     if (!pcbddc->benign_change || pcbddc->fake_change) {
6195       for (i=0;i<pcis->n;i++) {
6196         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6197       }
6198     } else {
6199       const PetscInt *ii,*jj;
6200       PetscScalar    *aa;
6201       PetscInt       n;
6202       PetscBool      flg_row;
6203       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6204       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6205       for (i=0;i<n;i++) {
6206         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6207       }
6208       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6209       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6210     }
6211 
6212     if (pcbddc->dbg_flag) {
6213       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6214       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6215     }
6216 
6217 
6218     /* Now we loop on the constraints which need a change of basis */
6219     /*
6220        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6221        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6222 
6223        Basic blocks of change of basis matrix T computed by
6224 
6225           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6226 
6227             | 1        0   ...        0         s_1/S |
6228             | 0        1   ...        0         s_2/S |
6229             |              ...                        |
6230             | 0        ...            1     s_{n-1}/S |
6231             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6232 
6233             with S = \sum_{i=1}^n s_i^2
6234             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6235                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6236 
6237           - QR decomposition of constraints otherwise
6238     */
6239     if (qr_needed) {
6240       /* space to store Q */
6241       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6242       /* array to store scaling factors for reflectors */
6243       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6244       /* first we issue queries for optimal work */
6245       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6246       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6247       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6248       lqr_work = -1;
6249       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6250       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6251       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6252       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6253       lgqr_work = -1;
6254       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6255       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6256       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6257       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6258       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6259       PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6260       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to ORGQR/UNGQR Lapack routine %d",(int)lierr);
6261       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6262       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6263       /* array to store rhs and solution of triangular solver */
6264       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6265       /* allocating workspace for check */
6266       if (pcbddc->dbg_flag) {
6267         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6268       }
6269     }
6270     /* array to store whether a node is primal or not */
6271     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6272     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6273     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6274     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);
6275     for (i=0;i<total_primal_vertices;i++) {
6276       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6277     }
6278     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6279 
6280     /* loop on constraints and see whether or not they need a change of basis and compute it */
6281     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6282       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6283       if (PetscBTLookup(change_basis,total_counts)) {
6284         /* get constraint info */
6285         primal_dofs = constraints_n[total_counts];
6286         dual_dofs = size_of_constraint-primal_dofs;
6287 
6288         if (pcbddc->dbg_flag) {
6289           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);
6290         }
6291 
6292         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6293 
6294           /* copy quadrature constraints for change of basis check */
6295           if (pcbddc->dbg_flag) {
6296             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6297           }
6298           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6299           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6300 
6301           /* compute QR decomposition of constraints */
6302           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6303           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6304           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6305           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6306           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6307           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6308           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6309 
6310           /* explictly compute R^-T */
6311           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
6312           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6313           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6314           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6315           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6316           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6317           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6318           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6319           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6320           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6321 
6322           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6323           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6324           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6325           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6326           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6327           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6328           PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6329           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in ORGQR/UNGQR Lapack routine %d",(int)lierr);
6330           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6331 
6332           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6333              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6334              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6335           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6336           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6337           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6338           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6339           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6340           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6341           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6342           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));
6343           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6344           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6345 
6346           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6347           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6348           /* insert cols for primal dofs */
6349           for (j=0;j<primal_dofs;j++) {
6350             start_vals = &qr_basis[j*size_of_constraint];
6351             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6352             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6353           }
6354           /* insert cols for dual dofs */
6355           for (j=0,k=0;j<dual_dofs;k++) {
6356             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6357               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6358               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6359               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6360               j++;
6361             }
6362           }
6363 
6364           /* check change of basis */
6365           if (pcbddc->dbg_flag) {
6366             PetscInt   ii,jj;
6367             PetscBool valid_qr=PETSC_TRUE;
6368             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6369             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6370             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6371             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6372             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6373             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6374             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6375             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));
6376             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6377             for (jj=0;jj<size_of_constraint;jj++) {
6378               for (ii=0;ii<primal_dofs;ii++) {
6379                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6380                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) valid_qr = PETSC_FALSE;
6381               }
6382             }
6383             if (!valid_qr) {
6384               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6385               for (jj=0;jj<size_of_constraint;jj++) {
6386                 for (ii=0;ii<primal_dofs;ii++) {
6387                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6388                     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]));
6389                   }
6390                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) {
6391                     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]));
6392                   }
6393                 }
6394               }
6395             } else {
6396               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6397             }
6398           }
6399         } else { /* simple transformation block */
6400           PetscInt    row,col;
6401           PetscScalar val,norm;
6402 
6403           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6404           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6405           for (j=0;j<size_of_constraint;j++) {
6406             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6407             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6408             if (!PetscBTLookup(is_primal,row_B)) {
6409               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6410               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6411               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6412             } else {
6413               for (k=0;k<size_of_constraint;k++) {
6414                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6415                 if (row != col) {
6416                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6417                 } else {
6418                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6419                 }
6420                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6421               }
6422             }
6423           }
6424           if (pcbddc->dbg_flag) {
6425             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6426           }
6427         }
6428       } else {
6429         if (pcbddc->dbg_flag) {
6430           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d does not need a change of basis (size %d)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6431         }
6432       }
6433     }
6434 
6435     /* free workspace */
6436     if (qr_needed) {
6437       if (pcbddc->dbg_flag) {
6438         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6439       }
6440       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6441       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6442       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6443       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6444       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6445     }
6446     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6447     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6448     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6449 
6450     /* assembling of global change of variable */
6451     if (!pcbddc->fake_change) {
6452       Mat      tmat;
6453       PetscInt bs;
6454 
6455       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6456       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6457       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6458       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6459       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6460       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6461       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6462       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6463       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6464       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6465       ierr = MatISGetMPIXAIJ(tmat,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6466       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6467       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6468       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6469       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6470       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6471       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6472       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6473 
6474       /* check */
6475       if (pcbddc->dbg_flag) {
6476         PetscReal error;
6477         Vec       x,x_change;
6478 
6479         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6480         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6481         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6482         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6483         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6484         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6485         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6486         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6487         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6488         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6489         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6490         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6491         if (error > PETSC_SMALL) {
6492           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
6493         }
6494         ierr = VecDestroy(&x);CHKERRQ(ierr);
6495         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6496       }
6497       /* adapt sub_schurs computed (if any) */
6498       if (pcbddc->use_deluxe_scaling) {
6499         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6500 
6501         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");
6502         if (sub_schurs && sub_schurs->S_Ej_all) {
6503           Mat                    S_new,tmat;
6504           IS                     is_all_N,is_V_Sall = NULL;
6505 
6506           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6507           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6508           if (pcbddc->deluxe_zerorows) {
6509             ISLocalToGlobalMapping NtoSall;
6510             IS                     is_V;
6511             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6512             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6513             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6514             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6515             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6516           }
6517           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6518           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6519           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6520           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6521           if (pcbddc->deluxe_zerorows) {
6522             const PetscScalar *array;
6523             const PetscInt    *idxs_V,*idxs_all;
6524             PetscInt          i,n_V;
6525 
6526             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6527             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6528             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6529             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6530             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6531             for (i=0;i<n_V;i++) {
6532               PetscScalar val;
6533               PetscInt    idx;
6534 
6535               idx = idxs_V[i];
6536               val = array[idxs_all[idxs_V[i]]];
6537               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6538             }
6539             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6540             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6541             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6542             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6543             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6544           }
6545           sub_schurs->S_Ej_all = S_new;
6546           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6547           if (sub_schurs->sum_S_Ej_all) {
6548             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6549             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6550             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6551             if (pcbddc->deluxe_zerorows) {
6552               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6553             }
6554             sub_schurs->sum_S_Ej_all = S_new;
6555             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6556           }
6557           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6558           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6559         }
6560         /* destroy any change of basis context in sub_schurs */
6561         if (sub_schurs && sub_schurs->change) {
6562           PetscInt i;
6563 
6564           for (i=0;i<sub_schurs->n_subs;i++) {
6565             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6566           }
6567           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6568         }
6569       }
6570       if (pcbddc->switch_static) { /* need to save the local change */
6571         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6572       } else {
6573         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6574       }
6575       /* determine if any process has changed the pressures locally */
6576       pcbddc->change_interior = pcbddc->benign_have_null;
6577     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6578       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6579       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6580       pcbddc->use_qr_single = qr_needed;
6581     }
6582   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6583     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6584       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6585       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6586     } else {
6587       Mat benign_global = NULL;
6588       if (pcbddc->benign_have_null) {
6589         Mat tmat;
6590 
6591         pcbddc->change_interior = PETSC_TRUE;
6592         ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6593         ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6594         ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6595         ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6596         ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6597         ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6598         ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6599         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6600         if (pcbddc->benign_change) {
6601           Mat M;
6602 
6603           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6604           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6605           ierr = MatISSetLocalMat(tmat,M);CHKERRQ(ierr);
6606           ierr = MatDestroy(&M);CHKERRQ(ierr);
6607         } else {
6608           Mat         eye;
6609           PetscScalar *array;
6610 
6611           ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6612           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&eye);CHKERRQ(ierr);
6613           for (i=0;i<pcis->n;i++) {
6614             ierr = MatSetValue(eye,i,i,array[i],INSERT_VALUES);CHKERRQ(ierr);
6615           }
6616           ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6617           ierr = MatAssemblyBegin(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6618           ierr = MatAssemblyEnd(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6619           ierr = MatISSetLocalMat(tmat,eye);CHKERRQ(ierr);
6620           ierr = MatDestroy(&eye);CHKERRQ(ierr);
6621         }
6622         ierr = MatISGetMPIXAIJ(tmat,MAT_INITIAL_MATRIX,&benign_global);CHKERRQ(ierr);
6623         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6624       }
6625       if (pcbddc->user_ChangeOfBasisMatrix) {
6626         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6627         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6628       } else if (pcbddc->benign_have_null) {
6629         pcbddc->ChangeOfBasisMatrix = benign_global;
6630       }
6631     }
6632     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6633       IS             is_global;
6634       const PetscInt *gidxs;
6635 
6636       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6637       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6638       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6639       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6640       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6641     }
6642   }
6643   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6644     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6645   }
6646 
6647   if (!pcbddc->fake_change) {
6648     /* add pressure dofs to set of primal nodes for numbering purposes */
6649     for (i=0;i<pcbddc->benign_n;i++) {
6650       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
6651       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
6652       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
6653       pcbddc->local_primal_size_cc++;
6654       pcbddc->local_primal_size++;
6655     }
6656 
6657     /* check if a new primal space has been introduced (also take into account benign trick) */
6658     pcbddc->new_primal_space_local = PETSC_TRUE;
6659     if (olocal_primal_size == pcbddc->local_primal_size) {
6660       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6661       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6662       if (!pcbddc->new_primal_space_local) {
6663         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6664         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6665       }
6666     }
6667     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
6668     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6669   }
6670   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
6671 
6672   /* flush dbg viewer */
6673   if (pcbddc->dbg_flag) {
6674     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6675   }
6676 
6677   /* free workspace */
6678   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
6679   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
6680   if (!pcbddc->adaptive_selection) {
6681     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
6682     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
6683   } else {
6684     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
6685                       pcbddc->adaptive_constraints_idxs_ptr,
6686                       pcbddc->adaptive_constraints_data_ptr,
6687                       pcbddc->adaptive_constraints_idxs,
6688                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
6689     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
6690     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
6691   }
6692   PetscFunctionReturn(0);
6693 }
6694 /* #undef PETSC_MISSING_LAPACK_GESVD */
6695 
6696 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
6697 {
6698   ISLocalToGlobalMapping map;
6699   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
6700   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
6701   PetscInt               i,N;
6702   PetscBool              rcsr = PETSC_FALSE;
6703   PetscErrorCode         ierr;
6704 
6705   PetscFunctionBegin;
6706   if (pcbddc->recompute_topography) {
6707     pcbddc->graphanalyzed = PETSC_FALSE;
6708     /* Reset previously computed graph */
6709     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
6710     /* Init local Graph struct */
6711     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
6712     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
6713     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
6714 
6715     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
6716       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6717     }
6718     /* Check validity of the csr graph passed in by the user */
6719     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);
6720 
6721     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
6722     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
6723       PetscInt  *xadj,*adjncy;
6724       PetscInt  nvtxs;
6725       PetscBool flg_row=PETSC_FALSE;
6726 
6727       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6728       if (flg_row) {
6729         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
6730         pcbddc->computed_rowadj = PETSC_TRUE;
6731       }
6732       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6733       rcsr = PETSC_TRUE;
6734     }
6735     if (pcbddc->dbg_flag) {
6736       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6737     }
6738 
6739     if (pcbddc->mat_graph->cdim && !pcbddc->mat_graph->cloc) {
6740       PetscReal    *lcoords;
6741       PetscInt     n;
6742       MPI_Datatype dimrealtype;
6743 
6744       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);
6745       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
6746       ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
6747       ierr = PetscMalloc1(pcbddc->mat_graph->cdim*n,&lcoords);CHKERRQ(ierr);
6748       ierr = MPI_Type_contiguous(pcbddc->mat_graph->cdim,MPIU_REAL,&dimrealtype);CHKERRQ(ierr);
6749       ierr = MPI_Type_commit(&dimrealtype);CHKERRQ(ierr);
6750       ierr = PetscSFBcastBegin(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
6751       ierr = PetscSFBcastEnd(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
6752       ierr = MPI_Type_free(&dimrealtype);CHKERRQ(ierr);
6753       ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
6754 
6755       pcbddc->mat_graph->coords = lcoords;
6756       pcbddc->mat_graph->cloc   = PETSC_TRUE;
6757       pcbddc->mat_graph->cnloc  = n;
6758     }
6759     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);
6760 
6761     /* Setup of Graph */
6762     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
6763     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6764 
6765     /* attach info on disconnected subdomains if present */
6766     if (pcbddc->n_local_subs) {
6767       PetscInt *local_subs;
6768 
6769       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
6770       for (i=0;i<pcbddc->n_local_subs;i++) {
6771         const PetscInt *idxs;
6772         PetscInt       nl,j;
6773 
6774         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
6775         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6776         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
6777         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6778       }
6779       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
6780       pcbddc->mat_graph->local_subs = local_subs;
6781     }
6782   }
6783 
6784   if (!pcbddc->graphanalyzed) {
6785     /* Graph's connected components analysis */
6786     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
6787     pcbddc->graphanalyzed = PETSC_TRUE;
6788   }
6789   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
6790   PetscFunctionReturn(0);
6791 }
6792 
6793 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
6794 {
6795   PetscInt       i,j;
6796   PetscScalar    *alphas;
6797   PetscErrorCode ierr;
6798 
6799   PetscFunctionBegin;
6800   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
6801   for (i=0;i<n;i++) {
6802     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
6803     ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],alphas);CHKERRQ(ierr);
6804     for (j=0;j<n-i-1;j++) alphas[j] = PetscConj(-alphas[j]);
6805     ierr = VecMAXPY(vecs[j],n-i-1,alphas,vecs+i);CHKERRQ(ierr);
6806   }
6807   ierr = PetscFree(alphas);CHKERRQ(ierr);
6808   PetscFunctionReturn(0);
6809 }
6810 
6811 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
6812 {
6813   Mat            A;
6814   PetscInt       n_neighs,*neighs,*n_shared,**shared;
6815   PetscMPIInt    size,rank,color;
6816   PetscInt       *xadj,*adjncy;
6817   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
6818   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
6819   PetscInt       void_procs,*procs_candidates = NULL;
6820   PetscInt       xadj_count,*count;
6821   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
6822   PetscSubcomm   psubcomm;
6823   MPI_Comm       subcomm;
6824   PetscErrorCode ierr;
6825 
6826   PetscFunctionBegin;
6827   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6828   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6829   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);
6830   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
6831   PetscValidLogicalCollectiveInt(mat,redprocs,3);
6832   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %d\n",*n_subdomains);
6833 
6834   if (have_void) *have_void = PETSC_FALSE;
6835   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
6836   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
6837   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
6838   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
6839   im_active = !!n;
6840   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6841   void_procs = size - active_procs;
6842   /* get ranks of of non-active processes in mat communicator */
6843   if (void_procs) {
6844     PetscInt ncand;
6845 
6846     if (have_void) *have_void = PETSC_TRUE;
6847     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
6848     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6849     for (i=0,ncand=0;i<size;i++) {
6850       if (!procs_candidates[i]) {
6851         procs_candidates[ncand++] = i;
6852       }
6853     }
6854     /* force n_subdomains to be not greater that the number of non-active processes */
6855     *n_subdomains = PetscMin(void_procs,*n_subdomains);
6856   }
6857 
6858   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
6859      number of subdomains requested 1 -> send to master or first candidate in voids  */
6860   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
6861   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
6862     PetscInt issize,isidx,dest;
6863     if (*n_subdomains == 1) dest = 0;
6864     else dest = rank;
6865     if (im_active) {
6866       issize = 1;
6867       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6868         isidx = procs_candidates[dest];
6869       } else {
6870         isidx = dest;
6871       }
6872     } else {
6873       issize = 0;
6874       isidx = -1;
6875     }
6876     if (*n_subdomains != 1) *n_subdomains = active_procs;
6877     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
6878     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6879     PetscFunctionReturn(0);
6880   }
6881   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
6882   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
6883   threshold = PetscMax(threshold,2);
6884 
6885   /* Get info on mapping */
6886   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6887 
6888   /* build local CSR graph of subdomains' connectivity */
6889   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
6890   xadj[0] = 0;
6891   xadj[1] = PetscMax(n_neighs-1,0);
6892   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
6893   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
6894   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
6895   for (i=1;i<n_neighs;i++)
6896     for (j=0;j<n_shared[i];j++)
6897       count[shared[i][j]] += 1;
6898 
6899   xadj_count = 0;
6900   for (i=1;i<n_neighs;i++) {
6901     for (j=0;j<n_shared[i];j++) {
6902       if (count[shared[i][j]] < threshold) {
6903         adjncy[xadj_count] = neighs[i];
6904         adjncy_wgt[xadj_count] = n_shared[i];
6905         xadj_count++;
6906         break;
6907       }
6908     }
6909   }
6910   xadj[1] = xadj_count;
6911   ierr = PetscFree(count);CHKERRQ(ierr);
6912   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6913   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6914 
6915   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
6916 
6917   /* Restrict work on active processes only */
6918   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
6919   if (void_procs) {
6920     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
6921     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
6922     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
6923     subcomm = PetscSubcommChild(psubcomm);
6924   } else {
6925     psubcomm = NULL;
6926     subcomm = PetscObjectComm((PetscObject)mat);
6927   }
6928 
6929   v_wgt = NULL;
6930   if (!color) {
6931     ierr = PetscFree(xadj);CHKERRQ(ierr);
6932     ierr = PetscFree(adjncy);CHKERRQ(ierr);
6933     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6934   } else {
6935     Mat             subdomain_adj;
6936     IS              new_ranks,new_ranks_contig;
6937     MatPartitioning partitioner;
6938     PetscInt        rstart=0,rend=0;
6939     PetscInt        *is_indices,*oldranks;
6940     PetscMPIInt     size;
6941     PetscBool       aggregate;
6942 
6943     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
6944     if (void_procs) {
6945       PetscInt prank = rank;
6946       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
6947       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
6948       for (i=0;i<xadj[1];i++) {
6949         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
6950       }
6951       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6952     } else {
6953       oldranks = NULL;
6954     }
6955     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
6956     if (aggregate) { /* TODO: all this part could be made more efficient */
6957       PetscInt    lrows,row,ncols,*cols;
6958       PetscMPIInt nrank;
6959       PetscScalar *vals;
6960 
6961       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
6962       lrows = 0;
6963       if (nrank<redprocs) {
6964         lrows = size/redprocs;
6965         if (nrank<size%redprocs) lrows++;
6966       }
6967       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
6968       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
6969       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6970       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6971       row = nrank;
6972       ncols = xadj[1]-xadj[0];
6973       cols = adjncy;
6974       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
6975       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
6976       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6977       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6978       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6979       ierr = PetscFree(xadj);CHKERRQ(ierr);
6980       ierr = PetscFree(adjncy);CHKERRQ(ierr);
6981       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6982       ierr = PetscFree(vals);CHKERRQ(ierr);
6983       if (use_vwgt) {
6984         Vec               v;
6985         const PetscScalar *array;
6986         PetscInt          nl;
6987 
6988         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
6989         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
6990         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
6991         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
6992         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
6993         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
6994         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
6995         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
6996         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
6997         ierr = VecDestroy(&v);CHKERRQ(ierr);
6998       }
6999     } else {
7000       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
7001       if (use_vwgt) {
7002         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
7003         v_wgt[0] = n;
7004       }
7005     }
7006     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
7007 
7008     /* Partition */
7009     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
7010     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
7011     if (v_wgt) {
7012       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
7013     }
7014     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
7015     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
7016     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
7017     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
7018     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
7019 
7020     /* renumber new_ranks to avoid "holes" in new set of processors */
7021     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
7022     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
7023     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7024     if (!aggregate) {
7025       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7026 #if defined(PETSC_USE_DEBUG)
7027         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7028 #endif
7029         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
7030       } else if (oldranks) {
7031         ranks_send_to_idx[0] = oldranks[is_indices[0]];
7032       } else {
7033         ranks_send_to_idx[0] = is_indices[0];
7034       }
7035     } else {
7036       PetscInt    idx = 0;
7037       PetscMPIInt tag;
7038       MPI_Request *reqs;
7039 
7040       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
7041       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
7042       for (i=rstart;i<rend;i++) {
7043         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
7044       }
7045       ierr = MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
7046       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7047       ierr = PetscFree(reqs);CHKERRQ(ierr);
7048       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7049 #if defined(PETSC_USE_DEBUG)
7050         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7051 #endif
7052         ranks_send_to_idx[0] = procs_candidates[oldranks[idx]];
7053       } else if (oldranks) {
7054         ranks_send_to_idx[0] = oldranks[idx];
7055       } else {
7056         ranks_send_to_idx[0] = idx;
7057       }
7058     }
7059     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7060     /* clean up */
7061     ierr = PetscFree(oldranks);CHKERRQ(ierr);
7062     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
7063     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
7064     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
7065   }
7066   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
7067   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7068 
7069   /* assemble parallel IS for sends */
7070   i = 1;
7071   if (!color) i=0;
7072   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
7073   PetscFunctionReturn(0);
7074 }
7075 
7076 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
7077 
7078 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[])
7079 {
7080   Mat                    local_mat;
7081   IS                     is_sends_internal;
7082   PetscInt               rows,cols,new_local_rows;
7083   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
7084   PetscBool              ismatis,isdense,newisdense,destroy_mat;
7085   ISLocalToGlobalMapping l2gmap;
7086   PetscInt*              l2gmap_indices;
7087   const PetscInt*        is_indices;
7088   MatType                new_local_type;
7089   /* buffers */
7090   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
7091   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
7092   PetscInt               *recv_buffer_idxs_local;
7093   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
7094   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
7095   /* MPI */
7096   MPI_Comm               comm,comm_n;
7097   PetscSubcomm           subcomm;
7098   PetscMPIInt            n_sends,n_recvs,commsize;
7099   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
7100   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
7101   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
7102   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
7103   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
7104   PetscErrorCode         ierr;
7105 
7106   PetscFunctionBegin;
7107   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7108   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7109   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);
7110   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
7111   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
7112   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
7113   PetscValidLogicalCollectiveBool(mat,reuse,6);
7114   PetscValidLogicalCollectiveInt(mat,nis,8);
7115   PetscValidLogicalCollectiveInt(mat,nvecs,10);
7116   if (nvecs) {
7117     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
7118     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
7119   }
7120   /* further checks */
7121   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7122   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
7123   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
7124   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
7125   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
7126   if (reuse && *mat_n) {
7127     PetscInt mrows,mcols,mnrows,mncols;
7128     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
7129     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
7130     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
7131     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
7132     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
7133     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
7134     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
7135   }
7136   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
7137   PetscValidLogicalCollectiveInt(mat,bs,0);
7138 
7139   /* prepare IS for sending if not provided */
7140   if (!is_sends) {
7141     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
7142     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
7143   } else {
7144     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
7145     is_sends_internal = is_sends;
7146   }
7147 
7148   /* get comm */
7149   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
7150 
7151   /* compute number of sends */
7152   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
7153   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7154 
7155   /* compute number of receives */
7156   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
7157   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
7158   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
7159   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7160   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7161   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7162   ierr = PetscFree(iflags);CHKERRQ(ierr);
7163 
7164   /* restrict comm if requested */
7165   subcomm = 0;
7166   destroy_mat = PETSC_FALSE;
7167   if (restrict_comm) {
7168     PetscMPIInt color,subcommsize;
7169 
7170     color = 0;
7171     if (restrict_full) {
7172       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7173     } else {
7174       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7175     }
7176     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
7177     subcommsize = commsize - subcommsize;
7178     /* check if reuse has been requested */
7179     if (reuse) {
7180       if (*mat_n) {
7181         PetscMPIInt subcommsize2;
7182         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
7183         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7184         comm_n = PetscObjectComm((PetscObject)*mat_n);
7185       } else {
7186         comm_n = PETSC_COMM_SELF;
7187       }
7188     } else { /* MAT_INITIAL_MATRIX */
7189       PetscMPIInt rank;
7190 
7191       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
7192       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7193       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7194       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7195       comm_n = PetscSubcommChild(subcomm);
7196     }
7197     /* flag to destroy *mat_n if not significative */
7198     if (color) destroy_mat = PETSC_TRUE;
7199   } else {
7200     comm_n = comm;
7201   }
7202 
7203   /* prepare send/receive buffers */
7204   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
7205   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
7206   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
7207   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
7208   if (nis) {
7209     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
7210   }
7211 
7212   /* Get data from local matrices */
7213   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7214     /* TODO: See below some guidelines on how to prepare the local buffers */
7215     /*
7216        send_buffer_vals should contain the raw values of the local matrix
7217        send_buffer_idxs should contain:
7218        - MatType_PRIVATE type
7219        - PetscInt        size_of_l2gmap
7220        - PetscInt        global_row_indices[size_of_l2gmap]
7221        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7222     */
7223   else {
7224     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7225     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7226     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7227     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7228     send_buffer_idxs[1] = i;
7229     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7230     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
7231     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7232     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7233     for (i=0;i<n_sends;i++) {
7234       ilengths_vals[is_indices[i]] = len*len;
7235       ilengths_idxs[is_indices[i]] = len+2;
7236     }
7237   }
7238   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7239   /* additional is (if any) */
7240   if (nis) {
7241     PetscMPIInt psum;
7242     PetscInt j;
7243     for (j=0,psum=0;j<nis;j++) {
7244       PetscInt plen;
7245       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7246       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7247       psum += len+1; /* indices + lenght */
7248     }
7249     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7250     for (j=0,psum=0;j<nis;j++) {
7251       PetscInt plen;
7252       const PetscInt *is_array_idxs;
7253       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7254       send_buffer_idxs_is[psum] = plen;
7255       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7256       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
7257       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7258       psum += plen+1; /* indices + lenght */
7259     }
7260     for (i=0;i<n_sends;i++) {
7261       ilengths_idxs_is[is_indices[i]] = psum;
7262     }
7263     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7264   }
7265   ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7266 
7267   buf_size_idxs = 0;
7268   buf_size_vals = 0;
7269   buf_size_idxs_is = 0;
7270   buf_size_vecs = 0;
7271   for (i=0;i<n_recvs;i++) {
7272     buf_size_idxs += (PetscInt)olengths_idxs[i];
7273     buf_size_vals += (PetscInt)olengths_vals[i];
7274     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7275     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7276   }
7277   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7278   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7279   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7280   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7281 
7282   /* get new tags for clean communications */
7283   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7284   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7285   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7286   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7287 
7288   /* allocate for requests */
7289   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7290   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7291   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7292   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7293   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7294   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7295   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7296   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7297 
7298   /* communications */
7299   ptr_idxs = recv_buffer_idxs;
7300   ptr_vals = recv_buffer_vals;
7301   ptr_idxs_is = recv_buffer_idxs_is;
7302   ptr_vecs = recv_buffer_vecs;
7303   for (i=0;i<n_recvs;i++) {
7304     source_dest = onodes[i];
7305     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7306     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7307     ptr_idxs += olengths_idxs[i];
7308     ptr_vals += olengths_vals[i];
7309     if (nis) {
7310       source_dest = onodes_is[i];
7311       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);
7312       ptr_idxs_is += olengths_idxs_is[i];
7313     }
7314     if (nvecs) {
7315       source_dest = onodes[i];
7316       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7317       ptr_vecs += olengths_idxs[i]-2;
7318     }
7319   }
7320   for (i=0;i<n_sends;i++) {
7321     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7322     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7323     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7324     if (nis) {
7325       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);
7326     }
7327     if (nvecs) {
7328       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7329       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7330     }
7331   }
7332   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7333   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7334 
7335   /* assemble new l2g map */
7336   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7337   ptr_idxs = recv_buffer_idxs;
7338   new_local_rows = 0;
7339   for (i=0;i<n_recvs;i++) {
7340     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7341     ptr_idxs += olengths_idxs[i];
7342   }
7343   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7344   ptr_idxs = recv_buffer_idxs;
7345   new_local_rows = 0;
7346   for (i=0;i<n_recvs;i++) {
7347     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
7348     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7349     ptr_idxs += olengths_idxs[i];
7350   }
7351   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7352   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7353   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7354 
7355   /* infer new local matrix type from received local matrices type */
7356   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7357   /* 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) */
7358   if (n_recvs) {
7359     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7360     ptr_idxs = recv_buffer_idxs;
7361     for (i=0;i<n_recvs;i++) {
7362       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7363         new_local_type_private = MATAIJ_PRIVATE;
7364         break;
7365       }
7366       ptr_idxs += olengths_idxs[i];
7367     }
7368     switch (new_local_type_private) {
7369       case MATDENSE_PRIVATE:
7370         new_local_type = MATSEQAIJ;
7371         bs = 1;
7372         break;
7373       case MATAIJ_PRIVATE:
7374         new_local_type = MATSEQAIJ;
7375         bs = 1;
7376         break;
7377       case MATBAIJ_PRIVATE:
7378         new_local_type = MATSEQBAIJ;
7379         break;
7380       case MATSBAIJ_PRIVATE:
7381         new_local_type = MATSEQSBAIJ;
7382         break;
7383       default:
7384         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7385         break;
7386     }
7387   } else { /* by default, new_local_type is seqaij */
7388     new_local_type = MATSEQAIJ;
7389     bs = 1;
7390   }
7391 
7392   /* create MATIS object if needed */
7393   if (!reuse) {
7394     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7395     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7396   } else {
7397     /* it also destroys the local matrices */
7398     if (*mat_n) {
7399       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7400     } else { /* this is a fake object */
7401       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7402     }
7403   }
7404   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7405   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7406 
7407   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7408 
7409   /* Global to local map of received indices */
7410   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7411   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7412   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7413 
7414   /* restore attributes -> type of incoming data and its size */
7415   buf_size_idxs = 0;
7416   for (i=0;i<n_recvs;i++) {
7417     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7418     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7419     buf_size_idxs += (PetscInt)olengths_idxs[i];
7420   }
7421   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7422 
7423   /* set preallocation */
7424   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7425   if (!newisdense) {
7426     PetscInt *new_local_nnz=0;
7427 
7428     ptr_idxs = recv_buffer_idxs_local;
7429     if (n_recvs) {
7430       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7431     }
7432     for (i=0;i<n_recvs;i++) {
7433       PetscInt j;
7434       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7435         for (j=0;j<*(ptr_idxs+1);j++) {
7436           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7437         }
7438       } else {
7439         /* TODO */
7440       }
7441       ptr_idxs += olengths_idxs[i];
7442     }
7443     if (new_local_nnz) {
7444       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7445       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7446       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7447       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7448       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7449       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7450     } else {
7451       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7452     }
7453     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7454   } else {
7455     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7456   }
7457 
7458   /* set values */
7459   ptr_vals = recv_buffer_vals;
7460   ptr_idxs = recv_buffer_idxs_local;
7461   for (i=0;i<n_recvs;i++) {
7462     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7463       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7464       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7465       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7466       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7467       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7468     } else {
7469       /* TODO */
7470     }
7471     ptr_idxs += olengths_idxs[i];
7472     ptr_vals += olengths_vals[i];
7473   }
7474   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7475   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7476   ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7477   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7478   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7479   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7480 
7481 #if 0
7482   if (!restrict_comm) { /* check */
7483     Vec       lvec,rvec;
7484     PetscReal infty_error;
7485 
7486     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7487     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7488     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7489     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7490     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7491     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7492     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7493     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7494     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7495   }
7496 #endif
7497 
7498   /* assemble new additional is (if any) */
7499   if (nis) {
7500     PetscInt **temp_idxs,*count_is,j,psum;
7501 
7502     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7503     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7504     ptr_idxs = recv_buffer_idxs_is;
7505     psum = 0;
7506     for (i=0;i<n_recvs;i++) {
7507       for (j=0;j<nis;j++) {
7508         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7509         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7510         psum += plen;
7511         ptr_idxs += plen+1; /* shift pointer to received data */
7512       }
7513     }
7514     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7515     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7516     for (i=1;i<nis;i++) {
7517       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7518     }
7519     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7520     ptr_idxs = recv_buffer_idxs_is;
7521     for (i=0;i<n_recvs;i++) {
7522       for (j=0;j<nis;j++) {
7523         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7524         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7525         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7526         ptr_idxs += plen+1; /* shift pointer to received data */
7527       }
7528     }
7529     for (i=0;i<nis;i++) {
7530       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7531       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7532       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7533     }
7534     ierr = PetscFree(count_is);CHKERRQ(ierr);
7535     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7536     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7537   }
7538   /* free workspace */
7539   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7540   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7541   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7542   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7543   if (isdense) {
7544     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7545     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7546     ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7547   } else {
7548     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7549   }
7550   if (nis) {
7551     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7552     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7553   }
7554 
7555   if (nvecs) {
7556     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7557     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7558     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7559     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7560     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7561     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7562     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7563     /* set values */
7564     ptr_vals = recv_buffer_vecs;
7565     ptr_idxs = recv_buffer_idxs_local;
7566     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7567     for (i=0;i<n_recvs;i++) {
7568       PetscInt j;
7569       for (j=0;j<*(ptr_idxs+1);j++) {
7570         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7571       }
7572       ptr_idxs += olengths_idxs[i];
7573       ptr_vals += olengths_idxs[i]-2;
7574     }
7575     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7576     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7577     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7578   }
7579 
7580   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7581   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7582   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7583   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7584   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7585   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7586   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7587   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7588   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7589   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7590   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7591   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7592   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7593   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7594   ierr = PetscFree(onodes);CHKERRQ(ierr);
7595   if (nis) {
7596     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7597     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7598     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7599   }
7600   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7601   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7602     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7603     for (i=0;i<nis;i++) {
7604       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7605     }
7606     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7607       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7608     }
7609     *mat_n = NULL;
7610   }
7611   PetscFunctionReturn(0);
7612 }
7613 
7614 /* temporary hack into ksp private data structure */
7615 #include <petsc/private/kspimpl.h>
7616 
7617 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7618 {
7619   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7620   PC_IS                  *pcis = (PC_IS*)pc->data;
7621   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7622   Mat                    coarsedivudotp = NULL;
7623   Mat                    coarseG,t_coarse_mat_is;
7624   MatNullSpace           CoarseNullSpace = NULL;
7625   ISLocalToGlobalMapping coarse_islg;
7626   IS                     coarse_is,*isarray;
7627   PetscInt               i,im_active=-1,active_procs=-1;
7628   PetscInt               nis,nisdofs,nisneu,nisvert;
7629   PC                     pc_temp;
7630   PCType                 coarse_pc_type;
7631   KSPType                coarse_ksp_type;
7632   PetscBool              multilevel_requested,multilevel_allowed;
7633   PetscBool              coarse_reuse;
7634   PetscInt               ncoarse,nedcfield;
7635   PetscBool              compute_vecs = PETSC_FALSE;
7636   PetscScalar            *array;
7637   MatReuse               coarse_mat_reuse;
7638   PetscBool              restr, full_restr, have_void;
7639   PetscMPIInt            commsize;
7640   PetscErrorCode         ierr;
7641 
7642   PetscFunctionBegin;
7643   /* Assign global numbering to coarse dofs */
7644   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 */
7645     PetscInt ocoarse_size;
7646     compute_vecs = PETSC_TRUE;
7647 
7648     pcbddc->new_primal_space = PETSC_TRUE;
7649     ocoarse_size = pcbddc->coarse_size;
7650     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
7651     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
7652     /* see if we can avoid some work */
7653     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
7654       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
7655       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
7656         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
7657         coarse_reuse = PETSC_FALSE;
7658       } else { /* we can safely reuse already computed coarse matrix */
7659         coarse_reuse = PETSC_TRUE;
7660       }
7661     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
7662       coarse_reuse = PETSC_FALSE;
7663     }
7664     /* reset any subassembling information */
7665     if (!coarse_reuse || pcbddc->recompute_topography) {
7666       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7667     }
7668   } else { /* primal space is unchanged, so we can reuse coarse matrix */
7669     coarse_reuse = PETSC_TRUE;
7670   }
7671   /* assemble coarse matrix */
7672   if (coarse_reuse && pcbddc->coarse_ksp) {
7673     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
7674     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
7675     coarse_mat_reuse = MAT_REUSE_MATRIX;
7676   } else {
7677     coarse_mat = NULL;
7678     coarse_mat_reuse = MAT_INITIAL_MATRIX;
7679   }
7680 
7681   /* creates temporary l2gmap and IS for coarse indexes */
7682   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
7683   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
7684 
7685   /* creates temporary MATIS object for coarse matrix */
7686   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
7687   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7688   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
7689   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7690   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);
7691   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
7692   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7693   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7694   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
7695 
7696   /* count "active" (i.e. with positive local size) and "void" processes */
7697   im_active = !!(pcis->n);
7698   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7699 
7700   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
7701   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
7702   /* full_restr : just use the receivers from the subassembling pattern */
7703   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&commsize);CHKERRQ(ierr);
7704   coarse_mat_is = NULL;
7705   multilevel_allowed = PETSC_FALSE;
7706   multilevel_requested = PETSC_FALSE;
7707   pcbddc->coarse_eqs_per_proc = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
7708   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
7709   if (multilevel_requested) {
7710     ncoarse = active_procs/pcbddc->coarsening_ratio;
7711     restr = PETSC_FALSE;
7712     full_restr = PETSC_FALSE;
7713   } else {
7714     ncoarse = pcbddc->coarse_size/pcbddc->coarse_eqs_per_proc;
7715     restr = PETSC_TRUE;
7716     full_restr = PETSC_TRUE;
7717   }
7718   if (!pcbddc->coarse_size || commsize == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
7719   ncoarse = PetscMax(1,ncoarse);
7720   if (!pcbddc->coarse_subassembling) {
7721     if (pcbddc->coarsening_ratio > 1) {
7722       if (multilevel_requested) {
7723         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7724       } else {
7725         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7726       }
7727     } else {
7728       PetscMPIInt rank;
7729       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
7730       have_void = (active_procs == (PetscInt)commsize) ? PETSC_FALSE : PETSC_TRUE;
7731       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7732     }
7733   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
7734     PetscInt    psum;
7735     if (pcbddc->coarse_ksp) psum = 1;
7736     else psum = 0;
7737     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7738     if (ncoarse < commsize) have_void = PETSC_TRUE;
7739   }
7740   /* determine if we can go multilevel */
7741   if (multilevel_requested) {
7742     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
7743     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
7744   }
7745   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
7746 
7747   /* dump subassembling pattern */
7748   if (pcbddc->dbg_flag && multilevel_allowed) {
7749     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
7750   }
7751 
7752   /* compute dofs splitting and neumann boundaries for coarse dofs */
7753   nedcfield = -1;
7754   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal)) { /* protects from unneded computations */
7755     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
7756     const PetscInt         *idxs;
7757     ISLocalToGlobalMapping tmap;
7758 
7759     /* create map between primal indices (in local representative ordering) and local primal numbering */
7760     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
7761     /* allocate space for temporary storage */
7762     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
7763     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
7764     /* allocate for IS array */
7765     nisdofs = pcbddc->n_ISForDofsLocal;
7766     if (pcbddc->nedclocal) {
7767       if (pcbddc->nedfield > -1) {
7768         nedcfield = pcbddc->nedfield;
7769       } else {
7770         nedcfield = 0;
7771         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%d)",nisdofs);
7772         nisdofs = 1;
7773       }
7774     }
7775     nisneu = !!pcbddc->NeumannBoundariesLocal;
7776     nisvert = 0; /* nisvert is not used */
7777     nis = nisdofs + nisneu + nisvert;
7778     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
7779     /* dofs splitting */
7780     for (i=0;i<nisdofs;i++) {
7781       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
7782       if (nedcfield != i) {
7783         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
7784         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7785         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7786         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7787       } else {
7788         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
7789         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7790         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7791         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %d != %d\n",tsize,nout);
7792         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7793       }
7794       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7795       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7796       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
7797     }
7798     /* neumann boundaries */
7799     if (pcbddc->NeumannBoundariesLocal) {
7800       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
7801       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
7802       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7803       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7804       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7805       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7806       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
7807       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
7808     }
7809     /* free memory */
7810     ierr = PetscFree(tidxs);CHKERRQ(ierr);
7811     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
7812     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
7813   } else {
7814     nis = 0;
7815     nisdofs = 0;
7816     nisneu = 0;
7817     nisvert = 0;
7818     isarray = NULL;
7819   }
7820   /* destroy no longer needed map */
7821   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
7822 
7823   /* subassemble */
7824   if (multilevel_allowed) {
7825     Vec       vp[1];
7826     PetscInt  nvecs = 0;
7827     PetscBool reuse,reuser;
7828 
7829     if (coarse_mat) reuse = PETSC_TRUE;
7830     else reuse = PETSC_FALSE;
7831     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7832     vp[0] = NULL;
7833     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
7834       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
7835       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
7836       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
7837       nvecs = 1;
7838 
7839       if (pcbddc->divudotp) {
7840         Mat      B,loc_divudotp;
7841         Vec      v,p;
7842         IS       dummy;
7843         PetscInt np;
7844 
7845         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
7846         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
7847         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
7848         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
7849         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
7850         ierr = VecSet(p,1.);CHKERRQ(ierr);
7851         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
7852         ierr = VecDestroy(&p);CHKERRQ(ierr);
7853         ierr = MatDestroy(&B);CHKERRQ(ierr);
7854         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
7855         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
7856         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
7857         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
7858         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
7859         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
7860         ierr = VecDestroy(&v);CHKERRQ(ierr);
7861       }
7862     }
7863     if (reuser) {
7864       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7865     } else {
7866       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7867     }
7868     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
7869       PetscScalar *arraym,*arrayv;
7870       PetscInt    nl;
7871       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
7872       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
7873       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7874       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
7875       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
7876       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
7877       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7878       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
7879     } else {
7880       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
7881     }
7882   } else {
7883     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
7884   }
7885   if (coarse_mat_is || coarse_mat) {
7886     PetscMPIInt size;
7887     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)coarse_mat_is),&size);CHKERRQ(ierr);
7888     if (!multilevel_allowed) {
7889       ierr = MatISGetMPIXAIJ(coarse_mat_is,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
7890     } else {
7891       Mat A;
7892 
7893       /* if this matrix is present, it means we are not reusing the coarse matrix */
7894       if (coarse_mat_is) {
7895         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
7896         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
7897         coarse_mat = coarse_mat_is;
7898       }
7899       /* be sure we don't have MatSeqDENSE as local mat */
7900       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
7901       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
7902     }
7903   }
7904   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
7905   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
7906 
7907   /* create local to global scatters for coarse problem */
7908   if (compute_vecs) {
7909     PetscInt lrows;
7910     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
7911     if (coarse_mat) {
7912       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
7913     } else {
7914       lrows = 0;
7915     }
7916     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
7917     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
7918     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
7919     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7920     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7921   }
7922   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
7923 
7924   /* set defaults for coarse KSP and PC */
7925   if (multilevel_allowed) {
7926     coarse_ksp_type = KSPRICHARDSON;
7927     coarse_pc_type = PCBDDC;
7928   } else {
7929     coarse_ksp_type = KSPPREONLY;
7930     coarse_pc_type = PCREDUNDANT;
7931   }
7932 
7933   /* print some info if requested */
7934   if (pcbddc->dbg_flag) {
7935     if (!multilevel_allowed) {
7936       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
7937       if (multilevel_requested) {
7938         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);
7939       } else if (pcbddc->max_levels) {
7940         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
7941       }
7942       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7943     }
7944   }
7945 
7946   /* communicate coarse discrete gradient */
7947   coarseG = NULL;
7948   if (pcbddc->nedcG && multilevel_allowed) {
7949     MPI_Comm ccomm;
7950     if (coarse_mat) {
7951       ccomm = PetscObjectComm((PetscObject)coarse_mat);
7952     } else {
7953       ccomm = MPI_COMM_NULL;
7954     }
7955     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
7956   }
7957 
7958   /* create the coarse KSP object only once with defaults */
7959   if (coarse_mat) {
7960     PetscBool   isredundant,isnn,isbddc;
7961     PetscViewer dbg_viewer = NULL;
7962 
7963     if (pcbddc->dbg_flag) {
7964       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
7965       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7966     }
7967     if (!pcbddc->coarse_ksp) {
7968       char prefix[256],str_level[16];
7969       size_t len;
7970 
7971       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
7972       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
7973       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
7974       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
7975       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7976       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
7977       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
7978       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7979       /* TODO is this logic correct? should check for coarse_mat type */
7980       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7981       /* prefix */
7982       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
7983       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
7984       if (!pcbddc->current_level) {
7985         ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
7986         ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
7987       } else {
7988         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
7989         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
7990         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
7991         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
7992         ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
7993         ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
7994       }
7995       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
7996       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7997       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
7998       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
7999       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8000       /* allow user customization */
8001       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
8002     }
8003     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8004     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8005     if (nisdofs) {
8006       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
8007       for (i=0;i<nisdofs;i++) {
8008         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8009       }
8010     }
8011     if (nisneu) {
8012       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
8013       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
8014     }
8015     if (nisvert) {
8016       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
8017       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
8018     }
8019     if (coarseG) {
8020       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
8021     }
8022 
8023     /* get some info after set from options */
8024     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8025     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
8026     if (isbddc && !multilevel_allowed) {
8027       ierr   = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8028       isbddc = PETSC_FALSE;
8029     }
8030     /* multilevel cannot be done with coarse PCs different from BDDC or NN */
8031     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
8032     if (multilevel_requested && multilevel_allowed && !isbddc && !isnn) {
8033       ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8034       isbddc = PETSC_TRUE;
8035     }
8036     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
8037     if (isredundant) {
8038       KSP inner_ksp;
8039       PC  inner_pc;
8040 
8041       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
8042       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
8043     }
8044 
8045     /* parameters which miss an API */
8046     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8047     if (isbddc) {
8048       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
8049 
8050       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
8051       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
8052       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
8053       if (pcbddc_coarse->benign_saddle_point) {
8054         Mat                    coarsedivudotp_is;
8055         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
8056         IS                     row,col;
8057         const PetscInt         *gidxs;
8058         PetscInt               n,st,M,N;
8059 
8060         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
8061         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
8062         st   = st-n;
8063         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
8064         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
8065         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
8066         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8067         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
8068         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8069         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
8070         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
8071         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
8072         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
8073         ierr = ISDestroy(&row);CHKERRQ(ierr);
8074         ierr = ISDestroy(&col);CHKERRQ(ierr);
8075         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
8076         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
8077         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
8078         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
8079         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
8080         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
8081         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
8082         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8083         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
8084         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
8085         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
8086         if (pcbddc->adaptive_threshold[0] == 0.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
8087       }
8088     }
8089 
8090     /* propagate symmetry info of coarse matrix */
8091     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
8092     if (pc->pmat->symmetric_set) {
8093       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
8094     }
8095     if (pc->pmat->hermitian_set) {
8096       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
8097     }
8098     if (pc->pmat->spd_set) {
8099       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
8100     }
8101     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
8102       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
8103     }
8104     /* set operators */
8105     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8106     if (pcbddc->dbg_flag) {
8107       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8108     }
8109   }
8110   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
8111   ierr = PetscFree(isarray);CHKERRQ(ierr);
8112 #if 0
8113   {
8114     PetscViewer viewer;
8115     char filename[256];
8116     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
8117     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
8118     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
8119     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
8120     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
8121     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
8122   }
8123 #endif
8124 
8125   if (pcbddc->coarse_ksp) {
8126     Vec crhs,csol;
8127 
8128     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
8129     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
8130     if (!csol) {
8131       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
8132     }
8133     if (!crhs) {
8134       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
8135     }
8136   }
8137   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8138 
8139   /* compute null space for coarse solver if the benign trick has been requested */
8140   if (pcbddc->benign_null) {
8141 
8142     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
8143     for (i=0;i<pcbddc->benign_n;i++) {
8144       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
8145     }
8146     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
8147     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
8148     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8149     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8150     if (coarse_mat) {
8151       Vec         nullv;
8152       PetscScalar *array,*array2;
8153       PetscInt    nl;
8154 
8155       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
8156       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
8157       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8158       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
8159       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
8160       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
8161       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8162       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
8163       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
8164       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
8165     }
8166   }
8167 
8168   if (pcbddc->coarse_ksp) {
8169     PetscBool ispreonly;
8170 
8171     if (CoarseNullSpace) {
8172       PetscBool isnull;
8173       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
8174       if (isnull) {
8175         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
8176       }
8177       /* TODO: add local nullspaces (if any) */
8178     }
8179     /* setup coarse ksp */
8180     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
8181     /* Check coarse problem if in debug mode or if solving with an iterative method */
8182     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
8183     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
8184       KSP       check_ksp;
8185       KSPType   check_ksp_type;
8186       PC        check_pc;
8187       Vec       check_vec,coarse_vec;
8188       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8189       PetscInt  its;
8190       PetscBool compute_eigs;
8191       PetscReal *eigs_r,*eigs_c;
8192       PetscInt  neigs;
8193       const char *prefix;
8194 
8195       /* Create ksp object suitable for estimation of extreme eigenvalues */
8196       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
8197       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8198       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8199       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
8200       /* prevent from setup unneeded object */
8201       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
8202       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
8203       if (ispreonly) {
8204         check_ksp_type = KSPPREONLY;
8205         compute_eigs = PETSC_FALSE;
8206       } else {
8207         check_ksp_type = KSPGMRES;
8208         compute_eigs = PETSC_TRUE;
8209       }
8210       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
8211       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
8212       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
8213       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
8214       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
8215       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
8216       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
8217       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
8218       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
8219       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
8220       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
8221       /* create random vec */
8222       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
8223       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8224       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8225       /* solve coarse problem */
8226       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8227       /* set eigenvalue estimation if preonly has not been requested */
8228       if (compute_eigs) {
8229         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8230         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8231         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8232         if (neigs) {
8233           lambda_max = eigs_r[neigs-1];
8234           lambda_min = eigs_r[0];
8235           if (pcbddc->use_coarse_estimates) {
8236             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8237               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8238               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8239             }
8240           }
8241         }
8242       }
8243 
8244       /* check coarse problem residual error */
8245       if (pcbddc->dbg_flag) {
8246         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8247         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8248         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8249         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8250         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8251         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8252         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8253         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8254         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8255         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8256         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8257         if (CoarseNullSpace) {
8258           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8259         }
8260         if (compute_eigs) {
8261           PetscReal          lambda_max_s,lambda_min_s;
8262           KSPConvergedReason reason;
8263           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8264           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8265           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8266           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8267           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);
8268           for (i=0;i<neigs;i++) {
8269             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8270           }
8271         }
8272         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8273         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8274       }
8275       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8276       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8277       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8278       if (compute_eigs) {
8279         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8280         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8281       }
8282     }
8283   }
8284   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8285   /* print additional info */
8286   if (pcbddc->dbg_flag) {
8287     /* waits until all processes reaches this point */
8288     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8289     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
8290     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8291   }
8292 
8293   /* free memory */
8294   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8295   PetscFunctionReturn(0);
8296 }
8297 
8298 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8299 {
8300   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8301   PC_IS*         pcis = (PC_IS*)pc->data;
8302   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8303   IS             subset,subset_mult,subset_n;
8304   PetscInt       local_size,coarse_size=0;
8305   PetscInt       *local_primal_indices=NULL;
8306   const PetscInt *t_local_primal_indices;
8307   PetscErrorCode ierr;
8308 
8309   PetscFunctionBegin;
8310   /* Compute global number of coarse dofs */
8311   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8312   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8313   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8314   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8315   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8316   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8317   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8318   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8319   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8320   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);
8321   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8322   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8323   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
8324   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8325   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8326 
8327   /* check numbering */
8328   if (pcbddc->dbg_flag) {
8329     PetscScalar coarsesum,*array,*array2;
8330     PetscInt    i;
8331     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8332 
8333     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8334     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8335     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8336     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8337     /* counter */
8338     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8339     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8340     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8341     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8342     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8343     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8344     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8345     for (i=0;i<pcbddc->local_primal_size;i++) {
8346       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8347     }
8348     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8349     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8350     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8351     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8352     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8353     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8354     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8355     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8356     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8357     for (i=0;i<pcis->n;i++) {
8358       if (array[i] != 0.0 && array[i] != array2[i]) {
8359         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8360         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8361         set_error = PETSC_TRUE;
8362         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8363         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);
8364       }
8365     }
8366     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8367     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8368     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8369     for (i=0;i<pcis->n;i++) {
8370       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8371     }
8372     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8373     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8374     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8375     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8376     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8377     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8378     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8379       PetscInt *gidxs;
8380 
8381       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8382       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8383       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8384       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8385       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8386       for (i=0;i<pcbddc->local_primal_size;i++) {
8387         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);
8388       }
8389       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8390       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8391     }
8392     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8393     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8394     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8395   }
8396   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
8397   /* get back data */
8398   *coarse_size_n = coarse_size;
8399   *local_primal_indices_n = local_primal_indices;
8400   PetscFunctionReturn(0);
8401 }
8402 
8403 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8404 {
8405   IS             localis_t;
8406   PetscInt       i,lsize,*idxs,n;
8407   PetscScalar    *vals;
8408   PetscErrorCode ierr;
8409 
8410   PetscFunctionBegin;
8411   /* get indices in local ordering exploiting local to global map */
8412   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8413   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8414   for (i=0;i<lsize;i++) vals[i] = 1.0;
8415   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8416   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8417   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8418   if (idxs) { /* multilevel guard */
8419     ierr = VecSetOption(gwork,VEC_IGNORE_NEGATIVE_INDICES,PETSC_TRUE);CHKERRQ(ierr);
8420     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8421   }
8422   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8423   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8424   ierr = PetscFree(vals);CHKERRQ(ierr);
8425   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8426   /* now compute set in local ordering */
8427   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8428   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8429   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8430   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8431   for (i=0,lsize=0;i<n;i++) {
8432     if (PetscRealPart(vals[i]) > 0.5) {
8433       lsize++;
8434     }
8435   }
8436   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8437   for (i=0,lsize=0;i<n;i++) {
8438     if (PetscRealPart(vals[i]) > 0.5) {
8439       idxs[lsize++] = i;
8440     }
8441   }
8442   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8443   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8444   *localis = localis_t;
8445   PetscFunctionReturn(0);
8446 }
8447 
8448 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8449 {
8450   PC_IS               *pcis=(PC_IS*)pc->data;
8451   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8452   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8453   Mat                 S_j;
8454   PetscInt            *used_xadj,*used_adjncy;
8455   PetscBool           free_used_adj;
8456   PetscErrorCode      ierr;
8457 
8458   PetscFunctionBegin;
8459   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8460   free_used_adj = PETSC_FALSE;
8461   if (pcbddc->sub_schurs_layers == -1) {
8462     used_xadj = NULL;
8463     used_adjncy = NULL;
8464   } else {
8465     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8466       used_xadj = pcbddc->mat_graph->xadj;
8467       used_adjncy = pcbddc->mat_graph->adjncy;
8468     } else if (pcbddc->computed_rowadj) {
8469       used_xadj = pcbddc->mat_graph->xadj;
8470       used_adjncy = pcbddc->mat_graph->adjncy;
8471     } else {
8472       PetscBool      flg_row=PETSC_FALSE;
8473       const PetscInt *xadj,*adjncy;
8474       PetscInt       nvtxs;
8475 
8476       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8477       if (flg_row) {
8478         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8479         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8480         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8481         free_used_adj = PETSC_TRUE;
8482       } else {
8483         pcbddc->sub_schurs_layers = -1;
8484         used_xadj = NULL;
8485         used_adjncy = NULL;
8486       }
8487       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8488     }
8489   }
8490 
8491   /* setup sub_schurs data */
8492   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8493   if (!sub_schurs->schur_explicit) {
8494     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8495     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8496     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);
8497   } else {
8498     Mat       change = NULL;
8499     Vec       scaling = NULL;
8500     IS        change_primal = NULL, iP;
8501     PetscInt  benign_n;
8502     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8503     PetscBool isseqaij,need_change = PETSC_FALSE;
8504     PetscBool discrete_harmonic = PETSC_FALSE;
8505 
8506     if (!pcbddc->use_vertices && reuse_solvers) {
8507       PetscInt n_vertices;
8508 
8509       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8510       reuse_solvers = (PetscBool)!n_vertices;
8511     }
8512     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8513     if (!isseqaij) {
8514       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8515       if (matis->A == pcbddc->local_mat) {
8516         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8517         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8518       } else {
8519         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8520       }
8521     }
8522     if (!pcbddc->benign_change_explicit) {
8523       benign_n = pcbddc->benign_n;
8524     } else {
8525       benign_n = 0;
8526     }
8527     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
8528        We need a global reduction to avoid possible deadlocks.
8529        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
8530     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
8531       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
8532       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8533       need_change = (PetscBool)(!need_change);
8534     }
8535     /* If the user defines additional constraints, we import them here.
8536        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 */
8537     if (need_change) {
8538       PC_IS   *pcisf;
8539       PC_BDDC *pcbddcf;
8540       PC      pcf;
8541 
8542       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
8543       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
8544       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
8545       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
8546 
8547       /* hacks */
8548       pcisf                        = (PC_IS*)pcf->data;
8549       pcisf->is_B_local            = pcis->is_B_local;
8550       pcisf->vec1_N                = pcis->vec1_N;
8551       pcisf->BtoNmap               = pcis->BtoNmap;
8552       pcisf->n                     = pcis->n;
8553       pcisf->n_B                   = pcis->n_B;
8554       pcbddcf                      = (PC_BDDC*)pcf->data;
8555       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
8556       pcbddcf->mat_graph           = pcbddc->mat_graph;
8557       pcbddcf->use_faces           = PETSC_TRUE;
8558       pcbddcf->use_change_of_basis = PETSC_TRUE;
8559       pcbddcf->use_change_on_faces = PETSC_TRUE;
8560       pcbddcf->use_qr_single       = PETSC_TRUE;
8561       pcbddcf->fake_change         = PETSC_TRUE;
8562 
8563       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
8564       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
8565       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
8566       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
8567       change = pcbddcf->ConstraintMatrix;
8568       pcbddcf->ConstraintMatrix = NULL;
8569 
8570       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
8571       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
8572       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
8573       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
8574       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
8575       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
8576       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
8577       pcf->ops->destroy = NULL;
8578       pcf->ops->reset   = NULL;
8579       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
8580     }
8581     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
8582 
8583     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
8584     if (iP) {
8585       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
8586       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
8587       ierr = PetscOptionsEnd();CHKERRQ(ierr);
8588     }
8589     if (discrete_harmonic) {
8590       Mat A;
8591       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
8592       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
8593       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
8594       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);
8595       ierr = MatDestroy(&A);CHKERRQ(ierr);
8596     } else {
8597       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);
8598     }
8599     ierr = MatDestroy(&change);CHKERRQ(ierr);
8600     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
8601   }
8602   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8603 
8604   /* free adjacency */
8605   if (free_used_adj) {
8606     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
8607   }
8608   PetscFunctionReturn(0);
8609 }
8610 
8611 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
8612 {
8613   PC_IS               *pcis=(PC_IS*)pc->data;
8614   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8615   PCBDDCGraph         graph;
8616   PetscErrorCode      ierr;
8617 
8618   PetscFunctionBegin;
8619   /* attach interface graph for determining subsets */
8620   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
8621     IS       verticesIS,verticescomm;
8622     PetscInt vsize,*idxs;
8623 
8624     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8625     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
8626     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8627     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
8628     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8629     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8630     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
8631     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
8632     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
8633     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
8634     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
8635   } else {
8636     graph = pcbddc->mat_graph;
8637   }
8638   /* print some info */
8639   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
8640     IS       vertices;
8641     PetscInt nv,nedges,nfaces;
8642     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
8643     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8644     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
8645     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8646     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
8647     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
8648     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
8649     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
8650     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8651     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8652     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8653   }
8654 
8655   /* sub_schurs init */
8656   if (!pcbddc->sub_schurs) {
8657     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
8658   }
8659   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);
8660 
8661   /* free graph struct */
8662   if (pcbddc->sub_schurs_rebuild) {
8663     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
8664   }
8665   PetscFunctionReturn(0);
8666 }
8667 
8668 PetscErrorCode PCBDDCCheckOperator(PC pc)
8669 {
8670   PC_IS               *pcis=(PC_IS*)pc->data;
8671   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8672   PetscErrorCode      ierr;
8673 
8674   PetscFunctionBegin;
8675   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
8676     IS             zerodiag = NULL;
8677     Mat            S_j,B0_B=NULL;
8678     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
8679     PetscScalar    *p0_check,*array,*array2;
8680     PetscReal      norm;
8681     PetscInt       i;
8682 
8683     /* B0 and B0_B */
8684     if (zerodiag) {
8685       IS       dummy;
8686 
8687       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
8688       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
8689       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
8690       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8691     }
8692     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
8693     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
8694     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
8695     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8696     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8697     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8698     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8699     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
8700     /* S_j */
8701     ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8702     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8703 
8704     /* mimic vector in \widetilde{W}_\Gamma */
8705     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
8706     /* continuous in primal space */
8707     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
8708     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8709     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8710     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8711     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
8712     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
8713     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8714     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8715     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8716     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8717     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8718     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8719     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
8720     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
8721 
8722     /* assemble rhs for coarse problem */
8723     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
8724     /* local with Schur */
8725     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
8726     if (zerodiag) {
8727       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8728       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
8729       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8730       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
8731     }
8732     /* sum on primal nodes the local contributions */
8733     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8734     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8735     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8736     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8737     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
8738     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8739     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8740     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
8741     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8742     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8743     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8744     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8745     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8746     /* scale primal nodes (BDDC sums contibutions) */
8747     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
8748     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8749     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8750     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8751     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8752     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8753     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8754     /* global: \widetilde{B0}_B w_\Gamma */
8755     if (zerodiag) {
8756       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
8757       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8758       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
8759       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8760     }
8761     /* BDDC */
8762     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
8763     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
8764 
8765     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
8766     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
8767     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
8768     PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);
8769     for (i=0;i<pcbddc->benign_n;i++) {
8770       PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%d] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));
8771     }
8772     ierr = PetscFree(p0_check);CHKERRQ(ierr);
8773     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
8774     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
8775     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
8776     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8777     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
8778   }
8779   PetscFunctionReturn(0);
8780 }
8781 
8782 #include <../src/mat/impls/aij/mpi/mpiaij.h>
8783 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
8784 {
8785   Mat            At;
8786   IS             rows;
8787   PetscInt       rst,ren;
8788   PetscErrorCode ierr;
8789   PetscLayout    rmap;
8790 
8791   PetscFunctionBegin;
8792   rst = ren = 0;
8793   if (ccomm != MPI_COMM_NULL) {
8794     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
8795     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
8796     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
8797     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
8798     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
8799   }
8800   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
8801   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
8802   ierr = ISDestroy(&rows);CHKERRQ(ierr);
8803 
8804   if (ccomm != MPI_COMM_NULL) {
8805     Mat_MPIAIJ *a,*b;
8806     IS         from,to;
8807     Vec        gvec;
8808     PetscInt   lsize;
8809 
8810     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
8811     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
8812     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
8813     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
8814     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
8815     a    = (Mat_MPIAIJ*)At->data;
8816     b    = (Mat_MPIAIJ*)(*B)->data;
8817     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
8818     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
8819     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
8820     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
8821     b->A = a->A;
8822     b->B = a->B;
8823 
8824     b->donotstash      = a->donotstash;
8825     b->roworiented     = a->roworiented;
8826     b->rowindices      = 0;
8827     b->rowvalues       = 0;
8828     b->getrowactive    = PETSC_FALSE;
8829 
8830     (*B)->rmap         = rmap;
8831     (*B)->factortype   = A->factortype;
8832     (*B)->assembled    = PETSC_TRUE;
8833     (*B)->insertmode   = NOT_SET_VALUES;
8834     (*B)->preallocated = PETSC_TRUE;
8835 
8836     if (a->colmap) {
8837 #if defined(PETSC_USE_CTABLE)
8838       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
8839 #else
8840       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
8841       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8842       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8843 #endif
8844     } else b->colmap = 0;
8845     if (a->garray) {
8846       PetscInt len;
8847       len  = a->B->cmap->n;
8848       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
8849       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
8850       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
8851     } else b->garray = 0;
8852 
8853     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
8854     b->lvec = a->lvec;
8855     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
8856 
8857     /* cannot use VecScatterCopy */
8858     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
8859     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
8860     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
8861     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
8862     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
8863     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
8864     ierr = ISDestroy(&from);CHKERRQ(ierr);
8865     ierr = ISDestroy(&to);CHKERRQ(ierr);
8866     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
8867   }
8868   ierr = MatDestroy(&At);CHKERRQ(ierr);
8869   PetscFunctionReturn(0);
8870 }
8871