xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 3007b4effb72abca36177fc63a17dfd2f80c6031)
1 #include <../src/mat/impls/aij/seq/aij.h>
2 #include <../src/ksp/pc/impls/bddc/bddc.h>
3 #include <../src/ksp/pc/impls/bddc/bddcprivate.h>
4 #include <../src/mat/impls/dense/seq/dense.h>
5 #include <petscdmplex.h>
6 #include <petscblaslapack.h>
7 #include <petsc/private/sfimpl.h>
8 #include <petsc/private/dmpleximpl.h>
9 #include <petscdmda.h>
10 
11 static PetscErrorCode MatMPIAIJRestrict(Mat,MPI_Comm,Mat*);
12 
13 /* if range is true,  it returns B s.t. span{B} = range(A)
14    if range is false, it returns B s.t. range(B) _|_ range(A) */
15 PetscErrorCode MatDenseOrthogonalRangeOrComplement(Mat A, PetscBool range, PetscInt lw, PetscScalar *work, PetscReal *rwork, Mat *B)
16 {
17 #if !defined(PETSC_USE_COMPLEX)
18   PetscScalar    *uwork,*data,*U, ds = 0.;
19   PetscReal      *sing;
20   PetscBLASInt   bM,bN,lwork,lierr,di = 1;
21   PetscInt       ulw,i,nr,nc,n;
22   PetscErrorCode ierr;
23 
24   PetscFunctionBegin;
25 #if defined(PETSC_MISSING_LAPACK_GESVD)
26   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"LAPACK _GESVD not available");
27 #else
28   ierr = MatGetSize(A,&nr,&nc);CHKERRQ(ierr);
29   if (!nr || !nc) PetscFunctionReturn(0);
30 
31   /* workspace */
32   if (!work) {
33     ulw  = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc));
34     ierr = PetscMalloc1(ulw,&uwork);CHKERRQ(ierr);
35   } else {
36     ulw   = lw;
37     uwork = work;
38   }
39   n = PetscMin(nr,nc);
40   if (!rwork) {
41     ierr = PetscMalloc1(n,&sing);CHKERRQ(ierr);
42   } else {
43     sing = rwork;
44   }
45 
46   /* SVD */
47   ierr = PetscMalloc1(nr*nr,&U);CHKERRQ(ierr);
48   ierr = PetscBLASIntCast(nr,&bM);CHKERRQ(ierr);
49   ierr = PetscBLASIntCast(nc,&bN);CHKERRQ(ierr);
50   ierr = PetscBLASIntCast(ulw,&lwork);CHKERRQ(ierr);
51   ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr);
52   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
53   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr));
54   ierr = PetscFPTrapPop();CHKERRQ(ierr);
55   if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
56   ierr = MatDenseRestoreArray(A,&data);CHKERRQ(ierr);
57   for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break;
58   if (!rwork) {
59     ierr = PetscFree(sing);CHKERRQ(ierr);
60   }
61   if (!work) {
62     ierr = PetscFree(uwork);CHKERRQ(ierr);
63   }
64   /* create B */
65   if (!range) {
66     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B);CHKERRQ(ierr);
67     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
68     ierr = PetscMemcpy(data,U+nr*i,(nr-i)*nr*sizeof(PetscScalar));CHKERRQ(ierr);
69   } else {
70     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,i,NULL,B);CHKERRQ(ierr);
71     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
72     ierr = PetscMemcpy(data,U,i*nr*sizeof(PetscScalar));CHKERRQ(ierr);
73   }
74   ierr = MatDenseRestoreArray(*B,&data);CHKERRQ(ierr);
75   ierr = PetscFree(U);CHKERRQ(ierr);
76 #endif
77 #else /* PETSC_USE_COMPLEX */
78   PetscFunctionBegin;
79   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented for complexes");
80 #endif
81   PetscFunctionReturn(0);
82 }
83 
84 /* TODO REMOVE */
85 #if defined(PRINT_GDET)
86 static int inc = 0;
87 static int lev = 0;
88 #endif
89 
90 PetscErrorCode PCBDDCComputeNedelecChangeEdge(Mat lG, IS edge, IS extrow, IS extcol, IS corners, Mat* Gins, Mat* GKins, PetscScalar cvals[2], PetscScalar *work, PetscReal *rwork)
91 {
92   PetscErrorCode ierr;
93   Mat            GE,GEd;
94   PetscInt       rsize,csize,esize;
95   PetscScalar    *ptr;
96 
97   PetscFunctionBegin;
98   ierr = ISGetSize(edge,&esize);CHKERRQ(ierr);
99   if (!esize) PetscFunctionReturn(0);
100   ierr = ISGetSize(extrow,&rsize);CHKERRQ(ierr);
101   ierr = ISGetSize(extcol,&csize);CHKERRQ(ierr);
102 
103   /* gradients */
104   ptr  = work + 5*esize;
105   ierr = MatCreateSubMatrix(lG,extrow,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
106   ierr = MatCreateSeqDense(PETSC_COMM_SELF,rsize,csize,ptr,Gins);CHKERRQ(ierr);
107   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,Gins);CHKERRQ(ierr);
108   ierr = MatDestroy(&GE);CHKERRQ(ierr);
109 
110   /* constants */
111   ptr += rsize*csize;
112   ierr = MatCreateSeqDense(PETSC_COMM_SELF,esize,csize,ptr,&GEd);CHKERRQ(ierr);
113   ierr = MatCreateSubMatrix(lG,edge,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
114   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,&GEd);CHKERRQ(ierr);
115   ierr = MatDestroy(&GE);CHKERRQ(ierr);
116   ierr = MatDenseOrthogonalRangeOrComplement(GEd,PETSC_FALSE,5*esize,work,rwork,GKins);CHKERRQ(ierr);
117   ierr = MatDestroy(&GEd);CHKERRQ(ierr);
118 
119   if (corners) {
120     Mat            GEc;
121     PetscScalar    *vals,v;
122 
123     ierr = MatCreateSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr);
124     ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr);
125     ierr = MatDenseGetArray(GEd,&vals);CHKERRQ(ierr);
126     /* v    = PetscAbsScalar(vals[0]) */;
127     v    = 1.;
128     cvals[0] = vals[0]/v;
129     cvals[1] = vals[1]/v;
130     ierr = MatDenseRestoreArray(GEd,&vals);CHKERRQ(ierr);
131     ierr = MatScale(*GKins,1./v);CHKERRQ(ierr);
132 #if defined(PRINT_GDET)
133     {
134       PetscViewer viewer;
135       char filename[256];
136       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
137       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
138       ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
139       ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr);
140       ierr = MatView(GEc,viewer);CHKERRQ(ierr);
141       ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr);
142       ierr = MatView(*GKins,viewer);CHKERRQ(ierr);
143       ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr);
144       ierr = MatView(GEd,viewer);CHKERRQ(ierr);
145       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
146     }
147 #endif
148     ierr = MatDestroy(&GEd);CHKERRQ(ierr);
149     ierr = MatDestroy(&GEc);CHKERRQ(ierr);
150   }
151 
152   PetscFunctionReturn(0);
153 }
154 
155 PetscErrorCode PCBDDCNedelecSupport(PC pc)
156 {
157   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
158   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
159   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
160   Vec                    tvec;
161   PetscSF                sfv;
162   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
163   MPI_Comm               comm;
164   IS                     lned,primals,allprimals,nedfieldlocal;
165   IS                     *eedges,*extrows,*extcols,*alleedges;
166   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
167   PetscScalar            *vals,*work;
168   PetscReal              *rwork;
169   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
170   PetscInt               ne,nv,Lv,order,n,field;
171   PetscInt               n_neigh,*neigh,*n_shared,**shared;
172   PetscInt               i,j,extmem,cum,maxsize,nee;
173   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
174   PetscInt               *sfvleaves,*sfvroots;
175   PetscInt               *corners,*cedges;
176   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
177 #if defined(PETSC_USE_DEBUG)
178   PetscInt               *emarks;
179 #endif
180   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
181   PetscErrorCode         ierr;
182 
183   PetscFunctionBegin;
184   /* If the discrete gradient is defined for a subset of dofs and global is true,
185      it assumes G is given in global ordering for all the dofs.
186      Otherwise, the ordering is global for the Nedelec field */
187   order      = pcbddc->nedorder;
188   conforming = pcbddc->conforming;
189   field      = pcbddc->nedfield;
190   global     = pcbddc->nedglobal;
191   setprimal  = PETSC_FALSE;
192   print      = PETSC_FALSE;
193   singular   = PETSC_FALSE;
194 
195   /* Command line customization */
196   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
197   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
198   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
199   ierr = PetscOptionsInt("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
200   /* print debug info TODO: to be removed */
201   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
202   ierr = PetscOptionsEnd();CHKERRQ(ierr);
203 
204   /* Return if there are no edges in the decomposition and the problem is not singular */
205   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
206   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
207   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
208   if (!singular) {
209     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
210     lrc[0] = PETSC_FALSE;
211     for (i=0;i<n;i++) {
212       if (PetscRealPart(vals[i]) > 2.) {
213         lrc[0] = PETSC_TRUE;
214         break;
215       }
216     }
217     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
218     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
219     if (!lrc[1]) PetscFunctionReturn(0);
220   }
221 
222   /* Get Nedelec field */
223   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
224   if (pcbddc->n_ISForDofsLocal && field >= pcbddc->n_ISForDofsLocal) SETERRQ2(comm,PETSC_ERR_USER,"Invalid field for Nedelec %d: number of fields is %d",field,pcbddc->n_ISForDofsLocal);
225   if (pcbddc->n_ISForDofsLocal && field >= 0) {
226     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
227     nedfieldlocal = pcbddc->ISForDofsLocal[field];
228     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
229   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
230     ne            = n;
231     nedfieldlocal = NULL;
232     global        = PETSC_TRUE;
233   } else if (field == PETSC_DECIDE) {
234     PetscInt rst,ren,*idx;
235 
236     ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
237     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
238     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
239     for (i=rst;i<ren;i++) {
240       PetscInt nc;
241 
242       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
243       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
244       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
245     }
246     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
247     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
248     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
249     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
250     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
251   } else {
252     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
253   }
254 
255   /* Sanity checks */
256   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
257   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
258   if (order && ne%order) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"The number of local edge dofs %d it's not a multiple of the order %d",ne,order);
259 
260   /* Just set primal dofs and return */
261   if (setprimal) {
262     IS       enedfieldlocal;
263     PetscInt *eidxs;
264 
265     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
266     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
267     if (nedfieldlocal) {
268       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
269       for (i=0,cum=0;i<ne;i++) {
270         if (PetscRealPart(vals[idxs[i]]) > 2.) {
271           eidxs[cum++] = idxs[i];
272         }
273       }
274       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
275     } else {
276       for (i=0,cum=0;i<ne;i++) {
277         if (PetscRealPart(vals[i]) > 2.) {
278           eidxs[cum++] = i;
279         }
280       }
281     }
282     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
283     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
284     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
285     ierr = PetscFree(eidxs);CHKERRQ(ierr);
286     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
287     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
288     PetscFunctionReturn(0);
289   }
290 
291   /* Compute some l2g maps */
292   if (nedfieldlocal) {
293     IS is;
294 
295     /* need to map from the local Nedelec field to local numbering */
296     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
297     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
298     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
299     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
300     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
301     if (global) {
302       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
303       el2g = al2g;
304     } else {
305       IS gis;
306 
307       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
308       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
309       ierr = ISDestroy(&gis);CHKERRQ(ierr);
310     }
311     ierr = ISDestroy(&is);CHKERRQ(ierr);
312   } else {
313     /* restore default */
314     pcbddc->nedfield = -1;
315     /* one ref for the destruction of al2g, one for el2g */
316     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
317     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
318     el2g = al2g;
319     fl2g = NULL;
320   }
321 
322   /* Start communication to drop connections for interior edges (for cc analysis only) */
323   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
324   ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
325   if (nedfieldlocal) {
326     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
327     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
328     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
329   } else {
330     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
331   }
332   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
333   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
334 
335   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
336     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
337     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
338     if (global) {
339       PetscInt rst;
340 
341       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
342       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
343         if (matis->sf_rootdata[i] < 2) {
344           matis->sf_rootdata[cum++] = i + rst;
345         }
346       }
347       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
348       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
349     } else {
350       PetscInt *tbz;
351 
352       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
353       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
354       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
355       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
356       for (i=0,cum=0;i<ne;i++)
357         if (matis->sf_leafdata[idxs[i]] == 1)
358           tbz[cum++] = i;
359       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
360       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
361       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
362       ierr = PetscFree(tbz);CHKERRQ(ierr);
363     }
364   } else { /* we need the entire G to infer the nullspace */
365     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
366     G    = pcbddc->discretegradient;
367   }
368 
369   /* Extract subdomain relevant rows of G */
370   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
371   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
372   ierr = MatCreateSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
373   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
374   ierr = ISDestroy(&lned);CHKERRQ(ierr);
375   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
376   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
377   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
378 
379   /* SF for nodal dofs communications */
380   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
381   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
382   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
383   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
384   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
385   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
386   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
387   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
388   i    = singular ? 2 : 1;
389   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
390 
391   /* Destroy temporary G created in MATIS format and modified G */
392   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
393   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
394   ierr = MatDestroy(&G);CHKERRQ(ierr);
395 
396   if (print) {
397     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
398     ierr = MatView(lG,NULL);CHKERRQ(ierr);
399   }
400 
401   /* Save lG for values insertion in change of basis */
402   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
403 
404   /* Analyze the edge-nodes connections (duplicate lG) */
405   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
406   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
407   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
408   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
409   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
410   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
411   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
412   /* need to import the boundary specification to ensure the
413      proper detection of coarse edges' endpoints */
414   if (pcbddc->DirichletBoundariesLocal) {
415     IS is;
416 
417     if (fl2g) {
418       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
419     } else {
420       is = pcbddc->DirichletBoundariesLocal;
421     }
422     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
423     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
424     for (i=0;i<cum;i++) {
425       if (idxs[i] >= 0) {
426         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
427         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
428       }
429     }
430     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
431     if (fl2g) {
432       ierr = ISDestroy(&is);CHKERRQ(ierr);
433     }
434   }
435   if (pcbddc->NeumannBoundariesLocal) {
436     IS is;
437 
438     if (fl2g) {
439       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
440     } else {
441       is = pcbddc->NeumannBoundariesLocal;
442     }
443     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
444     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
445     for (i=0;i<cum;i++) {
446       if (idxs[i] >= 0) {
447         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
448       }
449     }
450     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
451     if (fl2g) {
452       ierr = ISDestroy(&is);CHKERRQ(ierr);
453     }
454   }
455 
456   /* Count neighs per dof */
457   ierr = ISLocalToGlobalMappingGetNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
458   ierr = ISLocalToGlobalMappingGetNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
459 
460   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
461      for proper detection of coarse edges' endpoints */
462   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
463   for (i=0;i<ne;i++) {
464     if ((ecount[i] > 2 && !PetscBTLookup(btbd,i)) || (ecount[i] == 2 && PetscBTLookup(btb,i))) {
465       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
466     }
467   }
468   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
469   if (!conforming) {
470     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
471     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
472   }
473   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
474   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
475   cum  = 0;
476   for (i=0;i<ne;i++) {
477     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
478     if (!PetscBTLookup(btee,i)) {
479       marks[cum++] = i;
480       continue;
481     }
482     /* set badly connected edge dofs as primal */
483     if (!conforming) {
484       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
485         marks[cum++] = i;
486         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
487         for (j=ii[i];j<ii[i+1];j++) {
488           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
489         }
490       } else {
491         /* every edge dofs should be connected trough a certain number of nodal dofs
492            to other edge dofs belonging to coarse edges
493            - at most 2 endpoints
494            - order-1 interior nodal dofs
495            - no undefined nodal dofs (nconn < order)
496         */
497         PetscInt ends = 0,ints = 0, undef = 0;
498         for (j=ii[i];j<ii[i+1];j++) {
499           PetscInt v = jj[j],k;
500           PetscInt nconn = iit[v+1]-iit[v];
501           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
502           if (nconn > order) ends++;
503           else if (nconn == order) ints++;
504           else undef++;
505         }
506         if (undef || ends > 2 || ints != order -1) {
507           marks[cum++] = i;
508           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
509           for (j=ii[i];j<ii[i+1];j++) {
510             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
511           }
512         }
513       }
514     }
515     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
516     if (!order && ii[i+1] != ii[i]) {
517       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
518       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
519     }
520   }
521   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
522   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
523   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
524   if (!conforming) {
525     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
526     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
527   }
528   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
529 
530   /* identify splitpoints and corner candidates */
531   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
532   if (print) {
533     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
534     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
535     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
536     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
537   }
538   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
539   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
540   for (i=0;i<nv;i++) {
541     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
542     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
543     if (!order) { /* variable order */
544       PetscReal vorder = 0.;
545 
546       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
547       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
548       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%d)",vorder,test);
549       ord  = 1;
550     }
551 #if defined(PETSC_USE_DEBUG)
552     if (test%ord) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected number of edge dofs %d connected with nodal dof %d with order %d",test,i,ord);
553 #endif
554     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
555       if (PetscBTLookup(btbd,jj[j])) {
556         bdir = PETSC_TRUE;
557         break;
558       }
559       if (vc != ecount[jj[j]]) {
560         sneighs = PETSC_FALSE;
561       } else {
562         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
563         for (k=0;k<vc;k++) {
564           if (vn[k] != en[k]) {
565             sneighs = PETSC_FALSE;
566             break;
567           }
568         }
569       }
570     }
571     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
572       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %d (%d %d %d)\n",i,!sneighs,test >= 3*ord,bdir);
573       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
574     } else if (test == ord) {
575       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
576         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %d\n",i);
577         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
578       } else {
579         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %d\n",i);
580         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
581       }
582     }
583   }
584   ierr = ISLocalToGlobalMappingRestoreNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
585   ierr = ISLocalToGlobalMappingRestoreNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
586   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
587 
588   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
589   if (order != 1) {
590     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
591     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
592     for (i=0;i<nv;i++) {
593       if (PetscBTLookup(btvcand,i)) {
594         PetscBool found = PETSC_FALSE;
595         for (j=ii[i];j<ii[i+1] && !found;j++) {
596           PetscInt k,e = jj[j];
597           if (PetscBTLookup(bte,e)) continue;
598           for (k=iit[e];k<iit[e+1];k++) {
599             PetscInt v = jjt[k];
600             if (v != i && PetscBTLookup(btvcand,v)) {
601               found = PETSC_TRUE;
602               break;
603             }
604           }
605         }
606         if (!found) {
607           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d CLEARED\n",i);
608           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
609         } else {
610           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d ACCEPTED\n",i);
611         }
612       }
613     }
614     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
615   }
616   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
617   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
618   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
619 
620   /* Get the local G^T explicitly */
621   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
622   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
623   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
624 
625   /* Mark interior nodal dofs */
626   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
627   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
628   for (i=1;i<n_neigh;i++) {
629     for (j=0;j<n_shared[i];j++) {
630       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
631     }
632   }
633   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
634 
635   /* communicate corners and splitpoints */
636   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
637   ierr = PetscMemzero(sfvleaves,nv*sizeof(PetscInt));CHKERRQ(ierr);
638   ierr = PetscMemzero(sfvroots,Lv*sizeof(PetscInt));CHKERRQ(ierr);
639   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
640 
641   if (print) {
642     IS tbz;
643 
644     cum = 0;
645     for (i=0;i<nv;i++)
646       if (sfvleaves[i])
647         vmarks[cum++] = i;
648 
649     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
650     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
651     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
652     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
653   }
654 
655   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
656   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
657   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
658   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
659 
660   /* Zero rows of lGt corresponding to identified corners
661      and interior nodal dofs */
662   cum = 0;
663   for (i=0;i<nv;i++) {
664     if (sfvleaves[i]) {
665       vmarks[cum++] = i;
666       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
667     }
668     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
669   }
670   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
671   if (print) {
672     IS tbz;
673 
674     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
675     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
676     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
677     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
678   }
679   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
680   ierr = PetscFree(vmarks);CHKERRQ(ierr);
681   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
682   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
683 
684   /* Recompute G */
685   ierr = MatDestroy(&lG);CHKERRQ(ierr);
686   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
687   if (print) {
688     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
689     ierr = MatView(lG,NULL);CHKERRQ(ierr);
690     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
691     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
692   }
693 
694   /* Get primal dofs (if any) */
695   cum = 0;
696   for (i=0;i<ne;i++) {
697     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
698   }
699   if (fl2g) {
700     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
701   }
702   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
703   if (print) {
704     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
705     ierr = ISView(primals,NULL);CHKERRQ(ierr);
706   }
707   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
708   /* TODO: what if the user passed in some of them ?  */
709   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
710   ierr = ISDestroy(&primals);CHKERRQ(ierr);
711 
712   /* Compute edge connectivity */
713   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
714   ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr);
715   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
716   if (fl2g) {
717     PetscBT   btf;
718     PetscInt  *iia,*jja,*iiu,*jju;
719     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
720 
721     /* create CSR for all local dofs */
722     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
723     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
724       if (pcbddc->mat_graph->nvtxs_csr != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid size of CSR graph %d. Should be %d\n",pcbddc->mat_graph->nvtxs_csr,n);
725       iiu = pcbddc->mat_graph->xadj;
726       jju = pcbddc->mat_graph->adjncy;
727     } else if (pcbddc->use_local_adj) {
728       rest = PETSC_TRUE;
729       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
730     } else {
731       free   = PETSC_TRUE;
732       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
733       iiu[0] = 0;
734       for (i=0;i<n;i++) {
735         iiu[i+1] = i+1;
736         jju[i]   = -1;
737       }
738     }
739 
740     /* import sizes of CSR */
741     iia[0] = 0;
742     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
743 
744     /* overwrite entries corresponding to the Nedelec field */
745     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
746     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
747     for (i=0;i<ne;i++) {
748       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
749       iia[idxs[i]+1] = ii[i+1]-ii[i];
750     }
751 
752     /* iia in CSR */
753     for (i=0;i<n;i++) iia[i+1] += iia[i];
754 
755     /* jja in CSR */
756     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
757     for (i=0;i<n;i++)
758       if (!PetscBTLookup(btf,i))
759         for (j=0;j<iiu[i+1]-iiu[i];j++)
760           jja[iia[i]+j] = jju[iiu[i]+j];
761 
762     /* map edge dofs connectivity */
763     if (jj) {
764       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
765       for (i=0;i<ne;i++) {
766         PetscInt e = idxs[i];
767         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
768       }
769     }
770     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
771     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
772     if (rest) {
773       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
774     }
775     if (free) {
776       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
777     }
778     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
779   } else {
780     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
781   }
782 
783   /* Analyze interface for edge dofs */
784   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
785   pcbddc->mat_graph->twodim = PETSC_FALSE;
786 
787   /* Get coarse edges in the edge space */
788   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
789   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
790 
791   if (fl2g) {
792     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
793     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
794     for (i=0;i<nee;i++) {
795       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
796     }
797   } else {
798     eedges  = alleedges;
799     primals = allprimals;
800   }
801 
802   /* Mark fine edge dofs with their coarse edge id */
803   ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
804   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
805   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
806   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
807   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
808   if (print) {
809     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
810     ierr = ISView(primals,NULL);CHKERRQ(ierr);
811   }
812 
813   maxsize = 0;
814   for (i=0;i<nee;i++) {
815     PetscInt size,mark = i+1;
816 
817     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
818     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
819     for (j=0;j<size;j++) marks[idxs[j]] = mark;
820     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
821     maxsize = PetscMax(maxsize,size);
822   }
823 
824   /* Find coarse edge endpoints */
825   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
826   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
827   for (i=0;i<nee;i++) {
828     PetscInt mark = i+1,size;
829 
830     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
831     if (!size && nedfieldlocal) continue;
832     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
833     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
834     if (print) {
835       PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %d\n",i);
836       ISView(eedges[i],NULL);
837     }
838     for (j=0;j<size;j++) {
839       PetscInt k, ee = idxs[j];
840       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %d\n",ee);
841       for (k=ii[ee];k<ii[ee+1];k++) {
842         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %d\n",jj[k]);
843         if (PetscBTLookup(btv,jj[k])) {
844           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %d\n",jj[k]);
845         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
846           PetscInt  k2;
847           PetscBool corner = PETSC_FALSE;
848           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
849             if (print) PetscPrintf(PETSC_COMM_SELF,"        INSPECTING %d: mark %d (ref mark %d), boundary %d\n",jjt[k2],marks[jjt[k2]],mark,!!PetscBTLookup(btb,jjt[k2]));
850             /* it's a corner if either is connected with an edge dof belonging to a different cc or
851                if the edge dof lie on the natural part of the boundary */
852             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
853               corner = PETSC_TRUE;
854               break;
855             }
856           }
857           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
858             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %d\n",jj[k]);
859             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
860           } else {
861             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
862           }
863         }
864       }
865     }
866     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
867   }
868   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
869   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
870   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
871 
872   /* Reset marked primal dofs */
873   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
874   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
875   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
876   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
877 
878   /* Now use the initial lG */
879   ierr = MatDestroy(&lG);CHKERRQ(ierr);
880   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
881   lG   = lGinit;
882   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
883 
884   /* Compute extended cols indices */
885   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
886   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
887   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
888   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
889   i   *= maxsize;
890   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
891   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
892   eerr = PETSC_FALSE;
893   for (i=0;i<nee;i++) {
894     PetscInt size,found = 0;
895 
896     cum  = 0;
897     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
898     if (!size && nedfieldlocal) continue;
899     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
900     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
901     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
902     for (j=0;j<size;j++) {
903       PetscInt k,ee = idxs[j];
904       for (k=ii[ee];k<ii[ee+1];k++) {
905         PetscInt vv = jj[k];
906         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
907         else if (!PetscBTLookupSet(btvc,vv)) found++;
908       }
909     }
910     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
911     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
912     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
913     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
914     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
915     /* it may happen that endpoints are not defined at this point
916        if it is the case, mark this edge for a second pass */
917     if (cum != size -1 || found != 2) {
918       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
919       if (print) {
920         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
921         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
922         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
923         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
924       }
925       eerr = PETSC_TRUE;
926     }
927   }
928   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
929   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
930   if (done) {
931     PetscInt *newprimals;
932 
933     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
934     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
935     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
936     ierr = PetscMemcpy(newprimals,idxs,cum*sizeof(PetscInt));CHKERRQ(ierr);
937     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
938     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
939     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %d)\n",eerr);
940     for (i=0;i<nee;i++) {
941       PetscBool has_candidates = PETSC_FALSE;
942       if (PetscBTLookup(bter,i)) {
943         PetscInt size,mark = i+1;
944 
945         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
946         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
947         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
948         for (j=0;j<size;j++) {
949           PetscInt k,ee = idxs[j];
950           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %d [%d %d)\n",ee,ii[ee],ii[ee+1]);
951           for (k=ii[ee];k<ii[ee+1];k++) {
952             /* set all candidates located on the edge as corners */
953             if (PetscBTLookup(btvcand,jj[k])) {
954               PetscInt k2,vv = jj[k];
955               has_candidates = PETSC_TRUE;
956               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %d\n",vv);
957               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
958               /* set all edge dofs connected to candidate as primals */
959               for (k2=iit[vv];k2<iit[vv+1];k2++) {
960                 if (marks[jjt[k2]] == mark) {
961                   PetscInt k3,ee2 = jjt[k2];
962                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %d\n",ee2);
963                   newprimals[cum++] = ee2;
964                   /* finally set the new corners */
965                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
966                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %d\n",jj[k3]);
967                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
968                   }
969                 }
970               }
971             } else {
972               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %d\n",jj[k]);
973             }
974           }
975         }
976         if (!has_candidates) { /* circular edge */
977           PetscInt k, ee = idxs[0],*tmarks;
978 
979           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
980           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %d\n",i);
981           for (k=ii[ee];k<ii[ee+1];k++) {
982             PetscInt k2;
983             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %d\n",jj[k]);
984             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
985             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
986           }
987           for (j=0;j<size;j++) {
988             if (tmarks[idxs[j]] > 1) {
989               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %d\n",idxs[j]);
990               newprimals[cum++] = idxs[j];
991             }
992           }
993           ierr = PetscFree(tmarks);CHKERRQ(ierr);
994         }
995         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
996       }
997       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
998     }
999     ierr = PetscFree(extcols);CHKERRQ(ierr);
1000     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1001     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1002     if (fl2g) {
1003       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1004       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1005       for (i=0;i<nee;i++) {
1006         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1007       }
1008       ierr = PetscFree(eedges);CHKERRQ(ierr);
1009     }
1010     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1011     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1012     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1013     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1014     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1015     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1016     pcbddc->mat_graph->twodim = PETSC_FALSE;
1017     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1018     if (fl2g) {
1019       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1020       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1021       for (i=0;i<nee;i++) {
1022         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1023       }
1024     } else {
1025       eedges  = alleedges;
1026       primals = allprimals;
1027     }
1028     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1029 
1030     /* Mark again */
1031     ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
1032     for (i=0;i<nee;i++) {
1033       PetscInt size,mark = i+1;
1034 
1035       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1036       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1037       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1038       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1039     }
1040     if (print) {
1041       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1042       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1043     }
1044 
1045     /* Recompute extended cols */
1046     eerr = PETSC_FALSE;
1047     for (i=0;i<nee;i++) {
1048       PetscInt size;
1049 
1050       cum  = 0;
1051       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1052       if (!size && nedfieldlocal) continue;
1053       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1054       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1055       for (j=0;j<size;j++) {
1056         PetscInt k,ee = idxs[j];
1057         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1058       }
1059       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1060       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1061       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1062       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1063       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1064       if (cum != size -1) {
1065         if (print) {
1066           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1067           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1068           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1069           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1070         }
1071         eerr = PETSC_TRUE;
1072       }
1073     }
1074   }
1075   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1076   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1077   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1078   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1079   /* an error should not occur at this point */
1080   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1081 
1082   /* Check the number of endpoints */
1083   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1084   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1085   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1086   for (i=0;i<nee;i++) {
1087     PetscInt size, found = 0, gc[2];
1088 
1089     /* init with defaults */
1090     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1091     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1092     if (!size && nedfieldlocal) continue;
1093     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1094     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1095     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1096     for (j=0;j<size;j++) {
1097       PetscInt k,ee = idxs[j];
1098       for (k=ii[ee];k<ii[ee+1];k++) {
1099         PetscInt vv = jj[k];
1100         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1101           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %d\n",i);
1102           corners[i*2+found++] = vv;
1103         }
1104       }
1105     }
1106     if (found != 2) {
1107       PetscInt e;
1108       if (fl2g) {
1109         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1110       } else {
1111         e = idxs[0];
1112       }
1113       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %d corners for edge %d (astart %d, estart %d)\n",found,i,e,idxs[0]);
1114     }
1115 
1116     /* get primal dof index on this coarse edge */
1117     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1118     if (gc[0] > gc[1]) {
1119       PetscInt swap  = corners[2*i];
1120       corners[2*i]   = corners[2*i+1];
1121       corners[2*i+1] = swap;
1122     }
1123     cedges[i] = idxs[size-1];
1124     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1125     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %d: ce %d, corners (%d,%d)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1126   }
1127   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1128   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1129 
1130 #if defined(PETSC_USE_DEBUG)
1131   /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1132      not interfere with neighbouring coarse edges */
1133   ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1134   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1135   for (i=0;i<nv;i++) {
1136     PetscInt emax = 0,eemax = 0;
1137 
1138     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1139     ierr = PetscMemzero(emarks,(nee+1)*sizeof(PetscInt));CHKERRQ(ierr);
1140     for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1141     for (j=1;j<nee+1;j++) {
1142       if (emax < emarks[j]) {
1143         emax = emarks[j];
1144         eemax = j;
1145       }
1146     }
1147     /* not relevant for edges */
1148     if (!eemax) continue;
1149 
1150     for (j=ii[i];j<ii[i+1];j++) {
1151       if (marks[jj[j]] && marks[jj[j]] != eemax) {
1152         SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_SUP,"Found 2 coarse edges (id %d and %d) connected through the %d nodal dof at edge dof %d\n",marks[jj[j]]-1,eemax,i,jj[j]);
1153       }
1154     }
1155   }
1156   ierr = PetscFree(emarks);CHKERRQ(ierr);
1157   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1158 #endif
1159 
1160   /* Compute extended rows indices for edge blocks of the change of basis */
1161   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1162   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1163   extmem *= maxsize;
1164   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1165   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1166   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1167   for (i=0;i<nv;i++) {
1168     PetscInt mark = 0,size,start;
1169 
1170     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1171     for (j=ii[i];j<ii[i+1];j++)
1172       if (marks[jj[j]] && !mark)
1173         mark = marks[jj[j]];
1174 
1175     /* not relevant */
1176     if (!mark) continue;
1177 
1178     /* import extended row */
1179     mark--;
1180     start = mark*extmem+extrowcum[mark];
1181     size = ii[i+1]-ii[i];
1182     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %d > %d",extrowcum[mark] + size,extmem);
1183     ierr = PetscMemcpy(extrow+start,jj+ii[i],size*sizeof(PetscInt));CHKERRQ(ierr);
1184     extrowcum[mark] += size;
1185   }
1186   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1187   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1188   ierr = PetscFree(marks);CHKERRQ(ierr);
1189 
1190   /* Compress extrows */
1191   cum  = 0;
1192   for (i=0;i<nee;i++) {
1193     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1194     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1195     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1196     cum  = PetscMax(cum,size);
1197   }
1198   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1199   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1200   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1201 
1202   /* Workspace for lapack inner calls and VecSetValues */
1203   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1204 
1205   /* Create change of basis matrix (preallocation can be improved) */
1206   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1207   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1208                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1209   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1210   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1211   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1212   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1213   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1214   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1215   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1216 
1217   /* Defaults to identity */
1218   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1219   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1220   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1221   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1222 
1223   /* Create discrete gradient for the coarser level if needed */
1224   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1225   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1226   if (pcbddc->current_level < pcbddc->max_levels) {
1227     ISLocalToGlobalMapping cel2g,cvl2g;
1228     IS                     wis,gwis;
1229     PetscInt               cnv,cne;
1230 
1231     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1232     if (fl2g) {
1233       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1234     } else {
1235       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1236       pcbddc->nedclocal = wis;
1237     }
1238     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1239     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1240     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1241     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1242     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1243     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1244 
1245     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1246     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1247     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1248     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1249     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1250     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1251     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1252 
1253     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1254     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1255     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1256     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1257     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1258     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1259     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1260     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1261   }
1262   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1263 
1264 #if defined(PRINT_GDET)
1265   inc = 0;
1266   lev = pcbddc->current_level;
1267 #endif
1268 
1269   /* Insert values in the change of basis matrix */
1270   for (i=0;i<nee;i++) {
1271     Mat         Gins = NULL, GKins = NULL;
1272     IS          cornersis = NULL;
1273     PetscScalar cvals[2];
1274 
1275     if (pcbddc->nedcG) {
1276       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1277     }
1278     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1279     if (Gins && GKins) {
1280       PetscScalar    *data;
1281       const PetscInt *rows,*cols;
1282       PetscInt       nrh,nch,nrc,ncc;
1283 
1284       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1285       /* H1 */
1286       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1287       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1288       ierr = MatDenseGetArray(Gins,&data);CHKERRQ(ierr);
1289       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1290       ierr = MatDenseRestoreArray(Gins,&data);CHKERRQ(ierr);
1291       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1292       /* complement */
1293       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1294       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %d",i);
1295       if (ncc + nch != nrc) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"The sum of the number of columns of GKins %d and Gins %d does not match %d for coarse edge %d",ncc,nch,nrc,i);
1296       if (ncc != 1 && pcbddc->nedcG) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot generate the coarse discrete gradient for coarse edge %d with ncc %d",i,ncc);
1297       ierr = MatDenseGetArray(GKins,&data);CHKERRQ(ierr);
1298       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1299       ierr = MatDenseRestoreArray(GKins,&data);CHKERRQ(ierr);
1300 
1301       /* coarse discrete gradient */
1302       if (pcbddc->nedcG) {
1303         PetscInt cols[2];
1304 
1305         cols[0] = 2*i;
1306         cols[1] = 2*i+1;
1307         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1308       }
1309       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1310     }
1311     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1312     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1313     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1314     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1315     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1316   }
1317   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1318 
1319   /* Start assembling */
1320   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1321   if (pcbddc->nedcG) {
1322     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1323   }
1324 
1325   /* Free */
1326   if (fl2g) {
1327     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1328     for (i=0;i<nee;i++) {
1329       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1330     }
1331     ierr = PetscFree(eedges);CHKERRQ(ierr);
1332   }
1333 
1334   /* hack mat_graph with primal dofs on the coarse edges */
1335   {
1336     PCBDDCGraph graph   = pcbddc->mat_graph;
1337     PetscInt    *oqueue = graph->queue;
1338     PetscInt    *ocptr  = graph->cptr;
1339     PetscInt    ncc,*idxs;
1340 
1341     /* find first primal edge */
1342     if (pcbddc->nedclocal) {
1343       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1344     } else {
1345       if (fl2g) {
1346         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1347       }
1348       idxs = cedges;
1349     }
1350     cum = 0;
1351     while (cum < nee && cedges[cum] < 0) cum++;
1352 
1353     /* adapt connected components */
1354     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1355     graph->cptr[0] = 0;
1356     for (i=0,ncc=0;i<graph->ncc;i++) {
1357       PetscInt lc = ocptr[i+1]-ocptr[i];
1358       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1359         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1360         graph->queue[graph->cptr[ncc]] = cedges[cum];
1361         ncc++;
1362         lc--;
1363         cum++;
1364         while (cum < nee && cedges[cum] < 0) cum++;
1365       }
1366       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1367       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1368       ncc++;
1369     }
1370     graph->ncc = ncc;
1371     if (pcbddc->nedclocal) {
1372       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1373     }
1374     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1375   }
1376   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1377   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1378   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1379   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1380 
1381   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1382   ierr = PetscFree(extrow);CHKERRQ(ierr);
1383   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1384   ierr = PetscFree(corners);CHKERRQ(ierr);
1385   ierr = PetscFree(cedges);CHKERRQ(ierr);
1386   ierr = PetscFree(extrows);CHKERRQ(ierr);
1387   ierr = PetscFree(extcols);CHKERRQ(ierr);
1388   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1389 
1390   /* Complete assembling */
1391   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1392   if (pcbddc->nedcG) {
1393     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1394 #if 0
1395     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1396     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1397 #endif
1398   }
1399 
1400   /* set change of basis */
1401   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1402   ierr = MatDestroy(&T);CHKERRQ(ierr);
1403 
1404   PetscFunctionReturn(0);
1405 }
1406 
1407 /* the near-null space of BDDC carries information on quadrature weights,
1408    and these can be collinear -> so cheat with MatNullSpaceCreate
1409    and create a suitable set of basis vectors first */
1410 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1411 {
1412   PetscErrorCode ierr;
1413   PetscInt       i;
1414 
1415   PetscFunctionBegin;
1416   for (i=0;i<nvecs;i++) {
1417     PetscInt first,last;
1418 
1419     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1420     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1421     if (i>=first && i < last) {
1422       PetscScalar *data;
1423       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1424       if (!has_const) {
1425         data[i-first] = 1.;
1426       } else {
1427         data[2*i-first] = 1./PetscSqrtReal(2.);
1428         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1429       }
1430       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1431     }
1432     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1433   }
1434   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1435   for (i=0;i<nvecs;i++) { /* reset vectors */
1436     PetscInt first,last;
1437     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1438     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1439     if (i>=first && i < last) {
1440       PetscScalar *data;
1441       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1442       if (!has_const) {
1443         data[i-first] = 0.;
1444       } else {
1445         data[2*i-first] = 0.;
1446         data[2*i-first+1] = 0.;
1447       }
1448       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1449     }
1450     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1451     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1452   }
1453   PetscFunctionReturn(0);
1454 }
1455 
1456 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1457 {
1458   Mat                    loc_divudotp;
1459   Vec                    p,v,vins,quad_vec,*quad_vecs;
1460   ISLocalToGlobalMapping map;
1461   PetscScalar            *vals;
1462   const PetscScalar      *array;
1463   PetscInt               i,maxneighs,maxsize;
1464   PetscInt               n_neigh,*neigh,*n_shared,**shared;
1465   PetscMPIInt            rank;
1466   PetscErrorCode         ierr;
1467 
1468   PetscFunctionBegin;
1469   ierr = ISLocalToGlobalMappingGetInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1470   ierr = MPIU_Allreduce(&n_neigh,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1471   if (!maxneighs) {
1472     ierr  = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1473     *nnsp = NULL;
1474     PetscFunctionReturn(0);
1475   }
1476   maxsize = 0;
1477   for (i=0;i<n_neigh;i++) maxsize = PetscMax(n_shared[i],maxsize);
1478   ierr = PetscMalloc1(maxsize,&vals);CHKERRQ(ierr);
1479   /* create vectors to hold quadrature weights */
1480   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1481   if (!transpose) {
1482     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1483   } else {
1484     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1485   }
1486   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1487   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1488   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1489   for (i=0;i<maxneighs;i++) {
1490     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1491     ierr = VecSetLocalToGlobalMapping(quad_vecs[i],map);CHKERRQ(ierr);
1492   }
1493 
1494   /* compute local quad vec */
1495   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1496   if (!transpose) {
1497     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1498   } else {
1499     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1500   }
1501   ierr = VecSet(p,1.);CHKERRQ(ierr);
1502   if (!transpose) {
1503     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1504   } else {
1505     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1506   }
1507   if (vl2l) {
1508     Mat        lA;
1509     VecScatter sc;
1510 
1511     ierr = MatISGetLocalMat(A,&lA);CHKERRQ(ierr);
1512     ierr = MatCreateVecs(lA,&vins,NULL);CHKERRQ(ierr);
1513     ierr = VecScatterCreate(v,vl2l,vins,NULL,&sc);CHKERRQ(ierr);
1514     ierr = VecScatterBegin(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1515     ierr = VecScatterEnd(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1516     ierr = VecScatterDestroy(&sc);CHKERRQ(ierr);
1517   } else {
1518     vins = v;
1519   }
1520   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1521   ierr = VecDestroy(&p);CHKERRQ(ierr);
1522 
1523   /* insert in global quadrature vecs */
1524   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1525   for (i=0;i<n_neigh;i++) {
1526     const PetscInt    *idxs;
1527     PetscInt          idx,nn,j;
1528 
1529     idxs = shared[i];
1530     nn   = n_shared[i];
1531     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1532     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1533     idx  = -(idx+1);
1534     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1535   }
1536   ierr = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1537   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1538   if (vl2l) {
1539     ierr = VecDestroy(&vins);CHKERRQ(ierr);
1540   }
1541   ierr = VecDestroy(&v);CHKERRQ(ierr);
1542   ierr = PetscFree(vals);CHKERRQ(ierr);
1543 
1544   /* assemble near null space */
1545   for (i=0;i<maxneighs;i++) {
1546     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1547   }
1548   for (i=0;i<maxneighs;i++) {
1549     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1550     ierr = VecViewFromOptions(quad_vecs[i],NULL,"-pc_bddc_quad_vecs_view");CHKERRQ(ierr);
1551     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1552   }
1553   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1554   PetscFunctionReturn(0);
1555 }
1556 
1557 PetscErrorCode PCBDDCAddPrimalVerticesLocalIS(PC pc, IS primalv)
1558 {
1559   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1560   PetscErrorCode ierr;
1561 
1562   PetscFunctionBegin;
1563   if (primalv) {
1564     if (pcbddc->user_primal_vertices_local) {
1565       IS list[2], newp;
1566 
1567       list[0] = primalv;
1568       list[1] = pcbddc->user_primal_vertices_local;
1569       ierr = ISConcatenate(PetscObjectComm((PetscObject)pc),2,list,&newp);CHKERRQ(ierr);
1570       ierr = ISSortRemoveDups(newp);CHKERRQ(ierr);
1571       ierr = ISDestroy(&list[1]);CHKERRQ(ierr);
1572       pcbddc->user_primal_vertices_local = newp;
1573     } else {
1574       ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1575     }
1576   }
1577   PetscFunctionReturn(0);
1578 }
1579 
1580 static PetscErrorCode func_coords_private(PetscInt dim, PetscReal t, const PetscReal X[], PetscInt Nf, PetscScalar *out, void *ctx)
1581 {
1582   PetscInt f, *comp  = (PetscInt *)ctx;
1583 
1584   PetscFunctionBegin;
1585   for (f=0;f<Nf;f++) out[f] = X[*comp];
1586   PetscFunctionReturn(0);
1587 }
1588 
1589 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1590 {
1591   PetscErrorCode ierr;
1592   Vec            local,global;
1593   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1594   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1595   PetscBool      monolithic = PETSC_FALSE;
1596 
1597   PetscFunctionBegin;
1598   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC topology options","PC");CHKERRQ(ierr);
1599   ierr = PetscOptionsBool("-pc_bddc_monolithic","Discard any information on dofs splitting",NULL,monolithic,&monolithic,NULL);CHKERRQ(ierr);
1600   ierr = PetscOptionsEnd();CHKERRQ(ierr);
1601   /* need to convert from global to local topology information and remove references to information in global ordering */
1602   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1603   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1604   if (monolithic) { /* just get block size to properly compute vertices */
1605     if (pcbddc->vertex_size == 1) {
1606       ierr = MatGetBlockSize(pc->pmat,&pcbddc->vertex_size);CHKERRQ(ierr);
1607     }
1608     goto boundary;
1609   }
1610 
1611   if (pcbddc->user_provided_isfordofs) {
1612     if (pcbddc->n_ISForDofs) {
1613       PetscInt i;
1614       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1615       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1616         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1617         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1618       }
1619       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1620       pcbddc->n_ISForDofs = 0;
1621       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1622     }
1623   } else {
1624     if (!pcbddc->n_ISForDofsLocal) { /* field split not present */
1625       DM dm;
1626 
1627       ierr = PCGetDM(pc, &dm);CHKERRQ(ierr);
1628       if (!dm) {
1629         ierr = MatGetDM(pc->pmat, &dm);CHKERRQ(ierr);
1630       }
1631       if (dm) {
1632         IS      *fields;
1633         PetscInt nf,i;
1634         ierr = DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL);CHKERRQ(ierr);
1635         ierr = PetscMalloc1(nf,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1636         for (i=0;i<nf;i++) {
1637           ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1638           ierr = ISDestroy(&fields[i]);CHKERRQ(ierr);
1639         }
1640         ierr = PetscFree(fields);CHKERRQ(ierr);
1641         pcbddc->n_ISForDofsLocal = nf;
1642       } else { /* See if MATIS has fields attached by the conversion from MatNest */
1643         PetscContainer   c;
1644 
1645         ierr = PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c);CHKERRQ(ierr);
1646         if (c) {
1647           MatISLocalFields lf;
1648           ierr = PetscContainerGetPointer(c,(void**)&lf);CHKERRQ(ierr);
1649           ierr = PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf);CHKERRQ(ierr);
1650         } else { /* fallback, create the default fields if bs > 1 */
1651           PetscInt i, n = matis->A->rmap->n;
1652           ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1653           if (i > 1) {
1654             pcbddc->n_ISForDofsLocal = i;
1655             ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1656             for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1657               ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1658             }
1659           }
1660         }
1661       }
1662     } else {
1663       PetscInt i;
1664       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1665         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1666       }
1667     }
1668   }
1669 
1670 boundary:
1671   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1672     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1673   } else if (pcbddc->DirichletBoundariesLocal) {
1674     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1675   }
1676   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1677     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1678   } else if (pcbddc->NeumannBoundariesLocal) {
1679     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1680   }
1681   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1682     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1683   }
1684   ierr = VecDestroy(&global);CHKERRQ(ierr);
1685   ierr = VecDestroy(&local);CHKERRQ(ierr);
1686   /* detect local disconnected subdomains if requested (use matis->A) */
1687   if (pcbddc->detect_disconnected) {
1688     IS        primalv = NULL;
1689     PetscInt  i;
1690     PetscBool filter = pcbddc->detect_disconnected_filter;
1691 
1692     for (i=0;i<pcbddc->n_local_subs;i++) {
1693       ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
1694     }
1695     ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
1696     ierr = PCBDDCDetectDisconnectedComponents(pc,filter,&pcbddc->n_local_subs,&pcbddc->local_subs,&primalv);CHKERRQ(ierr);
1697     ierr = PCBDDCAddPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1698     ierr = ISDestroy(&primalv);CHKERRQ(ierr);
1699   }
1700   /* early stage corner detection */
1701   {
1702     DM dm;
1703 
1704     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1705     if (dm) {
1706       PetscBool isda;
1707 
1708       ierr = PetscObjectTypeCompare((PetscObject)dm,DMDA,&isda);CHKERRQ(ierr);
1709       if (isda) {
1710         ISLocalToGlobalMapping l2l;
1711         IS                     corners;
1712         Mat                    lA;
1713 
1714         ierr = DMDAGetSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1715         ierr = MatISGetLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1716         ierr = MatGetLocalToGlobalMapping(lA,&l2l,NULL);CHKERRQ(ierr);
1717         ierr = MatISRestoreLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1718         if (l2l && corners) {
1719           const PetscInt *idx;
1720           PetscInt       dof,bs,*idxout,n;
1721 
1722           ierr = DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
1723           ierr = ISLocalToGlobalMappingGetBlockSize(l2l,&bs);CHKERRQ(ierr);
1724           ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
1725           ierr = ISGetIndices(corners,&idx);CHKERRQ(ierr);
1726           if (bs == dof) {
1727             ierr = PetscMalloc1(n,&idxout);CHKERRQ(ierr);
1728             ierr = ISLocalToGlobalMappingApplyBlock(l2l,n,idx,idxout);CHKERRQ(ierr);
1729           } else { /* the original DMDA local-to-local map have been modified */
1730             PetscInt i,d;
1731 
1732             ierr = PetscMalloc1(dof*n,&idxout);CHKERRQ(ierr);
1733             for (i=0;i<n;i++) for (d=0;d<dof;d++) idxout[dof*i+d] = dof*idx[i]+d;
1734             ierr = ISLocalToGlobalMappingApply(l2l,dof*n,idxout,idxout);CHKERRQ(ierr);
1735 
1736             bs = 1;
1737             n *= dof;
1738           }
1739           ierr = ISRestoreIndices(corners,&idx);CHKERRQ(ierr);
1740           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1741           ierr = ISCreateBlock(PetscObjectComm((PetscObject)pc),bs,n,idxout,PETSC_OWN_POINTER,&corners);CHKERRQ(ierr);
1742           ierr = PCBDDCAddPrimalVerticesLocalIS(pc,corners);CHKERRQ(ierr);
1743           ierr = ISDestroy(&corners);CHKERRQ(ierr);
1744           pcbddc->corner_selected = PETSC_TRUE;
1745         } else if (corners) { /* not from DMDA */
1746           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1747         }
1748       }
1749     }
1750   }
1751   if (pcbddc->corner_selection && !pcbddc->mat_graph->cdim) {
1752     DM dm;
1753 
1754     ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
1755     if (!dm) {
1756       ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1757     }
1758     if (dm) {
1759       Vec            vcoords;
1760       PetscSection   section;
1761       PetscReal      *coords;
1762       PetscInt       d,cdim,nl,nf,**ctxs;
1763       PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *);
1764 
1765       ierr = DMGetCoordinateDim(dm,&cdim);CHKERRQ(ierr);
1766       ierr = DMGetSection(dm,&section);CHKERRQ(ierr);
1767       ierr = PetscSectionGetNumFields(section,&nf);CHKERRQ(ierr);
1768       ierr = DMCreateGlobalVector(dm,&vcoords);CHKERRQ(ierr);
1769       ierr = VecGetLocalSize(vcoords,&nl);CHKERRQ(ierr);
1770       ierr = PetscMalloc1(nl*cdim,&coords);CHKERRQ(ierr);
1771       ierr = PetscMalloc2(nf,&funcs,nf,&ctxs);CHKERRQ(ierr);
1772       ierr = PetscMalloc1(nf,&ctxs[0]);CHKERRQ(ierr);
1773       for (d=0;d<nf;d++) funcs[d] = func_coords_private;
1774       for (d=1;d<nf;d++) ctxs[d] = ctxs[d-1] + 1;
1775       for (d=0;d<cdim;d++) {
1776         PetscInt          i;
1777         const PetscScalar *v;
1778 
1779         for (i=0;i<nf;i++) ctxs[i][0] = d;
1780         ierr = DMProjectFunction(dm,0.0,funcs,(void**)ctxs,INSERT_VALUES,vcoords);CHKERRQ(ierr);
1781         ierr = VecGetArrayRead(vcoords,&v);CHKERRQ(ierr);
1782         for (i=0;i<nl;i++) coords[i*cdim+d] = PetscRealPart(v[i]);
1783         ierr = VecRestoreArrayRead(vcoords,&v);CHKERRQ(ierr);
1784       }
1785       ierr = VecDestroy(&vcoords);CHKERRQ(ierr);
1786       ierr = PCSetCoordinates(pc,cdim,nl,coords);CHKERRQ(ierr);
1787       ierr = PetscFree(coords);CHKERRQ(ierr);
1788       ierr = PetscFree(ctxs[0]);CHKERRQ(ierr);
1789       ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr);
1790     }
1791   }
1792   PetscFunctionReturn(0);
1793 }
1794 
1795 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1796 {
1797   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1798   PetscErrorCode  ierr;
1799   IS              nis;
1800   const PetscInt  *idxs;
1801   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1802   PetscBool       *ld;
1803 
1804   PetscFunctionBegin;
1805   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1806   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
1807   if (mop == MPI_LAND) {
1808     /* init rootdata with true */
1809     ld   = (PetscBool*) matis->sf_rootdata;
1810     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1811   } else {
1812     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscBool));CHKERRQ(ierr);
1813   }
1814   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscBool));CHKERRQ(ierr);
1815   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1816   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1817   ld   = (PetscBool*) matis->sf_leafdata;
1818   for (i=0;i<nd;i++)
1819     if (-1 < idxs[i] && idxs[i] < n)
1820       ld[idxs[i]] = PETSC_TRUE;
1821   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1822   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1823   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1824   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1825   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1826   if (mop == MPI_LAND) {
1827     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1828   } else {
1829     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1830   }
1831   for (i=0,nnd=0;i<n;i++)
1832     if (ld[i])
1833       nidxs[nnd++] = i;
1834   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1835   ierr = ISDestroy(is);CHKERRQ(ierr);
1836   *is  = nis;
1837   PetscFunctionReturn(0);
1838 }
1839 
1840 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1841 {
1842   PC_IS             *pcis = (PC_IS*)(pc->data);
1843   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1844   PetscErrorCode    ierr;
1845 
1846   PetscFunctionBegin;
1847   if (!pcbddc->benign_have_null) {
1848     PetscFunctionReturn(0);
1849   }
1850   if (pcbddc->ChangeOfBasisMatrix) {
1851     Vec swap;
1852 
1853     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1854     swap = pcbddc->work_change;
1855     pcbddc->work_change = r;
1856     r = swap;
1857   }
1858   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1859   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1860   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1861   ierr = VecSet(z,0.);CHKERRQ(ierr);
1862   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1863   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1864   if (pcbddc->ChangeOfBasisMatrix) {
1865     pcbddc->work_change = r;
1866     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1867     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1868   }
1869   PetscFunctionReturn(0);
1870 }
1871 
1872 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1873 {
1874   PCBDDCBenignMatMult_ctx ctx;
1875   PetscErrorCode          ierr;
1876   PetscBool               apply_right,apply_left,reset_x;
1877 
1878   PetscFunctionBegin;
1879   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1880   if (transpose) {
1881     apply_right = ctx->apply_left;
1882     apply_left = ctx->apply_right;
1883   } else {
1884     apply_right = ctx->apply_right;
1885     apply_left = ctx->apply_left;
1886   }
1887   reset_x = PETSC_FALSE;
1888   if (apply_right) {
1889     const PetscScalar *ax;
1890     PetscInt          nl,i;
1891 
1892     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1893     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1894     ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr);
1895     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1896     for (i=0;i<ctx->benign_n;i++) {
1897       PetscScalar    sum,val;
1898       const PetscInt *idxs;
1899       PetscInt       nz,j;
1900       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1901       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1902       sum = 0.;
1903       if (ctx->apply_p0) {
1904         val = ctx->work[idxs[nz-1]];
1905         for (j=0;j<nz-1;j++) {
1906           sum += ctx->work[idxs[j]];
1907           ctx->work[idxs[j]] += val;
1908         }
1909       } else {
1910         for (j=0;j<nz-1;j++) {
1911           sum += ctx->work[idxs[j]];
1912         }
1913       }
1914       ctx->work[idxs[nz-1]] -= sum;
1915       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1916     }
1917     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1918     reset_x = PETSC_TRUE;
1919   }
1920   if (transpose) {
1921     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1922   } else {
1923     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1924   }
1925   if (reset_x) {
1926     ierr = VecResetArray(x);CHKERRQ(ierr);
1927   }
1928   if (apply_left) {
1929     PetscScalar *ay;
1930     PetscInt    i;
1931 
1932     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1933     for (i=0;i<ctx->benign_n;i++) {
1934       PetscScalar    sum,val;
1935       const PetscInt *idxs;
1936       PetscInt       nz,j;
1937       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1938       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1939       val = -ay[idxs[nz-1]];
1940       if (ctx->apply_p0) {
1941         sum = 0.;
1942         for (j=0;j<nz-1;j++) {
1943           sum += ay[idxs[j]];
1944           ay[idxs[j]] += val;
1945         }
1946         ay[idxs[nz-1]] += sum;
1947       } else {
1948         for (j=0;j<nz-1;j++) {
1949           ay[idxs[j]] += val;
1950         }
1951         ay[idxs[nz-1]] = 0.;
1952       }
1953       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1954     }
1955     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
1956   }
1957   PetscFunctionReturn(0);
1958 }
1959 
1960 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
1961 {
1962   PetscErrorCode ierr;
1963 
1964   PetscFunctionBegin;
1965   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
1966   PetscFunctionReturn(0);
1967 }
1968 
1969 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
1970 {
1971   PetscErrorCode ierr;
1972 
1973   PetscFunctionBegin;
1974   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
1975   PetscFunctionReturn(0);
1976 }
1977 
1978 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
1979 {
1980   PC_IS                   *pcis = (PC_IS*)pc->data;
1981   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
1982   PCBDDCBenignMatMult_ctx ctx;
1983   PetscErrorCode          ierr;
1984 
1985   PetscFunctionBegin;
1986   if (!restore) {
1987     Mat                A_IB,A_BI;
1988     PetscScalar        *work;
1989     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
1990 
1991     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
1992     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
1993     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
1994     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
1995     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
1996     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
1997     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
1998     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
1999     ierr = PetscNew(&ctx);CHKERRQ(ierr);
2000     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
2001     ctx->apply_left = PETSC_TRUE;
2002     ctx->apply_right = PETSC_FALSE;
2003     ctx->apply_p0 = PETSC_FALSE;
2004     ctx->benign_n = pcbddc->benign_n;
2005     if (reuse) {
2006       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
2007       ctx->free = PETSC_FALSE;
2008     } else { /* TODO: could be optimized for successive solves */
2009       ISLocalToGlobalMapping N_to_D;
2010       PetscInt               i;
2011 
2012       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
2013       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2014       for (i=0;i<pcbddc->benign_n;i++) {
2015         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2016       }
2017       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
2018       ctx->free = PETSC_TRUE;
2019     }
2020     ctx->A = pcis->A_IB;
2021     ctx->work = work;
2022     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
2023     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2024     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2025     pcis->A_IB = A_IB;
2026 
2027     /* A_BI as A_IB^T */
2028     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
2029     pcbddc->benign_original_mat = pcis->A_BI;
2030     pcis->A_BI = A_BI;
2031   } else {
2032     if (!pcbddc->benign_original_mat) {
2033       PetscFunctionReturn(0);
2034     }
2035     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
2036     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
2037     pcis->A_IB = ctx->A;
2038     ctx->A = NULL;
2039     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
2040     pcis->A_BI = pcbddc->benign_original_mat;
2041     pcbddc->benign_original_mat = NULL;
2042     if (ctx->free) {
2043       PetscInt i;
2044       for (i=0;i<ctx->benign_n;i++) {
2045         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2046       }
2047       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2048     }
2049     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
2050     ierr = PetscFree(ctx);CHKERRQ(ierr);
2051   }
2052   PetscFunctionReturn(0);
2053 }
2054 
2055 /* used just in bddc debug mode */
2056 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
2057 {
2058   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
2059   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
2060   Mat            An;
2061   PetscErrorCode ierr;
2062 
2063   PetscFunctionBegin;
2064   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
2065   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
2066   if (is1) {
2067     ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
2068     ierr = MatDestroy(&An);CHKERRQ(ierr);
2069   } else {
2070     *B = An;
2071   }
2072   PetscFunctionReturn(0);
2073 }
2074 
2075 /* TODO: add reuse flag */
2076 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2077 {
2078   Mat            Bt;
2079   PetscScalar    *a,*bdata;
2080   const PetscInt *ii,*ij;
2081   PetscInt       m,n,i,nnz,*bii,*bij;
2082   PetscBool      flg_row;
2083   PetscErrorCode ierr;
2084 
2085   PetscFunctionBegin;
2086   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2087   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2088   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2089   nnz = n;
2090   for (i=0;i<ii[n];i++) {
2091     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2092   }
2093   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2094   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2095   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2096   nnz = 0;
2097   bii[0] = 0;
2098   for (i=0;i<n;i++) {
2099     PetscInt j;
2100     for (j=ii[i];j<ii[i+1];j++) {
2101       PetscScalar entry = a[j];
2102       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || (n == m && ij[j] == i)) {
2103         bij[nnz] = ij[j];
2104         bdata[nnz] = entry;
2105         nnz++;
2106       }
2107     }
2108     bii[i+1] = nnz;
2109   }
2110   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2111   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2112   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2113   {
2114     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2115     b->free_a = PETSC_TRUE;
2116     b->free_ij = PETSC_TRUE;
2117   }
2118   if (*B == A) {
2119     ierr = MatDestroy(&A);CHKERRQ(ierr);
2120   }
2121   *B = Bt;
2122   PetscFunctionReturn(0);
2123 }
2124 
2125 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscBool filter, PetscInt *ncc, IS* cc[], IS* primalv)
2126 {
2127   Mat                    B = NULL;
2128   DM                     dm;
2129   IS                     is_dummy,*cc_n;
2130   ISLocalToGlobalMapping l2gmap_dummy;
2131   PCBDDCGraph            graph;
2132   PetscInt               *xadj_filtered = NULL,*adjncy_filtered = NULL;
2133   PetscInt               i,n;
2134   PetscInt               *xadj,*adjncy;
2135   PetscBool              isplex = PETSC_FALSE;
2136   PetscErrorCode         ierr;
2137 
2138   PetscFunctionBegin;
2139   if (ncc) *ncc = 0;
2140   if (cc) *cc = NULL;
2141   if (primalv) *primalv = NULL;
2142   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2143   ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
2144   if (!dm) {
2145     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
2146   }
2147   if (dm) {
2148     ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr);
2149   }
2150   if (filter) isplex = PETSC_FALSE;
2151 
2152   if (isplex) { /* this code has been modified from plexpartition.c */
2153     PetscInt       p, pStart, pEnd, a, adjSize, idx, size, nroots;
2154     PetscInt      *adj = NULL;
2155     IS             cellNumbering;
2156     const PetscInt *cellNum;
2157     PetscBool      useCone, useClosure;
2158     PetscSection   section;
2159     PetscSegBuffer adjBuffer;
2160     PetscSF        sfPoint;
2161     PetscErrorCode ierr;
2162 
2163     PetscFunctionBegin;
2164     ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
2165     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2166     ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
2167     /* Build adjacency graph via a section/segbuffer */
2168     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &section);CHKERRQ(ierr);
2169     ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
2170     ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr);
2171     /* Always use FVM adjacency to create partitioner graph */
2172     ierr = DMPlexGetAdjacencyUseCone(dm, &useCone);CHKERRQ(ierr);
2173     ierr = DMPlexGetAdjacencyUseClosure(dm, &useClosure);CHKERRQ(ierr);
2174     ierr = DMPlexSetAdjacencyUseCone(dm, PETSC_TRUE);CHKERRQ(ierr);
2175     ierr = DMPlexSetAdjacencyUseClosure(dm, PETSC_FALSE);CHKERRQ(ierr);
2176     ierr = DMPlexGetCellNumbering(dm, &cellNumbering);CHKERRQ(ierr);
2177     ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr);
2178     for (n = 0, p = pStart; p < pEnd; p++) {
2179       /* Skip non-owned cells in parallel (ParMetis expects no overlap) */
2180       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2181       adjSize = PETSC_DETERMINE;
2182       ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr);
2183       for (a = 0; a < adjSize; ++a) {
2184         const PetscInt point = adj[a];
2185         if (pStart <= point && point < pEnd) {
2186           PetscInt *PETSC_RESTRICT pBuf;
2187           ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr);
2188           ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr);
2189           *pBuf = point;
2190         }
2191       }
2192       n++;
2193     }
2194     ierr = DMPlexSetAdjacencyUseCone(dm, useCone);CHKERRQ(ierr);
2195     ierr = DMPlexSetAdjacencyUseClosure(dm, useClosure);CHKERRQ(ierr);
2196     /* Derive CSR graph from section/segbuffer */
2197     ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
2198     ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
2199     ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr);
2200     for (idx = 0, p = pStart; p < pEnd; p++) {
2201       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2202       ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr);
2203     }
2204     xadj[n] = size;
2205     ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr);
2206     /* Clean up */
2207     ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr);
2208     ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
2209     ierr = PetscFree(adj);CHKERRQ(ierr);
2210     graph->xadj = xadj;
2211     graph->adjncy = adjncy;
2212   } else {
2213     Mat       A;
2214     PetscBool isseqaij, flg_row;
2215 
2216     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2217     if (!A->rmap->N || !A->cmap->N) {
2218       ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2219       PetscFunctionReturn(0);
2220     }
2221     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2222     if (!isseqaij && filter) {
2223       PetscBool isseqdense;
2224 
2225       ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2226       if (!isseqdense) {
2227         ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2228       } else { /* TODO: rectangular case and LDA */
2229         PetscScalar *array;
2230         PetscReal   chop=1.e-6;
2231 
2232         ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2233         ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2234         ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2235         for (i=0;i<n;i++) {
2236           PetscInt j;
2237           for (j=i+1;j<n;j++) {
2238             PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2239             if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2240             if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2241           }
2242         }
2243         ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2244         ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2245       }
2246     } else {
2247       ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
2248       B = A;
2249     }
2250     ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2251 
2252     /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2253     if (filter) {
2254       PetscScalar *data;
2255       PetscInt    j,cum;
2256 
2257       ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2258       ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2259       cum = 0;
2260       for (i=0;i<n;i++) {
2261         PetscInt t;
2262 
2263         for (j=xadj[i];j<xadj[i+1];j++) {
2264           if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2265             continue;
2266           }
2267           adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2268         }
2269         t = xadj_filtered[i];
2270         xadj_filtered[i] = cum;
2271         cum += t;
2272       }
2273       ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2274       graph->xadj = xadj_filtered;
2275       graph->adjncy = adjncy_filtered;
2276     } else {
2277       graph->xadj = xadj;
2278       graph->adjncy = adjncy;
2279     }
2280   }
2281   /* compute local connected components using PCBDDCGraph */
2282   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2283   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2284   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2285   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2286   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2287   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2288   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2289 
2290   /* partial clean up */
2291   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2292   if (B) {
2293     PetscBool flg_row;
2294     ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2295     ierr = MatDestroy(&B);CHKERRQ(ierr);
2296   }
2297   if (isplex) {
2298     ierr = PetscFree(xadj);CHKERRQ(ierr);
2299     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2300   }
2301 
2302   /* get back data */
2303   if (isplex) {
2304     if (ncc) *ncc = graph->ncc;
2305     if (cc || primalv) {
2306       Mat          A;
2307       PetscBT      btv,btvt;
2308       PetscSection subSection;
2309       PetscInt     *ids,cum,cump,*cids,*pids;
2310 
2311       ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr);
2312       ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2313       ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr);
2314       ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr);
2315       ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr);
2316 
2317       cids[0] = 0;
2318       for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) {
2319         PetscInt j;
2320 
2321         ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr);
2322         for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) {
2323           PetscInt k, size, *closure = NULL, cell = graph->queue[j];
2324 
2325           ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2326           for (k = 0; k < 2*size; k += 2) {
2327             PetscInt s, p = closure[k], off, dof, cdof;
2328 
2329             ierr = PetscSectionGetConstraintDof(subSection, p, &cdof);CHKERRQ(ierr);
2330             ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr);
2331             ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr);
2332             for (s = 0; s < dof-cdof; s++) {
2333               if (PetscBTLookupSet(btvt,off+s)) continue;
2334               if (!PetscBTLookup(btv,off+s)) {
2335                 ids[cum++] = off+s;
2336               } else { /* cross-vertex */
2337                 pids[cump++] = off+s;
2338               }
2339             }
2340           }
2341           ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2342         }
2343         cids[i+1] = cum;
2344         /* mark dofs as already assigned */
2345         for (j = cids[i]; j < cids[i+1]; j++) {
2346           ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr);
2347         }
2348       }
2349       if (cc) {
2350         ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2351         for (i = 0; i < graph->ncc; i++) {
2352           ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2353         }
2354         *cc = cc_n;
2355       }
2356       if (primalv) {
2357         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr);
2358       }
2359       ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr);
2360       ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
2361       ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr);
2362     }
2363   } else {
2364     if (ncc) *ncc = graph->ncc;
2365     if (cc) {
2366       ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2367       for (i=0;i<graph->ncc;i++) {
2368         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);
2369       }
2370       *cc = cc_n;
2371     }
2372   }
2373   /* clean up graph */
2374   graph->xadj = 0;
2375   graph->adjncy = 0;
2376   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2377   PetscFunctionReturn(0);
2378 }
2379 
2380 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2381 {
2382   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2383   PC_IS*         pcis = (PC_IS*)(pc->data);
2384   IS             dirIS = NULL;
2385   PetscInt       i;
2386   PetscErrorCode ierr;
2387 
2388   PetscFunctionBegin;
2389   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2390   if (zerodiag) {
2391     Mat            A;
2392     Vec            vec3_N;
2393     PetscScalar    *vals;
2394     const PetscInt *idxs;
2395     PetscInt       nz,*count;
2396 
2397     /* p0 */
2398     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2399     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2400     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2401     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2402     for (i=0;i<nz;i++) vals[i] = 1.;
2403     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2404     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2405     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2406     /* v_I */
2407     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2408     for (i=0;i<nz;i++) vals[i] = 0.;
2409     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2410     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2411     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2412     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2413     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2414     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2415     if (dirIS) {
2416       PetscInt n;
2417 
2418       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2419       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2420       for (i=0;i<n;i++) vals[i] = 0.;
2421       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2422       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2423     }
2424     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2425     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2426     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2427     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2428     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2429     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2430     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2431     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]));
2432     ierr = PetscFree(vals);CHKERRQ(ierr);
2433     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2434 
2435     /* there should not be any pressure dofs lying on the interface */
2436     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2437     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2438     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2439     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2440     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2441     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]);
2442     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2443     ierr = PetscFree(count);CHKERRQ(ierr);
2444   }
2445   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2446 
2447   /* check PCBDDCBenignGetOrSetP0 */
2448   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2449   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2450   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2451   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2452   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2453   for (i=0;i<pcbddc->benign_n;i++) {
2454     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2455     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);
2456   }
2457   PetscFunctionReturn(0);
2458 }
2459 
2460 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, IS *zerodiaglocal)
2461 {
2462   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2463   IS             pressures,zerodiag,zerodiag_save,*zerodiag_subs;
2464   PetscInt       nz,n;
2465   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2466   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2467   PetscErrorCode ierr;
2468 
2469   PetscFunctionBegin;
2470   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2471   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2472   for (n=0;n<pcbddc->benign_n;n++) {
2473     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2474   }
2475   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2476   pcbddc->benign_n = 0;
2477 
2478   /* if a local info on dofs is present, uses the last field for "pressures" (or fid by command line)
2479      otherwise, it uses only zerodiagonal dofs (ok if the pressure block is all zero; it could fail if it is not)
2480      Checks if all the pressure dofs in each subdomain have a zero diagonal
2481      If not, a change of basis on pressures is not needed
2482      since the local Schur complements are already SPD
2483   */
2484   has_null_pressures = PETSC_TRUE;
2485   have_null = PETSC_TRUE;
2486   if (pcbddc->n_ISForDofsLocal) {
2487     IS       iP = NULL;
2488     PetscInt npl,*idxs,p = pcbddc->n_ISForDofsLocal-1;
2489 
2490     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2491     ierr = PetscOptionsInt("-pc_bddc_pressure_field","Field id for pressures",NULL,p,&p,NULL);CHKERRQ(ierr);
2492     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2493     if (p < 0 || p > pcbddc->n_ISForDofsLocal-1) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %D",p);
2494     /* Dofs splitting for BDDC cannot have PETSC_COMM_SELF, so create a sequential IS */
2495     ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[p],&npl);CHKERRQ(ierr);
2496     ierr = ISGetIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2497     ierr = ISCreateGeneral(PETSC_COMM_SELF,npl,idxs,PETSC_COPY_VALUES,&pressures);CHKERRQ(ierr);
2498     ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2499     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2500     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2501     if (iP) {
2502       IS newpressures;
2503 
2504       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2505       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2506       pressures = newpressures;
2507     }
2508     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2509     if (!sorted) {
2510       ierr = ISSort(pressures);CHKERRQ(ierr);
2511     }
2512   } else {
2513     pressures = NULL;
2514   }
2515   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2516   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2517   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2518   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2519   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2520   if (!sorted) {
2521     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2522   }
2523   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2524   zerodiag_save = zerodiag;
2525   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2526   if (!nz) {
2527     if (n) have_null = PETSC_FALSE;
2528     has_null_pressures = PETSC_FALSE;
2529     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2530   }
2531   recompute_zerodiag = PETSC_FALSE;
2532   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2533   zerodiag_subs    = NULL;
2534   pcbddc->benign_n = 0;
2535   n_interior_dofs  = 0;
2536   interior_dofs    = NULL;
2537   nneu             = 0;
2538   if (pcbddc->NeumannBoundariesLocal) {
2539     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2540   }
2541   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2542   if (checkb) { /* need to compute interior nodes */
2543     PetscInt n,i,j;
2544     PetscInt n_neigh,*neigh,*n_shared,**shared;
2545     PetscInt *iwork;
2546 
2547     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2548     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2549     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2550     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2551     for (i=1;i<n_neigh;i++)
2552       for (j=0;j<n_shared[i];j++)
2553           iwork[shared[i][j]] += 1;
2554     for (i=0;i<n;i++)
2555       if (!iwork[i])
2556         interior_dofs[n_interior_dofs++] = i;
2557     ierr = PetscFree(iwork);CHKERRQ(ierr);
2558     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2559   }
2560   if (has_null_pressures) {
2561     IS             *subs;
2562     PetscInt       nsubs,i,j,nl;
2563     const PetscInt *idxs;
2564     PetscScalar    *array;
2565     Vec            *work;
2566     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2567 
2568     subs  = pcbddc->local_subs;
2569     nsubs = pcbddc->n_local_subs;
2570     /* 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) */
2571     if (checkb) {
2572       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2573       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2574       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2575       /* work[0] = 1_p */
2576       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2577       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2578       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2579       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2580       /* work[0] = 1_v */
2581       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2582       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2583       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2584       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2585       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2586     }
2587     if (nsubs > 1) {
2588       ierr = PetscCalloc1(nsubs,&zerodiag_subs);CHKERRQ(ierr);
2589       for (i=0;i<nsubs;i++) {
2590         ISLocalToGlobalMapping l2g;
2591         IS                     t_zerodiag_subs;
2592         PetscInt               nl;
2593 
2594         ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2595         ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,zerodiag,&t_zerodiag_subs);CHKERRQ(ierr);
2596         ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2597         if (nl) {
2598           PetscBool valid = PETSC_TRUE;
2599 
2600           if (checkb) {
2601             ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2602             ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2603             ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2604             ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2605             for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2606             ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2607             ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2608             ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2609             ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2610             ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2611             ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2612             for (j=0;j<n_interior_dofs;j++) {
2613               if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2614                 valid = PETSC_FALSE;
2615                 break;
2616               }
2617             }
2618             ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2619           }
2620           if (valid && nneu) {
2621             const PetscInt *idxs;
2622             PetscInt       nzb;
2623 
2624             ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2625             ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2626             ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2627             if (nzb) valid = PETSC_FALSE;
2628           }
2629           if (valid && pressures) {
2630             IS t_pressure_subs;
2631             ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2632             ierr = ISEqual(t_pressure_subs,t_zerodiag_subs,&valid);CHKERRQ(ierr);
2633             ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2634           }
2635           if (valid) {
2636             ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[pcbddc->benign_n]);CHKERRQ(ierr);
2637             pcbddc->benign_n++;
2638           } else {
2639             recompute_zerodiag = PETSC_TRUE;
2640           }
2641         }
2642         ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2643         ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2644       }
2645     } else { /* there's just one subdomain (or zero if they have not been detected */
2646       PetscBool valid = PETSC_TRUE;
2647 
2648       if (nneu) valid = PETSC_FALSE;
2649       if (valid && pressures) {
2650         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2651       }
2652       if (valid && checkb) {
2653         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2654         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2655         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2656         for (j=0;j<n_interior_dofs;j++) {
2657           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2658             valid = PETSC_FALSE;
2659             break;
2660           }
2661         }
2662         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2663       }
2664       if (valid) {
2665         pcbddc->benign_n = 1;
2666         ierr = PetscMalloc1(pcbddc->benign_n,&zerodiag_subs);CHKERRQ(ierr);
2667         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2668         zerodiag_subs[0] = zerodiag;
2669       }
2670     }
2671     if (checkb) {
2672       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2673     }
2674   }
2675   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2676 
2677   if (!pcbddc->benign_n) {
2678     PetscInt n;
2679 
2680     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2681     recompute_zerodiag = PETSC_FALSE;
2682     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2683     if (n) {
2684       has_null_pressures = PETSC_FALSE;
2685       have_null = PETSC_FALSE;
2686     }
2687   }
2688 
2689   /* final check for null pressures */
2690   if (zerodiag && pressures) {
2691     PetscInt nz,np;
2692     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2693     ierr = ISGetLocalSize(pressures,&np);CHKERRQ(ierr);
2694     if (nz != np) have_null = PETSC_FALSE;
2695   }
2696 
2697   if (recompute_zerodiag) {
2698     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2699     if (pcbddc->benign_n == 1) {
2700       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2701       zerodiag = zerodiag_subs[0];
2702     } else {
2703       PetscInt i,nzn,*new_idxs;
2704 
2705       nzn = 0;
2706       for (i=0;i<pcbddc->benign_n;i++) {
2707         PetscInt ns;
2708         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2709         nzn += ns;
2710       }
2711       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2712       nzn = 0;
2713       for (i=0;i<pcbddc->benign_n;i++) {
2714         PetscInt ns,*idxs;
2715         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2716         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2717         ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr);
2718         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2719         nzn += ns;
2720       }
2721       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2722       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2723     }
2724     have_null = PETSC_FALSE;
2725   }
2726 
2727   /* Prepare matrix to compute no-net-flux */
2728   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2729     Mat                    A,loc_divudotp;
2730     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2731     IS                     row,col,isused = NULL;
2732     PetscInt               M,N,n,st,n_isused;
2733 
2734     if (pressures) {
2735       isused = pressures;
2736     } else {
2737       isused = zerodiag_save;
2738     }
2739     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2740     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2741     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2742     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");
2743     n_isused = 0;
2744     if (isused) {
2745       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2746     }
2747     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2748     st = st-n_isused;
2749     if (n) {
2750       const PetscInt *gidxs;
2751 
2752       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2753       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2754       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2755       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2756       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2757       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2758     } else {
2759       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2760       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2761       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2762     }
2763     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2764     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2765     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2766     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2767     ierr = ISDestroy(&row);CHKERRQ(ierr);
2768     ierr = ISDestroy(&col);CHKERRQ(ierr);
2769     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2770     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2771     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2772     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2773     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2774     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2775     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2776     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2777     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2778     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2779   }
2780   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2781 
2782   /* change of basis and p0 dofs */
2783   if (has_null_pressures) {
2784     IS             zerodiagc;
2785     const PetscInt *idxs,*idxsc;
2786     PetscInt       i,s,*nnz;
2787 
2788     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2789     ierr = ISComplement(zerodiag,0,n,&zerodiagc);CHKERRQ(ierr);
2790     ierr = ISGetIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2791     /* local change of basis for pressures */
2792     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2793     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2794     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2795     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2796     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2797     for (i=0;i<n-nz;i++) nnz[idxsc[i]] = 1; /* identity on velocities plus pressure dofs for non-singular subdomains */
2798     for (i=0;i<pcbddc->benign_n;i++) {
2799       PetscInt nzs,j;
2800 
2801       ierr = ISGetLocalSize(zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2802       ierr = ISGetIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2803       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2804       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2805       ierr = ISRestoreIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2806     }
2807     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2808     ierr = MatSetOption(pcbddc->benign_change,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
2809     ierr = PetscFree(nnz);CHKERRQ(ierr);
2810     /* set identity on velocities */
2811     for (i=0;i<n-nz;i++) {
2812       ierr = MatSetValue(pcbddc->benign_change,idxsc[i],idxsc[i],1.,INSERT_VALUES);CHKERRQ(ierr);
2813     }
2814     ierr = ISRestoreIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2815     ierr = ISDestroy(&zerodiagc);CHKERRQ(ierr);
2816     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2817     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2818     /* set change on pressures */
2819     for (s=0;s<pcbddc->benign_n;s++) {
2820       PetscScalar *array;
2821       PetscInt    nzs;
2822 
2823       ierr = ISGetLocalSize(zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2824       ierr = ISGetIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2825       for (i=0;i<nzs-1;i++) {
2826         PetscScalar vals[2];
2827         PetscInt    cols[2];
2828 
2829         cols[0] = idxs[i];
2830         cols[1] = idxs[nzs-1];
2831         vals[0] = 1.;
2832         vals[1] = 1.;
2833         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2834       }
2835       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2836       for (i=0;i<nzs-1;i++) array[i] = -1.;
2837       array[nzs-1] = 1.;
2838       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2839       /* store local idxs for p0 */
2840       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2841       ierr = ISRestoreIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2842       ierr = PetscFree(array);CHKERRQ(ierr);
2843     }
2844     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2845     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2846     /* project if needed */
2847     if (pcbddc->benign_change_explicit) {
2848       Mat M;
2849 
2850       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2851       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2852       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2853       ierr = MatDestroy(&M);CHKERRQ(ierr);
2854     }
2855     /* store global idxs for p0 */
2856     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2857   }
2858   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2859   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2860 
2861   /* determines if the coarse solver will be singular or not */
2862   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2863   /* determines if the problem has subdomains with 0 pressure block */
2864   have_null = (PetscBool)(!!pcbddc->benign_n);
2865   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2866   *zerodiaglocal = zerodiag;
2867   PetscFunctionReturn(0);
2868 }
2869 
2870 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2871 {
2872   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2873   PetscScalar    *array;
2874   PetscErrorCode ierr;
2875 
2876   PetscFunctionBegin;
2877   if (!pcbddc->benign_sf) {
2878     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
2879     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2880   }
2881   if (get) {
2882     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2883     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2884     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2885     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2886   } else {
2887     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
2888     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2889     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2890     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
2891   }
2892   PetscFunctionReturn(0);
2893 }
2894 
2895 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
2896 {
2897   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2898   PetscErrorCode ierr;
2899 
2900   PetscFunctionBegin;
2901   /* TODO: add error checking
2902     - avoid nested pop (or push) calls.
2903     - cannot push before pop.
2904     - cannot call this if pcbddc->local_mat is NULL
2905   */
2906   if (!pcbddc->benign_n) {
2907     PetscFunctionReturn(0);
2908   }
2909   if (pop) {
2910     if (pcbddc->benign_change_explicit) {
2911       IS       is_p0;
2912       MatReuse reuse;
2913 
2914       /* extract B_0 */
2915       reuse = MAT_INITIAL_MATRIX;
2916       if (pcbddc->benign_B0) {
2917         reuse = MAT_REUSE_MATRIX;
2918       }
2919       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
2920       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
2921       /* remove rows and cols from local problem */
2922       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
2923       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
2924       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
2925       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
2926     } else {
2927       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
2928       PetscScalar *vals;
2929       PetscInt    i,n,*idxs_ins;
2930 
2931       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
2932       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
2933       if (!pcbddc->benign_B0) {
2934         PetscInt *nnz;
2935         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
2936         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
2937         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2938         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
2939         for (i=0;i<pcbddc->benign_n;i++) {
2940           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
2941           nnz[i] = n - nnz[i];
2942         }
2943         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
2944         ierr = MatSetOption(pcbddc->benign_B0,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
2945         ierr = PetscFree(nnz);CHKERRQ(ierr);
2946       }
2947 
2948       for (i=0;i<pcbddc->benign_n;i++) {
2949         PetscScalar *array;
2950         PetscInt    *idxs,j,nz,cum;
2951 
2952         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
2953         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
2954         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2955         for (j=0;j<nz;j++) vals[j] = 1.;
2956         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2957         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
2958         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
2959         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
2960         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2961         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2962         cum = 0;
2963         for (j=0;j<n;j++) {
2964           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
2965             vals[cum] = array[j];
2966             idxs_ins[cum] = j;
2967             cum++;
2968           }
2969         }
2970         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
2971         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2972         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2973       }
2974       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2975       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2976       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
2977     }
2978   } else { /* push */
2979     if (pcbddc->benign_change_explicit) {
2980       PetscInt i;
2981 
2982       for (i=0;i<pcbddc->benign_n;i++) {
2983         PetscScalar *B0_vals;
2984         PetscInt    *B0_cols,B0_ncol;
2985 
2986         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2987         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2988         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2989         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
2990         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2991       }
2992       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2993       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2994     } else {
2995       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!\n");
2996     }
2997   }
2998   PetscFunctionReturn(0);
2999 }
3000 
3001 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
3002 {
3003   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3004   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3005   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
3006   PetscBLASInt    *B_iwork,*B_ifail;
3007   PetscScalar     *work,lwork;
3008   PetscScalar     *St,*S,*eigv;
3009   PetscScalar     *Sarray,*Starray;
3010   PetscReal       *eigs,thresh,lthresh,uthresh;
3011   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
3012   PetscBool       allocated_S_St;
3013 #if defined(PETSC_USE_COMPLEX)
3014   PetscReal       *rwork;
3015 #endif
3016   PetscErrorCode  ierr;
3017 
3018   PetscFunctionBegin;
3019   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
3020   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
3021   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);
3022   ierr = PetscLogEventBegin(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3023 
3024   if (pcbddc->dbg_flag) {
3025     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3026     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3027     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
3028     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
3029   }
3030 
3031   if (pcbddc->dbg_flag) {
3032     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %d (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);
3033   }
3034 
3035   /* max size of subsets */
3036   mss = 0;
3037   for (i=0;i<sub_schurs->n_subs;i++) {
3038     PetscInt subset_size;
3039 
3040     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3041     mss = PetscMax(mss,subset_size);
3042   }
3043 
3044   /* min/max and threshold */
3045   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
3046   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
3047   nmax = PetscMax(nmin,nmax);
3048   allocated_S_St = PETSC_FALSE;
3049   if (nmin || !sub_schurs->is_posdef) { /* XXX */
3050     allocated_S_St = PETSC_TRUE;
3051   }
3052 
3053   /* allocate lapack workspace */
3054   cum = cum2 = 0;
3055   maxneigs = 0;
3056   for (i=0;i<sub_schurs->n_subs;i++) {
3057     PetscInt n,subset_size;
3058 
3059     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3060     n = PetscMin(subset_size,nmax);
3061     cum += subset_size;
3062     cum2 += subset_size*n;
3063     maxneigs = PetscMax(maxneigs,n);
3064   }
3065   if (mss) {
3066     if (sub_schurs->is_symmetric) {
3067       PetscBLASInt B_itype = 1;
3068       PetscBLASInt B_N = mss;
3069       PetscReal    zero = 0.0;
3070       PetscReal    eps = 0.0; /* dlamch? */
3071 
3072       B_lwork = -1;
3073       S = NULL;
3074       St = NULL;
3075       eigs = NULL;
3076       eigv = NULL;
3077       B_iwork = NULL;
3078       B_ifail = NULL;
3079 #if defined(PETSC_USE_COMPLEX)
3080       rwork = NULL;
3081 #endif
3082       thresh = 1.0;
3083       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3084 #if defined(PETSC_USE_COMPLEX)
3085       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));
3086 #else
3087       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));
3088 #endif
3089       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3090       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3091     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3092   } else {
3093     lwork = 0;
3094   }
3095 
3096   nv = 0;
3097   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) */
3098     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
3099   }
3100   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
3101   if (allocated_S_St) {
3102     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
3103   }
3104   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
3105 #if defined(PETSC_USE_COMPLEX)
3106   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
3107 #endif
3108   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3109                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3110                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3111                       nv+cum,&pcbddc->adaptive_constraints_idxs,
3112                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
3113   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
3114 
3115   maxneigs = 0;
3116   cum = cumarray = 0;
3117   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3118   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3119   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3120     const PetscInt *idxs;
3121 
3122     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3123     for (cum=0;cum<nv;cum++) {
3124       pcbddc->adaptive_constraints_n[cum] = 1;
3125       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3126       pcbddc->adaptive_constraints_data[cum] = 1.0;
3127       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3128       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3129     }
3130     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3131   }
3132 
3133   if (mss) { /* multilevel */
3134     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3135     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3136   }
3137 
3138   lthresh = pcbddc->adaptive_threshold[0];
3139   uthresh = pcbddc->adaptive_threshold[1];
3140   for (i=0;i<sub_schurs->n_subs;i++) {
3141     const PetscInt *idxs;
3142     PetscReal      upper,lower;
3143     PetscInt       j,subset_size,eigs_start = 0;
3144     PetscBLASInt   B_N;
3145     PetscBool      same_data = PETSC_FALSE;
3146     PetscBool      scal = PETSC_FALSE;
3147 
3148     if (pcbddc->use_deluxe_scaling) {
3149       upper = PETSC_MAX_REAL;
3150       lower = uthresh;
3151     } else {
3152       if (!sub_schurs->is_posdef) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented without deluxe scaling");
3153       upper = 1./uthresh;
3154       lower = 0.;
3155     }
3156     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3157     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3158     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
3159     /* this is experimental: we assume the dofs have been properly grouped to have
3160        the diagonal blocks Schur complements either positive or negative definite (true for Stokes) */
3161     if (!sub_schurs->is_posdef) {
3162       Mat T;
3163 
3164       for (j=0;j<subset_size;j++) {
3165         if (PetscRealPart(*(Sarray+cumarray+j*(subset_size+1))) < 0.0) {
3166           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Sarray+cumarray,&T);CHKERRQ(ierr);
3167           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3168           ierr = MatDestroy(&T);CHKERRQ(ierr);
3169           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Starray+cumarray,&T);CHKERRQ(ierr);
3170           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3171           ierr = MatDestroy(&T);CHKERRQ(ierr);
3172           if (sub_schurs->change_primal_sub) {
3173             PetscInt       nz,k;
3174             const PetscInt *idxs;
3175 
3176             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nz);CHKERRQ(ierr);
3177             ierr = ISGetIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3178             for (k=0;k<nz;k++) {
3179               *( Sarray + cumarray + idxs[k]*(subset_size+1)) *= -1.0;
3180               *(Starray + cumarray + idxs[k]*(subset_size+1))  = 0.0;
3181             }
3182             ierr = ISRestoreIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3183           }
3184           scal = PETSC_TRUE;
3185           break;
3186         }
3187       }
3188     }
3189 
3190     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3191       if (sub_schurs->is_symmetric) {
3192         PetscInt j,k;
3193         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */
3194           ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3195           ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3196         }
3197         for (j=0;j<subset_size;j++) {
3198           for (k=j;k<subset_size;k++) {
3199             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3200             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3201           }
3202         }
3203       } else {
3204         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3205         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3206       }
3207     } else {
3208       S = Sarray + cumarray;
3209       St = Starray + cumarray;
3210     }
3211     /* see if we can save some work */
3212     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3213       ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr);
3214     }
3215 
3216     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3217       B_neigs = 0;
3218     } else {
3219       if (sub_schurs->is_symmetric) {
3220         PetscBLASInt B_itype = 1;
3221         PetscBLASInt B_IL, B_IU;
3222         PetscReal    eps = -1.0; /* dlamch? */
3223         PetscInt     nmin_s;
3224         PetscBool    compute_range;
3225 
3226         B_neigs = 0;
3227         compute_range = (PetscBool)!same_data;
3228         if (nmin >= subset_size) compute_range = PETSC_FALSE;
3229 
3230         if (pcbddc->dbg_flag) {
3231           PetscInt nc = 0;
3232 
3233           if (sub_schurs->change_primal_sub) {
3234             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nc);CHKERRQ(ierr);
3235           }
3236           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Computing for sub %d/%d size %d count %d fid %d (range %d) (change %d).\n",i,sub_schurs->n_subs,subset_size,pcbddc->mat_graph->count[idxs[0]]+1,pcbddc->mat_graph->which_dof[idxs[0]],compute_range,nc);CHKERRQ(ierr);
3237         }
3238 
3239         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3240         if (compute_range) {
3241 
3242           /* ask for eigenvalues larger than thresh */
3243           if (sub_schurs->is_posdef) {
3244 #if defined(PETSC_USE_COMPLEX)
3245             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));
3246 #else
3247             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));
3248 #endif
3249             ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3250           } else { /* no theory so far, but it works nicely */
3251             PetscInt  recipe = 0,recipe_m = 1;
3252             PetscReal bb[2];
3253 
3254             ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe",&recipe,NULL);CHKERRQ(ierr);
3255             switch (recipe) {
3256             case 0:
3257               if (scal) { bb[0] = PETSC_MIN_REAL; bb[1] = lthresh; }
3258               else { bb[0] = uthresh; bb[1] = PETSC_MAX_REAL; }
3259 #if defined(PETSC_USE_COMPLEX)
3260               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));
3261 #else
3262               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));
3263 #endif
3264               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3265               break;
3266             case 1:
3267               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh*lthresh;
3268 #if defined(PETSC_USE_COMPLEX)
3269               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));
3270 #else
3271               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));
3272 #endif
3273               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3274               if (!scal) {
3275                 PetscBLASInt B_neigs2 = 0;
3276 
3277                 bb[0] = PetscMax(lthresh*lthresh,uthresh); bb[1] = PETSC_MAX_REAL;
3278                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3279                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3280 #if defined(PETSC_USE_COMPLEX)
3281                 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));
3282 #else
3283                 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));
3284 #endif
3285                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3286                 B_neigs += B_neigs2;
3287               }
3288               break;
3289             case 2:
3290               if (scal) {
3291                 bb[0] = PETSC_MIN_REAL;
3292                 bb[1] = 0;
3293 #if defined(PETSC_USE_COMPLEX)
3294                 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));
3295 #else
3296                 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));
3297 #endif
3298                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3299               } else {
3300                 PetscBLASInt B_neigs2 = 0;
3301                 PetscBool    import = PETSC_FALSE;
3302 
3303                 lthresh = PetscMax(lthresh,0.0);
3304                 if (lthresh > 0.0) {
3305                   bb[0] = PETSC_MIN_REAL;
3306                   bb[1] = lthresh*lthresh;
3307 
3308                   import = PETSC_TRUE;
3309 #if defined(PETSC_USE_COMPLEX)
3310                   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));
3311 #else
3312                   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));
3313 #endif
3314                   ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3315                 }
3316                 bb[0] = PetscMax(lthresh*lthresh,uthresh);
3317                 bb[1] = PETSC_MAX_REAL;
3318                 if (import) {
3319                   ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3320                   ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3321                 }
3322 #if defined(PETSC_USE_COMPLEX)
3323                 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));
3324 #else
3325                 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));
3326 #endif
3327                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3328                 B_neigs += B_neigs2;
3329               }
3330               break;
3331             case 3:
3332               if (scal) {
3333                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min_scal",&recipe_m,NULL);CHKERRQ(ierr);
3334               } else {
3335                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min",&recipe_m,NULL);CHKERRQ(ierr);
3336               }
3337               if (!scal) {
3338                 bb[0] = uthresh;
3339                 bb[1] = PETSC_MAX_REAL;
3340 #if defined(PETSC_USE_COMPLEX)
3341                 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));
3342 #else
3343                 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));
3344 #endif
3345                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3346               }
3347               if (recipe_m > 0 && B_N - B_neigs > 0) {
3348                 PetscBLASInt B_neigs2 = 0;
3349 
3350                 B_IL = 1;
3351                 ierr = PetscBLASIntCast(PetscMin(recipe_m,B_N - B_neigs),&B_IU);CHKERRQ(ierr);
3352                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3353                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3354 #if defined(PETSC_USE_COMPLEX)
3355                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3356 #else
3357                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3358 #endif
3359                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3360                 B_neigs += B_neigs2;
3361               }
3362               break;
3363             case 4:
3364               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh;
3365 #if defined(PETSC_USE_COMPLEX)
3366               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));
3367 #else
3368               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));
3369 #endif
3370               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3371               {
3372                 PetscBLASInt B_neigs2 = 0;
3373 
3374                 bb[0] = PetscMax(lthresh+PETSC_SMALL,uthresh); bb[1] = PETSC_MAX_REAL;
3375                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3376                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3377 #if defined(PETSC_USE_COMPLEX)
3378                 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));
3379 #else
3380                 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));
3381 #endif
3382                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3383                 B_neigs += B_neigs2;
3384               }
3385               break;
3386             case 5: /* same as before: first compute all eigenvalues, then filter */
3387 #if defined(PETSC_USE_COMPLEX)
3388               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","A","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3389 #else
3390               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","A","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3391 #endif
3392               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3393               {
3394                 PetscInt e,k,ne;
3395                 for (e=0,ne=0;e<B_neigs;e++) {
3396                   if (eigs[e] < lthresh || eigs[e] > uthresh) {
3397                     for (k=0;k<B_N;k++) S[ne*B_N+k] = eigv[e*B_N+k];
3398                     eigs[ne] = eigs[e];
3399                     ne++;
3400                   }
3401                 }
3402                 ierr = PetscMemcpy(eigv,S,B_N*ne*sizeof(PetscScalar));CHKERRQ(ierr);
3403                 B_neigs = ne;
3404               }
3405               break;
3406             default:
3407               SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Unknown recipe %D",recipe);
3408               break;
3409             }
3410           }
3411         } else if (!same_data) { /* this is just to see all the eigenvalues */
3412           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3413           B_IL = 1;
3414 #if defined(PETSC_USE_COMPLEX)
3415           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));
3416 #else
3417           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));
3418 #endif
3419           ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3420         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3421           PetscInt k;
3422           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3423           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3424           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3425           nmin = nmax;
3426           ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr);
3427           for (k=0;k<nmax;k++) {
3428             eigs[k] = 1./PETSC_SMALL;
3429             eigv[k*(subset_size+1)] = 1.0;
3430           }
3431         }
3432         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3433         if (B_ierr) {
3434           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3435           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);
3436           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);
3437         }
3438 
3439         if (B_neigs > nmax) {
3440           if (pcbddc->dbg_flag) {
3441             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %d.\n",B_neigs,nmax);CHKERRQ(ierr);
3442           }
3443           if (pcbddc->use_deluxe_scaling) eigs_start = scal ? 0 : B_neigs-nmax;
3444           B_neigs = nmax;
3445         }
3446 
3447         nmin_s = PetscMin(nmin,B_N);
3448         if (B_neigs < nmin_s) {
3449           PetscBLASInt B_neigs2 = 0;
3450 
3451           if (pcbddc->use_deluxe_scaling) {
3452             if (scal) {
3453               B_IU = nmin_s;
3454               B_IL = B_neigs + 1;
3455             } else {
3456               B_IL = B_N - nmin_s + 1;
3457               B_IU = B_N - B_neigs;
3458             }
3459           } else {
3460             B_IL = B_neigs + 1;
3461             B_IU = nmin_s;
3462           }
3463           if (pcbddc->dbg_flag) {
3464             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);
3465           }
3466           if (sub_schurs->is_symmetric) {
3467             PetscInt j,k;
3468             for (j=0;j<subset_size;j++) {
3469               for (k=j;k<subset_size;k++) {
3470                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3471                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3472               }
3473             }
3474           } else {
3475             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3476             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3477           }
3478           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3479 #if defined(PETSC_USE_COMPLEX)
3480           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*subset_size,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3481 #else
3482           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));
3483 #endif
3484           ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3485           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3486           B_neigs += B_neigs2;
3487         }
3488         if (B_ierr) {
3489           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3490           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);
3491           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);
3492         }
3493         if (pcbddc->dbg_flag) {
3494           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3495           for (j=0;j<B_neigs;j++) {
3496             if (eigs[j] == 0.0) {
3497               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3498             } else {
3499               if (pcbddc->use_deluxe_scaling) {
3500                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3501               } else {
3502                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3503               }
3504             }
3505           }
3506         }
3507       } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3508     }
3509     /* change the basis back to the original one */
3510     if (sub_schurs->change) {
3511       Mat change,phi,phit;
3512 
3513       if (pcbddc->dbg_flag > 2) {
3514         PetscInt ii;
3515         for (ii=0;ii<B_neigs;ii++) {
3516           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3517           for (j=0;j<B_N;j++) {
3518 #if defined(PETSC_USE_COMPLEX)
3519             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3520             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3521             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3522 #else
3523             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3524 #endif
3525           }
3526         }
3527       }
3528       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3529       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3530       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3531       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3532       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3533       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3534     }
3535     maxneigs = PetscMax(B_neigs,maxneigs);
3536     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3537     if (B_neigs) {
3538       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);
3539 
3540       if (pcbddc->dbg_flag > 1) {
3541         PetscInt ii;
3542         for (ii=0;ii<B_neigs;ii++) {
3543           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3544           for (j=0;j<B_N;j++) {
3545 #if defined(PETSC_USE_COMPLEX)
3546             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3547             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3548             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3549 #else
3550             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3551 #endif
3552           }
3553         }
3554       }
3555       ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
3556       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3557       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3558       cum++;
3559     }
3560     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3561     /* shift for next computation */
3562     cumarray += subset_size*subset_size;
3563   }
3564   if (pcbddc->dbg_flag) {
3565     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3566   }
3567 
3568   if (mss) {
3569     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3570     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3571     /* destroy matrices (junk) */
3572     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3573     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3574   }
3575   if (allocated_S_St) {
3576     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3577   }
3578   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3579 #if defined(PETSC_USE_COMPLEX)
3580   ierr = PetscFree(rwork);CHKERRQ(ierr);
3581 #endif
3582   if (pcbddc->dbg_flag) {
3583     PetscInt maxneigs_r;
3584     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3585     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %d\n",maxneigs_r);CHKERRQ(ierr);
3586   }
3587   ierr = PetscLogEventEnd(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3588   PetscFunctionReturn(0);
3589 }
3590 
3591 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3592 {
3593   PetscScalar    *coarse_submat_vals;
3594   PetscErrorCode ierr;
3595 
3596   PetscFunctionBegin;
3597   /* Setup local scatters R_to_B and (optionally) R_to_D */
3598   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3599   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3600 
3601   /* Setup local neumann solver ksp_R */
3602   /* PCBDDCSetUpLocalScatters should be called first! */
3603   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3604 
3605   /*
3606      Setup local correction and local part of coarse basis.
3607      Gives back the dense local part of the coarse matrix in column major ordering
3608   */
3609   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3610 
3611   /* Compute total number of coarse nodes and setup coarse solver */
3612   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3613 
3614   /* free */
3615   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3616   PetscFunctionReturn(0);
3617 }
3618 
3619 PetscErrorCode PCBDDCResetCustomization(PC pc)
3620 {
3621   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3622   PetscErrorCode ierr;
3623 
3624   PetscFunctionBegin;
3625   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3626   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3627   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3628   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3629   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3630   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3631   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3632   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3633   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3634   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3635   PetscFunctionReturn(0);
3636 }
3637 
3638 PetscErrorCode PCBDDCResetTopography(PC pc)
3639 {
3640   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3641   PetscInt       i;
3642   PetscErrorCode ierr;
3643 
3644   PetscFunctionBegin;
3645   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3646   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3647   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3648   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3649   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3650   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3651   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3652   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3653   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3654   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3655   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3656   for (i=0;i<pcbddc->n_local_subs;i++) {
3657     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3658   }
3659   pcbddc->n_local_subs = 0;
3660   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3661   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3662   pcbddc->graphanalyzed        = PETSC_FALSE;
3663   pcbddc->recompute_topography = PETSC_TRUE;
3664   pcbddc->corner_selected      = PETSC_FALSE;
3665   PetscFunctionReturn(0);
3666 }
3667 
3668 PetscErrorCode PCBDDCResetSolvers(PC pc)
3669 {
3670   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3671   PetscErrorCode ierr;
3672 
3673   PetscFunctionBegin;
3674   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3675   if (pcbddc->coarse_phi_B) {
3676     PetscScalar *array;
3677     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3678     ierr = PetscFree(array);CHKERRQ(ierr);
3679   }
3680   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3681   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3682   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3683   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3684   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3685   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3686   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3687   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3688   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3689   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3690   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3691   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3692   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3693   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3694   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3695   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3696   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3697   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3698   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3699   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3700   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3701   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3702   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3703   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3704   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3705   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3706   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3707   if (pcbddc->benign_zerodiag_subs) {
3708     PetscInt i;
3709     for (i=0;i<pcbddc->benign_n;i++) {
3710       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3711     }
3712     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3713   }
3714   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3715   PetscFunctionReturn(0);
3716 }
3717 
3718 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3719 {
3720   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3721   PC_IS          *pcis = (PC_IS*)pc->data;
3722   VecType        impVecType;
3723   PetscInt       n_constraints,n_R,old_size;
3724   PetscErrorCode ierr;
3725 
3726   PetscFunctionBegin;
3727   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3728   n_R = pcis->n - pcbddc->n_vertices;
3729   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3730   /* local work vectors (try to avoid unneeded work)*/
3731   /* R nodes */
3732   old_size = -1;
3733   if (pcbddc->vec1_R) {
3734     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3735   }
3736   if (n_R != old_size) {
3737     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3738     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3739     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3740     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3741     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3742     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3743   }
3744   /* local primal dofs */
3745   old_size = -1;
3746   if (pcbddc->vec1_P) {
3747     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3748   }
3749   if (pcbddc->local_primal_size != old_size) {
3750     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3751     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3752     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3753     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3754   }
3755   /* local explicit constraints */
3756   old_size = -1;
3757   if (pcbddc->vec1_C) {
3758     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3759   }
3760   if (n_constraints && n_constraints != old_size) {
3761     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3762     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3763     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3764     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3765   }
3766   PetscFunctionReturn(0);
3767 }
3768 
3769 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3770 {
3771   PetscErrorCode  ierr;
3772   /* pointers to pcis and pcbddc */
3773   PC_IS*          pcis = (PC_IS*)pc->data;
3774   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3775   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3776   /* submatrices of local problem */
3777   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3778   /* submatrices of local coarse problem */
3779   Mat             S_VV,S_CV,S_VC,S_CC;
3780   /* working matrices */
3781   Mat             C_CR;
3782   /* additional working stuff */
3783   PC              pc_R;
3784   Mat             F,Brhs = NULL;
3785   Vec             dummy_vec;
3786   PetscBool       isLU,isCHOL,isILU,need_benign_correction,sparserhs;
3787   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3788   PetscScalar     *work;
3789   PetscInt        *idx_V_B;
3790   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3791   PetscInt        i,n_R,n_D,n_B;
3792 
3793   /* some shortcuts to scalars */
3794   PetscScalar     one=1.0,m_one=-1.0;
3795 
3796   PetscFunctionBegin;
3797   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");
3798   ierr = PetscLogEventBegin(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3799 
3800   /* Set Non-overlapping dimensions */
3801   n_vertices = pcbddc->n_vertices;
3802   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3803   n_B = pcis->n_B;
3804   n_D = pcis->n - n_B;
3805   n_R = pcis->n - n_vertices;
3806 
3807   /* vertices in boundary numbering */
3808   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3809   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3810   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",n_vertices,i);
3811 
3812   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3813   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3814   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3815   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3816   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3817   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3818   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3819   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3820   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3821   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3822 
3823   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3824   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3825   ierr = PCSetUp(pc_R);CHKERRQ(ierr);
3826   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3827   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3828   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3829   lda_rhs = n_R;
3830   need_benign_correction = PETSC_FALSE;
3831   if (isLU || isILU || isCHOL) {
3832     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3833   } else if (sub_schurs && sub_schurs->reuse_solver) {
3834     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3835     MatFactorType      type;
3836 
3837     F = reuse_solver->F;
3838     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3839     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3840     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3841     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3842   } else {
3843     F = NULL;
3844   }
3845 
3846   /* determine if we can use a sparse right-hand side */
3847   sparserhs = PETSC_FALSE;
3848   if (F) {
3849     MatSolverType solver;
3850 
3851     ierr = MatFactorGetSolverType(F,&solver);CHKERRQ(ierr);
3852     ierr = PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs);CHKERRQ(ierr);
3853   }
3854 
3855   /* allocate workspace */
3856   n = 0;
3857   if (n_constraints) {
3858     n += lda_rhs*n_constraints;
3859   }
3860   if (n_vertices) {
3861     n = PetscMax(2*lda_rhs*n_vertices,n);
3862     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3863   }
3864   if (!pcbddc->symmetric_primal) {
3865     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3866   }
3867   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3868 
3869   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3870   dummy_vec = NULL;
3871   if (need_benign_correction && lda_rhs != n_R && F) {
3872     ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,lda_rhs,work,&dummy_vec);CHKERRQ(ierr);
3873   }
3874 
3875   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3876   if (n_constraints) {
3877     Mat         M3,C_B;
3878     IS          is_aux;
3879     PetscScalar *array,*array2;
3880 
3881     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3882     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3883 
3884     /* Extract constraints on R nodes: C_{CR}  */
3885     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
3886     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
3887     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
3888 
3889     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
3890     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
3891     if (!sparserhs) {
3892       ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
3893       for (i=0;i<n_constraints;i++) {
3894         const PetscScalar *row_cmat_values;
3895         const PetscInt    *row_cmat_indices;
3896         PetscInt          size_of_constraint,j;
3897 
3898         ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3899         for (j=0;j<size_of_constraint;j++) {
3900           work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
3901         }
3902         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3903       }
3904       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs);CHKERRQ(ierr);
3905     } else {
3906       Mat tC_CR;
3907 
3908       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
3909       if (lda_rhs != n_R) {
3910         PetscScalar *aa;
3911         PetscInt    r,*ii,*jj;
3912         PetscBool   done;
3913 
3914         ierr = MatGetRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3915         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
3916         ierr = MatSeqAIJGetArray(C_CR,&aa);CHKERRQ(ierr);
3917         ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR);CHKERRQ(ierr);
3918         ierr = MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3919         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
3920       } else {
3921         ierr  = PetscObjectReference((PetscObject)C_CR);CHKERRQ(ierr);
3922         tC_CR = C_CR;
3923       }
3924       ierr = MatCreateTranspose(tC_CR,&Brhs);CHKERRQ(ierr);
3925       ierr = MatDestroy(&tC_CR);CHKERRQ(ierr);
3926     }
3927     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
3928     if (F) {
3929       if (need_benign_correction) {
3930         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3931 
3932         /* rhs is already zero on interior dofs, no need to change the rhs */
3933         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
3934       }
3935       ierr = MatMatSolve(F,Brhs,local_auxmat2_R);CHKERRQ(ierr);
3936       if (need_benign_correction) {
3937         PetscScalar        *marr;
3938         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3939 
3940         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3941         if (lda_rhs != n_R) {
3942           for (i=0;i<n_constraints;i++) {
3943             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3944             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3945             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3946           }
3947         } else {
3948           for (i=0;i<n_constraints;i++) {
3949             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3950             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3951             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3952           }
3953         }
3954         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3955       }
3956     } else {
3957       PetscScalar *marr;
3958 
3959       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3960       for (i=0;i<n_constraints;i++) {
3961         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3962         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
3963         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3964         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3965         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3966       }
3967       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3968     }
3969     if (sparserhs) {
3970       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
3971     }
3972     ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
3973     if (!pcbddc->switch_static) {
3974       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3975       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3976       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3977       for (i=0;i<n_constraints;i++) {
3978         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
3979         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
3980         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3981         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3982         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3983         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3984       }
3985       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3986       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3987       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3988     } else {
3989       if (lda_rhs != n_R) {
3990         IS dummy;
3991 
3992         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
3993         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3994         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
3995       } else {
3996         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
3997         pcbddc->local_auxmat2 = local_auxmat2_R;
3998       }
3999       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4000     }
4001     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4002     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
4003     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
4004     if (isCHOL) {
4005       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
4006     } else {
4007       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
4008     }
4009     ierr = MatSeqDenseInvertFactors_Private(M3);CHKERRQ(ierr);
4010     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
4011     ierr = MatMatMult(M3,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
4012     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4013     ierr = MatCopy(M3,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
4014     ierr = MatDestroy(&M3);CHKERRQ(ierr);
4015   }
4016 
4017   /* Get submatrices from subdomain matrix */
4018   if (n_vertices) {
4019     IS        is_aux;
4020     PetscBool isseqaij;
4021 
4022     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
4023       IS tis;
4024 
4025       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
4026       ierr = ISSort(tis);CHKERRQ(ierr);
4027       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
4028       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4029     } else {
4030       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
4031     }
4032     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
4033     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
4034     ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4035     if (!isseqaij) { /* MatMatMult(A_VR,A_RRmA_RV) below will raise an error */
4036       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4037     }
4038     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
4039     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4040   }
4041 
4042   /* Matrix of coarse basis functions (local) */
4043   if (pcbddc->coarse_phi_B) {
4044     PetscInt on_B,on_primal,on_D=n_D;
4045     if (pcbddc->coarse_phi_D) {
4046       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
4047     }
4048     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
4049     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
4050       PetscScalar *marray;
4051 
4052       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
4053       ierr = PetscFree(marray);CHKERRQ(ierr);
4054       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4055       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4056       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4057       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4058     }
4059   }
4060 
4061   if (!pcbddc->coarse_phi_B) {
4062     PetscScalar *marr;
4063 
4064     /* memory size */
4065     n = n_B*pcbddc->local_primal_size;
4066     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
4067     if (!pcbddc->symmetric_primal) n *= 2;
4068     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
4069     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4070     marr += n_B*pcbddc->local_primal_size;
4071     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4072       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4073       marr += n_D*pcbddc->local_primal_size;
4074     }
4075     if (!pcbddc->symmetric_primal) {
4076       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4077       marr += n_B*pcbddc->local_primal_size;
4078       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4079         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4080       }
4081     } else {
4082       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
4083       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
4084       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4085         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
4086         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
4087       }
4088     }
4089   }
4090 
4091   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
4092   p0_lidx_I = NULL;
4093   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
4094     const PetscInt *idxs;
4095 
4096     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4097     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
4098     for (i=0;i<pcbddc->benign_n;i++) {
4099       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
4100     }
4101     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4102   }
4103 
4104   /* vertices */
4105   if (n_vertices) {
4106     PetscBool restoreavr = PETSC_FALSE;
4107 
4108     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
4109 
4110     if (n_R) {
4111       Mat          A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
4112       PetscBLASInt B_N,B_one = 1;
4113       PetscScalar  *x,*y;
4114 
4115       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
4116       if (need_benign_correction) {
4117         ISLocalToGlobalMapping RtoN;
4118         IS                     is_p0;
4119         PetscInt               *idxs_p0,n;
4120 
4121         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
4122         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
4123         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
4124         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);
4125         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
4126         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
4127         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
4128         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
4129       }
4130 
4131       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4132       if (!sparserhs || need_benign_correction) {
4133         if (lda_rhs == n_R) {
4134           ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4135         } else {
4136           PetscScalar    *av,*array;
4137           const PetscInt *xadj,*adjncy;
4138           PetscInt       n;
4139           PetscBool      flg_row;
4140 
4141           array = work+lda_rhs*n_vertices;
4142           ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
4143           ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4144           ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4145           ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
4146           for (i=0;i<n;i++) {
4147             PetscInt j;
4148             for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
4149           }
4150           ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4151           ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4152           ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
4153         }
4154         if (need_benign_correction) {
4155           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4156           PetscScalar        *marr;
4157 
4158           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
4159           /* need \Phi^T A_RV = (I+L)A_RV, L given by
4160 
4161                  | 0 0  0 | (V)
4162              L = | 0 0 -1 | (P-p0)
4163                  | 0 0 -1 | (p0)
4164 
4165           */
4166           for (i=0;i<reuse_solver->benign_n;i++) {
4167             const PetscScalar *vals;
4168             const PetscInt    *idxs,*idxs_zero;
4169             PetscInt          n,j,nz;
4170 
4171             ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4172             ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
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,col = idxs[j];
4177               for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
4178             }
4179             ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4180             ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4181           }
4182           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
4183         }
4184         ierr = PetscObjectReference((PetscObject)A_RV);CHKERRQ(ierr);
4185         Brhs = A_RV;
4186       } else {
4187         Mat tA_RVT,A_RVT;
4188 
4189         if (!pcbddc->symmetric_primal) {
4190           /* A_RV already scaled by -1 */
4191           ierr = MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT);CHKERRQ(ierr);
4192         } else {
4193           restoreavr = PETSC_TRUE;
4194           ierr  = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4195           ierr  = PetscObjectReference((PetscObject)A_VR);CHKERRQ(ierr);
4196           A_RVT = A_VR;
4197         }
4198         if (lda_rhs != n_R) {
4199           PetscScalar *aa;
4200           PetscInt    r,*ii,*jj;
4201           PetscBool   done;
4202 
4203           ierr = MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4204           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4205           ierr = MatSeqAIJGetArray(A_RVT,&aa);CHKERRQ(ierr);
4206           ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT);CHKERRQ(ierr);
4207           ierr = MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4208           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4209         } else {
4210           ierr   = PetscObjectReference((PetscObject)A_RVT);CHKERRQ(ierr);
4211           tA_RVT = A_RVT;
4212         }
4213         ierr = MatCreateTranspose(tA_RVT,&Brhs);CHKERRQ(ierr);
4214         ierr = MatDestroy(&tA_RVT);CHKERRQ(ierr);
4215         ierr = MatDestroy(&A_RVT);CHKERRQ(ierr);
4216       }
4217       if (F) {
4218         /* need to correct the rhs */
4219         if (need_benign_correction) {
4220           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4221           PetscScalar        *marr;
4222 
4223           ierr = MatDenseGetArray(Brhs,&marr);CHKERRQ(ierr);
4224           if (lda_rhs != n_R) {
4225             for (i=0;i<n_vertices;i++) {
4226               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4227               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4228               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4229             }
4230           } else {
4231             for (i=0;i<n_vertices;i++) {
4232               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4233               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4234               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4235             }
4236           }
4237           ierr = MatDenseRestoreArray(Brhs,&marr);CHKERRQ(ierr);
4238         }
4239         ierr = MatMatSolve(F,Brhs,A_RRmA_RV);CHKERRQ(ierr);
4240         if (restoreavr) {
4241           ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4242         }
4243         /* need to correct the solution */
4244         if (need_benign_correction) {
4245           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4246           PetscScalar        *marr;
4247 
4248           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4249           if (lda_rhs != n_R) {
4250             for (i=0;i<n_vertices;i++) {
4251               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4252               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4253               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4254             }
4255           } else {
4256             for (i=0;i<n_vertices;i++) {
4257               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4258               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4259               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4260             }
4261           }
4262           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4263         }
4264       } else {
4265         ierr = MatDenseGetArray(Brhs,&y);CHKERRQ(ierr);
4266         for (i=0;i<n_vertices;i++) {
4267           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
4268           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
4269           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4270           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4271           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4272         }
4273         ierr = MatDenseRestoreArray(Brhs,&y);CHKERRQ(ierr);
4274       }
4275       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4276       ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4277       /* S_VV and S_CV */
4278       if (n_constraints) {
4279         Mat B;
4280 
4281         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
4282         for (i=0;i<n_vertices;i++) {
4283           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4284           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
4285           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4286           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4287           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4288           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4289         }
4290         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4291         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
4292         ierr = MatDestroy(&B);CHKERRQ(ierr);
4293         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4294         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4295         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
4296         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
4297         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
4298         ierr = MatDestroy(&B);CHKERRQ(ierr);
4299       }
4300       if (lda_rhs != n_R) {
4301         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4302         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4303         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
4304       }
4305       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
4306       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
4307       if (need_benign_correction) {
4308         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4309         PetscScalar      *marr,*sums;
4310 
4311         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
4312         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
4313         for (i=0;i<reuse_solver->benign_n;i++) {
4314           const PetscScalar *vals;
4315           const PetscInt    *idxs,*idxs_zero;
4316           PetscInt          n,j,nz;
4317 
4318           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4319           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4320           for (j=0;j<n_vertices;j++) {
4321             PetscInt k;
4322             sums[j] = 0.;
4323             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
4324           }
4325           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4326           for (j=0;j<n;j++) {
4327             PetscScalar val = vals[j];
4328             PetscInt k;
4329             for (k=0;k<n_vertices;k++) {
4330               marr[idxs[j]+k*n_vertices] += val*sums[k];
4331             }
4332           }
4333           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4334           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4335         }
4336         ierr = PetscFree(sums);CHKERRQ(ierr);
4337         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
4338         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
4339       }
4340       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4341       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
4342       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
4343       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
4344       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4345       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
4346       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
4347       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4348       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
4349     } else {
4350       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4351     }
4352     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
4353 
4354     /* coarse basis functions */
4355     for (i=0;i<n_vertices;i++) {
4356       PetscScalar *y;
4357 
4358       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4359       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4360       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4361       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4362       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4363       y[n_B*i+idx_V_B[i]] = 1.0;
4364       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4365       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4366 
4367       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4368         PetscInt j;
4369 
4370         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4371         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4372         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4373         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4374         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4375         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4376         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4377       }
4378       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4379     }
4380     /* if n_R == 0 the object is not destroyed */
4381     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4382   }
4383   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4384 
4385   if (n_constraints) {
4386     Mat B;
4387 
4388     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4389     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4390     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4391     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4392     if (n_vertices) {
4393       if (isCHOL || need_benign_correction) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4394         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4395       } else {
4396         Mat S_VCt;
4397 
4398         if (lda_rhs != n_R) {
4399           ierr = MatDestroy(&B);CHKERRQ(ierr);
4400           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4401           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4402         }
4403         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4404         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4405         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4406       }
4407     }
4408     ierr = MatDestroy(&B);CHKERRQ(ierr);
4409     /* coarse basis functions */
4410     for (i=0;i<n_constraints;i++) {
4411       PetscScalar *y;
4412 
4413       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4414       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4415       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4416       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4417       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4418       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4419       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4420       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4421         PetscInt j;
4422 
4423         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4424         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4425         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4426         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4427         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4428         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4429         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4430       }
4431       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4432     }
4433   }
4434   if (n_constraints) {
4435     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4436   }
4437   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4438 
4439   /* coarse matrix entries relative to B_0 */
4440   if (pcbddc->benign_n) {
4441     Mat         B0_B,B0_BPHI;
4442     IS          is_dummy;
4443     PetscScalar *data;
4444     PetscInt    j;
4445 
4446     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4447     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4448     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4449     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4450     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4451     ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr);
4452     for (j=0;j<pcbddc->benign_n;j++) {
4453       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4454       for (i=0;i<pcbddc->local_primal_size;i++) {
4455         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4456         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4457       }
4458     }
4459     ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr);
4460     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4461     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4462   }
4463 
4464   /* compute other basis functions for non-symmetric problems */
4465   if (!pcbddc->symmetric_primal) {
4466     Mat         B_V=NULL,B_C=NULL;
4467     PetscScalar *marray;
4468 
4469     if (n_constraints) {
4470       Mat S_CCT,C_CRT;
4471 
4472       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4473       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4474       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4475       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4476       if (n_vertices) {
4477         Mat S_VCT;
4478 
4479         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4480         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4481         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4482       }
4483       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4484     } else {
4485       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4486     }
4487     if (n_vertices && n_R) {
4488       PetscScalar    *av,*marray;
4489       const PetscInt *xadj,*adjncy;
4490       PetscInt       n;
4491       PetscBool      flg_row;
4492 
4493       /* B_V = B_V - A_VR^T */
4494       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4495       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4496       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4497       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4498       for (i=0;i<n;i++) {
4499         PetscInt j;
4500         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4501       }
4502       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4503       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4504       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4505     }
4506 
4507     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4508     if (n_vertices) {
4509       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4510       for (i=0;i<n_vertices;i++) {
4511         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4512         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4513         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4514         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4515         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4516       }
4517       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4518     }
4519     if (B_C) {
4520       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4521       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4522         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4523         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4524         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4525         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4526         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4527       }
4528       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4529     }
4530     /* coarse basis functions */
4531     for (i=0;i<pcbddc->local_primal_size;i++) {
4532       PetscScalar *y;
4533 
4534       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4535       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4536       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4537       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4538       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4539       if (i<n_vertices) {
4540         y[n_B*i+idx_V_B[i]] = 1.0;
4541       }
4542       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4543       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4544 
4545       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4546         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4547         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4548         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4549         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4550         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4551         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4552       }
4553       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4554     }
4555     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4556     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4557   }
4558 
4559   /* free memory */
4560   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4561   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4562   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4563   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4564   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4565   ierr = PetscFree(work);CHKERRQ(ierr);
4566   if (n_vertices) {
4567     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4568   }
4569   if (n_constraints) {
4570     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4571   }
4572   /* Checking coarse_sub_mat and coarse basis functios */
4573   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4574   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4575   if (pcbddc->dbg_flag) {
4576     Mat         coarse_sub_mat;
4577     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4578     Mat         coarse_phi_D,coarse_phi_B;
4579     Mat         coarse_psi_D,coarse_psi_B;
4580     Mat         A_II,A_BB,A_IB,A_BI;
4581     Mat         C_B,CPHI;
4582     IS          is_dummy;
4583     Vec         mones;
4584     MatType     checkmattype=MATSEQAIJ;
4585     PetscReal   real_value;
4586 
4587     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4588       Mat A;
4589       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4590       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4591       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4592       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4593       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4594       ierr = MatDestroy(&A);CHKERRQ(ierr);
4595     } else {
4596       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4597       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4598       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4599       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4600     }
4601     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4602     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4603     if (!pcbddc->symmetric_primal) {
4604       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4605       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4606     }
4607     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4608 
4609     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4610     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4611     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4612     if (!pcbddc->symmetric_primal) {
4613       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4614       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4615       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4616       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4617       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4618       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4619       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4620       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4621       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4622       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4623       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4624       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4625     } else {
4626       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4627       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4628       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4629       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4630       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4631       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4632       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4633       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4634     }
4635     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4636     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4637     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4638     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4639     if (pcbddc->benign_n) {
4640       Mat         B0_B,B0_BPHI;
4641       PetscScalar *data,*data2;
4642       PetscInt    j;
4643 
4644       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4645       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4646       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4647       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4648       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4649       ierr = MatDenseGetArray(B0_BPHI,&data2);CHKERRQ(ierr);
4650       for (j=0;j<pcbddc->benign_n;j++) {
4651         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4652         for (i=0;i<pcbddc->local_primal_size;i++) {
4653           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4654           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4655         }
4656       }
4657       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4658       ierr = MatDenseRestoreArray(B0_BPHI,&data2);CHKERRQ(ierr);
4659       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4660       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4661       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4662     }
4663 #if 0
4664   {
4665     PetscViewer viewer;
4666     char filename[256];
4667     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4668     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4669     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4670     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4671     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4672     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4673     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4674     if (pcbddc->coarse_phi_B) {
4675       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4676       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4677     }
4678     if (pcbddc->coarse_phi_D) {
4679       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4680       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4681     }
4682     if (pcbddc->coarse_psi_B) {
4683       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4684       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4685     }
4686     if (pcbddc->coarse_psi_D) {
4687       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4688       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4689     }
4690     ierr = PetscObjectSetName((PetscObject)pcbddc->local_mat,"A");CHKERRQ(ierr);
4691     ierr = MatView(pcbddc->local_mat,viewer);CHKERRQ(ierr);
4692     ierr = PetscObjectSetName((PetscObject)pcbddc->ConstraintMatrix,"C");CHKERRQ(ierr);
4693     ierr = MatView(pcbddc->ConstraintMatrix,viewer);CHKERRQ(ierr);
4694     ierr = PetscObjectSetName((PetscObject)pcis->is_I_local,"I");CHKERRQ(ierr);
4695     ierr = ISView(pcis->is_I_local,viewer);CHKERRQ(ierr);
4696     ierr = PetscObjectSetName((PetscObject)pcis->is_B_local,"B");CHKERRQ(ierr);
4697     ierr = ISView(pcis->is_B_local,viewer);CHKERRQ(ierr);
4698     ierr = PetscObjectSetName((PetscObject)pcbddc->is_R_local,"R");CHKERRQ(ierr);
4699     ierr = ISView(pcbddc->is_R_local,viewer);CHKERRQ(ierr);
4700     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4701   }
4702 #endif
4703     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4704     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4705     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4706     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4707 
4708     /* check constraints */
4709     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4710     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4711     if (!pcbddc->benign_n) { /* TODO: add benign case */
4712       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4713     } else {
4714       PetscScalar *data;
4715       Mat         tmat;
4716       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4717       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4718       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4719       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4720       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4721     }
4722     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4723     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4724     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4725     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4726     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4727     if (!pcbddc->symmetric_primal) {
4728       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4729       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4730       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4731       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4732       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4733     }
4734     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4735     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4736     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4737     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4738     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4739     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4740     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4741     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4742     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4743     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4744     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4745     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4746     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4747     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4748     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4749     if (!pcbddc->symmetric_primal) {
4750       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4751       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4752     }
4753     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4754   }
4755   /* get back data */
4756   *coarse_submat_vals_n = coarse_submat_vals;
4757   ierr = PetscLogEventEnd(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
4758   PetscFunctionReturn(0);
4759 }
4760 
4761 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4762 {
4763   Mat            *work_mat;
4764   IS             isrow_s,iscol_s;
4765   PetscBool      rsorted,csorted;
4766   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4767   PetscErrorCode ierr;
4768 
4769   PetscFunctionBegin;
4770   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4771   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4772   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4773   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4774 
4775   if (!rsorted) {
4776     const PetscInt *idxs;
4777     PetscInt *idxs_sorted,i;
4778 
4779     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4780     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4781     for (i=0;i<rsize;i++) {
4782       idxs_perm_r[i] = i;
4783     }
4784     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4785     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4786     for (i=0;i<rsize;i++) {
4787       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4788     }
4789     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4790     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4791   } else {
4792     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4793     isrow_s = isrow;
4794   }
4795 
4796   if (!csorted) {
4797     if (isrow == iscol) {
4798       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4799       iscol_s = isrow_s;
4800     } else {
4801       const PetscInt *idxs;
4802       PetscInt       *idxs_sorted,i;
4803 
4804       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4805       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4806       for (i=0;i<csize;i++) {
4807         idxs_perm_c[i] = i;
4808       }
4809       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4810       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4811       for (i=0;i<csize;i++) {
4812         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4813       }
4814       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4815       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4816     }
4817   } else {
4818     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4819     iscol_s = iscol;
4820   }
4821 
4822   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4823 
4824   if (!rsorted || !csorted) {
4825     Mat      new_mat;
4826     IS       is_perm_r,is_perm_c;
4827 
4828     if (!rsorted) {
4829       PetscInt *idxs_r,i;
4830       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4831       for (i=0;i<rsize;i++) {
4832         idxs_r[idxs_perm_r[i]] = i;
4833       }
4834       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4835       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4836     } else {
4837       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4838     }
4839     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4840 
4841     if (!csorted) {
4842       if (isrow_s == iscol_s) {
4843         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4844         is_perm_c = is_perm_r;
4845       } else {
4846         PetscInt *idxs_c,i;
4847         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4848         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4849         for (i=0;i<csize;i++) {
4850           idxs_c[idxs_perm_c[i]] = i;
4851         }
4852         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4853         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4854       }
4855     } else {
4856       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4857     }
4858     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4859 
4860     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4861     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4862     work_mat[0] = new_mat;
4863     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4864     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4865   }
4866 
4867   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4868   *B = work_mat[0];
4869   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4870   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4871   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4872   PetscFunctionReturn(0);
4873 }
4874 
4875 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
4876 {
4877   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
4878   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4879   Mat            new_mat,lA;
4880   IS             is_local,is_global;
4881   PetscInt       local_size;
4882   PetscBool      isseqaij;
4883   PetscErrorCode ierr;
4884 
4885   PetscFunctionBegin;
4886   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4887   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
4888   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
4889   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
4890   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
4891   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
4892   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
4893 
4894   /* check */
4895   if (pcbddc->dbg_flag) {
4896     Vec       x,x_change;
4897     PetscReal error;
4898 
4899     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
4900     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
4901     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
4902     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4903     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4904     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
4905     if (!pcbddc->change_interior) {
4906       const PetscScalar *x,*y,*v;
4907       PetscReal         lerror = 0.;
4908       PetscInt          i;
4909 
4910       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
4911       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
4912       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
4913       for (i=0;i<local_size;i++)
4914         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
4915           lerror = PetscAbsScalar(x[i]-y[i]);
4916       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
4917       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
4918       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
4919       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4920       if (error > PETSC_SMALL) {
4921         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4922           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e\n",error);
4923         } else {
4924           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e\n",error);
4925         }
4926       }
4927     }
4928     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4929     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4930     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
4931     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
4932     if (error > PETSC_SMALL) {
4933       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4934         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
4935       } else {
4936         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e\n",error);
4937       }
4938     }
4939     ierr = VecDestroy(&x);CHKERRQ(ierr);
4940     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
4941   }
4942 
4943   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
4944   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
4945 
4946   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
4947   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4948   if (isseqaij) {
4949     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4950     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4951     if (lA) {
4952       Mat work;
4953       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4954       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4955       ierr = MatDestroy(&work);CHKERRQ(ierr);
4956     }
4957   } else {
4958     Mat work_mat;
4959 
4960     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4961     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4962     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4963     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
4964     if (lA) {
4965       Mat work;
4966       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4967       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4968       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4969       ierr = MatDestroy(&work);CHKERRQ(ierr);
4970     }
4971   }
4972   if (matis->A->symmetric_set) {
4973     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
4974 #if !defined(PETSC_USE_COMPLEX)
4975     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
4976 #endif
4977   }
4978   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
4979   PetscFunctionReturn(0);
4980 }
4981 
4982 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
4983 {
4984   PC_IS*          pcis = (PC_IS*)(pc->data);
4985   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
4986   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4987   PetscInt        *idx_R_local=NULL;
4988   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
4989   PetscInt        vbs,bs;
4990   PetscBT         bitmask=NULL;
4991   PetscErrorCode  ierr;
4992 
4993   PetscFunctionBegin;
4994   /*
4995     No need to setup local scatters if
4996       - primal space is unchanged
4997         AND
4998       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
4999         AND
5000       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
5001   */
5002   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
5003     PetscFunctionReturn(0);
5004   }
5005   /* destroy old objects */
5006   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
5007   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
5008   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
5009   /* Set Non-overlapping dimensions */
5010   n_B = pcis->n_B;
5011   n_D = pcis->n - n_B;
5012   n_vertices = pcbddc->n_vertices;
5013 
5014   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
5015 
5016   /* create auxiliary bitmask and allocate workspace */
5017   if (!sub_schurs || !sub_schurs->reuse_solver) {
5018     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
5019     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
5020     for (i=0;i<n_vertices;i++) {
5021       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
5022     }
5023 
5024     for (i=0, n_R=0; i<pcis->n; i++) {
5025       if (!PetscBTLookup(bitmask,i)) {
5026         idx_R_local[n_R++] = i;
5027       }
5028     }
5029   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
5030     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5031 
5032     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5033     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
5034   }
5035 
5036   /* Block code */
5037   vbs = 1;
5038   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
5039   if (bs>1 && !(n_vertices%bs)) {
5040     PetscBool is_blocked = PETSC_TRUE;
5041     PetscInt  *vary;
5042     if (!sub_schurs || !sub_schurs->reuse_solver) {
5043       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
5044       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
5045       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
5046       /* 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 */
5047       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
5048       for (i=0; i<pcis->n/bs; i++) {
5049         if (vary[i]!=0 && vary[i]!=bs) {
5050           is_blocked = PETSC_FALSE;
5051           break;
5052         }
5053       }
5054       ierr = PetscFree(vary);CHKERRQ(ierr);
5055     } else {
5056       /* Verify directly the R set */
5057       for (i=0; i<n_R/bs; i++) {
5058         PetscInt j,node=idx_R_local[bs*i];
5059         for (j=1; j<bs; j++) {
5060           if (node != idx_R_local[bs*i+j]-j) {
5061             is_blocked = PETSC_FALSE;
5062             break;
5063           }
5064         }
5065       }
5066     }
5067     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
5068       vbs = bs;
5069       for (i=0;i<n_R/vbs;i++) {
5070         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
5071       }
5072     }
5073   }
5074   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
5075   if (sub_schurs && sub_schurs->reuse_solver) {
5076     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5077 
5078     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5079     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
5080     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
5081     reuse_solver->is_R = pcbddc->is_R_local;
5082   } else {
5083     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
5084   }
5085 
5086   /* print some info if requested */
5087   if (pcbddc->dbg_flag) {
5088     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5089     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5090     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5091     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
5092     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
5093     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);
5094     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5095   }
5096 
5097   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
5098   if (!sub_schurs || !sub_schurs->reuse_solver) {
5099     IS       is_aux1,is_aux2;
5100     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
5101 
5102     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5103     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
5104     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
5105     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5106     for (i=0; i<n_D; i++) {
5107       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
5108     }
5109     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5110     for (i=0, j=0; i<n_R; i++) {
5111       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
5112         aux_array1[j++] = i;
5113       }
5114     }
5115     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5116     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5117     for (i=0, j=0; i<n_B; i++) {
5118       if (!PetscBTLookup(bitmask,is_indices[i])) {
5119         aux_array2[j++] = i;
5120       }
5121     }
5122     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5123     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
5124     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
5125     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5126     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
5127 
5128     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5129       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
5130       for (i=0, j=0; i<n_R; i++) {
5131         if (PetscBTLookup(bitmask,idx_R_local[i])) {
5132           aux_array1[j++] = i;
5133         }
5134       }
5135       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5136       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5137       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5138     }
5139     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
5140     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5141   } else {
5142     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5143     IS                 tis;
5144     PetscInt           schur_size;
5145 
5146     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
5147     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
5148     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
5149     ierr = ISDestroy(&tis);CHKERRQ(ierr);
5150     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5151       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
5152       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5153       ierr = ISDestroy(&tis);CHKERRQ(ierr);
5154     }
5155   }
5156   PetscFunctionReturn(0);
5157 }
5158 
5159 
5160 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
5161 {
5162   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
5163   PC_IS          *pcis = (PC_IS*)pc->data;
5164   PC             pc_temp;
5165   Mat            A_RR;
5166   MatReuse       reuse;
5167   PetscScalar    m_one = -1.0;
5168   PetscReal      value;
5169   PetscInt       n_D,n_R;
5170   PetscBool      check_corr,issbaij;
5171   PetscErrorCode ierr;
5172   /* prefixes stuff */
5173   char           dir_prefix[256],neu_prefix[256],str_level[16];
5174   size_t         len;
5175 
5176   PetscFunctionBegin;
5177   ierr = PetscLogEventBegin(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5178   /* compute prefixes */
5179   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
5180   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
5181   if (!pcbddc->current_level) {
5182     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,sizeof(dir_prefix));CHKERRQ(ierr);
5183     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,sizeof(neu_prefix));CHKERRQ(ierr);
5184     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5185     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5186   } else {
5187     ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
5188     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
5189     len -= 15; /* remove "pc_bddc_coarse_" */
5190     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
5191     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
5192     /* Nonstandard use of PetscStrncpy() to only copy a portion of the input string */
5193     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5194     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5195     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5196     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5197     ierr = PetscStrlcat(dir_prefix,str_level,sizeof(dir_prefix));CHKERRQ(ierr);
5198     ierr = PetscStrlcat(neu_prefix,str_level,sizeof(neu_prefix));CHKERRQ(ierr);
5199   }
5200 
5201   /* DIRICHLET PROBLEM */
5202   if (dirichlet) {
5203     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5204     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
5205       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented\n");
5206       if (pcbddc->dbg_flag) {
5207         Mat    A_IIn;
5208 
5209         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
5210         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
5211         pcis->A_II = A_IIn;
5212       }
5213     }
5214     if (pcbddc->local_mat->symmetric_set) {
5215       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
5216     }
5217     /* Matrix for Dirichlet problem is pcis->A_II */
5218     n_D = pcis->n - pcis->n_B;
5219     if (!pcbddc->ksp_D) { /* create object if not yet build */
5220       void (*f)(void) = 0;
5221 
5222       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
5223       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
5224       /* default */
5225       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
5226       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
5227       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5228       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5229       if (issbaij) {
5230         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5231       } else {
5232         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5233       }
5234       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_D,pc->erroriffailure);CHKERRQ(ierr);
5235       /* Allow user's customization */
5236       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
5237       ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5238       if (f && pcbddc->mat_graph->cloc) {
5239         PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5240         const PetscInt *idxs;
5241         PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5242 
5243         ierr = ISGetLocalSize(pcis->is_I_local,&nl);CHKERRQ(ierr);
5244         ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5245         ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5246         for (i=0;i<nl;i++) {
5247           for (d=0;d<cdim;d++) {
5248             scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5249           }
5250         }
5251         ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5252         ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5253         ierr = PetscFree(scoords);CHKERRQ(ierr);
5254       }
5255     }
5256     ierr = MatSetOptionsPrefix(pcis->A_II,((PetscObject)pcbddc->ksp_D)->prefix);CHKERRQ(ierr);
5257     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
5258     if (sub_schurs && sub_schurs->reuse_solver) {
5259       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5260 
5261       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
5262     }
5263     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5264     if (!n_D) {
5265       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5266       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5267     }
5268     /* set ksp_D into pcis data */
5269     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
5270     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
5271     pcis->ksp_D = pcbddc->ksp_D;
5272   }
5273 
5274   /* NEUMANN PROBLEM */
5275   A_RR = 0;
5276   if (neumann) {
5277     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5278     PetscInt        ibs,mbs;
5279     PetscBool       issbaij, reuse_neumann_solver;
5280     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
5281 
5282     reuse_neumann_solver = PETSC_FALSE;
5283     if (sub_schurs && sub_schurs->reuse_solver) {
5284       IS iP;
5285 
5286       reuse_neumann_solver = PETSC_TRUE;
5287       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
5288       if (iP) reuse_neumann_solver = PETSC_FALSE;
5289     }
5290     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
5291     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
5292     if (pcbddc->ksp_R) { /* already created ksp */
5293       PetscInt nn_R;
5294       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
5295       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5296       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
5297       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
5298         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
5299         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5300         reuse = MAT_INITIAL_MATRIX;
5301       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5302         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5303           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5304           reuse = MAT_INITIAL_MATRIX;
5305         } else { /* safe to reuse the matrix */
5306           reuse = MAT_REUSE_MATRIX;
5307         }
5308       }
5309       /* last check */
5310       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5311         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5312         reuse = MAT_INITIAL_MATRIX;
5313       }
5314     } else { /* first time, so we need to create the matrix */
5315       reuse = MAT_INITIAL_MATRIX;
5316     }
5317     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
5318     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5319     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5320     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5321     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5322       if (matis->A == pcbddc->local_mat) {
5323         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5324         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5325       } else {
5326         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5327       }
5328     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5329       if (matis->A == pcbddc->local_mat) {
5330         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5331         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5332       } else {
5333         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5334       }
5335     }
5336     /* extract A_RR */
5337     if (reuse_neumann_solver) {
5338       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5339 
5340       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5341         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5342         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5343           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5344         } else {
5345           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5346         }
5347       } else {
5348         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5349         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5350         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5351       }
5352     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5353       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5354     }
5355     if (pcbddc->local_mat->symmetric_set) {
5356       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
5357     }
5358     if (!pcbddc->ksp_R) { /* create object if not present */
5359       void (*f)(void) = 0;
5360 
5361       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5362       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5363       /* default */
5364       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5365       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5366       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5367       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5368       if (issbaij) {
5369         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5370       } else {
5371         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5372       }
5373       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_R,pc->erroriffailure);CHKERRQ(ierr);
5374       /* Allow user's customization */
5375       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5376       ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5377       if (f && pcbddc->mat_graph->cloc) {
5378         PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5379         const PetscInt *idxs;
5380         PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5381 
5382         ierr = ISGetLocalSize(pcbddc->is_R_local,&nl);CHKERRQ(ierr);
5383         ierr = ISGetIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5384         ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5385         for (i=0;i<nl;i++) {
5386           for (d=0;d<cdim;d++) {
5387             scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5388           }
5389         }
5390         ierr = ISRestoreIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5391         ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5392         ierr = PetscFree(scoords);CHKERRQ(ierr);
5393       }
5394     }
5395     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5396     if (!n_R) {
5397       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5398       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5399     }
5400     ierr = MatSetOptionsPrefix(A_RR,((PetscObject)pcbddc->ksp_R)->prefix);CHKERRQ(ierr);
5401     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5402     /* Reuse solver if it is present */
5403     if (reuse_neumann_solver) {
5404       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5405 
5406       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5407     }
5408   }
5409 
5410   if (pcbddc->dbg_flag) {
5411     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5412     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5413     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5414   }
5415 
5416   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5417   check_corr = PETSC_FALSE;
5418   if (pcbddc->NullSpace_corr[0]) {
5419     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5420   }
5421   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5422     check_corr = PETSC_TRUE;
5423     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5424   }
5425   if (neumann && pcbddc->NullSpace_corr[2]) {
5426     check_corr = PETSC_TRUE;
5427     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5428   }
5429   /* check Dirichlet and Neumann solvers */
5430   if (pcbddc->dbg_flag) {
5431     if (dirichlet) { /* Dirichlet */
5432       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5433       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5434       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5435       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5436       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5437       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);
5438       if (check_corr) {
5439         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_TRUE);CHKERRQ(ierr);
5440       }
5441       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5442     }
5443     if (neumann) { /* Neumann */
5444       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5445       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5446       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5447       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5448       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5449       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);
5450       if (check_corr) {
5451         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_FALSE);CHKERRQ(ierr);
5452       }
5453       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5454     }
5455   }
5456   /* free Neumann problem's matrix */
5457   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5458   ierr = PetscLogEventEnd(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5459   PetscFunctionReturn(0);
5460 }
5461 
5462 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5463 {
5464   PetscErrorCode  ierr;
5465   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5466   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5467   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5468 
5469   PetscFunctionBegin;
5470   if (!reuse_solver) {
5471     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5472   }
5473   if (!pcbddc->switch_static) {
5474     if (applytranspose && pcbddc->local_auxmat1) {
5475       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5476       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5477     }
5478     if (!reuse_solver) {
5479       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5480       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5481     } else {
5482       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5483 
5484       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5485       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5486     }
5487   } else {
5488     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5489     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5490     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5491     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5492     if (applytranspose && pcbddc->local_auxmat1) {
5493       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5494       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5495       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5496       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5497     }
5498   }
5499   if (!reuse_solver || pcbddc->switch_static) {
5500     if (applytranspose) {
5501       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5502     } else {
5503       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5504     }
5505   } else {
5506     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5507 
5508     if (applytranspose) {
5509       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5510     } else {
5511       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5512     }
5513   }
5514   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5515   if (!pcbddc->switch_static) {
5516     if (!reuse_solver) {
5517       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5518       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5519     } else {
5520       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5521 
5522       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5523       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5524     }
5525     if (!applytranspose && pcbddc->local_auxmat1) {
5526       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5527       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5528     }
5529   } else {
5530     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5531     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5532     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5533     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5534     if (!applytranspose && pcbddc->local_auxmat1) {
5535       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5536       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5537     }
5538     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5539     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5540     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5541     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5542   }
5543   PetscFunctionReturn(0);
5544 }
5545 
5546 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5547 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5548 {
5549   PetscErrorCode ierr;
5550   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5551   PC_IS*            pcis = (PC_IS*)  (pc->data);
5552   const PetscScalar zero = 0.0;
5553 
5554   PetscFunctionBegin;
5555   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5556   if (!pcbddc->benign_apply_coarse_only) {
5557     if (applytranspose) {
5558       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5559       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5560     } else {
5561       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5562       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5563     }
5564   } else {
5565     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5566   }
5567 
5568   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5569   if (pcbddc->benign_n) {
5570     PetscScalar *array;
5571     PetscInt    j;
5572 
5573     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5574     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5575     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5576   }
5577 
5578   /* start communications from local primal nodes to rhs of coarse solver */
5579   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5580   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5581   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5582 
5583   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5584   if (pcbddc->coarse_ksp) {
5585     Mat          coarse_mat;
5586     Vec          rhs,sol;
5587     MatNullSpace nullsp;
5588     PetscBool    isbddc = PETSC_FALSE;
5589 
5590     if (pcbddc->benign_have_null) {
5591       PC        coarse_pc;
5592 
5593       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5594       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5595       /* we need to propagate to coarser levels the need for a possible benign correction */
5596       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5597         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5598         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5599         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5600       }
5601     }
5602     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5603     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5604     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5605     ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5606     if (nullsp) {
5607       ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5608     }
5609     if (applytranspose) {
5610       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5611       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5612     } else {
5613       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5614         PC        coarse_pc;
5615 
5616         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5617         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5618         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5619         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5620       } else {
5621         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5622       }
5623     }
5624     /* we don't need the benign correction at coarser levels anymore */
5625     if (pcbddc->benign_have_null && isbddc) {
5626       PC        coarse_pc;
5627       PC_BDDC*  coarsepcbddc;
5628 
5629       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5630       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5631       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5632       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5633     }
5634     if (nullsp) {
5635       ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5636     }
5637   }
5638 
5639   /* Local solution on R nodes */
5640   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5641     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5642   }
5643   /* communications from coarse sol to local primal nodes */
5644   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5645   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5646 
5647   /* Sum contributions from the two levels */
5648   if (!pcbddc->benign_apply_coarse_only) {
5649     if (applytranspose) {
5650       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5651       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5652     } else {
5653       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5654       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5655     }
5656     /* store p0 */
5657     if (pcbddc->benign_n) {
5658       PetscScalar *array;
5659       PetscInt    j;
5660 
5661       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5662       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5663       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5664     }
5665   } else { /* expand the coarse solution */
5666     if (applytranspose) {
5667       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5668     } else {
5669       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5670     }
5671   }
5672   PetscFunctionReturn(0);
5673 }
5674 
5675 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5676 {
5677   PetscErrorCode ierr;
5678   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5679   PetscScalar    *array;
5680   Vec            from,to;
5681 
5682   PetscFunctionBegin;
5683   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5684     from = pcbddc->coarse_vec;
5685     to = pcbddc->vec1_P;
5686     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5687       Vec tvec;
5688 
5689       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5690       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5691       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5692       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5693       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5694       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5695     }
5696   } else { /* from local to global -> put data in coarse right hand side */
5697     from = pcbddc->vec1_P;
5698     to = pcbddc->coarse_vec;
5699   }
5700   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5701   PetscFunctionReturn(0);
5702 }
5703 
5704 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5705 {
5706   PetscErrorCode ierr;
5707   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5708   PetscScalar    *array;
5709   Vec            from,to;
5710 
5711   PetscFunctionBegin;
5712   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5713     from = pcbddc->coarse_vec;
5714     to = pcbddc->vec1_P;
5715   } else { /* from local to global -> put data in coarse right hand side */
5716     from = pcbddc->vec1_P;
5717     to = pcbddc->coarse_vec;
5718   }
5719   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5720   if (smode == SCATTER_FORWARD) {
5721     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5722       Vec tvec;
5723 
5724       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5725       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5726       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5727       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5728     }
5729   } else {
5730     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5731      ierr = VecResetArray(from);CHKERRQ(ierr);
5732     }
5733   }
5734   PetscFunctionReturn(0);
5735 }
5736 
5737 /* uncomment for testing purposes */
5738 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5739 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5740 {
5741   PetscErrorCode    ierr;
5742   PC_IS*            pcis = (PC_IS*)(pc->data);
5743   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5744   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5745   /* one and zero */
5746   PetscScalar       one=1.0,zero=0.0;
5747   /* space to store constraints and their local indices */
5748   PetscScalar       *constraints_data;
5749   PetscInt          *constraints_idxs,*constraints_idxs_B;
5750   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5751   PetscInt          *constraints_n;
5752   /* iterators */
5753   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5754   /* BLAS integers */
5755   PetscBLASInt      lwork,lierr;
5756   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5757   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5758   /* reuse */
5759   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5760   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5761   /* change of basis */
5762   PetscBool         qr_needed;
5763   PetscBT           change_basis,qr_needed_idx;
5764   /* auxiliary stuff */
5765   PetscInt          *nnz,*is_indices;
5766   PetscInt          ncc;
5767   /* some quantities */
5768   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5769   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5770   PetscReal         tol; /* tolerance for retaining eigenmodes */
5771 
5772   PetscFunctionBegin;
5773   tol  = PetscSqrtReal(PETSC_SMALL);
5774   /* Destroy Mat objects computed previously */
5775   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5776   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5777   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5778   /* save info on constraints from previous setup (if any) */
5779   olocal_primal_size = pcbddc->local_primal_size;
5780   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5781   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5782   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5783   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5784   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5785   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5786 
5787   if (!pcbddc->adaptive_selection) {
5788     IS           ISForVertices,*ISForFaces,*ISForEdges;
5789     MatNullSpace nearnullsp;
5790     const Vec    *nearnullvecs;
5791     Vec          *localnearnullsp;
5792     PetscScalar  *array;
5793     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5794     PetscBool    nnsp_has_cnst;
5795     /* LAPACK working arrays for SVD or POD */
5796     PetscBool    skip_lapack,boolforchange;
5797     PetscScalar  *work;
5798     PetscReal    *singular_vals;
5799 #if defined(PETSC_USE_COMPLEX)
5800     PetscReal    *rwork;
5801 #endif
5802 #if defined(PETSC_MISSING_LAPACK_GESVD)
5803     PetscScalar  *temp_basis,*correlation_mat;
5804 #else
5805     PetscBLASInt dummy_int=1;
5806     PetscScalar  dummy_scalar=1.;
5807 #endif
5808 
5809     /* Get index sets for faces, edges and vertices from graph */
5810     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
5811     /* print some info */
5812     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
5813       PetscInt nv;
5814 
5815       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
5816       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
5817       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5818       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5819       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
5820       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
5821       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
5822       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5823       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5824     }
5825 
5826     /* free unneeded index sets */
5827     if (!pcbddc->use_vertices) {
5828       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5829     }
5830     if (!pcbddc->use_edges) {
5831       for (i=0;i<n_ISForEdges;i++) {
5832         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5833       }
5834       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5835       n_ISForEdges = 0;
5836     }
5837     if (!pcbddc->use_faces) {
5838       for (i=0;i<n_ISForFaces;i++) {
5839         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5840       }
5841       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5842       n_ISForFaces = 0;
5843     }
5844 
5845     /* check if near null space is attached to global mat */
5846     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
5847     if (nearnullsp) {
5848       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
5849       /* remove any stored info */
5850       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
5851       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5852       /* store information for BDDC solver reuse */
5853       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
5854       pcbddc->onearnullspace = nearnullsp;
5855       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5856       for (i=0;i<nnsp_size;i++) {
5857         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
5858       }
5859     } else { /* if near null space is not provided BDDC uses constants by default */
5860       nnsp_size = 0;
5861       nnsp_has_cnst = PETSC_TRUE;
5862     }
5863     /* get max number of constraints on a single cc */
5864     max_constraints = nnsp_size;
5865     if (nnsp_has_cnst) max_constraints++;
5866 
5867     /*
5868          Evaluate maximum storage size needed by the procedure
5869          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
5870          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
5871          There can be multiple constraints per connected component
5872                                                                                                                                                            */
5873     n_vertices = 0;
5874     if (ISForVertices) {
5875       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
5876     }
5877     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
5878     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
5879 
5880     total_counts = n_ISForFaces+n_ISForEdges;
5881     total_counts *= max_constraints;
5882     total_counts += n_vertices;
5883     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
5884 
5885     total_counts = 0;
5886     max_size_of_constraint = 0;
5887     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
5888       IS used_is;
5889       if (i<n_ISForEdges) {
5890         used_is = ISForEdges[i];
5891       } else {
5892         used_is = ISForFaces[i-n_ISForEdges];
5893       }
5894       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
5895       total_counts += j;
5896       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
5897     }
5898     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);
5899 
5900     /* get local part of global near null space vectors */
5901     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
5902     for (k=0;k<nnsp_size;k++) {
5903       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
5904       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5905       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5906     }
5907 
5908     /* whether or not to skip lapack calls */
5909     skip_lapack = PETSC_TRUE;
5910     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
5911 
5912     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
5913     if (!skip_lapack) {
5914       PetscScalar temp_work;
5915 
5916 #if defined(PETSC_MISSING_LAPACK_GESVD)
5917       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
5918       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
5919       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
5920       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
5921 #if defined(PETSC_USE_COMPLEX)
5922       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
5923 #endif
5924       /* now we evaluate the optimal workspace using query with lwork=-1 */
5925       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5926       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
5927       lwork = -1;
5928       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5929 #if !defined(PETSC_USE_COMPLEX)
5930       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
5931 #else
5932       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
5933 #endif
5934       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5935       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
5936 #else /* on missing GESVD */
5937       /* SVD */
5938       PetscInt max_n,min_n;
5939       max_n = max_size_of_constraint;
5940       min_n = max_constraints;
5941       if (max_size_of_constraint < max_constraints) {
5942         min_n = max_size_of_constraint;
5943         max_n = max_constraints;
5944       }
5945       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
5946 #if defined(PETSC_USE_COMPLEX)
5947       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
5948 #endif
5949       /* now we evaluate the optimal workspace using query with lwork=-1 */
5950       lwork = -1;
5951       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
5952       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
5953       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
5954       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5955 #if !defined(PETSC_USE_COMPLEX)
5956       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));
5957 #else
5958       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));
5959 #endif
5960       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5961       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
5962 #endif /* on missing GESVD */
5963       /* Allocate optimal workspace */
5964       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
5965       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
5966     }
5967     /* Now we can loop on constraining sets */
5968     total_counts = 0;
5969     constraints_idxs_ptr[0] = 0;
5970     constraints_data_ptr[0] = 0;
5971     /* vertices */
5972     if (n_vertices) {
5973       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5974       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5975       for (i=0;i<n_vertices;i++) {
5976         constraints_n[total_counts] = 1;
5977         constraints_data[total_counts] = 1.0;
5978         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
5979         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
5980         total_counts++;
5981       }
5982       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5983       n_vertices = total_counts;
5984     }
5985 
5986     /* edges and faces */
5987     total_counts_cc = total_counts;
5988     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
5989       IS        used_is;
5990       PetscBool idxs_copied = PETSC_FALSE;
5991 
5992       if (ncc<n_ISForEdges) {
5993         used_is = ISForEdges[ncc];
5994         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
5995       } else {
5996         used_is = ISForFaces[ncc-n_ISForEdges];
5997         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
5998       }
5999       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
6000 
6001       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
6002       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6003       /* change of basis should not be performed on local periodic nodes */
6004       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
6005       if (nnsp_has_cnst) {
6006         PetscScalar quad_value;
6007 
6008         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
6009         idxs_copied = PETSC_TRUE;
6010 
6011         if (!pcbddc->use_nnsp_true) {
6012           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
6013         } else {
6014           quad_value = 1.0;
6015         }
6016         for (j=0;j<size_of_constraint;j++) {
6017           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
6018         }
6019         temp_constraints++;
6020         total_counts++;
6021       }
6022       for (k=0;k<nnsp_size;k++) {
6023         PetscReal real_value;
6024         PetscScalar *ptr_to_data;
6025 
6026         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6027         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
6028         for (j=0;j<size_of_constraint;j++) {
6029           ptr_to_data[j] = array[is_indices[j]];
6030         }
6031         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6032         /* check if array is null on the connected component */
6033         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6034         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
6035         if (real_value > tol*size_of_constraint) { /* keep indices and values */
6036           temp_constraints++;
6037           total_counts++;
6038           if (!idxs_copied) {
6039             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
6040             idxs_copied = PETSC_TRUE;
6041           }
6042         }
6043       }
6044       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6045       valid_constraints = temp_constraints;
6046       if (!pcbddc->use_nnsp_true && temp_constraints) {
6047         if (temp_constraints == 1) { /* just normalize the constraint */
6048           PetscScalar norm,*ptr_to_data;
6049 
6050           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6051           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6052           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
6053           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
6054           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
6055         } else { /* perform SVD */
6056           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6057 
6058 #if defined(PETSC_MISSING_LAPACK_GESVD)
6059           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
6060              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
6061              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
6062                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
6063                 from that computed using LAPACKgesvd
6064              -> This is due to a different computation of eigenvectors in LAPACKheev
6065              -> The quality of the POD-computed basis will be the same */
6066           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
6067           /* Store upper triangular part of correlation matrix */
6068           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6069           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6070           for (j=0;j<temp_constraints;j++) {
6071             for (k=0;k<j+1;k++) {
6072               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));
6073             }
6074           }
6075           /* compute eigenvalues and eigenvectors of correlation matrix */
6076           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6077           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
6078 #if !defined(PETSC_USE_COMPLEX)
6079           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
6080 #else
6081           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
6082 #endif
6083           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6084           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
6085           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
6086           j = 0;
6087           while (j < temp_constraints && singular_vals[j] < tol) j++;
6088           total_counts = total_counts-j;
6089           valid_constraints = temp_constraints-j;
6090           /* scale and copy POD basis into used quadrature memory */
6091           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6092           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6093           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
6094           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6095           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
6096           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6097           if (j<temp_constraints) {
6098             PetscInt ii;
6099             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
6100             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6101             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));
6102             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6103             for (k=0;k<temp_constraints-j;k++) {
6104               for (ii=0;ii<size_of_constraint;ii++) {
6105                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
6106               }
6107             }
6108           }
6109 #else  /* on missing GESVD */
6110           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6111           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6112           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6113           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6114 #if !defined(PETSC_USE_COMPLEX)
6115           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));
6116 #else
6117           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));
6118 #endif
6119           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
6120           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6121           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
6122           k = temp_constraints;
6123           if (k > size_of_constraint) k = size_of_constraint;
6124           j = 0;
6125           while (j < k && singular_vals[k-j-1] < tol) j++;
6126           valid_constraints = k-j;
6127           total_counts = total_counts-temp_constraints+valid_constraints;
6128 #endif /* on missing GESVD */
6129         }
6130       }
6131       /* update pointers information */
6132       if (valid_constraints) {
6133         constraints_n[total_counts_cc] = valid_constraints;
6134         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
6135         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
6136         /* set change_of_basis flag */
6137         if (boolforchange) {
6138           PetscBTSet(change_basis,total_counts_cc);
6139         }
6140         total_counts_cc++;
6141       }
6142     }
6143     /* free workspace */
6144     if (!skip_lapack) {
6145       ierr = PetscFree(work);CHKERRQ(ierr);
6146 #if defined(PETSC_USE_COMPLEX)
6147       ierr = PetscFree(rwork);CHKERRQ(ierr);
6148 #endif
6149       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
6150 #if defined(PETSC_MISSING_LAPACK_GESVD)
6151       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
6152       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
6153 #endif
6154     }
6155     for (k=0;k<nnsp_size;k++) {
6156       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
6157     }
6158     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
6159     /* free index sets of faces, edges and vertices */
6160     for (i=0;i<n_ISForFaces;i++) {
6161       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6162     }
6163     if (n_ISForFaces) {
6164       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6165     }
6166     for (i=0;i<n_ISForEdges;i++) {
6167       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6168     }
6169     if (n_ISForEdges) {
6170       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6171     }
6172     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6173   } else {
6174     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
6175 
6176     total_counts = 0;
6177     n_vertices = 0;
6178     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
6179       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
6180     }
6181     max_constraints = 0;
6182     total_counts_cc = 0;
6183     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6184       total_counts += pcbddc->adaptive_constraints_n[i];
6185       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
6186       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
6187     }
6188     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
6189     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
6190     constraints_idxs = pcbddc->adaptive_constraints_idxs;
6191     constraints_data = pcbddc->adaptive_constraints_data;
6192     /* constraints_n differs from pcbddc->adaptive_constraints_n */
6193     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
6194     total_counts_cc = 0;
6195     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6196       if (pcbddc->adaptive_constraints_n[i]) {
6197         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
6198       }
6199     }
6200 
6201     max_size_of_constraint = 0;
6202     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]);
6203     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
6204     /* Change of basis */
6205     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
6206     if (pcbddc->use_change_of_basis) {
6207       for (i=0;i<sub_schurs->n_subs;i++) {
6208         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
6209           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
6210         }
6211       }
6212     }
6213   }
6214   pcbddc->local_primal_size = total_counts;
6215   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6216 
6217   /* map constraints_idxs in boundary numbering */
6218   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
6219   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);
6220 
6221   /* Create constraint matrix */
6222   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6223   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
6224   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
6225 
6226   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
6227   /* determine if a QR strategy is needed for change of basis */
6228   qr_needed = PETSC_FALSE;
6229   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
6230   total_primal_vertices=0;
6231   pcbddc->local_primal_size_cc = 0;
6232   for (i=0;i<total_counts_cc;i++) {
6233     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6234     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
6235       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
6236       pcbddc->local_primal_size_cc += 1;
6237     } else if (PetscBTLookup(change_basis,i)) {
6238       for (k=0;k<constraints_n[i];k++) {
6239         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6240       }
6241       pcbddc->local_primal_size_cc += constraints_n[i];
6242       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
6243         PetscBTSet(qr_needed_idx,i);
6244         qr_needed = PETSC_TRUE;
6245       }
6246     } else {
6247       pcbddc->local_primal_size_cc += 1;
6248     }
6249   }
6250   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
6251   pcbddc->n_vertices = total_primal_vertices;
6252   /* permute indices in order to have a sorted set of vertices */
6253   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6254   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);
6255   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
6256   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
6257 
6258   /* nonzero structure of constraint matrix */
6259   /* and get reference dof for local constraints */
6260   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
6261   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
6262 
6263   j = total_primal_vertices;
6264   total_counts = total_primal_vertices;
6265   cum = total_primal_vertices;
6266   for (i=n_vertices;i<total_counts_cc;i++) {
6267     if (!PetscBTLookup(change_basis,i)) {
6268       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
6269       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
6270       cum++;
6271       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6272       for (k=0;k<constraints_n[i];k++) {
6273         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6274         nnz[j+k] = size_of_constraint;
6275       }
6276       j += constraints_n[i];
6277     }
6278   }
6279   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
6280   ierr = MatSetOption(pcbddc->ConstraintMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6281   ierr = PetscFree(nnz);CHKERRQ(ierr);
6282 
6283   /* set values in constraint matrix */
6284   for (i=0;i<total_primal_vertices;i++) {
6285     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
6286   }
6287   total_counts = total_primal_vertices;
6288   for (i=n_vertices;i<total_counts_cc;i++) {
6289     if (!PetscBTLookup(change_basis,i)) {
6290       PetscInt *cols;
6291 
6292       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6293       cols = constraints_idxs+constraints_idxs_ptr[i];
6294       for (k=0;k<constraints_n[i];k++) {
6295         PetscInt    row = total_counts+k;
6296         PetscScalar *vals;
6297 
6298         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
6299         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6300       }
6301       total_counts += constraints_n[i];
6302     }
6303   }
6304   /* assembling */
6305   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6306   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6307   ierr = MatViewFromOptions(pcbddc->ConstraintMatrix,NULL,"-pc_bddc_constraint_mat_view");CHKERRQ(ierr);
6308 
6309   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6310   if (pcbddc->use_change_of_basis) {
6311     /* dual and primal dofs on a single cc */
6312     PetscInt     dual_dofs,primal_dofs;
6313     /* working stuff for GEQRF */
6314     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
6315     PetscBLASInt lqr_work;
6316     /* working stuff for UNGQR */
6317     PetscScalar  *gqr_work,lgqr_work_t;
6318     PetscBLASInt lgqr_work;
6319     /* working stuff for TRTRS */
6320     PetscScalar  *trs_rhs;
6321     PetscBLASInt Blas_NRHS;
6322     /* pointers for values insertion into change of basis matrix */
6323     PetscInt     *start_rows,*start_cols;
6324     PetscScalar  *start_vals;
6325     /* working stuff for values insertion */
6326     PetscBT      is_primal;
6327     PetscInt     *aux_primal_numbering_B;
6328     /* matrix sizes */
6329     PetscInt     global_size,local_size;
6330     /* temporary change of basis */
6331     Mat          localChangeOfBasisMatrix;
6332     /* extra space for debugging */
6333     PetscScalar  *dbg_work;
6334 
6335     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6336     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6337     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6338     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6339     /* nonzeros for local mat */
6340     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6341     if (!pcbddc->benign_change || pcbddc->fake_change) {
6342       for (i=0;i<pcis->n;i++) nnz[i]=1;
6343     } else {
6344       const PetscInt *ii;
6345       PetscInt       n;
6346       PetscBool      flg_row;
6347       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6348       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6349       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6350     }
6351     for (i=n_vertices;i<total_counts_cc;i++) {
6352       if (PetscBTLookup(change_basis,i)) {
6353         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6354         if (PetscBTLookup(qr_needed_idx,i)) {
6355           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6356         } else {
6357           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6358           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6359         }
6360       }
6361     }
6362     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6363     ierr = MatSetOption(localChangeOfBasisMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6364     ierr = PetscFree(nnz);CHKERRQ(ierr);
6365     /* Set interior change in the matrix */
6366     if (!pcbddc->benign_change || pcbddc->fake_change) {
6367       for (i=0;i<pcis->n;i++) {
6368         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6369       }
6370     } else {
6371       const PetscInt *ii,*jj;
6372       PetscScalar    *aa;
6373       PetscInt       n;
6374       PetscBool      flg_row;
6375       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6376       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6377       for (i=0;i<n;i++) {
6378         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6379       }
6380       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6381       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6382     }
6383 
6384     if (pcbddc->dbg_flag) {
6385       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6386       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6387     }
6388 
6389 
6390     /* Now we loop on the constraints which need a change of basis */
6391     /*
6392        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6393        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6394 
6395        Basic blocks of change of basis matrix T computed by
6396 
6397           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6398 
6399             | 1        0   ...        0         s_1/S |
6400             | 0        1   ...        0         s_2/S |
6401             |              ...                        |
6402             | 0        ...            1     s_{n-1}/S |
6403             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6404 
6405             with S = \sum_{i=1}^n s_i^2
6406             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6407                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6408 
6409           - QR decomposition of constraints otherwise
6410     */
6411     if (qr_needed) {
6412       /* space to store Q */
6413       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6414       /* array to store scaling factors for reflectors */
6415       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6416       /* first we issue queries for optimal work */
6417       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6418       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6419       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6420       lqr_work = -1;
6421       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6422       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6423       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6424       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6425       lgqr_work = -1;
6426       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6427       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6428       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6429       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6430       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6431       PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6432       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to ORGQR/UNGQR Lapack routine %d",(int)lierr);
6433       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6434       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6435       /* array to store rhs and solution of triangular solver */
6436       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6437       /* allocating workspace for check */
6438       if (pcbddc->dbg_flag) {
6439         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6440       }
6441     }
6442     /* array to store whether a node is primal or not */
6443     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6444     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6445     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6446     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);
6447     for (i=0;i<total_primal_vertices;i++) {
6448       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6449     }
6450     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6451 
6452     /* loop on constraints and see whether or not they need a change of basis and compute it */
6453     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6454       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6455       if (PetscBTLookup(change_basis,total_counts)) {
6456         /* get constraint info */
6457         primal_dofs = constraints_n[total_counts];
6458         dual_dofs = size_of_constraint-primal_dofs;
6459 
6460         if (pcbddc->dbg_flag) {
6461           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);
6462         }
6463 
6464         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6465 
6466           /* copy quadrature constraints for change of basis check */
6467           if (pcbddc->dbg_flag) {
6468             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6469           }
6470           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6471           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6472 
6473           /* compute QR decomposition of constraints */
6474           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6475           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6476           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6477           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6478           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6479           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6480           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6481 
6482           /* explictly compute R^-T */
6483           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
6484           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6485           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6486           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6487           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6488           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6489           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6490           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6491           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6492           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6493 
6494           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6495           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6496           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6497           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6498           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6499           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6500           PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6501           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in ORGQR/UNGQR Lapack routine %d",(int)lierr);
6502           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6503 
6504           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6505              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6506              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6507           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6508           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6509           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6510           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6511           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6512           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6513           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6514           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));
6515           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6516           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6517 
6518           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6519           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6520           /* insert cols for primal dofs */
6521           for (j=0;j<primal_dofs;j++) {
6522             start_vals = &qr_basis[j*size_of_constraint];
6523             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6524             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6525           }
6526           /* insert cols for dual dofs */
6527           for (j=0,k=0;j<dual_dofs;k++) {
6528             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6529               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6530               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6531               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6532               j++;
6533             }
6534           }
6535 
6536           /* check change of basis */
6537           if (pcbddc->dbg_flag) {
6538             PetscInt   ii,jj;
6539             PetscBool valid_qr=PETSC_TRUE;
6540             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6541             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6542             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6543             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6544             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6545             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6546             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6547             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));
6548             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6549             for (jj=0;jj<size_of_constraint;jj++) {
6550               for (ii=0;ii<primal_dofs;ii++) {
6551                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6552                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) valid_qr = PETSC_FALSE;
6553               }
6554             }
6555             if (!valid_qr) {
6556               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6557               for (jj=0;jj<size_of_constraint;jj++) {
6558                 for (ii=0;ii<primal_dofs;ii++) {
6559                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6560                     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]));
6561                   }
6562                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) {
6563                     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]));
6564                   }
6565                 }
6566               }
6567             } else {
6568               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6569             }
6570           }
6571         } else { /* simple transformation block */
6572           PetscInt    row,col;
6573           PetscScalar val,norm;
6574 
6575           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6576           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6577           for (j=0;j<size_of_constraint;j++) {
6578             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6579             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6580             if (!PetscBTLookup(is_primal,row_B)) {
6581               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6582               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6583               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6584             } else {
6585               for (k=0;k<size_of_constraint;k++) {
6586                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6587                 if (row != col) {
6588                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6589                 } else {
6590                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6591                 }
6592                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6593               }
6594             }
6595           }
6596           if (pcbddc->dbg_flag) {
6597             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6598           }
6599         }
6600       } else {
6601         if (pcbddc->dbg_flag) {
6602           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d does not need a change of basis (size %d)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6603         }
6604       }
6605     }
6606 
6607     /* free workspace */
6608     if (qr_needed) {
6609       if (pcbddc->dbg_flag) {
6610         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6611       }
6612       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6613       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6614       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6615       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6616       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6617     }
6618     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6619     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6620     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6621 
6622     /* assembling of global change of variable */
6623     if (!pcbddc->fake_change) {
6624       Mat      tmat;
6625       PetscInt bs;
6626 
6627       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6628       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6629       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6630       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6631       ierr = MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6632       ierr = MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6633       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6634       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6635       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6636       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6637       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6638       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6639       ierr = MatConvert(tmat,MATAIJ,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6640       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6641       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6642       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6643       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6644       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6645       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6646       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6647 
6648       /* check */
6649       if (pcbddc->dbg_flag) {
6650         PetscReal error;
6651         Vec       x,x_change;
6652 
6653         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6654         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6655         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6656         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6657         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6658         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6659         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6660         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6661         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6662         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6663         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6664         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6665         if (error > PETSC_SMALL) {
6666           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
6667         }
6668         ierr = VecDestroy(&x);CHKERRQ(ierr);
6669         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6670       }
6671       /* adapt sub_schurs computed (if any) */
6672       if (pcbddc->use_deluxe_scaling) {
6673         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6674 
6675         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");
6676         if (sub_schurs && sub_schurs->S_Ej_all) {
6677           Mat                    S_new,tmat;
6678           IS                     is_all_N,is_V_Sall = NULL;
6679 
6680           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6681           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6682           if (pcbddc->deluxe_zerorows) {
6683             ISLocalToGlobalMapping NtoSall;
6684             IS                     is_V;
6685             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6686             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6687             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6688             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6689             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6690           }
6691           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6692           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6693           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6694           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6695           if (pcbddc->deluxe_zerorows) {
6696             const PetscScalar *array;
6697             const PetscInt    *idxs_V,*idxs_all;
6698             PetscInt          i,n_V;
6699 
6700             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6701             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6702             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6703             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6704             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6705             for (i=0;i<n_V;i++) {
6706               PetscScalar val;
6707               PetscInt    idx;
6708 
6709               idx = idxs_V[i];
6710               val = array[idxs_all[idxs_V[i]]];
6711               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6712             }
6713             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6714             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6715             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6716             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6717             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6718           }
6719           sub_schurs->S_Ej_all = S_new;
6720           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6721           if (sub_schurs->sum_S_Ej_all) {
6722             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6723             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6724             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6725             if (pcbddc->deluxe_zerorows) {
6726               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6727             }
6728             sub_schurs->sum_S_Ej_all = S_new;
6729             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6730           }
6731           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6732           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6733         }
6734         /* destroy any change of basis context in sub_schurs */
6735         if (sub_schurs && sub_schurs->change) {
6736           PetscInt i;
6737 
6738           for (i=0;i<sub_schurs->n_subs;i++) {
6739             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6740           }
6741           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6742         }
6743       }
6744       if (pcbddc->switch_static) { /* need to save the local change */
6745         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6746       } else {
6747         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6748       }
6749       /* determine if any process has changed the pressures locally */
6750       pcbddc->change_interior = pcbddc->benign_have_null;
6751     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6752       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6753       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6754       pcbddc->use_qr_single = qr_needed;
6755     }
6756   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6757     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6758       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6759       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6760     } else {
6761       Mat benign_global = NULL;
6762       if (pcbddc->benign_have_null) {
6763         Mat M;
6764 
6765         pcbddc->change_interior = PETSC_TRUE;
6766         ierr = VecCopy(matis->counter,pcis->vec1_N);CHKERRQ(ierr);
6767         ierr = VecReciprocal(pcis->vec1_N);CHKERRQ(ierr);
6768         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&benign_global);CHKERRQ(ierr);
6769         if (pcbddc->benign_change) {
6770           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6771           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6772         } else {
6773           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&M);CHKERRQ(ierr);
6774           ierr = MatDiagonalSet(M,pcis->vec1_N,INSERT_VALUES);CHKERRQ(ierr);
6775         }
6776         ierr = MatISSetLocalMat(benign_global,M);CHKERRQ(ierr);
6777         ierr = MatDestroy(&M);CHKERRQ(ierr);
6778         ierr = MatAssemblyBegin(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6779         ierr = MatAssemblyEnd(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6780       }
6781       if (pcbddc->user_ChangeOfBasisMatrix) {
6782         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6783         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6784       } else if (pcbddc->benign_have_null) {
6785         pcbddc->ChangeOfBasisMatrix = benign_global;
6786       }
6787     }
6788     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6789       IS             is_global;
6790       const PetscInt *gidxs;
6791 
6792       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6793       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6794       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6795       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6796       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6797     }
6798   }
6799   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6800     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6801   }
6802 
6803   if (!pcbddc->fake_change) {
6804     /* add pressure dofs to set of primal nodes for numbering purposes */
6805     for (i=0;i<pcbddc->benign_n;i++) {
6806       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
6807       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
6808       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
6809       pcbddc->local_primal_size_cc++;
6810       pcbddc->local_primal_size++;
6811     }
6812 
6813     /* check if a new primal space has been introduced (also take into account benign trick) */
6814     pcbddc->new_primal_space_local = PETSC_TRUE;
6815     if (olocal_primal_size == pcbddc->local_primal_size) {
6816       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6817       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6818       if (!pcbddc->new_primal_space_local) {
6819         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6820         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6821       }
6822     }
6823     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
6824     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6825   }
6826   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
6827 
6828   /* flush dbg viewer */
6829   if (pcbddc->dbg_flag) {
6830     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6831   }
6832 
6833   /* free workspace */
6834   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
6835   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
6836   if (!pcbddc->adaptive_selection) {
6837     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
6838     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
6839   } else {
6840     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
6841                       pcbddc->adaptive_constraints_idxs_ptr,
6842                       pcbddc->adaptive_constraints_data_ptr,
6843                       pcbddc->adaptive_constraints_idxs,
6844                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
6845     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
6846     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
6847   }
6848   PetscFunctionReturn(0);
6849 }
6850 /* #undef PETSC_MISSING_LAPACK_GESVD */
6851 
6852 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
6853 {
6854   ISLocalToGlobalMapping map;
6855   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
6856   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
6857   PetscInt               i,N;
6858   PetscBool              rcsr = PETSC_FALSE;
6859   PetscErrorCode         ierr;
6860 
6861   PetscFunctionBegin;
6862   if (pcbddc->recompute_topography) {
6863     pcbddc->graphanalyzed = PETSC_FALSE;
6864     /* Reset previously computed graph */
6865     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
6866     /* Init local Graph struct */
6867     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
6868     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
6869     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
6870 
6871     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
6872       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6873     }
6874     /* Check validity of the csr graph passed in by the user */
6875     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);
6876 
6877     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
6878     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
6879       PetscInt  *xadj,*adjncy;
6880       PetscInt  nvtxs;
6881       PetscBool flg_row=PETSC_FALSE;
6882 
6883       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6884       if (flg_row) {
6885         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
6886         pcbddc->computed_rowadj = PETSC_TRUE;
6887       }
6888       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6889       rcsr = PETSC_TRUE;
6890     }
6891     if (pcbddc->dbg_flag) {
6892       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6893     }
6894 
6895     if (pcbddc->mat_graph->cdim && !pcbddc->mat_graph->cloc) {
6896       PetscReal    *lcoords;
6897       PetscInt     n;
6898       MPI_Datatype dimrealtype;
6899 
6900       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);
6901       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
6902       ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
6903       ierr = PetscMalloc1(pcbddc->mat_graph->cdim*n,&lcoords);CHKERRQ(ierr);
6904       ierr = MPI_Type_contiguous(pcbddc->mat_graph->cdim,MPIU_REAL,&dimrealtype);CHKERRQ(ierr);
6905       ierr = MPI_Type_commit(&dimrealtype);CHKERRQ(ierr);
6906       ierr = PetscSFBcastBegin(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
6907       ierr = PetscSFBcastEnd(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
6908       ierr = MPI_Type_free(&dimrealtype);CHKERRQ(ierr);
6909       ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
6910 
6911       pcbddc->mat_graph->coords = lcoords;
6912       pcbddc->mat_graph->cloc   = PETSC_TRUE;
6913       pcbddc->mat_graph->cnloc  = n;
6914     }
6915     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);
6916     pcbddc->mat_graph->active_coords = (PetscBool)(pcbddc->corner_selection && !pcbddc->corner_selected);
6917 
6918     /* Setup of Graph */
6919     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
6920     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6921 
6922     /* attach info on disconnected subdomains if present */
6923     if (pcbddc->n_local_subs) {
6924       PetscInt *local_subs;
6925 
6926       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
6927       for (i=0;i<pcbddc->n_local_subs;i++) {
6928         const PetscInt *idxs;
6929         PetscInt       nl,j;
6930 
6931         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
6932         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6933         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
6934         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6935       }
6936       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
6937       pcbddc->mat_graph->local_subs = local_subs;
6938     }
6939   }
6940 
6941   if (!pcbddc->graphanalyzed) {
6942     /* Graph's connected components analysis */
6943     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
6944     pcbddc->graphanalyzed = PETSC_TRUE;
6945   }
6946   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
6947   PetscFunctionReturn(0);
6948 }
6949 
6950 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
6951 {
6952   PetscInt       i,j;
6953   PetscScalar    *alphas;
6954   PetscErrorCode ierr;
6955 
6956   PetscFunctionBegin;
6957   if (!n) PetscFunctionReturn(0);
6958   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
6959   ierr = VecNormalize(vecs[0],NULL);CHKERRQ(ierr);
6960   for (i=1;i<n;i++) {
6961     ierr = VecMDot(vecs[i],i,vecs,alphas);CHKERRQ(ierr);
6962     for (j=0;j<i;j++) alphas[j] = PetscConj(-alphas[j]);
6963     ierr = VecMAXPY(vecs[i],i,alphas,vecs);CHKERRQ(ierr);
6964     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
6965   }
6966   ierr = PetscFree(alphas);CHKERRQ(ierr);
6967   PetscFunctionReturn(0);
6968 }
6969 
6970 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
6971 {
6972   Mat            A;
6973   PetscInt       n_neighs,*neighs,*n_shared,**shared;
6974   PetscMPIInt    size,rank,color;
6975   PetscInt       *xadj,*adjncy;
6976   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
6977   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
6978   PetscInt       void_procs,*procs_candidates = NULL;
6979   PetscInt       xadj_count,*count;
6980   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
6981   PetscSubcomm   psubcomm;
6982   MPI_Comm       subcomm;
6983   PetscErrorCode ierr;
6984 
6985   PetscFunctionBegin;
6986   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6987   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6988   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);
6989   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
6990   PetscValidLogicalCollectiveInt(mat,redprocs,3);
6991   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %d\n",*n_subdomains);
6992 
6993   if (have_void) *have_void = PETSC_FALSE;
6994   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
6995   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
6996   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
6997   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
6998   im_active = !!n;
6999   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7000   void_procs = size - active_procs;
7001   /* get ranks of of non-active processes in mat communicator */
7002   if (void_procs) {
7003     PetscInt ncand;
7004 
7005     if (have_void) *have_void = PETSC_TRUE;
7006     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
7007     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7008     for (i=0,ncand=0;i<size;i++) {
7009       if (!procs_candidates[i]) {
7010         procs_candidates[ncand++] = i;
7011       }
7012     }
7013     /* force n_subdomains to be not greater that the number of non-active processes */
7014     *n_subdomains = PetscMin(void_procs,*n_subdomains);
7015   }
7016 
7017   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
7018      number of subdomains requested 1 -> send to master or first candidate in voids  */
7019   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
7020   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
7021     PetscInt issize,isidx,dest;
7022     if (*n_subdomains == 1) dest = 0;
7023     else dest = rank;
7024     if (im_active) {
7025       issize = 1;
7026       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7027         isidx = procs_candidates[dest];
7028       } else {
7029         isidx = dest;
7030       }
7031     } else {
7032       issize = 0;
7033       isidx = -1;
7034     }
7035     if (*n_subdomains != 1) *n_subdomains = active_procs;
7036     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
7037     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7038     PetscFunctionReturn(0);
7039   }
7040   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
7041   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
7042   threshold = PetscMax(threshold,2);
7043 
7044   /* Get info on mapping */
7045   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7046 
7047   /* build local CSR graph of subdomains' connectivity */
7048   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
7049   xadj[0] = 0;
7050   xadj[1] = PetscMax(n_neighs-1,0);
7051   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
7052   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
7053   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
7054   for (i=1;i<n_neighs;i++)
7055     for (j=0;j<n_shared[i];j++)
7056       count[shared[i][j]] += 1;
7057 
7058   xadj_count = 0;
7059   for (i=1;i<n_neighs;i++) {
7060     for (j=0;j<n_shared[i];j++) {
7061       if (count[shared[i][j]] < threshold) {
7062         adjncy[xadj_count] = neighs[i];
7063         adjncy_wgt[xadj_count] = n_shared[i];
7064         xadj_count++;
7065         break;
7066       }
7067     }
7068   }
7069   xadj[1] = xadj_count;
7070   ierr = PetscFree(count);CHKERRQ(ierr);
7071   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7072   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7073 
7074   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
7075 
7076   /* Restrict work on active processes only */
7077   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
7078   if (void_procs) {
7079     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
7080     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
7081     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
7082     subcomm = PetscSubcommChild(psubcomm);
7083   } else {
7084     psubcomm = NULL;
7085     subcomm = PetscObjectComm((PetscObject)mat);
7086   }
7087 
7088   v_wgt = NULL;
7089   if (!color) {
7090     ierr = PetscFree(xadj);CHKERRQ(ierr);
7091     ierr = PetscFree(adjncy);CHKERRQ(ierr);
7092     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7093   } else {
7094     Mat             subdomain_adj;
7095     IS              new_ranks,new_ranks_contig;
7096     MatPartitioning partitioner;
7097     PetscInt        rstart=0,rend=0;
7098     PetscInt        *is_indices,*oldranks;
7099     PetscMPIInt     size;
7100     PetscBool       aggregate;
7101 
7102     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
7103     if (void_procs) {
7104       PetscInt prank = rank;
7105       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
7106       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
7107       for (i=0;i<xadj[1];i++) {
7108         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
7109       }
7110       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7111     } else {
7112       oldranks = NULL;
7113     }
7114     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
7115     if (aggregate) { /* TODO: all this part could be made more efficient */
7116       PetscInt    lrows,row,ncols,*cols;
7117       PetscMPIInt nrank;
7118       PetscScalar *vals;
7119 
7120       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
7121       lrows = 0;
7122       if (nrank<redprocs) {
7123         lrows = size/redprocs;
7124         if (nrank<size%redprocs) lrows++;
7125       }
7126       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
7127       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
7128       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7129       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7130       row = nrank;
7131       ncols = xadj[1]-xadj[0];
7132       cols = adjncy;
7133       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
7134       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
7135       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
7136       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7137       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7138       ierr = PetscFree(xadj);CHKERRQ(ierr);
7139       ierr = PetscFree(adjncy);CHKERRQ(ierr);
7140       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7141       ierr = PetscFree(vals);CHKERRQ(ierr);
7142       if (use_vwgt) {
7143         Vec               v;
7144         const PetscScalar *array;
7145         PetscInt          nl;
7146 
7147         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
7148         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
7149         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
7150         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
7151         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
7152         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
7153         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
7154         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
7155         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
7156         ierr = VecDestroy(&v);CHKERRQ(ierr);
7157       }
7158     } else {
7159       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
7160       if (use_vwgt) {
7161         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
7162         v_wgt[0] = n;
7163       }
7164     }
7165     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
7166 
7167     /* Partition */
7168     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
7169     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
7170     if (v_wgt) {
7171       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
7172     }
7173     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
7174     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
7175     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
7176     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
7177     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
7178 
7179     /* renumber new_ranks to avoid "holes" in new set of processors */
7180     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
7181     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
7182     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7183     if (!aggregate) {
7184       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7185 #if defined(PETSC_USE_DEBUG)
7186         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7187 #endif
7188         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
7189       } else if (oldranks) {
7190         ranks_send_to_idx[0] = oldranks[is_indices[0]];
7191       } else {
7192         ranks_send_to_idx[0] = is_indices[0];
7193       }
7194     } else {
7195       PetscInt    idx = 0;
7196       PetscMPIInt tag;
7197       MPI_Request *reqs;
7198 
7199       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
7200       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
7201       for (i=rstart;i<rend;i++) {
7202         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
7203       }
7204       ierr = MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
7205       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7206       ierr = PetscFree(reqs);CHKERRQ(ierr);
7207       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7208 #if defined(PETSC_USE_DEBUG)
7209         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7210 #endif
7211         ranks_send_to_idx[0] = procs_candidates[oldranks[idx]];
7212       } else if (oldranks) {
7213         ranks_send_to_idx[0] = oldranks[idx];
7214       } else {
7215         ranks_send_to_idx[0] = idx;
7216       }
7217     }
7218     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7219     /* clean up */
7220     ierr = PetscFree(oldranks);CHKERRQ(ierr);
7221     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
7222     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
7223     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
7224   }
7225   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
7226   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7227 
7228   /* assemble parallel IS for sends */
7229   i = 1;
7230   if (!color) i=0;
7231   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
7232   PetscFunctionReturn(0);
7233 }
7234 
7235 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
7236 
7237 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[])
7238 {
7239   Mat                    local_mat;
7240   IS                     is_sends_internal;
7241   PetscInt               rows,cols,new_local_rows;
7242   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
7243   PetscBool              ismatis,isdense,newisdense,destroy_mat;
7244   ISLocalToGlobalMapping l2gmap;
7245   PetscInt*              l2gmap_indices;
7246   const PetscInt*        is_indices;
7247   MatType                new_local_type;
7248   /* buffers */
7249   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
7250   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
7251   PetscInt               *recv_buffer_idxs_local;
7252   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
7253   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
7254   /* MPI */
7255   MPI_Comm               comm,comm_n;
7256   PetscSubcomm           subcomm;
7257   PetscMPIInt            n_sends,n_recvs,commsize;
7258   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
7259   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
7260   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
7261   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
7262   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
7263   PetscErrorCode         ierr;
7264 
7265   PetscFunctionBegin;
7266   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7267   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7268   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);
7269   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
7270   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
7271   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
7272   PetscValidLogicalCollectiveBool(mat,reuse,6);
7273   PetscValidLogicalCollectiveInt(mat,nis,8);
7274   PetscValidLogicalCollectiveInt(mat,nvecs,10);
7275   if (nvecs) {
7276     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
7277     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
7278   }
7279   /* further checks */
7280   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7281   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
7282   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
7283   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
7284   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
7285   if (reuse && *mat_n) {
7286     PetscInt mrows,mcols,mnrows,mncols;
7287     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
7288     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
7289     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
7290     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
7291     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
7292     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
7293     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
7294   }
7295   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
7296   PetscValidLogicalCollectiveInt(mat,bs,0);
7297 
7298   /* prepare IS for sending if not provided */
7299   if (!is_sends) {
7300     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
7301     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
7302   } else {
7303     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
7304     is_sends_internal = is_sends;
7305   }
7306 
7307   /* get comm */
7308   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
7309 
7310   /* compute number of sends */
7311   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
7312   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7313 
7314   /* compute number of receives */
7315   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
7316   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
7317   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
7318   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7319   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7320   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7321   ierr = PetscFree(iflags);CHKERRQ(ierr);
7322 
7323   /* restrict comm if requested */
7324   subcomm = 0;
7325   destroy_mat = PETSC_FALSE;
7326   if (restrict_comm) {
7327     PetscMPIInt color,subcommsize;
7328 
7329     color = 0;
7330     if (restrict_full) {
7331       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7332     } else {
7333       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7334     }
7335     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
7336     subcommsize = commsize - subcommsize;
7337     /* check if reuse has been requested */
7338     if (reuse) {
7339       if (*mat_n) {
7340         PetscMPIInt subcommsize2;
7341         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
7342         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7343         comm_n = PetscObjectComm((PetscObject)*mat_n);
7344       } else {
7345         comm_n = PETSC_COMM_SELF;
7346       }
7347     } else { /* MAT_INITIAL_MATRIX */
7348       PetscMPIInt rank;
7349 
7350       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
7351       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7352       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7353       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7354       comm_n = PetscSubcommChild(subcomm);
7355     }
7356     /* flag to destroy *mat_n if not significative */
7357     if (color) destroy_mat = PETSC_TRUE;
7358   } else {
7359     comm_n = comm;
7360   }
7361 
7362   /* prepare send/receive buffers */
7363   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
7364   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
7365   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
7366   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
7367   if (nis) {
7368     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
7369   }
7370 
7371   /* Get data from local matrices */
7372   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7373     /* TODO: See below some guidelines on how to prepare the local buffers */
7374     /*
7375        send_buffer_vals should contain the raw values of the local matrix
7376        send_buffer_idxs should contain:
7377        - MatType_PRIVATE type
7378        - PetscInt        size_of_l2gmap
7379        - PetscInt        global_row_indices[size_of_l2gmap]
7380        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7381     */
7382   else {
7383     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7384     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7385     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7386     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7387     send_buffer_idxs[1] = i;
7388     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7389     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
7390     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7391     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7392     for (i=0;i<n_sends;i++) {
7393       ilengths_vals[is_indices[i]] = len*len;
7394       ilengths_idxs[is_indices[i]] = len+2;
7395     }
7396   }
7397   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7398   /* additional is (if any) */
7399   if (nis) {
7400     PetscMPIInt psum;
7401     PetscInt j;
7402     for (j=0,psum=0;j<nis;j++) {
7403       PetscInt plen;
7404       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7405       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7406       psum += len+1; /* indices + lenght */
7407     }
7408     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7409     for (j=0,psum=0;j<nis;j++) {
7410       PetscInt plen;
7411       const PetscInt *is_array_idxs;
7412       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7413       send_buffer_idxs_is[psum] = plen;
7414       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7415       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
7416       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7417       psum += plen+1; /* indices + lenght */
7418     }
7419     for (i=0;i<n_sends;i++) {
7420       ilengths_idxs_is[is_indices[i]] = psum;
7421     }
7422     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7423   }
7424   ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7425 
7426   buf_size_idxs = 0;
7427   buf_size_vals = 0;
7428   buf_size_idxs_is = 0;
7429   buf_size_vecs = 0;
7430   for (i=0;i<n_recvs;i++) {
7431     buf_size_idxs += (PetscInt)olengths_idxs[i];
7432     buf_size_vals += (PetscInt)olengths_vals[i];
7433     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7434     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7435   }
7436   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7437   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7438   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7439   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7440 
7441   /* get new tags for clean communications */
7442   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7443   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7444   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7445   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7446 
7447   /* allocate for requests */
7448   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7449   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7450   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7451   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7452   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7453   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7454   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7455   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7456 
7457   /* communications */
7458   ptr_idxs = recv_buffer_idxs;
7459   ptr_vals = recv_buffer_vals;
7460   ptr_idxs_is = recv_buffer_idxs_is;
7461   ptr_vecs = recv_buffer_vecs;
7462   for (i=0;i<n_recvs;i++) {
7463     source_dest = onodes[i];
7464     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7465     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7466     ptr_idxs += olengths_idxs[i];
7467     ptr_vals += olengths_vals[i];
7468     if (nis) {
7469       source_dest = onodes_is[i];
7470       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);
7471       ptr_idxs_is += olengths_idxs_is[i];
7472     }
7473     if (nvecs) {
7474       source_dest = onodes[i];
7475       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7476       ptr_vecs += olengths_idxs[i]-2;
7477     }
7478   }
7479   for (i=0;i<n_sends;i++) {
7480     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7481     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7482     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7483     if (nis) {
7484       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);
7485     }
7486     if (nvecs) {
7487       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7488       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7489     }
7490   }
7491   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7492   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7493 
7494   /* assemble new l2g map */
7495   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7496   ptr_idxs = recv_buffer_idxs;
7497   new_local_rows = 0;
7498   for (i=0;i<n_recvs;i++) {
7499     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7500     ptr_idxs += olengths_idxs[i];
7501   }
7502   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7503   ptr_idxs = recv_buffer_idxs;
7504   new_local_rows = 0;
7505   for (i=0;i<n_recvs;i++) {
7506     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
7507     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7508     ptr_idxs += olengths_idxs[i];
7509   }
7510   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7511   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7512   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7513 
7514   /* infer new local matrix type from received local matrices type */
7515   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7516   /* 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) */
7517   if (n_recvs) {
7518     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7519     ptr_idxs = recv_buffer_idxs;
7520     for (i=0;i<n_recvs;i++) {
7521       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7522         new_local_type_private = MATAIJ_PRIVATE;
7523         break;
7524       }
7525       ptr_idxs += olengths_idxs[i];
7526     }
7527     switch (new_local_type_private) {
7528       case MATDENSE_PRIVATE:
7529         new_local_type = MATSEQAIJ;
7530         bs = 1;
7531         break;
7532       case MATAIJ_PRIVATE:
7533         new_local_type = MATSEQAIJ;
7534         bs = 1;
7535         break;
7536       case MATBAIJ_PRIVATE:
7537         new_local_type = MATSEQBAIJ;
7538         break;
7539       case MATSBAIJ_PRIVATE:
7540         new_local_type = MATSEQSBAIJ;
7541         break;
7542       default:
7543         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7544         break;
7545     }
7546   } else { /* by default, new_local_type is seqaij */
7547     new_local_type = MATSEQAIJ;
7548     bs = 1;
7549   }
7550 
7551   /* create MATIS object if needed */
7552   if (!reuse) {
7553     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7554     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7555   } else {
7556     /* it also destroys the local matrices */
7557     if (*mat_n) {
7558       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7559     } else { /* this is a fake object */
7560       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7561     }
7562   }
7563   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7564   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7565 
7566   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7567 
7568   /* Global to local map of received indices */
7569   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7570   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7571   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7572 
7573   /* restore attributes -> type of incoming data and its size */
7574   buf_size_idxs = 0;
7575   for (i=0;i<n_recvs;i++) {
7576     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7577     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7578     buf_size_idxs += (PetscInt)olengths_idxs[i];
7579   }
7580   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7581 
7582   /* set preallocation */
7583   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7584   if (!newisdense) {
7585     PetscInt *new_local_nnz=0;
7586 
7587     ptr_idxs = recv_buffer_idxs_local;
7588     if (n_recvs) {
7589       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7590     }
7591     for (i=0;i<n_recvs;i++) {
7592       PetscInt j;
7593       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7594         for (j=0;j<*(ptr_idxs+1);j++) {
7595           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7596         }
7597       } else {
7598         /* TODO */
7599       }
7600       ptr_idxs += olengths_idxs[i];
7601     }
7602     if (new_local_nnz) {
7603       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7604       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7605       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7606       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7607       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7608       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7609     } else {
7610       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7611     }
7612     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7613   } else {
7614     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7615   }
7616 
7617   /* set values */
7618   ptr_vals = recv_buffer_vals;
7619   ptr_idxs = recv_buffer_idxs_local;
7620   for (i=0;i<n_recvs;i++) {
7621     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7622       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7623       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7624       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7625       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7626       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7627     } else {
7628       /* TODO */
7629     }
7630     ptr_idxs += olengths_idxs[i];
7631     ptr_vals += olengths_vals[i];
7632   }
7633   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7634   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7635   ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7636   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7637   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7638   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7639 
7640 #if 0
7641   if (!restrict_comm) { /* check */
7642     Vec       lvec,rvec;
7643     PetscReal infty_error;
7644 
7645     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7646     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7647     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7648     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7649     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7650     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7651     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7652     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7653     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7654   }
7655 #endif
7656 
7657   /* assemble new additional is (if any) */
7658   if (nis) {
7659     PetscInt **temp_idxs,*count_is,j,psum;
7660 
7661     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7662     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7663     ptr_idxs = recv_buffer_idxs_is;
7664     psum = 0;
7665     for (i=0;i<n_recvs;i++) {
7666       for (j=0;j<nis;j++) {
7667         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7668         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7669         psum += plen;
7670         ptr_idxs += plen+1; /* shift pointer to received data */
7671       }
7672     }
7673     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7674     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7675     for (i=1;i<nis;i++) {
7676       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7677     }
7678     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7679     ptr_idxs = recv_buffer_idxs_is;
7680     for (i=0;i<n_recvs;i++) {
7681       for (j=0;j<nis;j++) {
7682         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7683         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7684         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7685         ptr_idxs += plen+1; /* shift pointer to received data */
7686       }
7687     }
7688     for (i=0;i<nis;i++) {
7689       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7690       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7691       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7692     }
7693     ierr = PetscFree(count_is);CHKERRQ(ierr);
7694     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7695     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7696   }
7697   /* free workspace */
7698   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7699   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7700   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7701   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7702   if (isdense) {
7703     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7704     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7705     ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7706   } else {
7707     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7708   }
7709   if (nis) {
7710     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7711     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7712   }
7713 
7714   if (nvecs) {
7715     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7716     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7717     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7718     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7719     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7720     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7721     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7722     /* set values */
7723     ptr_vals = recv_buffer_vecs;
7724     ptr_idxs = recv_buffer_idxs_local;
7725     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7726     for (i=0;i<n_recvs;i++) {
7727       PetscInt j;
7728       for (j=0;j<*(ptr_idxs+1);j++) {
7729         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7730       }
7731       ptr_idxs += olengths_idxs[i];
7732       ptr_vals += olengths_idxs[i]-2;
7733     }
7734     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7735     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7736     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7737   }
7738 
7739   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7740   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7741   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7742   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7743   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7744   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7745   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7746   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7747   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7748   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7749   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7750   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7751   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7752   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7753   ierr = PetscFree(onodes);CHKERRQ(ierr);
7754   if (nis) {
7755     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7756     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7757     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7758   }
7759   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7760   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7761     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7762     for (i=0;i<nis;i++) {
7763       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7764     }
7765     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7766       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7767     }
7768     *mat_n = NULL;
7769   }
7770   PetscFunctionReturn(0);
7771 }
7772 
7773 /* temporary hack into ksp private data structure */
7774 #include <petsc/private/kspimpl.h>
7775 
7776 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7777 {
7778   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7779   PC_IS                  *pcis = (PC_IS*)pc->data;
7780   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7781   Mat                    coarsedivudotp = NULL;
7782   Mat                    coarseG,t_coarse_mat_is;
7783   MatNullSpace           CoarseNullSpace = NULL;
7784   ISLocalToGlobalMapping coarse_islg;
7785   IS                     coarse_is,*isarray;
7786   PetscInt               i,im_active=-1,active_procs=-1;
7787   PetscInt               nis,nisdofs,nisneu,nisvert;
7788   PC                     pc_temp;
7789   PCType                 coarse_pc_type;
7790   KSPType                coarse_ksp_type;
7791   PetscBool              multilevel_requested,multilevel_allowed;
7792   PetscBool              coarse_reuse;
7793   PetscInt               ncoarse,nedcfield;
7794   PetscBool              compute_vecs = PETSC_FALSE;
7795   PetscScalar            *array;
7796   MatReuse               coarse_mat_reuse;
7797   PetscBool              restr, full_restr, have_void;
7798   PetscMPIInt            commsize;
7799   PetscErrorCode         ierr;
7800 
7801   PetscFunctionBegin;
7802   ierr = PetscLogEventBegin(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
7803   /* Assign global numbering to coarse dofs */
7804   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 */
7805     PetscInt ocoarse_size;
7806     compute_vecs = PETSC_TRUE;
7807 
7808     pcbddc->new_primal_space = PETSC_TRUE;
7809     ocoarse_size = pcbddc->coarse_size;
7810     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
7811     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
7812     /* see if we can avoid some work */
7813     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
7814       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
7815       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
7816         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
7817         coarse_reuse = PETSC_FALSE;
7818       } else { /* we can safely reuse already computed coarse matrix */
7819         coarse_reuse = PETSC_TRUE;
7820       }
7821     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
7822       coarse_reuse = PETSC_FALSE;
7823     }
7824     /* reset any subassembling information */
7825     if (!coarse_reuse || pcbddc->recompute_topography) {
7826       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7827     }
7828   } else { /* primal space is unchanged, so we can reuse coarse matrix */
7829     coarse_reuse = PETSC_TRUE;
7830   }
7831   /* assemble coarse matrix */
7832   if (coarse_reuse && pcbddc->coarse_ksp) {
7833     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
7834     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
7835     coarse_mat_reuse = MAT_REUSE_MATRIX;
7836   } else {
7837     coarse_mat = NULL;
7838     coarse_mat_reuse = MAT_INITIAL_MATRIX;
7839   }
7840 
7841   /* creates temporary l2gmap and IS for coarse indexes */
7842   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
7843   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
7844 
7845   /* creates temporary MATIS object for coarse matrix */
7846   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
7847   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7848   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
7849   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7850   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);
7851   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
7852   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7853   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7854   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
7855 
7856   /* count "active" (i.e. with positive local size) and "void" processes */
7857   im_active = !!(pcis->n);
7858   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7859 
7860   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
7861   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
7862   /* full_restr : just use the receivers from the subassembling pattern */
7863   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&commsize);CHKERRQ(ierr);
7864   coarse_mat_is = NULL;
7865   multilevel_allowed = PETSC_FALSE;
7866   multilevel_requested = PETSC_FALSE;
7867   pcbddc->coarse_eqs_per_proc = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
7868   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
7869   if (multilevel_requested) {
7870     ncoarse = active_procs/pcbddc->coarsening_ratio;
7871     restr = PETSC_FALSE;
7872     full_restr = PETSC_FALSE;
7873   } else {
7874     ncoarse = pcbddc->coarse_size/pcbddc->coarse_eqs_per_proc;
7875     restr = PETSC_TRUE;
7876     full_restr = PETSC_TRUE;
7877   }
7878   if (!pcbddc->coarse_size || commsize == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
7879   ncoarse = PetscMax(1,ncoarse);
7880   if (!pcbddc->coarse_subassembling) {
7881     if (pcbddc->coarsening_ratio > 1) {
7882       if (multilevel_requested) {
7883         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7884       } else {
7885         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7886       }
7887     } else {
7888       PetscMPIInt rank;
7889       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
7890       have_void = (active_procs == (PetscInt)commsize) ? PETSC_FALSE : PETSC_TRUE;
7891       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7892     }
7893   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
7894     PetscInt    psum;
7895     if (pcbddc->coarse_ksp) psum = 1;
7896     else psum = 0;
7897     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7898     if (ncoarse < commsize) have_void = PETSC_TRUE;
7899   }
7900   /* determine if we can go multilevel */
7901   if (multilevel_requested) {
7902     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
7903     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
7904   }
7905   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
7906 
7907   /* dump subassembling pattern */
7908   if (pcbddc->dbg_flag && multilevel_allowed) {
7909     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
7910   }
7911 
7912   /* compute dofs splitting and neumann boundaries for coarse dofs */
7913   nedcfield = -1;
7914   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal)) { /* protects from unneded computations */
7915     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
7916     const PetscInt         *idxs;
7917     ISLocalToGlobalMapping tmap;
7918 
7919     /* create map between primal indices (in local representative ordering) and local primal numbering */
7920     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
7921     /* allocate space for temporary storage */
7922     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
7923     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
7924     /* allocate for IS array */
7925     nisdofs = pcbddc->n_ISForDofsLocal;
7926     if (pcbddc->nedclocal) {
7927       if (pcbddc->nedfield > -1) {
7928         nedcfield = pcbddc->nedfield;
7929       } else {
7930         nedcfield = 0;
7931         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%d)",nisdofs);
7932         nisdofs = 1;
7933       }
7934     }
7935     nisneu = !!pcbddc->NeumannBoundariesLocal;
7936     nisvert = 0; /* nisvert is not used */
7937     nis = nisdofs + nisneu + nisvert;
7938     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
7939     /* dofs splitting */
7940     for (i=0;i<nisdofs;i++) {
7941       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
7942       if (nedcfield != i) {
7943         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
7944         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7945         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7946         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7947       } else {
7948         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
7949         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7950         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7951         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %d != %d\n",tsize,nout);
7952         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7953       }
7954       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7955       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7956       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
7957     }
7958     /* neumann boundaries */
7959     if (pcbddc->NeumannBoundariesLocal) {
7960       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
7961       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
7962       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7963       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7964       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7965       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7966       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
7967       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
7968     }
7969     /* free memory */
7970     ierr = PetscFree(tidxs);CHKERRQ(ierr);
7971     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
7972     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
7973   } else {
7974     nis = 0;
7975     nisdofs = 0;
7976     nisneu = 0;
7977     nisvert = 0;
7978     isarray = NULL;
7979   }
7980   /* destroy no longer needed map */
7981   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
7982 
7983   /* subassemble */
7984   if (multilevel_allowed) {
7985     Vec       vp[1];
7986     PetscInt  nvecs = 0;
7987     PetscBool reuse,reuser;
7988 
7989     if (coarse_mat) reuse = PETSC_TRUE;
7990     else reuse = PETSC_FALSE;
7991     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7992     vp[0] = NULL;
7993     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
7994       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
7995       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
7996       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
7997       nvecs = 1;
7998 
7999       if (pcbddc->divudotp) {
8000         Mat      B,loc_divudotp;
8001         Vec      v,p;
8002         IS       dummy;
8003         PetscInt np;
8004 
8005         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
8006         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
8007         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
8008         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
8009         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
8010         ierr = VecSet(p,1.);CHKERRQ(ierr);
8011         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
8012         ierr = VecDestroy(&p);CHKERRQ(ierr);
8013         ierr = MatDestroy(&B);CHKERRQ(ierr);
8014         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
8015         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
8016         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
8017         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
8018         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
8019         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8020         ierr = VecDestroy(&v);CHKERRQ(ierr);
8021       }
8022     }
8023     if (reuser) {
8024       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8025     } else {
8026       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8027     }
8028     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
8029       PetscScalar *arraym,*arrayv;
8030       PetscInt    nl;
8031       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
8032       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
8033       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8034       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
8035       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
8036       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
8037       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8038       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
8039     } else {
8040       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
8041     }
8042   } else {
8043     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
8044   }
8045   if (coarse_mat_is || coarse_mat) {
8046     PetscMPIInt size;
8047     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)coarse_mat_is),&size);CHKERRQ(ierr);
8048     if (!multilevel_allowed) {
8049       ierr = MatConvert(coarse_mat_is,MATAIJ,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
8050     } else {
8051       Mat A;
8052 
8053       /* if this matrix is present, it means we are not reusing the coarse matrix */
8054       if (coarse_mat_is) {
8055         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
8056         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
8057         coarse_mat = coarse_mat_is;
8058       }
8059       /* be sure we don't have MatSeqDENSE as local mat */
8060       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
8061       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
8062     }
8063   }
8064   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
8065   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
8066 
8067   /* create local to global scatters for coarse problem */
8068   if (compute_vecs) {
8069     PetscInt lrows;
8070     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
8071     if (coarse_mat) {
8072       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
8073     } else {
8074       lrows = 0;
8075     }
8076     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
8077     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
8078     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
8079     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8080     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8081   }
8082   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
8083 
8084   /* set defaults for coarse KSP and PC */
8085   if (multilevel_allowed) {
8086     coarse_ksp_type = KSPRICHARDSON;
8087     coarse_pc_type = PCBDDC;
8088   } else {
8089     coarse_ksp_type = KSPPREONLY;
8090     coarse_pc_type = PCREDUNDANT;
8091   }
8092 
8093   /* print some info if requested */
8094   if (pcbddc->dbg_flag) {
8095     if (!multilevel_allowed) {
8096       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8097       if (multilevel_requested) {
8098         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);
8099       } else if (pcbddc->max_levels) {
8100         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
8101       }
8102       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8103     }
8104   }
8105 
8106   /* communicate coarse discrete gradient */
8107   coarseG = NULL;
8108   if (pcbddc->nedcG && multilevel_allowed) {
8109     MPI_Comm ccomm;
8110     if (coarse_mat) {
8111       ccomm = PetscObjectComm((PetscObject)coarse_mat);
8112     } else {
8113       ccomm = MPI_COMM_NULL;
8114     }
8115     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
8116   }
8117 
8118   /* create the coarse KSP object only once with defaults */
8119   if (coarse_mat) {
8120     PetscBool   isredundant,isnn,isbddc;
8121     PetscViewer dbg_viewer = NULL;
8122 
8123     if (pcbddc->dbg_flag) {
8124       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
8125       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8126     }
8127     if (!pcbddc->coarse_ksp) {
8128       char   prefix[256],str_level[16];
8129       size_t len;
8130 
8131       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
8132       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8133       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
8134       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
8135       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8136       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
8137       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
8138       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8139       /* TODO is this logic correct? should check for coarse_mat type */
8140       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8141       /* prefix */
8142       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
8143       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
8144       if (!pcbddc->current_level) {
8145         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,sizeof(prefix));CHKERRQ(ierr);
8146         ierr = PetscStrlcat(prefix,"pc_bddc_coarse_",sizeof(prefix));CHKERRQ(ierr);
8147       } else {
8148         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
8149         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
8150         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
8151         /* Nonstandard use of PetscStrncpy() to copy only a portion of the string */
8152         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
8153         ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
8154         ierr = PetscStrlcat(prefix,str_level,sizeof(prefix));CHKERRQ(ierr);
8155       }
8156       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
8157       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8158       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8159       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8160       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8161       /* allow user customization */
8162       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
8163     }
8164     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8165     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8166     if (nisdofs) {
8167       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
8168       for (i=0;i<nisdofs;i++) {
8169         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8170       }
8171     }
8172     if (nisneu) {
8173       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
8174       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
8175     }
8176     if (nisvert) {
8177       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
8178       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
8179     }
8180     if (coarseG) {
8181       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
8182     }
8183 
8184     /* get some info after set from options */
8185     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8186     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
8187     if (isbddc && !multilevel_allowed) {
8188       ierr   = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8189       isbddc = PETSC_FALSE;
8190     }
8191     /* multilevel cannot be done with coarse PCs different from BDDC or NN */
8192     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
8193     if (multilevel_requested && multilevel_allowed && !isbddc && !isnn) {
8194       ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8195       isbddc = PETSC_TRUE;
8196     }
8197     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
8198     if (isredundant) {
8199       KSP inner_ksp;
8200       PC  inner_pc;
8201 
8202       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
8203       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
8204     }
8205 
8206     /* parameters which miss an API */
8207     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8208     if (isbddc) {
8209       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
8210 
8211       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
8212       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
8213       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
8214       if (pcbddc_coarse->benign_saddle_point) {
8215         Mat                    coarsedivudotp_is;
8216         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
8217         IS                     row,col;
8218         const PetscInt         *gidxs;
8219         PetscInt               n,st,M,N;
8220 
8221         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
8222         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
8223         st   = st-n;
8224         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
8225         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
8226         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
8227         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8228         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
8229         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8230         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
8231         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
8232         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
8233         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
8234         ierr = ISDestroy(&row);CHKERRQ(ierr);
8235         ierr = ISDestroy(&col);CHKERRQ(ierr);
8236         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
8237         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
8238         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
8239         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
8240         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
8241         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
8242         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
8243         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8244         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
8245         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
8246         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
8247         if (pcbddc->adaptive_threshold[0] == 0.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
8248       }
8249     }
8250 
8251     /* propagate symmetry info of coarse matrix */
8252     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
8253     if (pc->pmat->symmetric_set) {
8254       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
8255     }
8256     if (pc->pmat->hermitian_set) {
8257       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
8258     }
8259     if (pc->pmat->spd_set) {
8260       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
8261     }
8262     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
8263       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
8264     }
8265     /* set operators */
8266     ierr = MatViewFromOptions(coarse_mat,(PetscObject)pc,"-pc_bddc_coarse_mat_view");CHKERRQ(ierr);
8267     ierr = MatSetOptionsPrefix(coarse_mat,((PetscObject)pcbddc->coarse_ksp)->prefix);CHKERRQ(ierr);
8268     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8269     if (pcbddc->dbg_flag) {
8270       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8271     }
8272   }
8273   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
8274   ierr = PetscFree(isarray);CHKERRQ(ierr);
8275 #if 0
8276   {
8277     PetscViewer viewer;
8278     char filename[256];
8279     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
8280     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
8281     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
8282     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
8283     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
8284     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
8285   }
8286 #endif
8287 
8288   if (pcbddc->coarse_ksp) {
8289     Vec crhs,csol;
8290 
8291     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
8292     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
8293     if (!csol) {
8294       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
8295     }
8296     if (!crhs) {
8297       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
8298     }
8299   }
8300   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8301 
8302   /* compute null space for coarse solver if the benign trick has been requested */
8303   if (pcbddc->benign_null) {
8304 
8305     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
8306     for (i=0;i<pcbddc->benign_n;i++) {
8307       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
8308     }
8309     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
8310     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
8311     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8312     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8313     if (coarse_mat) {
8314       Vec         nullv;
8315       PetscScalar *array,*array2;
8316       PetscInt    nl;
8317 
8318       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
8319       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
8320       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8321       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
8322       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
8323       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
8324       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8325       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
8326       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
8327       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
8328     }
8329   }
8330   ierr = PetscLogEventEnd(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8331 
8332   ierr = PetscLogEventBegin(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8333   if (pcbddc->coarse_ksp) {
8334     PetscBool ispreonly;
8335 
8336     if (CoarseNullSpace) {
8337       PetscBool isnull;
8338       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
8339       if (isnull) {
8340         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
8341       }
8342       /* TODO: add local nullspaces (if any) */
8343     }
8344     /* setup coarse ksp */
8345     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
8346     /* Check coarse problem if in debug mode or if solving with an iterative method */
8347     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
8348     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
8349       KSP       check_ksp;
8350       KSPType   check_ksp_type;
8351       PC        check_pc;
8352       Vec       check_vec,coarse_vec;
8353       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8354       PetscInt  its;
8355       PetscBool compute_eigs;
8356       PetscReal *eigs_r,*eigs_c;
8357       PetscInt  neigs;
8358       const char *prefix;
8359 
8360       /* Create ksp object suitable for estimation of extreme eigenvalues */
8361       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
8362       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,PETSC_FALSE);CHKERRQ(ierr);
8363       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8364       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
8365       /* prevent from setup unneeded object */
8366       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
8367       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
8368       if (ispreonly) {
8369         check_ksp_type = KSPPREONLY;
8370         compute_eigs = PETSC_FALSE;
8371       } else {
8372         check_ksp_type = KSPGMRES;
8373         compute_eigs = PETSC_TRUE;
8374       }
8375       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
8376       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
8377       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
8378       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
8379       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
8380       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
8381       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
8382       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
8383       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
8384       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
8385       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
8386       /* create random vec */
8387       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
8388       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8389       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8390       /* solve coarse problem */
8391       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8392       /* set eigenvalue estimation if preonly has not been requested */
8393       if (compute_eigs) {
8394         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8395         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8396         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8397         if (neigs) {
8398           lambda_max = eigs_r[neigs-1];
8399           lambda_min = eigs_r[0];
8400           if (pcbddc->use_coarse_estimates) {
8401             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8402               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8403               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8404             }
8405           }
8406         }
8407       }
8408 
8409       /* check coarse problem residual error */
8410       if (pcbddc->dbg_flag) {
8411         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8412         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8413         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8414         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8415         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8416         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8417         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8418         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8419         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8420         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8421         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8422         if (CoarseNullSpace) {
8423           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8424         }
8425         if (compute_eigs) {
8426           PetscReal          lambda_max_s,lambda_min_s;
8427           KSPConvergedReason reason;
8428           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8429           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8430           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8431           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8432           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);
8433           for (i=0;i<neigs;i++) {
8434             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8435           }
8436         }
8437         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8438         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8439       }
8440       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8441       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8442       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8443       if (compute_eigs) {
8444         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8445         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8446       }
8447     }
8448   }
8449   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8450   /* print additional info */
8451   if (pcbddc->dbg_flag) {
8452     /* waits until all processes reaches this point */
8453     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8454     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
8455     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8456   }
8457 
8458   /* free memory */
8459   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8460   ierr = PetscLogEventEnd(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8461   PetscFunctionReturn(0);
8462 }
8463 
8464 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8465 {
8466   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8467   PC_IS*         pcis = (PC_IS*)pc->data;
8468   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8469   IS             subset,subset_mult,subset_n;
8470   PetscInt       local_size,coarse_size=0;
8471   PetscInt       *local_primal_indices=NULL;
8472   const PetscInt *t_local_primal_indices;
8473   PetscErrorCode ierr;
8474 
8475   PetscFunctionBegin;
8476   /* Compute global number of coarse dofs */
8477   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8478   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8479   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8480   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8481   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8482   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8483   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8484   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8485   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8486   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);
8487   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8488   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8489   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
8490   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8491   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8492 
8493   /* check numbering */
8494   if (pcbddc->dbg_flag) {
8495     PetscScalar coarsesum,*array,*array2;
8496     PetscInt    i;
8497     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8498 
8499     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8500     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8501     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8502     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8503     /* counter */
8504     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8505     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8506     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8507     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8508     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8509     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8510     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8511     for (i=0;i<pcbddc->local_primal_size;i++) {
8512       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8513     }
8514     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8515     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8516     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8517     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8518     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8519     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8520     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8521     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8522     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8523     for (i=0;i<pcis->n;i++) {
8524       if (array[i] != 0.0 && array[i] != array2[i]) {
8525         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8526         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8527         set_error = PETSC_TRUE;
8528         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8529         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);
8530       }
8531     }
8532     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8533     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8534     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8535     for (i=0;i<pcis->n;i++) {
8536       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8537     }
8538     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8539     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8540     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8541     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8542     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8543     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8544     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8545       PetscInt *gidxs;
8546 
8547       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8548       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8549       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8550       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8551       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8552       for (i=0;i<pcbddc->local_primal_size;i++) {
8553         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);
8554       }
8555       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8556       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8557     }
8558     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8559     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8560     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8561   }
8562   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
8563   /* get back data */
8564   *coarse_size_n = coarse_size;
8565   *local_primal_indices_n = local_primal_indices;
8566   PetscFunctionReturn(0);
8567 }
8568 
8569 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8570 {
8571   IS             localis_t;
8572   PetscInt       i,lsize,*idxs,n;
8573   PetscScalar    *vals;
8574   PetscErrorCode ierr;
8575 
8576   PetscFunctionBegin;
8577   /* get indices in local ordering exploiting local to global map */
8578   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8579   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8580   for (i=0;i<lsize;i++) vals[i] = 1.0;
8581   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8582   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8583   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8584   if (idxs) { /* multilevel guard */
8585     ierr = VecSetOption(gwork,VEC_IGNORE_NEGATIVE_INDICES,PETSC_TRUE);CHKERRQ(ierr);
8586     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8587   }
8588   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8589   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8590   ierr = PetscFree(vals);CHKERRQ(ierr);
8591   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8592   /* now compute set in local ordering */
8593   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8594   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8595   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8596   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8597   for (i=0,lsize=0;i<n;i++) {
8598     if (PetscRealPart(vals[i]) > 0.5) {
8599       lsize++;
8600     }
8601   }
8602   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8603   for (i=0,lsize=0;i<n;i++) {
8604     if (PetscRealPart(vals[i]) > 0.5) {
8605       idxs[lsize++] = i;
8606     }
8607   }
8608   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8609   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8610   *localis = localis_t;
8611   PetscFunctionReturn(0);
8612 }
8613 
8614 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8615 {
8616   PC_IS               *pcis=(PC_IS*)pc->data;
8617   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8618   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8619   Mat                 S_j;
8620   PetscInt            *used_xadj,*used_adjncy;
8621   PetscBool           free_used_adj;
8622   PetscErrorCode      ierr;
8623 
8624   PetscFunctionBegin;
8625   ierr = PetscLogEventBegin(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8626   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8627   free_used_adj = PETSC_FALSE;
8628   if (pcbddc->sub_schurs_layers == -1) {
8629     used_xadj = NULL;
8630     used_adjncy = NULL;
8631   } else {
8632     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8633       used_xadj = pcbddc->mat_graph->xadj;
8634       used_adjncy = pcbddc->mat_graph->adjncy;
8635     } else if (pcbddc->computed_rowadj) {
8636       used_xadj = pcbddc->mat_graph->xadj;
8637       used_adjncy = pcbddc->mat_graph->adjncy;
8638     } else {
8639       PetscBool      flg_row=PETSC_FALSE;
8640       const PetscInt *xadj,*adjncy;
8641       PetscInt       nvtxs;
8642 
8643       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8644       if (flg_row) {
8645         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8646         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8647         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8648         free_used_adj = PETSC_TRUE;
8649       } else {
8650         pcbddc->sub_schurs_layers = -1;
8651         used_xadj = NULL;
8652         used_adjncy = NULL;
8653       }
8654       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8655     }
8656   }
8657 
8658   /* setup sub_schurs data */
8659   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8660   if (!sub_schurs->schur_explicit) {
8661     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8662     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8663     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);
8664   } else {
8665     Mat       change = NULL;
8666     Vec       scaling = NULL;
8667     IS        change_primal = NULL, iP;
8668     PetscInt  benign_n;
8669     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8670     PetscBool isseqaij,need_change = PETSC_FALSE;
8671     PetscBool discrete_harmonic = PETSC_FALSE;
8672 
8673     if (!pcbddc->use_vertices && reuse_solvers) {
8674       PetscInt n_vertices;
8675 
8676       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8677       reuse_solvers = (PetscBool)!n_vertices;
8678     }
8679     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8680     if (!isseqaij) {
8681       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8682       if (matis->A == pcbddc->local_mat) {
8683         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8684         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8685       } else {
8686         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8687       }
8688     }
8689     if (!pcbddc->benign_change_explicit) {
8690       benign_n = pcbddc->benign_n;
8691     } else {
8692       benign_n = 0;
8693     }
8694     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
8695        We need a global reduction to avoid possible deadlocks.
8696        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
8697     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
8698       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
8699       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8700       need_change = (PetscBool)(!need_change);
8701     }
8702     /* If the user defines additional constraints, we import them here.
8703        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 */
8704     if (need_change) {
8705       PC_IS   *pcisf;
8706       PC_BDDC *pcbddcf;
8707       PC      pcf;
8708 
8709       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
8710       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
8711       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
8712       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
8713 
8714       /* hacks */
8715       pcisf                        = (PC_IS*)pcf->data;
8716       pcisf->is_B_local            = pcis->is_B_local;
8717       pcisf->vec1_N                = pcis->vec1_N;
8718       pcisf->BtoNmap               = pcis->BtoNmap;
8719       pcisf->n                     = pcis->n;
8720       pcisf->n_B                   = pcis->n_B;
8721       pcbddcf                      = (PC_BDDC*)pcf->data;
8722       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
8723       pcbddcf->mat_graph           = pcbddc->mat_graph;
8724       pcbddcf->use_faces           = PETSC_TRUE;
8725       pcbddcf->use_change_of_basis = PETSC_TRUE;
8726       pcbddcf->use_change_on_faces = PETSC_TRUE;
8727       pcbddcf->use_qr_single       = PETSC_TRUE;
8728       pcbddcf->fake_change         = PETSC_TRUE;
8729 
8730       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
8731       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
8732       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
8733       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
8734       change = pcbddcf->ConstraintMatrix;
8735       pcbddcf->ConstraintMatrix = NULL;
8736 
8737       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
8738       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
8739       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
8740       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
8741       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
8742       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
8743       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
8744       pcf->ops->destroy = NULL;
8745       pcf->ops->reset   = NULL;
8746       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
8747     }
8748     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
8749 
8750     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
8751     if (iP) {
8752       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
8753       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
8754       ierr = PetscOptionsEnd();CHKERRQ(ierr);
8755     }
8756     if (discrete_harmonic) {
8757       Mat A;
8758       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
8759       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
8760       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
8761       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);
8762       ierr = MatDestroy(&A);CHKERRQ(ierr);
8763     } else {
8764       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);
8765     }
8766     ierr = MatDestroy(&change);CHKERRQ(ierr);
8767     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
8768   }
8769   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8770 
8771   /* free adjacency */
8772   if (free_used_adj) {
8773     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
8774   }
8775   ierr = PetscLogEventEnd(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8776   PetscFunctionReturn(0);
8777 }
8778 
8779 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
8780 {
8781   PC_IS               *pcis=(PC_IS*)pc->data;
8782   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8783   PCBDDCGraph         graph;
8784   PetscErrorCode      ierr;
8785 
8786   PetscFunctionBegin;
8787   /* attach interface graph for determining subsets */
8788   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
8789     IS       verticesIS,verticescomm;
8790     PetscInt vsize,*idxs;
8791 
8792     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8793     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
8794     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8795     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
8796     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8797     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8798     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
8799     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
8800     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
8801     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
8802     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
8803   } else {
8804     graph = pcbddc->mat_graph;
8805   }
8806   /* print some info */
8807   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
8808     IS       vertices;
8809     PetscInt nv,nedges,nfaces;
8810     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
8811     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8812     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
8813     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8814     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
8815     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
8816     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
8817     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
8818     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8819     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8820     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8821   }
8822 
8823   /* sub_schurs init */
8824   if (!pcbddc->sub_schurs) {
8825     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
8826   }
8827   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);
8828 
8829   /* free graph struct */
8830   if (pcbddc->sub_schurs_rebuild) {
8831     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
8832   }
8833   PetscFunctionReturn(0);
8834 }
8835 
8836 PetscErrorCode PCBDDCCheckOperator(PC pc)
8837 {
8838   PC_IS               *pcis=(PC_IS*)pc->data;
8839   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8840   PetscErrorCode      ierr;
8841 
8842   PetscFunctionBegin;
8843   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
8844     IS             zerodiag = NULL;
8845     Mat            S_j,B0_B=NULL;
8846     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
8847     PetscScalar    *p0_check,*array,*array2;
8848     PetscReal      norm;
8849     PetscInt       i;
8850 
8851     /* B0 and B0_B */
8852     if (zerodiag) {
8853       IS       dummy;
8854 
8855       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
8856       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
8857       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
8858       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8859     }
8860     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
8861     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
8862     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
8863     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8864     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8865     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8866     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8867     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
8868     /* S_j */
8869     ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8870     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8871 
8872     /* mimic vector in \widetilde{W}_\Gamma */
8873     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
8874     /* continuous in primal space */
8875     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
8876     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8877     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8878     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8879     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
8880     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
8881     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8882     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8883     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8884     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8885     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8886     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8887     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
8888     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
8889 
8890     /* assemble rhs for coarse problem */
8891     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
8892     /* local with Schur */
8893     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
8894     if (zerodiag) {
8895       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8896       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
8897       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8898       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
8899     }
8900     /* sum on primal nodes the local contributions */
8901     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8902     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8903     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8904     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8905     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
8906     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8907     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8908     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
8909     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8910     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8911     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8912     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8913     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8914     /* scale primal nodes (BDDC sums contibutions) */
8915     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
8916     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8917     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8918     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8919     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8920     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8921     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8922     /* global: \widetilde{B0}_B w_\Gamma */
8923     if (zerodiag) {
8924       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
8925       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8926       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
8927       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8928     }
8929     /* BDDC */
8930     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
8931     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
8932 
8933     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
8934     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
8935     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
8936     PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);
8937     for (i=0;i<pcbddc->benign_n;i++) {
8938       PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%d] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));
8939     }
8940     ierr = PetscFree(p0_check);CHKERRQ(ierr);
8941     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
8942     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
8943     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
8944     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8945     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
8946   }
8947   PetscFunctionReturn(0);
8948 }
8949 
8950 #include <../src/mat/impls/aij/mpi/mpiaij.h>
8951 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
8952 {
8953   Mat            At;
8954   IS             rows;
8955   PetscInt       rst,ren;
8956   PetscErrorCode ierr;
8957   PetscLayout    rmap;
8958 
8959   PetscFunctionBegin;
8960   rst = ren = 0;
8961   if (ccomm != MPI_COMM_NULL) {
8962     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
8963     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
8964     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
8965     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
8966     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
8967   }
8968   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
8969   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
8970   ierr = ISDestroy(&rows);CHKERRQ(ierr);
8971 
8972   if (ccomm != MPI_COMM_NULL) {
8973     Mat_MPIAIJ *a,*b;
8974     IS         from,to;
8975     Vec        gvec;
8976     PetscInt   lsize;
8977 
8978     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
8979     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
8980     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
8981     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
8982     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
8983     a    = (Mat_MPIAIJ*)At->data;
8984     b    = (Mat_MPIAIJ*)(*B)->data;
8985     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
8986     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
8987     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
8988     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
8989     b->A = a->A;
8990     b->B = a->B;
8991 
8992     b->donotstash      = a->donotstash;
8993     b->roworiented     = a->roworiented;
8994     b->rowindices      = 0;
8995     b->rowvalues       = 0;
8996     b->getrowactive    = PETSC_FALSE;
8997 
8998     (*B)->rmap         = rmap;
8999     (*B)->factortype   = A->factortype;
9000     (*B)->assembled    = PETSC_TRUE;
9001     (*B)->insertmode   = NOT_SET_VALUES;
9002     (*B)->preallocated = PETSC_TRUE;
9003 
9004     if (a->colmap) {
9005 #if defined(PETSC_USE_CTABLE)
9006       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
9007 #else
9008       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
9009       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9010       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9011 #endif
9012     } else b->colmap = 0;
9013     if (a->garray) {
9014       PetscInt len;
9015       len  = a->B->cmap->n;
9016       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
9017       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
9018       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
9019     } else b->garray = 0;
9020 
9021     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
9022     b->lvec = a->lvec;
9023     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
9024 
9025     /* cannot use VecScatterCopy */
9026     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
9027     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
9028     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
9029     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
9030     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
9031     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
9032     ierr = ISDestroy(&from);CHKERRQ(ierr);
9033     ierr = ISDestroy(&to);CHKERRQ(ierr);
9034     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
9035   }
9036   ierr = MatDestroy(&At);CHKERRQ(ierr);
9037   PetscFunctionReturn(0);
9038 }
9039