xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision b63b1311b61d321cbc2655d0e4e3a2582d736adc)
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 
1691     for (i=0;i<pcbddc->n_local_subs;i++) {
1692       ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
1693     }
1694     ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
1695     ierr = PCBDDCDetectDisconnectedComponents(pc,&pcbddc->n_local_subs,&pcbddc->local_subs,&primalv);CHKERRQ(ierr);
1696     ierr = PCBDDCAddPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1697     ierr = ISDestroy(&primalv);CHKERRQ(ierr);
1698   }
1699   /* early stage corner detection */
1700   {
1701     DM dm;
1702 
1703     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1704     if (dm) {
1705       PetscBool isda;
1706 
1707       ierr = PetscObjectTypeCompare((PetscObject)dm,DMDA,&isda);CHKERRQ(ierr);
1708       if (isda) {
1709         ISLocalToGlobalMapping l2l;
1710         IS                     corners;
1711         Mat                    lA;
1712 
1713         ierr = DMDAGetSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1714         ierr = MatISGetLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1715         ierr = MatGetLocalToGlobalMapping(lA,&l2l,NULL);CHKERRQ(ierr);
1716         ierr = MatISRestoreLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1717         if (l2l) {
1718           const PetscInt *idx;
1719           PetscInt       bs,*idxout,n;
1720 
1721           ierr = ISLocalToGlobalMappingGetBlockSize(l2l,&bs);CHKERRQ(ierr);
1722           ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
1723           ierr = ISGetIndices(corners,&idx);CHKERRQ(ierr);
1724           ierr = PetscMalloc1(n,&idxout);CHKERRQ(ierr);
1725           ierr = ISLocalToGlobalMappingApplyBlock(l2l,n,idx,idxout);CHKERRQ(ierr);
1726           ierr = ISRestoreIndices(corners,&idx);CHKERRQ(ierr);
1727           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1728           ierr = ISCreateBlock(PetscObjectComm((PetscObject)pc),bs,n,idxout,PETSC_OWN_POINTER,&corners);CHKERRQ(ierr);
1729           ierr = PCBDDCAddPrimalVerticesLocalIS(pc,corners);CHKERRQ(ierr);
1730           ierr = ISDestroy(&corners);CHKERRQ(ierr);
1731           pcbddc->corner_selected = PETSC_TRUE;
1732         } else { /* not from DMDA */
1733           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1734         }
1735       }
1736     }
1737   }
1738   if (pcbddc->corner_selection && !pcbddc->mat_graph->cdim) {
1739     DM dm;
1740 
1741     ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
1742     if (!dm) {
1743       ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1744     }
1745     if (dm) {
1746       Vec            vcoords;
1747       PetscSection   section;
1748       PetscReal      *coords;
1749       PetscInt       d,cdim,nl,nf,**ctxs;
1750       PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *);
1751 
1752       ierr = DMGetCoordinateDim(dm,&cdim);CHKERRQ(ierr);
1753       ierr = DMGetDefaultSection(dm,&section);CHKERRQ(ierr);
1754       ierr = PetscSectionGetNumFields(section,&nf);CHKERRQ(ierr);
1755       ierr = DMCreateGlobalVector(dm,&vcoords);CHKERRQ(ierr);
1756       ierr = VecGetLocalSize(vcoords,&nl);CHKERRQ(ierr);
1757       ierr = PetscMalloc1(nl*cdim,&coords);CHKERRQ(ierr);
1758       ierr = PetscMalloc2(nf,&funcs,nf,&ctxs);CHKERRQ(ierr);
1759       ierr = PetscMalloc1(nf,&ctxs[0]);CHKERRQ(ierr);
1760       for (d=0;d<nf;d++) funcs[d] = func_coords_private;
1761       for (d=1;d<nf;d++) ctxs[d] = ctxs[d-1] + 1;
1762       for (d=0;d<cdim;d++) {
1763         PetscInt          i;
1764         const PetscScalar *v;
1765 
1766         for (i=0;i<nf;i++) ctxs[i][0] = d;
1767         ierr = DMProjectFunction(dm,0.0,funcs,(void**)ctxs,INSERT_VALUES,vcoords);CHKERRQ(ierr);
1768         ierr = VecGetArrayRead(vcoords,&v);CHKERRQ(ierr);
1769         for (i=0;i<nl;i++) coords[i*cdim+d] = PetscRealPart(v[i]);
1770         ierr = VecRestoreArrayRead(vcoords,&v);CHKERRQ(ierr);
1771       }
1772       ierr = VecDestroy(&vcoords);CHKERRQ(ierr);
1773       ierr = PCSetCoordinates(pc,cdim,nl,coords);CHKERRQ(ierr);
1774       ierr = PetscFree(coords);CHKERRQ(ierr);
1775       ierr = PetscFree(ctxs[0]);CHKERRQ(ierr);
1776       ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr);
1777     }
1778   }
1779   PetscFunctionReturn(0);
1780 }
1781 
1782 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1783 {
1784   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1785   PetscErrorCode  ierr;
1786   IS              nis;
1787   const PetscInt  *idxs;
1788   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1789   PetscBool       *ld;
1790 
1791   PetscFunctionBegin;
1792   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1793   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
1794   if (mop == MPI_LAND) {
1795     /* init rootdata with true */
1796     ld   = (PetscBool*) matis->sf_rootdata;
1797     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1798   } else {
1799     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscBool));CHKERRQ(ierr);
1800   }
1801   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscBool));CHKERRQ(ierr);
1802   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1803   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1804   ld   = (PetscBool*) matis->sf_leafdata;
1805   for (i=0;i<nd;i++)
1806     if (-1 < idxs[i] && idxs[i] < n)
1807       ld[idxs[i]] = PETSC_TRUE;
1808   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1809   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1810   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1811   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1812   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1813   if (mop == MPI_LAND) {
1814     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1815   } else {
1816     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1817   }
1818   for (i=0,nnd=0;i<n;i++)
1819     if (ld[i])
1820       nidxs[nnd++] = i;
1821   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1822   ierr = ISDestroy(is);CHKERRQ(ierr);
1823   *is  = nis;
1824   PetscFunctionReturn(0);
1825 }
1826 
1827 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1828 {
1829   PC_IS             *pcis = (PC_IS*)(pc->data);
1830   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1831   PetscErrorCode    ierr;
1832 
1833   PetscFunctionBegin;
1834   if (!pcbddc->benign_have_null) {
1835     PetscFunctionReturn(0);
1836   }
1837   if (pcbddc->ChangeOfBasisMatrix) {
1838     Vec swap;
1839 
1840     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1841     swap = pcbddc->work_change;
1842     pcbddc->work_change = r;
1843     r = swap;
1844   }
1845   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1846   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1847   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1848   ierr = VecSet(z,0.);CHKERRQ(ierr);
1849   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1850   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1851   if (pcbddc->ChangeOfBasisMatrix) {
1852     pcbddc->work_change = r;
1853     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1854     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1855   }
1856   PetscFunctionReturn(0);
1857 }
1858 
1859 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1860 {
1861   PCBDDCBenignMatMult_ctx ctx;
1862   PetscErrorCode          ierr;
1863   PetscBool               apply_right,apply_left,reset_x;
1864 
1865   PetscFunctionBegin;
1866   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1867   if (transpose) {
1868     apply_right = ctx->apply_left;
1869     apply_left = ctx->apply_right;
1870   } else {
1871     apply_right = ctx->apply_right;
1872     apply_left = ctx->apply_left;
1873   }
1874   reset_x = PETSC_FALSE;
1875   if (apply_right) {
1876     const PetscScalar *ax;
1877     PetscInt          nl,i;
1878 
1879     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1880     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1881     ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr);
1882     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1883     for (i=0;i<ctx->benign_n;i++) {
1884       PetscScalar    sum,val;
1885       const PetscInt *idxs;
1886       PetscInt       nz,j;
1887       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1888       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1889       sum = 0.;
1890       if (ctx->apply_p0) {
1891         val = ctx->work[idxs[nz-1]];
1892         for (j=0;j<nz-1;j++) {
1893           sum += ctx->work[idxs[j]];
1894           ctx->work[idxs[j]] += val;
1895         }
1896       } else {
1897         for (j=0;j<nz-1;j++) {
1898           sum += ctx->work[idxs[j]];
1899         }
1900       }
1901       ctx->work[idxs[nz-1]] -= sum;
1902       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1903     }
1904     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1905     reset_x = PETSC_TRUE;
1906   }
1907   if (transpose) {
1908     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1909   } else {
1910     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1911   }
1912   if (reset_x) {
1913     ierr = VecResetArray(x);CHKERRQ(ierr);
1914   }
1915   if (apply_left) {
1916     PetscScalar *ay;
1917     PetscInt    i;
1918 
1919     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1920     for (i=0;i<ctx->benign_n;i++) {
1921       PetscScalar    sum,val;
1922       const PetscInt *idxs;
1923       PetscInt       nz,j;
1924       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1925       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1926       val = -ay[idxs[nz-1]];
1927       if (ctx->apply_p0) {
1928         sum = 0.;
1929         for (j=0;j<nz-1;j++) {
1930           sum += ay[idxs[j]];
1931           ay[idxs[j]] += val;
1932         }
1933         ay[idxs[nz-1]] += sum;
1934       } else {
1935         for (j=0;j<nz-1;j++) {
1936           ay[idxs[j]] += val;
1937         }
1938         ay[idxs[nz-1]] = 0.;
1939       }
1940       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1941     }
1942     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
1943   }
1944   PetscFunctionReturn(0);
1945 }
1946 
1947 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
1948 {
1949   PetscErrorCode ierr;
1950 
1951   PetscFunctionBegin;
1952   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
1953   PetscFunctionReturn(0);
1954 }
1955 
1956 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
1957 {
1958   PetscErrorCode ierr;
1959 
1960   PetscFunctionBegin;
1961   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
1962   PetscFunctionReturn(0);
1963 }
1964 
1965 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
1966 {
1967   PC_IS                   *pcis = (PC_IS*)pc->data;
1968   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
1969   PCBDDCBenignMatMult_ctx ctx;
1970   PetscErrorCode          ierr;
1971 
1972   PetscFunctionBegin;
1973   if (!restore) {
1974     Mat                A_IB,A_BI;
1975     PetscScalar        *work;
1976     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
1977 
1978     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
1979     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
1980     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
1981     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
1982     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
1983     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
1984     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
1985     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
1986     ierr = PetscNew(&ctx);CHKERRQ(ierr);
1987     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
1988     ctx->apply_left = PETSC_TRUE;
1989     ctx->apply_right = PETSC_FALSE;
1990     ctx->apply_p0 = PETSC_FALSE;
1991     ctx->benign_n = pcbddc->benign_n;
1992     if (reuse) {
1993       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
1994       ctx->free = PETSC_FALSE;
1995     } else { /* TODO: could be optimized for successive solves */
1996       ISLocalToGlobalMapping N_to_D;
1997       PetscInt               i;
1998 
1999       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
2000       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2001       for (i=0;i<pcbddc->benign_n;i++) {
2002         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2003       }
2004       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
2005       ctx->free = PETSC_TRUE;
2006     }
2007     ctx->A = pcis->A_IB;
2008     ctx->work = work;
2009     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
2010     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2011     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2012     pcis->A_IB = A_IB;
2013 
2014     /* A_BI as A_IB^T */
2015     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
2016     pcbddc->benign_original_mat = pcis->A_BI;
2017     pcis->A_BI = A_BI;
2018   } else {
2019     if (!pcbddc->benign_original_mat) {
2020       PetscFunctionReturn(0);
2021     }
2022     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
2023     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
2024     pcis->A_IB = ctx->A;
2025     ctx->A = NULL;
2026     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
2027     pcis->A_BI = pcbddc->benign_original_mat;
2028     pcbddc->benign_original_mat = NULL;
2029     if (ctx->free) {
2030       PetscInt i;
2031       for (i=0;i<ctx->benign_n;i++) {
2032         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2033       }
2034       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2035     }
2036     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
2037     ierr = PetscFree(ctx);CHKERRQ(ierr);
2038   }
2039   PetscFunctionReturn(0);
2040 }
2041 
2042 /* used just in bddc debug mode */
2043 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
2044 {
2045   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
2046   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
2047   Mat            An;
2048   PetscErrorCode ierr;
2049 
2050   PetscFunctionBegin;
2051   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
2052   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
2053   if (is1) {
2054     ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
2055     ierr = MatDestroy(&An);CHKERRQ(ierr);
2056   } else {
2057     *B = An;
2058   }
2059   PetscFunctionReturn(0);
2060 }
2061 
2062 /* TODO: add reuse flag */
2063 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2064 {
2065   Mat            Bt;
2066   PetscScalar    *a,*bdata;
2067   const PetscInt *ii,*ij;
2068   PetscInt       m,n,i,nnz,*bii,*bij;
2069   PetscBool      flg_row;
2070   PetscErrorCode ierr;
2071 
2072   PetscFunctionBegin;
2073   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2074   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2075   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2076   nnz = n;
2077   for (i=0;i<ii[n];i++) {
2078     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2079   }
2080   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2081   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2082   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2083   nnz = 0;
2084   bii[0] = 0;
2085   for (i=0;i<n;i++) {
2086     PetscInt j;
2087     for (j=ii[i];j<ii[i+1];j++) {
2088       PetscScalar entry = a[j];
2089       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || (n == m && ij[j] == i)) {
2090         bij[nnz] = ij[j];
2091         bdata[nnz] = entry;
2092         nnz++;
2093       }
2094     }
2095     bii[i+1] = nnz;
2096   }
2097   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2098   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2099   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2100   {
2101     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2102     b->free_a = PETSC_TRUE;
2103     b->free_ij = PETSC_TRUE;
2104   }
2105   if (*B == A) {
2106     ierr = MatDestroy(&A);CHKERRQ(ierr);
2107   }
2108   *B = Bt;
2109   PetscFunctionReturn(0);
2110 }
2111 
2112 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscInt *ncc, IS* cc[], IS* primalv)
2113 {
2114   Mat                    B = NULL;
2115   DM                     dm;
2116   IS                     is_dummy,*cc_n;
2117   ISLocalToGlobalMapping l2gmap_dummy;
2118   PCBDDCGraph            graph;
2119   PetscInt               *xadj_filtered = NULL,*adjncy_filtered = NULL;
2120   PetscInt               i,n;
2121   PetscInt               *xadj,*adjncy;
2122   PetscBool              isplex = PETSC_FALSE;
2123   PetscErrorCode         ierr;
2124 
2125   PetscFunctionBegin;
2126   if (ncc) *ncc = 0;
2127   if (cc) *cc = NULL;
2128   if (primalv) *primalv = NULL;
2129   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2130   ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
2131   if (!dm) {
2132     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
2133   }
2134   if (dm) {
2135     ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr);
2136   }
2137   if (isplex) { /* this code has been modified from plexpartition.c */
2138     PetscInt       p, pStart, pEnd, a, adjSize, idx, size, nroots;
2139     PetscInt      *adj = NULL;
2140     IS             cellNumbering;
2141     const PetscInt *cellNum;
2142     PetscBool      useCone, useClosure;
2143     PetscSection   section;
2144     PetscSegBuffer adjBuffer;
2145     PetscSF        sfPoint;
2146     PetscErrorCode ierr;
2147 
2148     PetscFunctionBegin;
2149     ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
2150     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2151     ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
2152     /* Build adjacency graph via a section/segbuffer */
2153     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &section);CHKERRQ(ierr);
2154     ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
2155     ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr);
2156     /* Always use FVM adjacency to create partitioner graph */
2157     ierr = DMPlexGetAdjacencyUseCone(dm, &useCone);CHKERRQ(ierr);
2158     ierr = DMPlexGetAdjacencyUseClosure(dm, &useClosure);CHKERRQ(ierr);
2159     ierr = DMPlexSetAdjacencyUseCone(dm, PETSC_TRUE);CHKERRQ(ierr);
2160     ierr = DMPlexSetAdjacencyUseClosure(dm, PETSC_FALSE);CHKERRQ(ierr);
2161     ierr = DMPlexGetCellNumbering(dm, &cellNumbering);CHKERRQ(ierr);
2162     ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr);
2163     for (n = 0, p = pStart; p < pEnd; p++) {
2164       /* Skip non-owned cells in parallel (ParMetis expects no overlap) */
2165       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2166       adjSize = PETSC_DETERMINE;
2167       ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr);
2168       for (a = 0; a < adjSize; ++a) {
2169         const PetscInt point = adj[a];
2170         if (pStart <= point && point < pEnd) {
2171           PetscInt *PETSC_RESTRICT pBuf;
2172           ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr);
2173           ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr);
2174           *pBuf = point;
2175         }
2176       }
2177       n++;
2178     }
2179     ierr = DMPlexSetAdjacencyUseCone(dm, useCone);CHKERRQ(ierr);
2180     ierr = DMPlexSetAdjacencyUseClosure(dm, useClosure);CHKERRQ(ierr);
2181     /* Derive CSR graph from section/segbuffer */
2182     ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
2183     ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
2184     ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr);
2185     for (idx = 0, p = pStart; p < pEnd; p++) {
2186       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2187       ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr);
2188     }
2189     xadj[n] = size;
2190     ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr);
2191     /* Clean up */
2192     ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr);
2193     ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
2194     ierr = PetscFree(adj);CHKERRQ(ierr);
2195     graph->xadj = xadj;
2196     graph->adjncy = adjncy;
2197   } else {
2198     Mat       A;
2199     PetscBool filter = PETSC_FALSE, isseqaij, flg_row;
2200 
2201     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2202     if (!A->rmap->N || !A->cmap->N) {
2203       ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2204       PetscFunctionReturn(0);
2205     }
2206     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2207     if (!isseqaij && filter) {
2208       PetscBool isseqdense;
2209 
2210       ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2211       if (!isseqdense) {
2212         ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2213       } else { /* TODO: rectangular case and LDA */
2214         PetscScalar *array;
2215         PetscReal   chop=1.e-6;
2216 
2217         ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2218         ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2219         ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2220         for (i=0;i<n;i++) {
2221           PetscInt j;
2222           for (j=i+1;j<n;j++) {
2223             PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2224             if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2225             if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2226           }
2227         }
2228         ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2229         ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2230       }
2231     } else {
2232       ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
2233       B = A;
2234     }
2235     ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2236 
2237     /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2238     if (filter) {
2239       PetscScalar *data;
2240       PetscInt    j,cum;
2241 
2242       ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2243       ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2244       cum = 0;
2245       for (i=0;i<n;i++) {
2246         PetscInt t;
2247 
2248         for (j=xadj[i];j<xadj[i+1];j++) {
2249           if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2250             continue;
2251           }
2252           adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2253         }
2254         t = xadj_filtered[i];
2255         xadj_filtered[i] = cum;
2256         cum += t;
2257       }
2258       ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2259       graph->xadj = xadj_filtered;
2260       graph->adjncy = adjncy_filtered;
2261     } else {
2262       graph->xadj = xadj;
2263       graph->adjncy = adjncy;
2264     }
2265   }
2266   /* compute local connected components using PCBDDCGraph */
2267   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2268   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2269   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2270   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2271   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2272   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2273   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2274 
2275   /* partial clean up */
2276   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2277   if (B) {
2278     PetscBool flg_row;
2279     ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2280     ierr = MatDestroy(&B);CHKERRQ(ierr);
2281   }
2282   if (isplex) {
2283     ierr = PetscFree(xadj);CHKERRQ(ierr);
2284     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2285   }
2286 
2287   /* get back data */
2288   if (isplex) {
2289     if (ncc) *ncc = graph->ncc;
2290     if (cc || primalv) {
2291       Mat          A;
2292       PetscBT      btv,btvt;
2293       PetscSection subSection;
2294       PetscInt     *ids,cum,cump,*cids,*pids;
2295 
2296       ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr);
2297       ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2298       ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr);
2299       ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr);
2300       ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr);
2301 
2302       cids[0] = 0;
2303       for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) {
2304         PetscInt j;
2305 
2306         ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr);
2307         for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) {
2308           PetscInt k, size, *closure = NULL, cell = graph->queue[j];
2309 
2310           ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2311           for (k = 0; k < 2*size; k += 2) {
2312             PetscInt s, p = closure[k], off, dof, cdof;
2313 
2314             ierr = PetscSectionGetConstraintDof(subSection, p, &cdof);CHKERRQ(ierr);
2315             ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr);
2316             ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr);
2317             for (s = 0; s < dof-cdof; s++) {
2318               if (PetscBTLookupSet(btvt,off+s)) continue;
2319               if (!PetscBTLookup(btv,off+s)) {
2320                 ids[cum++] = off+s;
2321               } else { /* cross-vertex */
2322                 pids[cump++] = off+s;
2323               }
2324             }
2325           }
2326           ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2327         }
2328         cids[i+1] = cum;
2329         /* mark dofs as already assigned */
2330         for (j = cids[i]; j < cids[i+1]; j++) {
2331           ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr);
2332         }
2333       }
2334       if (cc) {
2335         ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2336         for (i = 0; i < graph->ncc; i++) {
2337           ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2338         }
2339         *cc = cc_n;
2340       }
2341       if (primalv) {
2342         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr);
2343       }
2344       ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr);
2345       ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
2346       ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr);
2347     }
2348   } else {
2349     if (ncc) *ncc = graph->ncc;
2350     if (cc) {
2351       ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2352       for (i=0;i<graph->ncc;i++) {
2353         ierr = ISCreateGeneral(PETSC_COMM_SELF,graph->cptr[i+1]-graph->cptr[i],graph->queue+graph->cptr[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2354       }
2355       *cc = cc_n;
2356     }
2357   }
2358   /* clean up graph */
2359   graph->xadj = 0;
2360   graph->adjncy = 0;
2361   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2362   PetscFunctionReturn(0);
2363 }
2364 
2365 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2366 {
2367   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2368   PC_IS*         pcis = (PC_IS*)(pc->data);
2369   IS             dirIS = NULL;
2370   PetscInt       i;
2371   PetscErrorCode ierr;
2372 
2373   PetscFunctionBegin;
2374   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2375   if (zerodiag) {
2376     Mat            A;
2377     Vec            vec3_N;
2378     PetscScalar    *vals;
2379     const PetscInt *idxs;
2380     PetscInt       nz,*count;
2381 
2382     /* p0 */
2383     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2384     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2385     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2386     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2387     for (i=0;i<nz;i++) vals[i] = 1.;
2388     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2389     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2390     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2391     /* v_I */
2392     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2393     for (i=0;i<nz;i++) vals[i] = 0.;
2394     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2395     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2396     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2397     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2398     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2399     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2400     if (dirIS) {
2401       PetscInt n;
2402 
2403       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2404       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2405       for (i=0;i<n;i++) vals[i] = 0.;
2406       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2407       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2408     }
2409     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2410     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2411     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2412     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2413     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2414     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2415     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2416     if (PetscAbsScalar(vals[0]) > 1.e-1) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Benign trick can not be applied! b(v_I,p_0) = %1.6e (should be numerically 0.)",PetscAbsScalar(vals[0]));
2417     ierr = PetscFree(vals);CHKERRQ(ierr);
2418     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2419 
2420     /* there should not be any pressure dofs lying on the interface */
2421     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2422     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2423     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2424     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2425     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2426     for (i=0;i<nz;i++) if (count[idxs[i]]) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Benign trick can not be applied! pressure dof %d is an interface dof",idxs[i]);
2427     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2428     ierr = PetscFree(count);CHKERRQ(ierr);
2429   }
2430   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2431 
2432   /* check PCBDDCBenignGetOrSetP0 */
2433   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2434   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2435   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2436   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2437   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2438   for (i=0;i<pcbddc->benign_n;i++) {
2439     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2440     if (val != -PetscGlobalRank-i) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error testing PCBDDCBenignGetOrSetP0! Found %g at %d instead of %g\n",PetscRealPart(pcbddc->benign_p0[i]),i,-PetscGlobalRank-i);
2441   }
2442   PetscFunctionReturn(0);
2443 }
2444 
2445 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, IS *zerodiaglocal)
2446 {
2447   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2448   IS             pressures,zerodiag,zerodiag_save,*zerodiag_subs;
2449   PetscInt       nz,n;
2450   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2451   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2452   PetscErrorCode ierr;
2453 
2454   PetscFunctionBegin;
2455   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2456   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2457   for (n=0;n<pcbddc->benign_n;n++) {
2458     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2459   }
2460   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2461   pcbddc->benign_n = 0;
2462 
2463   /* if a local info on dofs is present, uses the last field for "pressures" (or fid by command line)
2464      otherwise, it uses only zerodiagonal dofs (ok if the pressure block is all zero; it could fail if it is not)
2465      Checks if all the pressure dofs in each subdomain have a zero diagonal
2466      If not, a change of basis on pressures is not needed
2467      since the local Schur complements are already SPD
2468   */
2469   has_null_pressures = PETSC_TRUE;
2470   have_null = PETSC_TRUE;
2471   if (pcbddc->n_ISForDofsLocal) {
2472     IS       iP = NULL;
2473     PetscInt npl,*idxs,p = pcbddc->n_ISForDofsLocal-1;
2474 
2475     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2476     ierr = PetscOptionsInt("-pc_bddc_pressure_field","Field id for pressures",NULL,p,&p,NULL);CHKERRQ(ierr);
2477     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2478     if (p < 0 || p > pcbddc->n_ISForDofsLocal-1) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %D",p);
2479     /* Dofs splitting for BDDC cannot have PETSC_COMM_SELF, so create a sequential IS */
2480     ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[p],&npl);CHKERRQ(ierr);
2481     ierr = ISGetIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2482     ierr = ISCreateGeneral(PETSC_COMM_SELF,npl,idxs,PETSC_COPY_VALUES,&pressures);CHKERRQ(ierr);
2483     ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2484     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2485     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2486     if (iP) {
2487       IS newpressures;
2488 
2489       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2490       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2491       pressures = newpressures;
2492     }
2493     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2494     if (!sorted) {
2495       ierr = ISSort(pressures);CHKERRQ(ierr);
2496     }
2497   } else {
2498     pressures = NULL;
2499   }
2500   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2501   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2502   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2503   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2504   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2505   if (!sorted) {
2506     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2507   }
2508   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2509   zerodiag_save = zerodiag;
2510   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2511   if (!nz) {
2512     if (n) have_null = PETSC_FALSE;
2513     has_null_pressures = PETSC_FALSE;
2514     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2515   }
2516   recompute_zerodiag = PETSC_FALSE;
2517   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2518   zerodiag_subs    = NULL;
2519   pcbddc->benign_n = 0;
2520   n_interior_dofs  = 0;
2521   interior_dofs    = NULL;
2522   nneu             = 0;
2523   if (pcbddc->NeumannBoundariesLocal) {
2524     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2525   }
2526   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2527   if (checkb) { /* need to compute interior nodes */
2528     PetscInt n,i,j;
2529     PetscInt n_neigh,*neigh,*n_shared,**shared;
2530     PetscInt *iwork;
2531 
2532     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2533     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2534     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2535     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2536     for (i=1;i<n_neigh;i++)
2537       for (j=0;j<n_shared[i];j++)
2538           iwork[shared[i][j]] += 1;
2539     for (i=0;i<n;i++)
2540       if (!iwork[i])
2541         interior_dofs[n_interior_dofs++] = i;
2542     ierr = PetscFree(iwork);CHKERRQ(ierr);
2543     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2544   }
2545   if (has_null_pressures) {
2546     IS             *subs;
2547     PetscInt       nsubs,i,j,nl;
2548     const PetscInt *idxs;
2549     PetscScalar    *array;
2550     Vec            *work;
2551     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2552 
2553     subs  = pcbddc->local_subs;
2554     nsubs = pcbddc->n_local_subs;
2555     /* these vectors are needed to check if the constant on pressures is in the kernel of the local operator B (i.e. B(v_I,p0) should be zero) */
2556     if (checkb) {
2557       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2558       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2559       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2560       /* work[0] = 1_p */
2561       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2562       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2563       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2564       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2565       /* work[0] = 1_v */
2566       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2567       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2568       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2569       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2570       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2571     }
2572     if (nsubs > 1) {
2573       ierr = PetscCalloc1(nsubs,&zerodiag_subs);CHKERRQ(ierr);
2574       for (i=0;i<nsubs;i++) {
2575         ISLocalToGlobalMapping l2g;
2576         IS                     t_zerodiag_subs;
2577         PetscInt               nl;
2578 
2579         ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2580         ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,zerodiag,&t_zerodiag_subs);CHKERRQ(ierr);
2581         ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2582         if (nl) {
2583           PetscBool valid = PETSC_TRUE;
2584 
2585           if (checkb) {
2586             ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2587             ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2588             ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2589             ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2590             for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2591             ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2592             ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2593             ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2594             ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2595             ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2596             ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2597             for (j=0;j<n_interior_dofs;j++) {
2598               if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2599                 valid = PETSC_FALSE;
2600                 break;
2601               }
2602             }
2603             ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2604           }
2605           if (valid && nneu) {
2606             const PetscInt *idxs;
2607             PetscInt       nzb;
2608 
2609             ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2610             ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2611             ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2612             if (nzb) valid = PETSC_FALSE;
2613           }
2614           if (valid && pressures) {
2615             IS t_pressure_subs;
2616             ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2617             ierr = ISEqual(t_pressure_subs,t_zerodiag_subs,&valid);CHKERRQ(ierr);
2618             ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2619           }
2620           if (valid) {
2621             ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[pcbddc->benign_n]);CHKERRQ(ierr);
2622             pcbddc->benign_n++;
2623           } else {
2624             recompute_zerodiag = PETSC_TRUE;
2625           }
2626         }
2627         ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2628         ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2629       }
2630     } else { /* there's just one subdomain (or zero if they have not been detected */
2631       PetscBool valid = PETSC_TRUE;
2632 
2633       if (nneu) valid = PETSC_FALSE;
2634       if (valid && pressures) {
2635         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2636       }
2637       if (valid && checkb) {
2638         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2639         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2640         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2641         for (j=0;j<n_interior_dofs;j++) {
2642           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2643             valid = PETSC_FALSE;
2644             break;
2645           }
2646         }
2647         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2648       }
2649       if (valid) {
2650         pcbddc->benign_n = 1;
2651         ierr = PetscMalloc1(pcbddc->benign_n,&zerodiag_subs);CHKERRQ(ierr);
2652         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2653         zerodiag_subs[0] = zerodiag;
2654       }
2655     }
2656     if (checkb) {
2657       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2658     }
2659   }
2660   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2661 
2662   if (!pcbddc->benign_n) {
2663     PetscInt n;
2664 
2665     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2666     recompute_zerodiag = PETSC_FALSE;
2667     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2668     if (n) {
2669       has_null_pressures = PETSC_FALSE;
2670       have_null = PETSC_FALSE;
2671     }
2672   }
2673 
2674   /* final check for null pressures */
2675   if (zerodiag && pressures) {
2676     PetscInt nz,np;
2677     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2678     ierr = ISGetLocalSize(pressures,&np);CHKERRQ(ierr);
2679     if (nz != np) have_null = PETSC_FALSE;
2680   }
2681 
2682   if (recompute_zerodiag) {
2683     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2684     if (pcbddc->benign_n == 1) {
2685       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2686       zerodiag = zerodiag_subs[0];
2687     } else {
2688       PetscInt i,nzn,*new_idxs;
2689 
2690       nzn = 0;
2691       for (i=0;i<pcbddc->benign_n;i++) {
2692         PetscInt ns;
2693         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2694         nzn += ns;
2695       }
2696       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2697       nzn = 0;
2698       for (i=0;i<pcbddc->benign_n;i++) {
2699         PetscInt ns,*idxs;
2700         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2701         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2702         ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr);
2703         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2704         nzn += ns;
2705       }
2706       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2707       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2708     }
2709     have_null = PETSC_FALSE;
2710   }
2711 
2712   /* Prepare matrix to compute no-net-flux */
2713   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2714     Mat                    A,loc_divudotp;
2715     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2716     IS                     row,col,isused = NULL;
2717     PetscInt               M,N,n,st,n_isused;
2718 
2719     if (pressures) {
2720       isused = pressures;
2721     } else {
2722       isused = zerodiag_save;
2723     }
2724     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2725     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2726     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2727     if (!isused && n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"Don't know how to extract div u dot p! Please provide the pressure field");
2728     n_isused = 0;
2729     if (isused) {
2730       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2731     }
2732     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2733     st = st-n_isused;
2734     if (n) {
2735       const PetscInt *gidxs;
2736 
2737       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2738       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2739       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2740       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2741       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2742       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2743     } else {
2744       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2745       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2746       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2747     }
2748     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2749     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2750     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2751     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2752     ierr = ISDestroy(&row);CHKERRQ(ierr);
2753     ierr = ISDestroy(&col);CHKERRQ(ierr);
2754     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2755     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2756     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2757     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2758     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2759     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2760     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2761     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2762     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2763     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2764   }
2765   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2766 
2767   /* change of basis and p0 dofs */
2768   if (has_null_pressures) {
2769     IS             zerodiagc;
2770     const PetscInt *idxs,*idxsc;
2771     PetscInt       i,s,*nnz;
2772 
2773     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2774     ierr = ISComplement(zerodiag,0,n,&zerodiagc);CHKERRQ(ierr);
2775     ierr = ISGetIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2776     /* local change of basis for pressures */
2777     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2778     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2779     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2780     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2781     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2782     for (i=0;i<n-nz;i++) nnz[idxsc[i]] = 1; /* identity on velocities plus pressure dofs for non-singular subdomains */
2783     for (i=0;i<pcbddc->benign_n;i++) {
2784       PetscInt nzs,j;
2785 
2786       ierr = ISGetLocalSize(zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2787       ierr = ISGetIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2788       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2789       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2790       ierr = ISRestoreIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2791     }
2792     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2793     ierr = PetscFree(nnz);CHKERRQ(ierr);
2794     /* set identity on velocities */
2795     for (i=0;i<n-nz;i++) {
2796       ierr = MatSetValue(pcbddc->benign_change,idxsc[i],idxsc[i],1.,INSERT_VALUES);CHKERRQ(ierr);
2797     }
2798     ierr = ISRestoreIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2799     ierr = ISDestroy(&zerodiagc);CHKERRQ(ierr);
2800     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2801     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2802     /* set change on pressures */
2803     for (s=0;s<pcbddc->benign_n;s++) {
2804       PetscScalar *array;
2805       PetscInt    nzs;
2806 
2807       ierr = ISGetLocalSize(zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2808       ierr = ISGetIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2809       for (i=0;i<nzs-1;i++) {
2810         PetscScalar vals[2];
2811         PetscInt    cols[2];
2812 
2813         cols[0] = idxs[i];
2814         cols[1] = idxs[nzs-1];
2815         vals[0] = 1.;
2816         vals[1] = 1.;
2817         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2818       }
2819       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2820       for (i=0;i<nzs-1;i++) array[i] = -1.;
2821       array[nzs-1] = 1.;
2822       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2823       /* store local idxs for p0 */
2824       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2825       ierr = ISRestoreIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2826       ierr = PetscFree(array);CHKERRQ(ierr);
2827     }
2828     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2829     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2830     /* project if needed */
2831     if (pcbddc->benign_change_explicit) {
2832       Mat M;
2833 
2834       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2835       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2836       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2837       ierr = MatDestroy(&M);CHKERRQ(ierr);
2838     }
2839     /* store global idxs for p0 */
2840     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2841   }
2842   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2843   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2844 
2845   /* determines if the coarse solver will be singular or not */
2846   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2847   /* determines if the problem has subdomains with 0 pressure block */
2848   have_null = (PetscBool)(!!pcbddc->benign_n);
2849   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2850   *zerodiaglocal = zerodiag;
2851   PetscFunctionReturn(0);
2852 }
2853 
2854 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2855 {
2856   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2857   PetscScalar    *array;
2858   PetscErrorCode ierr;
2859 
2860   PetscFunctionBegin;
2861   if (!pcbddc->benign_sf) {
2862     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
2863     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2864   }
2865   if (get) {
2866     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2867     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2868     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2869     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2870   } else {
2871     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
2872     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2873     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2874     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
2875   }
2876   PetscFunctionReturn(0);
2877 }
2878 
2879 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
2880 {
2881   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2882   PetscErrorCode ierr;
2883 
2884   PetscFunctionBegin;
2885   /* TODO: add error checking
2886     - avoid nested pop (or push) calls.
2887     - cannot push before pop.
2888     - cannot call this if pcbddc->local_mat is NULL
2889   */
2890   if (!pcbddc->benign_n) {
2891     PetscFunctionReturn(0);
2892   }
2893   if (pop) {
2894     if (pcbddc->benign_change_explicit) {
2895       IS       is_p0;
2896       MatReuse reuse;
2897 
2898       /* extract B_0 */
2899       reuse = MAT_INITIAL_MATRIX;
2900       if (pcbddc->benign_B0) {
2901         reuse = MAT_REUSE_MATRIX;
2902       }
2903       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
2904       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
2905       /* remove rows and cols from local problem */
2906       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
2907       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
2908       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
2909       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
2910     } else {
2911       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
2912       PetscScalar *vals;
2913       PetscInt    i,n,*idxs_ins;
2914 
2915       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
2916       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
2917       if (!pcbddc->benign_B0) {
2918         PetscInt *nnz;
2919         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
2920         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
2921         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2922         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
2923         for (i=0;i<pcbddc->benign_n;i++) {
2924           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
2925           nnz[i] = n - nnz[i];
2926         }
2927         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
2928         ierr = PetscFree(nnz);CHKERRQ(ierr);
2929       }
2930 
2931       for (i=0;i<pcbddc->benign_n;i++) {
2932         PetscScalar *array;
2933         PetscInt    *idxs,j,nz,cum;
2934 
2935         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
2936         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
2937         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2938         for (j=0;j<nz;j++) vals[j] = 1.;
2939         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2940         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
2941         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
2942         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
2943         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2944         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2945         cum = 0;
2946         for (j=0;j<n;j++) {
2947           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
2948             vals[cum] = array[j];
2949             idxs_ins[cum] = j;
2950             cum++;
2951           }
2952         }
2953         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
2954         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2955         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2956       }
2957       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2958       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2959       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
2960     }
2961   } else { /* push */
2962     if (pcbddc->benign_change_explicit) {
2963       PetscInt i;
2964 
2965       for (i=0;i<pcbddc->benign_n;i++) {
2966         PetscScalar *B0_vals;
2967         PetscInt    *B0_cols,B0_ncol;
2968 
2969         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2970         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2971         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2972         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
2973         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2974       }
2975       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2976       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2977     } else {
2978       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!\n");
2979     }
2980   }
2981   PetscFunctionReturn(0);
2982 }
2983 
2984 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
2985 {
2986   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
2987   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
2988   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
2989   PetscBLASInt    *B_iwork,*B_ifail;
2990   PetscScalar     *work,lwork;
2991   PetscScalar     *St,*S,*eigv;
2992   PetscScalar     *Sarray,*Starray;
2993   PetscReal       *eigs,thresh,lthresh,uthresh;
2994   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
2995   PetscBool       allocated_S_St;
2996 #if defined(PETSC_USE_COMPLEX)
2997   PetscReal       *rwork;
2998 #endif
2999   PetscErrorCode  ierr;
3000 
3001   PetscFunctionBegin;
3002   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
3003   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
3004   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);
3005 
3006   if (pcbddc->dbg_flag) {
3007     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3008     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3009     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
3010     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
3011   }
3012 
3013   if (pcbddc->dbg_flag) {
3014     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %d (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);
3015   }
3016 
3017   /* max size of subsets */
3018   mss = 0;
3019   for (i=0;i<sub_schurs->n_subs;i++) {
3020     PetscInt subset_size;
3021 
3022     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3023     mss = PetscMax(mss,subset_size);
3024   }
3025 
3026   /* min/max and threshold */
3027   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
3028   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
3029   nmax = PetscMax(nmin,nmax);
3030   allocated_S_St = PETSC_FALSE;
3031   if (nmin || !sub_schurs->is_posdef) { /* XXX */
3032     allocated_S_St = PETSC_TRUE;
3033   }
3034 
3035   /* allocate lapack workspace */
3036   cum = cum2 = 0;
3037   maxneigs = 0;
3038   for (i=0;i<sub_schurs->n_subs;i++) {
3039     PetscInt n,subset_size;
3040 
3041     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3042     n = PetscMin(subset_size,nmax);
3043     cum += subset_size;
3044     cum2 += subset_size*n;
3045     maxneigs = PetscMax(maxneigs,n);
3046   }
3047   if (mss) {
3048     if (sub_schurs->is_symmetric) {
3049       PetscBLASInt B_itype = 1;
3050       PetscBLASInt B_N = mss;
3051       PetscReal    zero = 0.0;
3052       PetscReal    eps = 0.0; /* dlamch? */
3053 
3054       B_lwork = -1;
3055       S = NULL;
3056       St = NULL;
3057       eigs = NULL;
3058       eigv = NULL;
3059       B_iwork = NULL;
3060       B_ifail = NULL;
3061 #if defined(PETSC_USE_COMPLEX)
3062       rwork = NULL;
3063 #endif
3064       thresh = 1.0;
3065       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3066 #if defined(PETSC_USE_COMPLEX)
3067       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));
3068 #else
3069       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));
3070 #endif
3071       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3072       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3073     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3074   } else {
3075     lwork = 0;
3076   }
3077 
3078   nv = 0;
3079   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) */
3080     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
3081   }
3082   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
3083   if (allocated_S_St) {
3084     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
3085   }
3086   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
3087 #if defined(PETSC_USE_COMPLEX)
3088   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
3089 #endif
3090   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3091                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3092                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3093                       nv+cum,&pcbddc->adaptive_constraints_idxs,
3094                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
3095   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
3096 
3097   maxneigs = 0;
3098   cum = cumarray = 0;
3099   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3100   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3101   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3102     const PetscInt *idxs;
3103 
3104     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3105     for (cum=0;cum<nv;cum++) {
3106       pcbddc->adaptive_constraints_n[cum] = 1;
3107       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3108       pcbddc->adaptive_constraints_data[cum] = 1.0;
3109       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3110       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3111     }
3112     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3113   }
3114 
3115   if (mss) { /* multilevel */
3116     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3117     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3118   }
3119 
3120   lthresh = pcbddc->adaptive_threshold[0];
3121   uthresh = pcbddc->adaptive_threshold[1];
3122   for (i=0;i<sub_schurs->n_subs;i++) {
3123     const PetscInt *idxs;
3124     PetscReal      upper,lower;
3125     PetscInt       j,subset_size,eigs_start = 0;
3126     PetscBLASInt   B_N;
3127     PetscBool      same_data = PETSC_FALSE;
3128     PetscBool      scal = PETSC_FALSE;
3129 
3130     if (pcbddc->use_deluxe_scaling) {
3131       upper = PETSC_MAX_REAL;
3132       lower = uthresh;
3133     } else {
3134       if (!sub_schurs->is_posdef) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented without deluxe scaling");
3135       upper = 1./uthresh;
3136       lower = 0.;
3137     }
3138     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3139     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3140     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
3141     /* this is experimental: we assume the dofs have been properly grouped to have
3142        the diagonal blocks Schur complements either positive or negative definite (true for Stokes) */
3143     if (!sub_schurs->is_posdef) {
3144       Mat T;
3145 
3146       for (j=0;j<subset_size;j++) {
3147         if (PetscRealPart(*(Sarray+cumarray+j*(subset_size+1))) < 0.0) {
3148           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Sarray+cumarray,&T);CHKERRQ(ierr);
3149           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3150           ierr = MatDestroy(&T);CHKERRQ(ierr);
3151           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Starray+cumarray,&T);CHKERRQ(ierr);
3152           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3153           ierr = MatDestroy(&T);CHKERRQ(ierr);
3154           if (sub_schurs->change_primal_sub) {
3155             PetscInt       nz,k;
3156             const PetscInt *idxs;
3157 
3158             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nz);CHKERRQ(ierr);
3159             ierr = ISGetIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3160             for (k=0;k<nz;k++) {
3161               *( Sarray + cumarray + idxs[k]*(subset_size+1)) *= -1.0;
3162               *(Starray + cumarray + idxs[k]*(subset_size+1))  = 0.0;
3163             }
3164             ierr = ISRestoreIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3165           }
3166           scal = PETSC_TRUE;
3167           break;
3168         }
3169       }
3170     }
3171 
3172     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3173       if (sub_schurs->is_symmetric) {
3174         PetscInt j,k;
3175         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */
3176           ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3177           ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3178         }
3179         for (j=0;j<subset_size;j++) {
3180           for (k=j;k<subset_size;k++) {
3181             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3182             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3183           }
3184         }
3185       } else {
3186         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3187         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3188       }
3189     } else {
3190       S = Sarray + cumarray;
3191       St = Starray + cumarray;
3192     }
3193     /* see if we can save some work */
3194     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3195       ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr);
3196     }
3197 
3198     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3199       B_neigs = 0;
3200     } else {
3201       if (sub_schurs->is_symmetric) {
3202         PetscBLASInt B_itype = 1;
3203         PetscBLASInt B_IL, B_IU;
3204         PetscReal    eps = -1.0; /* dlamch? */
3205         PetscInt     nmin_s;
3206         PetscBool    compute_range;
3207 
3208         B_neigs = 0;
3209         compute_range = (PetscBool)!same_data;
3210         if (nmin >= subset_size) compute_range = PETSC_FALSE;
3211 
3212         if (pcbddc->dbg_flag) {
3213           PetscInt nc = 0;
3214 
3215           if (sub_schurs->change_primal_sub) {
3216             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nc);CHKERRQ(ierr);
3217           }
3218           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);
3219         }
3220 
3221         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3222         if (compute_range) {
3223 
3224           /* ask for eigenvalues larger than thresh */
3225           if (sub_schurs->is_posdef) {
3226 #if defined(PETSC_USE_COMPLEX)
3227             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));
3228 #else
3229             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));
3230 #endif
3231           } else { /* no theory so far, but it works nicely */
3232             PetscInt  recipe = 0,recipe_m = 1;
3233             PetscReal bb[2];
3234 
3235             ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe",&recipe,NULL);CHKERRQ(ierr);
3236             switch (recipe) {
3237             case 0:
3238               if (scal) { bb[0] = PETSC_MIN_REAL; bb[1] = lthresh; }
3239               else { bb[0] = uthresh; bb[1] = PETSC_MAX_REAL; }
3240 #if defined(PETSC_USE_COMPLEX)
3241               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));
3242 #else
3243               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));
3244 #endif
3245               break;
3246             case 1:
3247               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh*lthresh;
3248 #if defined(PETSC_USE_COMPLEX)
3249               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));
3250 #else
3251               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));
3252 #endif
3253               if (!scal) {
3254                 PetscBLASInt B_neigs2 = 0;
3255 
3256                 bb[0] = PetscMax(lthresh*lthresh,uthresh); bb[1] = PETSC_MAX_REAL;
3257                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3258                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
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_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&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_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3263 #endif
3264                 B_neigs += B_neigs2;
3265               }
3266               break;
3267             case 2:
3268               if (scal) {
3269                 bb[0] = PETSC_MIN_REAL;
3270                 bb[1] = 0;
3271 #if defined(PETSC_USE_COMPLEX)
3272                 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));
3273 #else
3274                 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));
3275 #endif
3276               } else {
3277                 PetscBLASInt B_neigs2 = 0;
3278                 PetscBool    import = PETSC_FALSE;
3279 
3280                 lthresh = PetscMax(lthresh,0.0);
3281                 if (lthresh > 0.0) {
3282                   bb[0] = PETSC_MIN_REAL;
3283                   bb[1] = lthresh*lthresh;
3284 
3285                   import = PETSC_TRUE;
3286 #if defined(PETSC_USE_COMPLEX)
3287                   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));
3288 #else
3289                   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));
3290 #endif
3291                 }
3292                 bb[0] = PetscMax(lthresh*lthresh,uthresh);
3293                 bb[1] = PETSC_MAX_REAL;
3294                 if (import) {
3295                   ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3296                   ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3297                 }
3298 #if defined(PETSC_USE_COMPLEX)
3299                 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));
3300 #else
3301                 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));
3302 #endif
3303                 B_neigs += B_neigs2;
3304               }
3305               break;
3306             case 3:
3307               if (scal) {
3308                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min_scal",&recipe_m,NULL);CHKERRQ(ierr);
3309               } else {
3310                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min",&recipe_m,NULL);CHKERRQ(ierr);
3311               }
3312               if (!scal) {
3313                 bb[0] = uthresh;
3314                 bb[1] = PETSC_MAX_REAL;
3315 #if defined(PETSC_USE_COMPLEX)
3316                 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));
3317 #else
3318                 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));
3319 #endif
3320               }
3321               if (recipe_m > 0 && B_N - B_neigs > 0) {
3322                 PetscBLASInt B_neigs2 = 0;
3323 
3324                 B_IL = 1;
3325                 ierr = PetscBLASIntCast(PetscMin(recipe_m,B_N - B_neigs),&B_IU);CHKERRQ(ierr);
3326                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3327                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3328 #if defined(PETSC_USE_COMPLEX)
3329                 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));
3330 #else
3331                 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));
3332 #endif
3333                 B_neigs += B_neigs2;
3334               }
3335               break;
3336             case 4:
3337               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh;
3338 #if defined(PETSC_USE_COMPLEX)
3339               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));
3340 #else
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,B_iwork,B_ifail,&B_ierr));
3342 #endif
3343               {
3344                 PetscBLASInt B_neigs2 = 0;
3345 
3346                 bb[0] = PetscMax(lthresh+PETSC_SMALL,uthresh); bb[1] = PETSC_MAX_REAL;
3347                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3348                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3349 #if defined(PETSC_USE_COMPLEX)
3350                 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));
3351 #else
3352                 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));
3353 #endif
3354                 B_neigs += B_neigs2;
3355               }
3356               break;
3357             case 5: /* same as before: first compute all eigenvalues, then filter */
3358 #if defined(PETSC_USE_COMPLEX)
3359               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));
3360 #else
3361               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));
3362 #endif
3363               {
3364                 PetscInt e,k,ne;
3365                 for (e=0,ne=0;e<B_neigs;e++) {
3366                   if (eigs[e] < lthresh || eigs[e] > uthresh) {
3367                     for (k=0;k<B_N;k++) S[ne*B_N+k] = eigv[e*B_N+k];
3368                     eigs[ne] = eigs[e];
3369                     ne++;
3370                   }
3371                 }
3372                 ierr = PetscMemcpy(eigv,S,B_N*ne*sizeof(PetscScalar));CHKERRQ(ierr);
3373                 B_neigs = ne;
3374               }
3375               break;
3376             default:
3377               SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Unknown recipe %D",recipe);
3378               break;
3379             }
3380           }
3381         } else if (!same_data) { /* this is just to see all the eigenvalues */
3382           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3383           B_IL = 1;
3384 #if defined(PETSC_USE_COMPLEX)
3385           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));
3386 #else
3387           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));
3388 #endif
3389         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3390           PetscInt k;
3391           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3392           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3393           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3394           nmin = nmax;
3395           ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr);
3396           for (k=0;k<nmax;k++) {
3397             eigs[k] = 1./PETSC_SMALL;
3398             eigv[k*(subset_size+1)] = 1.0;
3399           }
3400         }
3401         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3402         if (B_ierr) {
3403           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3404           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);
3405           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);
3406         }
3407 
3408         if (B_neigs > nmax) {
3409           if (pcbddc->dbg_flag) {
3410             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %d.\n",B_neigs,nmax);CHKERRQ(ierr);
3411           }
3412           if (pcbddc->use_deluxe_scaling) eigs_start = scal ? 0 : B_neigs-nmax;
3413           B_neigs = nmax;
3414         }
3415 
3416         nmin_s = PetscMin(nmin,B_N);
3417         if (B_neigs < nmin_s) {
3418           PetscBLASInt B_neigs2 = 0;
3419 
3420           if (pcbddc->use_deluxe_scaling) {
3421             if (scal) {
3422               B_IU = nmin_s;
3423               B_IL = B_neigs + 1;
3424             } else {
3425               B_IL = B_N - nmin_s + 1;
3426               B_IU = B_N - B_neigs;
3427             }
3428           } else {
3429             B_IL = B_neigs + 1;
3430             B_IU = nmin_s;
3431           }
3432           if (pcbddc->dbg_flag) {
3433             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);
3434           }
3435           if (sub_schurs->is_symmetric) {
3436             PetscInt j,k;
3437             for (j=0;j<subset_size;j++) {
3438               for (k=j;k<subset_size;k++) {
3439                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3440                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3441               }
3442             }
3443           } else {
3444             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3445             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3446           }
3447           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3448 #if defined(PETSC_USE_COMPLEX)
3449           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));
3450 #else
3451           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));
3452 #endif
3453           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3454           B_neigs += B_neigs2;
3455         }
3456         if (B_ierr) {
3457           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3458           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);
3459           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);
3460         }
3461         if (pcbddc->dbg_flag) {
3462           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3463           for (j=0;j<B_neigs;j++) {
3464             if (eigs[j] == 0.0) {
3465               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3466             } else {
3467               if (pcbddc->use_deluxe_scaling) {
3468                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3469               } else {
3470                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3471               }
3472             }
3473           }
3474         }
3475       } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3476     }
3477     /* change the basis back to the original one */
3478     if (sub_schurs->change) {
3479       Mat change,phi,phit;
3480 
3481       if (pcbddc->dbg_flag > 2) {
3482         PetscInt ii;
3483         for (ii=0;ii<B_neigs;ii++) {
3484           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3485           for (j=0;j<B_N;j++) {
3486 #if defined(PETSC_USE_COMPLEX)
3487             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3488             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3489             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3490 #else
3491             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3492 #endif
3493           }
3494         }
3495       }
3496       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3497       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3498       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3499       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3500       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3501       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3502     }
3503     maxneigs = PetscMax(B_neigs,maxneigs);
3504     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3505     if (B_neigs) {
3506       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);
3507 
3508       if (pcbddc->dbg_flag > 1) {
3509         PetscInt ii;
3510         for (ii=0;ii<B_neigs;ii++) {
3511           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3512           for (j=0;j<B_N;j++) {
3513 #if defined(PETSC_USE_COMPLEX)
3514             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3515             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3516             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3517 #else
3518             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3519 #endif
3520           }
3521         }
3522       }
3523       ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
3524       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3525       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3526       cum++;
3527     }
3528     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3529     /* shift for next computation */
3530     cumarray += subset_size*subset_size;
3531   }
3532   if (pcbddc->dbg_flag) {
3533     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3534   }
3535 
3536   if (mss) {
3537     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3538     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3539     /* destroy matrices (junk) */
3540     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3541     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3542   }
3543   if (allocated_S_St) {
3544     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3545   }
3546   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3547 #if defined(PETSC_USE_COMPLEX)
3548   ierr = PetscFree(rwork);CHKERRQ(ierr);
3549 #endif
3550   if (pcbddc->dbg_flag) {
3551     PetscInt maxneigs_r;
3552     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3553     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %d\n",maxneigs_r);CHKERRQ(ierr);
3554   }
3555   PetscFunctionReturn(0);
3556 }
3557 
3558 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3559 {
3560   PetscScalar    *coarse_submat_vals;
3561   PetscErrorCode ierr;
3562 
3563   PetscFunctionBegin;
3564   /* Setup local scatters R_to_B and (optionally) R_to_D */
3565   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3566   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3567 
3568   /* Setup local neumann solver ksp_R */
3569   /* PCBDDCSetUpLocalScatters should be called first! */
3570   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3571 
3572   /*
3573      Setup local correction and local part of coarse basis.
3574      Gives back the dense local part of the coarse matrix in column major ordering
3575   */
3576   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3577 
3578   /* Compute total number of coarse nodes and setup coarse solver */
3579   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3580 
3581   /* free */
3582   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3583   PetscFunctionReturn(0);
3584 }
3585 
3586 PetscErrorCode PCBDDCResetCustomization(PC pc)
3587 {
3588   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3589   PetscErrorCode ierr;
3590 
3591   PetscFunctionBegin;
3592   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3593   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3594   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3595   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3596   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3597   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3598   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3599   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3600   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3601   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3602   PetscFunctionReturn(0);
3603 }
3604 
3605 PetscErrorCode PCBDDCResetTopography(PC pc)
3606 {
3607   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3608   PetscInt       i;
3609   PetscErrorCode ierr;
3610 
3611   PetscFunctionBegin;
3612   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3613   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3614   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3615   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3616   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3617   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3618   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3619   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3620   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3621   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3622   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3623   for (i=0;i<pcbddc->n_local_subs;i++) {
3624     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3625   }
3626   pcbddc->n_local_subs = 0;
3627   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3628   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3629   pcbddc->graphanalyzed        = PETSC_FALSE;
3630   pcbddc->recompute_topography = PETSC_TRUE;
3631   pcbddc->corner_selected      = PETSC_FALSE;
3632   PetscFunctionReturn(0);
3633 }
3634 
3635 PetscErrorCode PCBDDCResetSolvers(PC pc)
3636 {
3637   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3638   PetscErrorCode ierr;
3639 
3640   PetscFunctionBegin;
3641   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3642   if (pcbddc->coarse_phi_B) {
3643     PetscScalar *array;
3644     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3645     ierr = PetscFree(array);CHKERRQ(ierr);
3646   }
3647   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3648   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3649   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3650   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3651   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3652   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3653   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3654   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3655   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3656   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3657   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3658   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3659   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3660   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3661   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3662   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3663   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3664   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3665   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3666   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3667   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3668   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3669   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3670   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3671   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3672   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3673   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3674   if (pcbddc->benign_zerodiag_subs) {
3675     PetscInt i;
3676     for (i=0;i<pcbddc->benign_n;i++) {
3677       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3678     }
3679     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3680   }
3681   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3682   PetscFunctionReturn(0);
3683 }
3684 
3685 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3686 {
3687   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3688   PC_IS          *pcis = (PC_IS*)pc->data;
3689   VecType        impVecType;
3690   PetscInt       n_constraints,n_R,old_size;
3691   PetscErrorCode ierr;
3692 
3693   PetscFunctionBegin;
3694   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3695   n_R = pcis->n - pcbddc->n_vertices;
3696   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3697   /* local work vectors (try to avoid unneeded work)*/
3698   /* R nodes */
3699   old_size = -1;
3700   if (pcbddc->vec1_R) {
3701     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3702   }
3703   if (n_R != old_size) {
3704     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3705     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3706     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3707     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3708     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3709     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3710   }
3711   /* local primal dofs */
3712   old_size = -1;
3713   if (pcbddc->vec1_P) {
3714     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3715   }
3716   if (pcbddc->local_primal_size != old_size) {
3717     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3718     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3719     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3720     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3721   }
3722   /* local explicit constraints */
3723   old_size = -1;
3724   if (pcbddc->vec1_C) {
3725     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3726   }
3727   if (n_constraints && n_constraints != old_size) {
3728     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3729     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3730     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3731     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3732   }
3733   PetscFunctionReturn(0);
3734 }
3735 
3736 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3737 {
3738   PetscErrorCode  ierr;
3739   /* pointers to pcis and pcbddc */
3740   PC_IS*          pcis = (PC_IS*)pc->data;
3741   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3742   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3743   /* submatrices of local problem */
3744   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3745   /* submatrices of local coarse problem */
3746   Mat             S_VV,S_CV,S_VC,S_CC;
3747   /* working matrices */
3748   Mat             C_CR;
3749   /* additional working stuff */
3750   PC              pc_R;
3751   Mat             F,Brhs = NULL;
3752   Vec             dummy_vec;
3753   PetscBool       isLU,isCHOL,isILU,need_benign_correction,sparserhs;
3754   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3755   PetscScalar     *work;
3756   PetscInt        *idx_V_B;
3757   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3758   PetscInt        i,n_R,n_D,n_B;
3759 
3760   /* some shortcuts to scalars */
3761   PetscScalar     one=1.0,m_one=-1.0;
3762 
3763   PetscFunctionBegin;
3764   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");
3765 
3766   /* Set Non-overlapping dimensions */
3767   n_vertices = pcbddc->n_vertices;
3768   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3769   n_B = pcis->n_B;
3770   n_D = pcis->n - n_B;
3771   n_R = pcis->n - n_vertices;
3772 
3773   /* vertices in boundary numbering */
3774   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3775   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3776   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",n_vertices,i);
3777 
3778   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3779   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3780   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3781   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3782   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3783   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3784   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3785   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3786   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3787   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3788 
3789   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3790   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3791   ierr = PCSetUp(pc_R);CHKERRQ(ierr);
3792   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3793   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3794   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3795   lda_rhs = n_R;
3796   need_benign_correction = PETSC_FALSE;
3797   if (isLU || isILU || isCHOL) {
3798     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3799   } else if (sub_schurs && sub_schurs->reuse_solver) {
3800     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3801     MatFactorType      type;
3802 
3803     F = reuse_solver->F;
3804     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3805     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3806     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3807     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3808   } else {
3809     F = NULL;
3810   }
3811 
3812   /* determine if we can use a sparse right-hand side */
3813   sparserhs = PETSC_FALSE;
3814   if (F) {
3815     MatSolverType solver;
3816 
3817     ierr = MatFactorGetSolverType(F,&solver);CHKERRQ(ierr);
3818     ierr = PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs);CHKERRQ(ierr);
3819   }
3820 
3821   /* allocate workspace */
3822   n = 0;
3823   if (n_constraints) {
3824     n += lda_rhs*n_constraints;
3825   }
3826   if (n_vertices) {
3827     n = PetscMax(2*lda_rhs*n_vertices,n);
3828     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3829   }
3830   if (!pcbddc->symmetric_primal) {
3831     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3832   }
3833   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3834 
3835   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3836   dummy_vec = NULL;
3837   if (need_benign_correction && lda_rhs != n_R && F) {
3838     ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,lda_rhs,work,&dummy_vec);CHKERRQ(ierr);
3839   }
3840 
3841   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3842   if (n_constraints) {
3843     Mat         M3,C_B;
3844     IS          is_aux;
3845     PetscScalar *array,*array2;
3846 
3847     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3848     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3849 
3850     /* Extract constraints on R nodes: C_{CR}  */
3851     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
3852     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
3853     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
3854 
3855     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
3856     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
3857     if (!sparserhs) {
3858       ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
3859       for (i=0;i<n_constraints;i++) {
3860         const PetscScalar *row_cmat_values;
3861         const PetscInt    *row_cmat_indices;
3862         PetscInt          size_of_constraint,j;
3863 
3864         ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3865         for (j=0;j<size_of_constraint;j++) {
3866           work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
3867         }
3868         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3869       }
3870       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs);CHKERRQ(ierr);
3871     } else {
3872       Mat tC_CR;
3873 
3874       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
3875       if (lda_rhs != n_R) {
3876         PetscScalar *aa;
3877         PetscInt    r,*ii,*jj;
3878         PetscBool   done;
3879 
3880         ierr = MatGetRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3881         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
3882         ierr = MatSeqAIJGetArray(C_CR,&aa);CHKERRQ(ierr);
3883         ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR);CHKERRQ(ierr);
3884         ierr = MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3885         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
3886       } else {
3887         ierr  = PetscObjectReference((PetscObject)C_CR);CHKERRQ(ierr);
3888         tC_CR = C_CR;
3889       }
3890       ierr = MatCreateTranspose(tC_CR,&Brhs);CHKERRQ(ierr);
3891       ierr = MatDestroy(&tC_CR);CHKERRQ(ierr);
3892     }
3893     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
3894     if (F) {
3895       if (need_benign_correction) {
3896         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3897 
3898         /* rhs is already zero on interior dofs, no need to change the rhs */
3899         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
3900       }
3901       ierr = MatMatSolve(F,Brhs,local_auxmat2_R);CHKERRQ(ierr);
3902       if (need_benign_correction) {
3903         PetscScalar        *marr;
3904         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3905 
3906         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3907         if (lda_rhs != n_R) {
3908           for (i=0;i<n_constraints;i++) {
3909             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3910             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3911             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3912           }
3913         } else {
3914           for (i=0;i<n_constraints;i++) {
3915             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3916             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3917             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3918           }
3919         }
3920         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3921       }
3922     } else {
3923       PetscScalar *marr;
3924 
3925       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3926       for (i=0;i<n_constraints;i++) {
3927         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3928         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
3929         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3930         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3931         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3932       }
3933       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3934     }
3935     if (sparserhs) {
3936       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
3937     }
3938     ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
3939     if (!pcbddc->switch_static) {
3940       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3941       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3942       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3943       for (i=0;i<n_constraints;i++) {
3944         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
3945         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
3946         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3947         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3948         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3949         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3950       }
3951       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3952       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3953       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3954     } else {
3955       if (lda_rhs != n_R) {
3956         IS dummy;
3957 
3958         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
3959         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3960         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
3961       } else {
3962         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
3963         pcbddc->local_auxmat2 = local_auxmat2_R;
3964       }
3965       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3966     }
3967     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3968     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
3969     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
3970     if (isCHOL) {
3971       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
3972     } else {
3973       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
3974     }
3975     ierr = MatSeqDenseInvertFactors_Private(M3);CHKERRQ(ierr);
3976     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
3977     ierr = MatMatMult(M3,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
3978     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
3979     ierr = MatCopy(M3,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
3980     ierr = MatDestroy(&M3);CHKERRQ(ierr);
3981   }
3982 
3983   /* Get submatrices from subdomain matrix */
3984   if (n_vertices) {
3985     IS        is_aux;
3986     PetscBool isseqaij;
3987 
3988     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
3989       IS tis;
3990 
3991       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
3992       ierr = ISSort(tis);CHKERRQ(ierr);
3993       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
3994       ierr = ISDestroy(&tis);CHKERRQ(ierr);
3995     } else {
3996       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
3997     }
3998     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3999     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
4000     ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4001     if (!isseqaij) { /* MatMatMult(A_VR,A_RRmA_RV) below will raise an error */
4002       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4003     }
4004     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
4005     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4006   }
4007 
4008   /* Matrix of coarse basis functions (local) */
4009   if (pcbddc->coarse_phi_B) {
4010     PetscInt on_B,on_primal,on_D=n_D;
4011     if (pcbddc->coarse_phi_D) {
4012       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
4013     }
4014     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
4015     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
4016       PetscScalar *marray;
4017 
4018       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
4019       ierr = PetscFree(marray);CHKERRQ(ierr);
4020       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4021       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4022       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4023       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4024     }
4025   }
4026 
4027   if (!pcbddc->coarse_phi_B) {
4028     PetscScalar *marr;
4029 
4030     /* memory size */
4031     n = n_B*pcbddc->local_primal_size;
4032     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
4033     if (!pcbddc->symmetric_primal) n *= 2;
4034     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
4035     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4036     marr += n_B*pcbddc->local_primal_size;
4037     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4038       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4039       marr += n_D*pcbddc->local_primal_size;
4040     }
4041     if (!pcbddc->symmetric_primal) {
4042       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4043       marr += n_B*pcbddc->local_primal_size;
4044       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4045         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4046       }
4047     } else {
4048       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
4049       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
4050       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4051         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
4052         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
4053       }
4054     }
4055   }
4056 
4057   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
4058   p0_lidx_I = NULL;
4059   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
4060     const PetscInt *idxs;
4061 
4062     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4063     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
4064     for (i=0;i<pcbddc->benign_n;i++) {
4065       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
4066     }
4067     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4068   }
4069 
4070   /* vertices */
4071   if (n_vertices) {
4072     PetscBool restoreavr = PETSC_FALSE;
4073 
4074     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
4075 
4076     if (n_R) {
4077       Mat          A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
4078       PetscBLASInt B_N,B_one = 1;
4079       PetscScalar  *x,*y;
4080 
4081       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
4082       if (need_benign_correction) {
4083         ISLocalToGlobalMapping RtoN;
4084         IS                     is_p0;
4085         PetscInt               *idxs_p0,n;
4086 
4087         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
4088         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
4089         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
4090         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);
4091         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
4092         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
4093         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
4094         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
4095       }
4096 
4097       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4098       if (!sparserhs || need_benign_correction) {
4099         if (lda_rhs == n_R) {
4100           ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4101         } else {
4102           PetscScalar    *av,*array;
4103           const PetscInt *xadj,*adjncy;
4104           PetscInt       n;
4105           PetscBool      flg_row;
4106 
4107           array = work+lda_rhs*n_vertices;
4108           ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
4109           ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4110           ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4111           ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
4112           for (i=0;i<n;i++) {
4113             PetscInt j;
4114             for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
4115           }
4116           ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4117           ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4118           ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
4119         }
4120         if (need_benign_correction) {
4121           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4122           PetscScalar        *marr;
4123 
4124           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
4125           /* need \Phi^T A_RV = (I+L)A_RV, L given by
4126 
4127                  | 0 0  0 | (V)
4128              L = | 0 0 -1 | (P-p0)
4129                  | 0 0 -1 | (p0)
4130 
4131           */
4132           for (i=0;i<reuse_solver->benign_n;i++) {
4133             const PetscScalar *vals;
4134             const PetscInt    *idxs,*idxs_zero;
4135             PetscInt          n,j,nz;
4136 
4137             ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4138             ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4139             ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4140             for (j=0;j<n;j++) {
4141               PetscScalar val = vals[j];
4142               PetscInt    k,col = idxs[j];
4143               for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
4144             }
4145             ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4146             ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4147           }
4148           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
4149         }
4150         ierr = PetscObjectReference((PetscObject)A_RV);CHKERRQ(ierr);
4151         Brhs = A_RV;
4152       } else {
4153         Mat tA_RVT,A_RVT;
4154 
4155         if (!pcbddc->symmetric_primal) {
4156           /* A_RV already scaled by -1 */
4157           ierr = MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT);CHKERRQ(ierr);
4158         } else {
4159           restoreavr = PETSC_TRUE;
4160           ierr  = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4161           ierr  = PetscObjectReference((PetscObject)A_VR);CHKERRQ(ierr);
4162           A_RVT = A_VR;
4163         }
4164         if (lda_rhs != n_R) {
4165           PetscScalar *aa;
4166           PetscInt    r,*ii,*jj;
4167           PetscBool   done;
4168 
4169           ierr = MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4170           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4171           ierr = MatSeqAIJGetArray(A_RVT,&aa);CHKERRQ(ierr);
4172           ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT);CHKERRQ(ierr);
4173           ierr = MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4174           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4175         } else {
4176           ierr   = PetscObjectReference((PetscObject)A_RVT);CHKERRQ(ierr);
4177           tA_RVT = A_RVT;
4178         }
4179         ierr = MatCreateTranspose(tA_RVT,&Brhs);CHKERRQ(ierr);
4180         ierr = MatDestroy(&tA_RVT);CHKERRQ(ierr);
4181         ierr = MatDestroy(&A_RVT);CHKERRQ(ierr);
4182       }
4183       if (F) {
4184         /* need to correct the rhs */
4185         if (need_benign_correction) {
4186           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4187           PetscScalar        *marr;
4188 
4189           ierr = MatDenseGetArray(Brhs,&marr);CHKERRQ(ierr);
4190           if (lda_rhs != n_R) {
4191             for (i=0;i<n_vertices;i++) {
4192               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4193               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4194               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4195             }
4196           } else {
4197             for (i=0;i<n_vertices;i++) {
4198               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4199               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4200               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4201             }
4202           }
4203           ierr = MatDenseRestoreArray(Brhs,&marr);CHKERRQ(ierr);
4204         }
4205         ierr = MatMatSolve(F,Brhs,A_RRmA_RV);CHKERRQ(ierr);
4206         if (restoreavr) {
4207           ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4208         }
4209         /* need to correct the solution */
4210         if (need_benign_correction) {
4211           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4212           PetscScalar        *marr;
4213 
4214           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4215           if (lda_rhs != n_R) {
4216             for (i=0;i<n_vertices;i++) {
4217               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4218               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4219               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4220             }
4221           } else {
4222             for (i=0;i<n_vertices;i++) {
4223               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4224               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4225               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4226             }
4227           }
4228           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4229         }
4230       } else {
4231         ierr = MatDenseGetArray(Brhs,&y);CHKERRQ(ierr);
4232         for (i=0;i<n_vertices;i++) {
4233           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
4234           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
4235           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4236           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4237           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4238         }
4239         ierr = MatDenseRestoreArray(Brhs,&y);CHKERRQ(ierr);
4240       }
4241       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4242       ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4243       /* S_VV and S_CV */
4244       if (n_constraints) {
4245         Mat B;
4246 
4247         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
4248         for (i=0;i<n_vertices;i++) {
4249           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4250           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
4251           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4252           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4253           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4254           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4255         }
4256         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4257         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
4258         ierr = MatDestroy(&B);CHKERRQ(ierr);
4259         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4260         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4261         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
4262         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
4263         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
4264         ierr = MatDestroy(&B);CHKERRQ(ierr);
4265       }
4266       if (lda_rhs != n_R) {
4267         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4268         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4269         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
4270       }
4271       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
4272       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
4273       if (need_benign_correction) {
4274         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4275         PetscScalar      *marr,*sums;
4276 
4277         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
4278         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
4279         for (i=0;i<reuse_solver->benign_n;i++) {
4280           const PetscScalar *vals;
4281           const PetscInt    *idxs,*idxs_zero;
4282           PetscInt          n,j,nz;
4283 
4284           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4285           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4286           for (j=0;j<n_vertices;j++) {
4287             PetscInt k;
4288             sums[j] = 0.;
4289             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
4290           }
4291           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4292           for (j=0;j<n;j++) {
4293             PetscScalar val = vals[j];
4294             PetscInt k;
4295             for (k=0;k<n_vertices;k++) {
4296               marr[idxs[j]+k*n_vertices] += val*sums[k];
4297             }
4298           }
4299           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4300           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4301         }
4302         ierr = PetscFree(sums);CHKERRQ(ierr);
4303         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
4304         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
4305       }
4306       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4307       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
4308       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
4309       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
4310       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4311       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
4312       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
4313       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4314       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
4315     } else {
4316       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4317     }
4318     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
4319 
4320     /* coarse basis functions */
4321     for (i=0;i<n_vertices;i++) {
4322       PetscScalar *y;
4323 
4324       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4325       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4326       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4327       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4328       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4329       y[n_B*i+idx_V_B[i]] = 1.0;
4330       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4331       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4332 
4333       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4334         PetscInt j;
4335 
4336         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4337         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4338         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4339         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4340         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4341         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4342         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4343       }
4344       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4345     }
4346     /* if n_R == 0 the object is not destroyed */
4347     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4348   }
4349   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4350 
4351   if (n_constraints) {
4352     Mat B;
4353 
4354     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4355     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4356     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4357     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4358     if (n_vertices) {
4359       if (isCHOL || need_benign_correction) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4360         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4361       } else {
4362         Mat S_VCt;
4363 
4364         if (lda_rhs != n_R) {
4365           ierr = MatDestroy(&B);CHKERRQ(ierr);
4366           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4367           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4368         }
4369         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4370         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4371         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4372       }
4373     }
4374     ierr = MatDestroy(&B);CHKERRQ(ierr);
4375     /* coarse basis functions */
4376     for (i=0;i<n_constraints;i++) {
4377       PetscScalar *y;
4378 
4379       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4380       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4381       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4382       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4383       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4384       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4385       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4386       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4387         PetscInt j;
4388 
4389         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4390         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4391         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4392         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4393         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4394         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4395         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4396       }
4397       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4398     }
4399   }
4400   if (n_constraints) {
4401     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4402   }
4403   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4404 
4405   /* coarse matrix entries relative to B_0 */
4406   if (pcbddc->benign_n) {
4407     Mat         B0_B,B0_BPHI;
4408     IS          is_dummy;
4409     PetscScalar *data;
4410     PetscInt    j;
4411 
4412     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4413     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4414     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4415     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4416     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4417     ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr);
4418     for (j=0;j<pcbddc->benign_n;j++) {
4419       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4420       for (i=0;i<pcbddc->local_primal_size;i++) {
4421         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4422         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4423       }
4424     }
4425     ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr);
4426     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4427     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4428   }
4429 
4430   /* compute other basis functions for non-symmetric problems */
4431   if (!pcbddc->symmetric_primal) {
4432     Mat         B_V=NULL,B_C=NULL;
4433     PetscScalar *marray;
4434 
4435     if (n_constraints) {
4436       Mat S_CCT,C_CRT;
4437 
4438       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4439       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4440       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4441       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4442       if (n_vertices) {
4443         Mat S_VCT;
4444 
4445         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4446         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4447         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4448       }
4449       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4450     } else {
4451       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4452     }
4453     if (n_vertices && n_R) {
4454       PetscScalar    *av,*marray;
4455       const PetscInt *xadj,*adjncy;
4456       PetscInt       n;
4457       PetscBool      flg_row;
4458 
4459       /* B_V = B_V - A_VR^T */
4460       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4461       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4462       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4463       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4464       for (i=0;i<n;i++) {
4465         PetscInt j;
4466         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4467       }
4468       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4469       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4470       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4471     }
4472 
4473     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4474     if (n_vertices) {
4475       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4476       for (i=0;i<n_vertices;i++) {
4477         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4478         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4479         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4480         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4481         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4482       }
4483       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4484     }
4485     if (B_C) {
4486       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4487       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4488         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4489         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4490         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4491         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4492         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4493       }
4494       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4495     }
4496     /* coarse basis functions */
4497     for (i=0;i<pcbddc->local_primal_size;i++) {
4498       PetscScalar *y;
4499 
4500       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4501       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4502       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4503       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4504       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4505       if (i<n_vertices) {
4506         y[n_B*i+idx_V_B[i]] = 1.0;
4507       }
4508       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4509       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4510 
4511       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4512         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4513         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4514         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4515         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4516         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4517         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4518       }
4519       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4520     }
4521     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4522     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4523   }
4524 
4525   /* free memory */
4526   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4527   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4528   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4529   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4530   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4531   ierr = PetscFree(work);CHKERRQ(ierr);
4532   if (n_vertices) {
4533     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4534   }
4535   if (n_constraints) {
4536     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4537   }
4538   /* Checking coarse_sub_mat and coarse basis functios */
4539   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4540   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4541   if (pcbddc->dbg_flag) {
4542     Mat         coarse_sub_mat;
4543     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4544     Mat         coarse_phi_D,coarse_phi_B;
4545     Mat         coarse_psi_D,coarse_psi_B;
4546     Mat         A_II,A_BB,A_IB,A_BI;
4547     Mat         C_B,CPHI;
4548     IS          is_dummy;
4549     Vec         mones;
4550     MatType     checkmattype=MATSEQAIJ;
4551     PetscReal   real_value;
4552 
4553     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4554       Mat A;
4555       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4556       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4557       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4558       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4559       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4560       ierr = MatDestroy(&A);CHKERRQ(ierr);
4561     } else {
4562       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4563       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4564       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4565       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4566     }
4567     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4568     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4569     if (!pcbddc->symmetric_primal) {
4570       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4571       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4572     }
4573     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4574 
4575     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4576     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4577     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4578     if (!pcbddc->symmetric_primal) {
4579       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4580       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4581       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4582       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4583       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4584       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4585       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4586       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4587       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4588       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4589       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4590       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4591     } else {
4592       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4593       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4594       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4595       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4596       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4597       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4598       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4599       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4600     }
4601     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4602     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4603     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4604     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4605     if (pcbddc->benign_n) {
4606       Mat         B0_B,B0_BPHI;
4607       PetscScalar *data,*data2;
4608       PetscInt    j;
4609 
4610       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4611       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4612       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4613       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4614       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4615       ierr = MatDenseGetArray(B0_BPHI,&data2);CHKERRQ(ierr);
4616       for (j=0;j<pcbddc->benign_n;j++) {
4617         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4618         for (i=0;i<pcbddc->local_primal_size;i++) {
4619           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4620           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4621         }
4622       }
4623       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4624       ierr = MatDenseRestoreArray(B0_BPHI,&data2);CHKERRQ(ierr);
4625       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4626       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4627       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4628     }
4629 #if 0
4630   {
4631     PetscViewer viewer;
4632     char filename[256];
4633     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4634     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4635     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4636     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4637     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4638     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4639     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4640     if (pcbddc->coarse_phi_B) {
4641       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4642       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4643     }
4644     if (pcbddc->coarse_phi_D) {
4645       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4646       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4647     }
4648     if (pcbddc->coarse_psi_B) {
4649       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4650       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4651     }
4652     if (pcbddc->coarse_psi_D) {
4653       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4654       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4655     }
4656     ierr = PetscObjectSetName((PetscObject)pcbddc->local_mat,"A");CHKERRQ(ierr);
4657     ierr = MatView(pcbddc->local_mat,viewer);CHKERRQ(ierr);
4658     ierr = PetscObjectSetName((PetscObject)pcbddc->ConstraintMatrix,"C");CHKERRQ(ierr);
4659     ierr = MatView(pcbddc->ConstraintMatrix,viewer);CHKERRQ(ierr);
4660     ierr = PetscObjectSetName((PetscObject)pcis->is_I_local,"I");CHKERRQ(ierr);
4661     ierr = ISView(pcis->is_I_local,viewer);CHKERRQ(ierr);
4662     ierr = PetscObjectSetName((PetscObject)pcis->is_B_local,"B");CHKERRQ(ierr);
4663     ierr = ISView(pcis->is_B_local,viewer);CHKERRQ(ierr);
4664     ierr = PetscObjectSetName((PetscObject)pcbddc->is_R_local,"R");CHKERRQ(ierr);
4665     ierr = ISView(pcbddc->is_R_local,viewer);CHKERRQ(ierr);
4666     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4667   }
4668 #endif
4669     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4670     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4671     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4672     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4673 
4674     /* check constraints */
4675     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4676     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4677     if (!pcbddc->benign_n) { /* TODO: add benign case */
4678       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4679     } else {
4680       PetscScalar *data;
4681       Mat         tmat;
4682       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4683       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4684       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4685       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4686       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4687     }
4688     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4689     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4690     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4691     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4692     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4693     if (!pcbddc->symmetric_primal) {
4694       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4695       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4696       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4697       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4698       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4699     }
4700     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4701     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4702     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4703     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4704     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4705     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4706     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4707     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4708     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4709     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4710     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4711     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4712     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4713     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4714     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4715     if (!pcbddc->symmetric_primal) {
4716       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4717       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4718     }
4719     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4720   }
4721   /* get back data */
4722   *coarse_submat_vals_n = coarse_submat_vals;
4723   PetscFunctionReturn(0);
4724 }
4725 
4726 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4727 {
4728   Mat            *work_mat;
4729   IS             isrow_s,iscol_s;
4730   PetscBool      rsorted,csorted;
4731   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4732   PetscErrorCode ierr;
4733 
4734   PetscFunctionBegin;
4735   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4736   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4737   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4738   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4739 
4740   if (!rsorted) {
4741     const PetscInt *idxs;
4742     PetscInt *idxs_sorted,i;
4743 
4744     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4745     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4746     for (i=0;i<rsize;i++) {
4747       idxs_perm_r[i] = i;
4748     }
4749     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4750     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4751     for (i=0;i<rsize;i++) {
4752       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4753     }
4754     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4755     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4756   } else {
4757     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4758     isrow_s = isrow;
4759   }
4760 
4761   if (!csorted) {
4762     if (isrow == iscol) {
4763       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4764       iscol_s = isrow_s;
4765     } else {
4766       const PetscInt *idxs;
4767       PetscInt       *idxs_sorted,i;
4768 
4769       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4770       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4771       for (i=0;i<csize;i++) {
4772         idxs_perm_c[i] = i;
4773       }
4774       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4775       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4776       for (i=0;i<csize;i++) {
4777         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4778       }
4779       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4780       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4781     }
4782   } else {
4783     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4784     iscol_s = iscol;
4785   }
4786 
4787   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4788 
4789   if (!rsorted || !csorted) {
4790     Mat      new_mat;
4791     IS       is_perm_r,is_perm_c;
4792 
4793     if (!rsorted) {
4794       PetscInt *idxs_r,i;
4795       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4796       for (i=0;i<rsize;i++) {
4797         idxs_r[idxs_perm_r[i]] = i;
4798       }
4799       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4800       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4801     } else {
4802       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4803     }
4804     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4805 
4806     if (!csorted) {
4807       if (isrow_s == iscol_s) {
4808         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4809         is_perm_c = is_perm_r;
4810       } else {
4811         PetscInt *idxs_c,i;
4812         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4813         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4814         for (i=0;i<csize;i++) {
4815           idxs_c[idxs_perm_c[i]] = i;
4816         }
4817         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4818         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4819       }
4820     } else {
4821       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4822     }
4823     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4824 
4825     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4826     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4827     work_mat[0] = new_mat;
4828     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4829     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4830   }
4831 
4832   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4833   *B = work_mat[0];
4834   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4835   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4836   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4837   PetscFunctionReturn(0);
4838 }
4839 
4840 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
4841 {
4842   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
4843   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4844   Mat            new_mat,lA;
4845   IS             is_local,is_global;
4846   PetscInt       local_size;
4847   PetscBool      isseqaij;
4848   PetscErrorCode ierr;
4849 
4850   PetscFunctionBegin;
4851   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4852   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
4853   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
4854   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
4855   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
4856   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
4857   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
4858 
4859   /* check */
4860   if (pcbddc->dbg_flag) {
4861     Vec       x,x_change;
4862     PetscReal error;
4863 
4864     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
4865     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
4866     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
4867     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4868     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4869     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
4870     if (!pcbddc->change_interior) {
4871       const PetscScalar *x,*y,*v;
4872       PetscReal         lerror = 0.;
4873       PetscInt          i;
4874 
4875       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
4876       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
4877       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
4878       for (i=0;i<local_size;i++)
4879         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
4880           lerror = PetscAbsScalar(x[i]-y[i]);
4881       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
4882       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
4883       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
4884       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4885       if (error > PETSC_SMALL) {
4886         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4887           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e\n",error);
4888         } else {
4889           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e\n",error);
4890         }
4891       }
4892     }
4893     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4894     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4895     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
4896     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
4897     if (error > PETSC_SMALL) {
4898       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4899         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
4900       } else {
4901         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e\n",error);
4902       }
4903     }
4904     ierr = VecDestroy(&x);CHKERRQ(ierr);
4905     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
4906   }
4907 
4908   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
4909   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
4910 
4911   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
4912   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4913   if (isseqaij) {
4914     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4915     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4916     if (lA) {
4917       Mat work;
4918       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4919       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4920       ierr = MatDestroy(&work);CHKERRQ(ierr);
4921     }
4922   } else {
4923     Mat work_mat;
4924 
4925     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4926     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4927     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4928     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
4929     if (lA) {
4930       Mat work;
4931       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4932       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4933       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4934       ierr = MatDestroy(&work);CHKERRQ(ierr);
4935     }
4936   }
4937   if (matis->A->symmetric_set) {
4938     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
4939 #if !defined(PETSC_USE_COMPLEX)
4940     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
4941 #endif
4942   }
4943   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
4944   PetscFunctionReturn(0);
4945 }
4946 
4947 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
4948 {
4949   PC_IS*          pcis = (PC_IS*)(pc->data);
4950   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
4951   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4952   PetscInt        *idx_R_local=NULL;
4953   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
4954   PetscInt        vbs,bs;
4955   PetscBT         bitmask=NULL;
4956   PetscErrorCode  ierr;
4957 
4958   PetscFunctionBegin;
4959   /*
4960     No need to setup local scatters if
4961       - primal space is unchanged
4962         AND
4963       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
4964         AND
4965       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
4966   */
4967   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
4968     PetscFunctionReturn(0);
4969   }
4970   /* destroy old objects */
4971   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
4972   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
4973   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
4974   /* Set Non-overlapping dimensions */
4975   n_B = pcis->n_B;
4976   n_D = pcis->n - n_B;
4977   n_vertices = pcbddc->n_vertices;
4978 
4979   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
4980 
4981   /* create auxiliary bitmask and allocate workspace */
4982   if (!sub_schurs || !sub_schurs->reuse_solver) {
4983     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
4984     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
4985     for (i=0;i<n_vertices;i++) {
4986       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
4987     }
4988 
4989     for (i=0, n_R=0; i<pcis->n; i++) {
4990       if (!PetscBTLookup(bitmask,i)) {
4991         idx_R_local[n_R++] = i;
4992       }
4993     }
4994   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
4995     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4996 
4997     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4998     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
4999   }
5000 
5001   /* Block code */
5002   vbs = 1;
5003   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
5004   if (bs>1 && !(n_vertices%bs)) {
5005     PetscBool is_blocked = PETSC_TRUE;
5006     PetscInt  *vary;
5007     if (!sub_schurs || !sub_schurs->reuse_solver) {
5008       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
5009       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
5010       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
5011       /* 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 */
5012       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
5013       for (i=0; i<pcis->n/bs; i++) {
5014         if (vary[i]!=0 && vary[i]!=bs) {
5015           is_blocked = PETSC_FALSE;
5016           break;
5017         }
5018       }
5019       ierr = PetscFree(vary);CHKERRQ(ierr);
5020     } else {
5021       /* Verify directly the R set */
5022       for (i=0; i<n_R/bs; i++) {
5023         PetscInt j,node=idx_R_local[bs*i];
5024         for (j=1; j<bs; j++) {
5025           if (node != idx_R_local[bs*i+j]-j) {
5026             is_blocked = PETSC_FALSE;
5027             break;
5028           }
5029         }
5030       }
5031     }
5032     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
5033       vbs = bs;
5034       for (i=0;i<n_R/vbs;i++) {
5035         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
5036       }
5037     }
5038   }
5039   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
5040   if (sub_schurs && sub_schurs->reuse_solver) {
5041     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5042 
5043     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5044     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
5045     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
5046     reuse_solver->is_R = pcbddc->is_R_local;
5047   } else {
5048     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
5049   }
5050 
5051   /* print some info if requested */
5052   if (pcbddc->dbg_flag) {
5053     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5054     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5055     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5056     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
5057     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
5058     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);
5059     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5060   }
5061 
5062   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
5063   if (!sub_schurs || !sub_schurs->reuse_solver) {
5064     IS       is_aux1,is_aux2;
5065     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
5066 
5067     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5068     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
5069     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
5070     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5071     for (i=0; i<n_D; i++) {
5072       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
5073     }
5074     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5075     for (i=0, j=0; i<n_R; i++) {
5076       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
5077         aux_array1[j++] = i;
5078       }
5079     }
5080     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5081     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5082     for (i=0, j=0; i<n_B; i++) {
5083       if (!PetscBTLookup(bitmask,is_indices[i])) {
5084         aux_array2[j++] = i;
5085       }
5086     }
5087     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5088     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
5089     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
5090     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5091     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
5092 
5093     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5094       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
5095       for (i=0, j=0; i<n_R; i++) {
5096         if (PetscBTLookup(bitmask,idx_R_local[i])) {
5097           aux_array1[j++] = i;
5098         }
5099       }
5100       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5101       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5102       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5103     }
5104     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
5105     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5106   } else {
5107     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5108     IS                 tis;
5109     PetscInt           schur_size;
5110 
5111     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
5112     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
5113     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
5114     ierr = ISDestroy(&tis);CHKERRQ(ierr);
5115     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5116       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
5117       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5118       ierr = ISDestroy(&tis);CHKERRQ(ierr);
5119     }
5120   }
5121   PetscFunctionReturn(0);
5122 }
5123 
5124 
5125 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
5126 {
5127   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
5128   PC_IS          *pcis = (PC_IS*)pc->data;
5129   PC             pc_temp;
5130   Mat            A_RR;
5131   MatReuse       reuse;
5132   PetscScalar    m_one = -1.0;
5133   PetscReal      value;
5134   PetscInt       n_D,n_R;
5135   PetscBool      check_corr,issbaij;
5136   PetscErrorCode ierr;
5137   /* prefixes stuff */
5138   char           dir_prefix[256],neu_prefix[256],str_level[16];
5139   size_t         len;
5140 
5141   PetscFunctionBegin;
5142 
5143   /* compute prefixes */
5144   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
5145   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
5146   if (!pcbddc->current_level) {
5147     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,sizeof(dir_prefix));CHKERRQ(ierr);
5148     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,sizeof(neu_prefix));CHKERRQ(ierr);
5149     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5150     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5151   } else {
5152     ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
5153     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
5154     len -= 15; /* remove "pc_bddc_coarse_" */
5155     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
5156     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
5157     /* Nonstandard use of PetscStrncpy() to only copy a portion of the input string */
5158     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5159     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5160     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5161     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5162     ierr = PetscStrlcat(dir_prefix,str_level,sizeof(dir_prefix));CHKERRQ(ierr);
5163     ierr = PetscStrlcat(neu_prefix,str_level,sizeof(neu_prefix));CHKERRQ(ierr);
5164   }
5165 
5166   /* DIRICHLET PROBLEM */
5167   if (dirichlet) {
5168     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5169     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
5170       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented\n");
5171       if (pcbddc->dbg_flag) {
5172         Mat    A_IIn;
5173 
5174         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
5175         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
5176         pcis->A_II = A_IIn;
5177       }
5178     }
5179     if (pcbddc->local_mat->symmetric_set) {
5180       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
5181     }
5182     /* Matrix for Dirichlet problem is pcis->A_II */
5183     n_D = pcis->n - pcis->n_B;
5184     if (!pcbddc->ksp_D) { /* create object if not yet build */
5185       void (*f)(void) = 0;
5186 
5187       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
5188       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
5189       /* default */
5190       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
5191       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
5192       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5193       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5194       if (issbaij) {
5195         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5196       } else {
5197         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5198       }
5199       /* Allow user's customization */
5200       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
5201       ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5202       if (f && pcbddc->mat_graph->cloc) {
5203         PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5204         const PetscInt *idxs;
5205         PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5206 
5207         ierr = ISGetLocalSize(pcis->is_I_local,&nl);CHKERRQ(ierr);
5208         ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5209         ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5210         for (i=0;i<nl;i++) {
5211           for (d=0;d<cdim;d++) {
5212             scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5213           }
5214         }
5215         ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5216         ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5217         ierr = PetscFree(scoords);CHKERRQ(ierr);
5218       }
5219     }
5220     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
5221     if (sub_schurs && sub_schurs->reuse_solver) {
5222       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5223 
5224       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
5225     }
5226     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5227     if (!n_D) {
5228       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5229       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5230     }
5231     /* set ksp_D into pcis data */
5232     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
5233     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
5234     pcis->ksp_D = pcbddc->ksp_D;
5235   }
5236 
5237   /* NEUMANN PROBLEM */
5238   A_RR = 0;
5239   if (neumann) {
5240     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5241     PetscInt        ibs,mbs;
5242     PetscBool       issbaij, reuse_neumann_solver;
5243     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
5244 
5245     reuse_neumann_solver = PETSC_FALSE;
5246     if (sub_schurs && sub_schurs->reuse_solver) {
5247       IS iP;
5248 
5249       reuse_neumann_solver = PETSC_TRUE;
5250       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
5251       if (iP) reuse_neumann_solver = PETSC_FALSE;
5252     }
5253     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
5254     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
5255     if (pcbddc->ksp_R) { /* already created ksp */
5256       PetscInt nn_R;
5257       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
5258       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5259       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
5260       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
5261         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
5262         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5263         reuse = MAT_INITIAL_MATRIX;
5264       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5265         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5266           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5267           reuse = MAT_INITIAL_MATRIX;
5268         } else { /* safe to reuse the matrix */
5269           reuse = MAT_REUSE_MATRIX;
5270         }
5271       }
5272       /* last check */
5273       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5274         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5275         reuse = MAT_INITIAL_MATRIX;
5276       }
5277     } else { /* first time, so we need to create the matrix */
5278       reuse = MAT_INITIAL_MATRIX;
5279     }
5280     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
5281     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5282     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5283     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5284     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5285       if (matis->A == pcbddc->local_mat) {
5286         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5287         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5288       } else {
5289         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5290       }
5291     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5292       if (matis->A == pcbddc->local_mat) {
5293         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5294         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5295       } else {
5296         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5297       }
5298     }
5299     /* extract A_RR */
5300     if (reuse_neumann_solver) {
5301       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5302 
5303       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5304         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5305         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5306           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5307         } else {
5308           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5309         }
5310       } else {
5311         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5312         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5313         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5314       }
5315     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5316       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5317     }
5318     if (pcbddc->local_mat->symmetric_set) {
5319       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
5320     }
5321     if (!pcbddc->ksp_R) { /* create object if not present */
5322       void (*f)(void) = 0;
5323 
5324       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5325       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5326       /* default */
5327       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5328       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5329       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5330       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5331       if (issbaij) {
5332         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5333       } else {
5334         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5335       }
5336       /* Allow user's customization */
5337       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5338       ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5339       if (f && pcbddc->mat_graph->cloc) {
5340         PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5341         const PetscInt *idxs;
5342         PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5343 
5344         ierr = ISGetLocalSize(pcbddc->is_R_local,&nl);CHKERRQ(ierr);
5345         ierr = ISGetIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5346         ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5347         for (i=0;i<nl;i++) {
5348           for (d=0;d<cdim;d++) {
5349             scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5350           }
5351         }
5352         ierr = ISRestoreIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5353         ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5354         ierr = PetscFree(scoords);CHKERRQ(ierr);
5355       }
5356     }
5357     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5358     if (!n_R) {
5359       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5360       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5361     }
5362     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5363     /* Reuse solver if it is present */
5364     if (reuse_neumann_solver) {
5365       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5366 
5367       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5368     }
5369   }
5370 
5371   if (pcbddc->dbg_flag) {
5372     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5373     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5374     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5375   }
5376 
5377   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5378   check_corr = PETSC_FALSE;
5379   if (pcbddc->NullSpace_corr[0]) {
5380     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5381   }
5382   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5383     check_corr = PETSC_TRUE;
5384     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5385   }
5386   if (neumann && pcbddc->NullSpace_corr[2]) {
5387     check_corr = PETSC_TRUE;
5388     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5389   }
5390   /* check Dirichlet and Neumann solvers */
5391   if (pcbddc->dbg_flag) {
5392     if (dirichlet) { /* Dirichlet */
5393       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5394       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5395       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5396       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5397       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5398       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);
5399       if (check_corr) {
5400         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_TRUE);CHKERRQ(ierr);
5401       }
5402       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5403     }
5404     if (neumann) { /* Neumann */
5405       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5406       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5407       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5408       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5409       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5410       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);
5411       if (check_corr) {
5412         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_FALSE);CHKERRQ(ierr);
5413       }
5414       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5415     }
5416   }
5417   /* free Neumann problem's matrix */
5418   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5419   PetscFunctionReturn(0);
5420 }
5421 
5422 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5423 {
5424   PetscErrorCode  ierr;
5425   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5426   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5427   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5428 
5429   PetscFunctionBegin;
5430   if (!reuse_solver) {
5431     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5432   }
5433   if (!pcbddc->switch_static) {
5434     if (applytranspose && pcbddc->local_auxmat1) {
5435       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5436       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5437     }
5438     if (!reuse_solver) {
5439       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5440       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5441     } else {
5442       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5443 
5444       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5445       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5446     }
5447   } else {
5448     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5449     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5450     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5451     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5452     if (applytranspose && pcbddc->local_auxmat1) {
5453       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5454       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5455       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5456       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5457     }
5458   }
5459   if (!reuse_solver || pcbddc->switch_static) {
5460     if (applytranspose) {
5461       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5462     } else {
5463       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5464     }
5465   } else {
5466     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5467 
5468     if (applytranspose) {
5469       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5470     } else {
5471       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5472     }
5473   }
5474   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5475   if (!pcbddc->switch_static) {
5476     if (!reuse_solver) {
5477       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5478       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5479     } else {
5480       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5481 
5482       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5483       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5484     }
5485     if (!applytranspose && pcbddc->local_auxmat1) {
5486       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5487       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5488     }
5489   } else {
5490     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5491     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5492     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5493     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5494     if (!applytranspose && pcbddc->local_auxmat1) {
5495       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5496       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5497     }
5498     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5499     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5500     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5501     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5502   }
5503   PetscFunctionReturn(0);
5504 }
5505 
5506 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5507 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5508 {
5509   PetscErrorCode ierr;
5510   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5511   PC_IS*            pcis = (PC_IS*)  (pc->data);
5512   const PetscScalar zero = 0.0;
5513 
5514   PetscFunctionBegin;
5515   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5516   if (!pcbddc->benign_apply_coarse_only) {
5517     if (applytranspose) {
5518       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5519       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5520     } else {
5521       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5522       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5523     }
5524   } else {
5525     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5526   }
5527 
5528   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5529   if (pcbddc->benign_n) {
5530     PetscScalar *array;
5531     PetscInt    j;
5532 
5533     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5534     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5535     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5536   }
5537 
5538   /* start communications from local primal nodes to rhs of coarse solver */
5539   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5540   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5541   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5542 
5543   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5544   if (pcbddc->coarse_ksp) {
5545     Mat          coarse_mat;
5546     Vec          rhs,sol;
5547     MatNullSpace nullsp;
5548     PetscBool    isbddc = PETSC_FALSE;
5549 
5550     if (pcbddc->benign_have_null) {
5551       PC        coarse_pc;
5552 
5553       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5554       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5555       /* we need to propagate to coarser levels the need for a possible benign correction */
5556       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5557         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5558         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5559         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5560       }
5561     }
5562     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5563     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5564     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5565     ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5566     if (nullsp) {
5567       ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5568     }
5569     if (applytranspose) {
5570       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5571       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5572     } else {
5573       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5574         PC        coarse_pc;
5575 
5576         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5577         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5578         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5579         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5580       } else {
5581         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5582       }
5583     }
5584     /* we don't need the benign correction at coarser levels anymore */
5585     if (pcbddc->benign_have_null && isbddc) {
5586       PC        coarse_pc;
5587       PC_BDDC*  coarsepcbddc;
5588 
5589       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5590       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5591       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5592       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5593     }
5594     if (nullsp) {
5595       ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5596     }
5597   }
5598 
5599   /* Local solution on R nodes */
5600   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5601     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5602   }
5603   /* communications from coarse sol to local primal nodes */
5604   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5605   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5606 
5607   /* Sum contributions from the two levels */
5608   if (!pcbddc->benign_apply_coarse_only) {
5609     if (applytranspose) {
5610       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5611       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5612     } else {
5613       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5614       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5615     }
5616     /* store p0 */
5617     if (pcbddc->benign_n) {
5618       PetscScalar *array;
5619       PetscInt    j;
5620 
5621       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5622       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5623       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5624     }
5625   } else { /* expand the coarse solution */
5626     if (applytranspose) {
5627       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5628     } else {
5629       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5630     }
5631   }
5632   PetscFunctionReturn(0);
5633 }
5634 
5635 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5636 {
5637   PetscErrorCode ierr;
5638   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5639   PetscScalar    *array;
5640   Vec            from,to;
5641 
5642   PetscFunctionBegin;
5643   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5644     from = pcbddc->coarse_vec;
5645     to = pcbddc->vec1_P;
5646     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5647       Vec tvec;
5648 
5649       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5650       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5651       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5652       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5653       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5654       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5655     }
5656   } else { /* from local to global -> put data in coarse right hand side */
5657     from = pcbddc->vec1_P;
5658     to = pcbddc->coarse_vec;
5659   }
5660   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5661   PetscFunctionReturn(0);
5662 }
5663 
5664 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5665 {
5666   PetscErrorCode ierr;
5667   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5668   PetscScalar    *array;
5669   Vec            from,to;
5670 
5671   PetscFunctionBegin;
5672   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5673     from = pcbddc->coarse_vec;
5674     to = pcbddc->vec1_P;
5675   } else { /* from local to global -> put data in coarse right hand side */
5676     from = pcbddc->vec1_P;
5677     to = pcbddc->coarse_vec;
5678   }
5679   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5680   if (smode == SCATTER_FORWARD) {
5681     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5682       Vec tvec;
5683 
5684       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5685       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5686       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5687       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5688     }
5689   } else {
5690     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5691      ierr = VecResetArray(from);CHKERRQ(ierr);
5692     }
5693   }
5694   PetscFunctionReturn(0);
5695 }
5696 
5697 /* uncomment for testing purposes */
5698 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5699 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5700 {
5701   PetscErrorCode    ierr;
5702   PC_IS*            pcis = (PC_IS*)(pc->data);
5703   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5704   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5705   /* one and zero */
5706   PetscScalar       one=1.0,zero=0.0;
5707   /* space to store constraints and their local indices */
5708   PetscScalar       *constraints_data;
5709   PetscInt          *constraints_idxs,*constraints_idxs_B;
5710   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5711   PetscInt          *constraints_n;
5712   /* iterators */
5713   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5714   /* BLAS integers */
5715   PetscBLASInt      lwork,lierr;
5716   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5717   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5718   /* reuse */
5719   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5720   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5721   /* change of basis */
5722   PetscBool         qr_needed;
5723   PetscBT           change_basis,qr_needed_idx;
5724   /* auxiliary stuff */
5725   PetscInt          *nnz,*is_indices;
5726   PetscInt          ncc;
5727   /* some quantities */
5728   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5729   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5730   PetscReal         tol; /* tolerance for retaining eigenmodes */
5731 
5732   PetscFunctionBegin;
5733   tol  = PetscSqrtReal(PETSC_SMALL);
5734   /* Destroy Mat objects computed previously */
5735   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5736   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5737   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5738   /* save info on constraints from previous setup (if any) */
5739   olocal_primal_size = pcbddc->local_primal_size;
5740   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5741   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5742   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5743   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5744   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5745   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5746 
5747   if (!pcbddc->adaptive_selection) {
5748     IS           ISForVertices,*ISForFaces,*ISForEdges;
5749     MatNullSpace nearnullsp;
5750     const Vec    *nearnullvecs;
5751     Vec          *localnearnullsp;
5752     PetscScalar  *array;
5753     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5754     PetscBool    nnsp_has_cnst;
5755     /* LAPACK working arrays for SVD or POD */
5756     PetscBool    skip_lapack,boolforchange;
5757     PetscScalar  *work;
5758     PetscReal    *singular_vals;
5759 #if defined(PETSC_USE_COMPLEX)
5760     PetscReal    *rwork;
5761 #endif
5762 #if defined(PETSC_MISSING_LAPACK_GESVD)
5763     PetscScalar  *temp_basis,*correlation_mat;
5764 #else
5765     PetscBLASInt dummy_int=1;
5766     PetscScalar  dummy_scalar=1.;
5767 #endif
5768 
5769     /* Get index sets for faces, edges and vertices from graph */
5770     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
5771     /* print some info */
5772     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
5773       PetscInt nv;
5774 
5775       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
5776       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
5777       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5778       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5779       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
5780       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
5781       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
5782       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5783       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5784     }
5785 
5786     /* free unneeded index sets */
5787     if (!pcbddc->use_vertices) {
5788       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5789     }
5790     if (!pcbddc->use_edges) {
5791       for (i=0;i<n_ISForEdges;i++) {
5792         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5793       }
5794       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5795       n_ISForEdges = 0;
5796     }
5797     if (!pcbddc->use_faces) {
5798       for (i=0;i<n_ISForFaces;i++) {
5799         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5800       }
5801       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5802       n_ISForFaces = 0;
5803     }
5804 
5805     /* check if near null space is attached to global mat */
5806     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
5807     if (nearnullsp) {
5808       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
5809       /* remove any stored info */
5810       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
5811       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5812       /* store information for BDDC solver reuse */
5813       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
5814       pcbddc->onearnullspace = nearnullsp;
5815       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5816       for (i=0;i<nnsp_size;i++) {
5817         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
5818       }
5819     } else { /* if near null space is not provided BDDC uses constants by default */
5820       nnsp_size = 0;
5821       nnsp_has_cnst = PETSC_TRUE;
5822     }
5823     /* get max number of constraints on a single cc */
5824     max_constraints = nnsp_size;
5825     if (nnsp_has_cnst) max_constraints++;
5826 
5827     /*
5828          Evaluate maximum storage size needed by the procedure
5829          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
5830          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
5831          There can be multiple constraints per connected component
5832                                                                                                                                                            */
5833     n_vertices = 0;
5834     if (ISForVertices) {
5835       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
5836     }
5837     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
5838     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
5839 
5840     total_counts = n_ISForFaces+n_ISForEdges;
5841     total_counts *= max_constraints;
5842     total_counts += n_vertices;
5843     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
5844 
5845     total_counts = 0;
5846     max_size_of_constraint = 0;
5847     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
5848       IS used_is;
5849       if (i<n_ISForEdges) {
5850         used_is = ISForEdges[i];
5851       } else {
5852         used_is = ISForFaces[i-n_ISForEdges];
5853       }
5854       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
5855       total_counts += j;
5856       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
5857     }
5858     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);
5859 
5860     /* get local part of global near null space vectors */
5861     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
5862     for (k=0;k<nnsp_size;k++) {
5863       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
5864       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5865       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5866     }
5867 
5868     /* whether or not to skip lapack calls */
5869     skip_lapack = PETSC_TRUE;
5870     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
5871 
5872     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
5873     if (!skip_lapack) {
5874       PetscScalar temp_work;
5875 
5876 #if defined(PETSC_MISSING_LAPACK_GESVD)
5877       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
5878       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
5879       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
5880       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
5881 #if defined(PETSC_USE_COMPLEX)
5882       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
5883 #endif
5884       /* now we evaluate the optimal workspace using query with lwork=-1 */
5885       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5886       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
5887       lwork = -1;
5888       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5889 #if !defined(PETSC_USE_COMPLEX)
5890       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
5891 #else
5892       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
5893 #endif
5894       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5895       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
5896 #else /* on missing GESVD */
5897       /* SVD */
5898       PetscInt max_n,min_n;
5899       max_n = max_size_of_constraint;
5900       min_n = max_constraints;
5901       if (max_size_of_constraint < max_constraints) {
5902         min_n = max_size_of_constraint;
5903         max_n = max_constraints;
5904       }
5905       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
5906 #if defined(PETSC_USE_COMPLEX)
5907       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
5908 #endif
5909       /* now we evaluate the optimal workspace using query with lwork=-1 */
5910       lwork = -1;
5911       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
5912       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
5913       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
5914       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5915 #if !defined(PETSC_USE_COMPLEX)
5916       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));
5917 #else
5918       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));
5919 #endif
5920       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5921       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
5922 #endif /* on missing GESVD */
5923       /* Allocate optimal workspace */
5924       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
5925       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
5926     }
5927     /* Now we can loop on constraining sets */
5928     total_counts = 0;
5929     constraints_idxs_ptr[0] = 0;
5930     constraints_data_ptr[0] = 0;
5931     /* vertices */
5932     if (n_vertices) {
5933       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5934       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5935       for (i=0;i<n_vertices;i++) {
5936         constraints_n[total_counts] = 1;
5937         constraints_data[total_counts] = 1.0;
5938         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
5939         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
5940         total_counts++;
5941       }
5942       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5943       n_vertices = total_counts;
5944     }
5945 
5946     /* edges and faces */
5947     total_counts_cc = total_counts;
5948     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
5949       IS        used_is;
5950       PetscBool idxs_copied = PETSC_FALSE;
5951 
5952       if (ncc<n_ISForEdges) {
5953         used_is = ISForEdges[ncc];
5954         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
5955       } else {
5956         used_is = ISForFaces[ncc-n_ISForEdges];
5957         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
5958       }
5959       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
5960 
5961       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
5962       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5963       /* change of basis should not be performed on local periodic nodes */
5964       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
5965       if (nnsp_has_cnst) {
5966         PetscScalar quad_value;
5967 
5968         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5969         idxs_copied = PETSC_TRUE;
5970 
5971         if (!pcbddc->use_nnsp_true) {
5972           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
5973         } else {
5974           quad_value = 1.0;
5975         }
5976         for (j=0;j<size_of_constraint;j++) {
5977           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
5978         }
5979         temp_constraints++;
5980         total_counts++;
5981       }
5982       for (k=0;k<nnsp_size;k++) {
5983         PetscReal real_value;
5984         PetscScalar *ptr_to_data;
5985 
5986         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5987         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
5988         for (j=0;j<size_of_constraint;j++) {
5989           ptr_to_data[j] = array[is_indices[j]];
5990         }
5991         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5992         /* check if array is null on the connected component */
5993         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5994         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
5995         if (real_value > tol*size_of_constraint) { /* keep indices and values */
5996           temp_constraints++;
5997           total_counts++;
5998           if (!idxs_copied) {
5999             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
6000             idxs_copied = PETSC_TRUE;
6001           }
6002         }
6003       }
6004       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6005       valid_constraints = temp_constraints;
6006       if (!pcbddc->use_nnsp_true && temp_constraints) {
6007         if (temp_constraints == 1) { /* just normalize the constraint */
6008           PetscScalar norm,*ptr_to_data;
6009 
6010           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6011           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6012           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
6013           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
6014           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
6015         } else { /* perform SVD */
6016           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6017 
6018 #if defined(PETSC_MISSING_LAPACK_GESVD)
6019           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
6020              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
6021              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
6022                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
6023                 from that computed using LAPACKgesvd
6024              -> This is due to a different computation of eigenvectors in LAPACKheev
6025              -> The quality of the POD-computed basis will be the same */
6026           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
6027           /* Store upper triangular part of correlation matrix */
6028           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6029           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6030           for (j=0;j<temp_constraints;j++) {
6031             for (k=0;k<j+1;k++) {
6032               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));
6033             }
6034           }
6035           /* compute eigenvalues and eigenvectors of correlation matrix */
6036           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6037           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
6038 #if !defined(PETSC_USE_COMPLEX)
6039           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
6040 #else
6041           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
6042 #endif
6043           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6044           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
6045           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
6046           j = 0;
6047           while (j < temp_constraints && singular_vals[j] < tol) j++;
6048           total_counts = total_counts-j;
6049           valid_constraints = temp_constraints-j;
6050           /* scale and copy POD basis into used quadrature memory */
6051           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6052           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6053           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
6054           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6055           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
6056           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6057           if (j<temp_constraints) {
6058             PetscInt ii;
6059             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
6060             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6061             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));
6062             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6063             for (k=0;k<temp_constraints-j;k++) {
6064               for (ii=0;ii<size_of_constraint;ii++) {
6065                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
6066               }
6067             }
6068           }
6069 #else  /* on missing GESVD */
6070           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6071           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6072           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6073           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6074 #if !defined(PETSC_USE_COMPLEX)
6075           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));
6076 #else
6077           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));
6078 #endif
6079           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
6080           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6081           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
6082           k = temp_constraints;
6083           if (k > size_of_constraint) k = size_of_constraint;
6084           j = 0;
6085           while (j < k && singular_vals[k-j-1] < tol) j++;
6086           valid_constraints = k-j;
6087           total_counts = total_counts-temp_constraints+valid_constraints;
6088 #endif /* on missing GESVD */
6089         }
6090       }
6091       /* update pointers information */
6092       if (valid_constraints) {
6093         constraints_n[total_counts_cc] = valid_constraints;
6094         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
6095         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
6096         /* set change_of_basis flag */
6097         if (boolforchange) {
6098           PetscBTSet(change_basis,total_counts_cc);
6099         }
6100         total_counts_cc++;
6101       }
6102     }
6103     /* free workspace */
6104     if (!skip_lapack) {
6105       ierr = PetscFree(work);CHKERRQ(ierr);
6106 #if defined(PETSC_USE_COMPLEX)
6107       ierr = PetscFree(rwork);CHKERRQ(ierr);
6108 #endif
6109       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
6110 #if defined(PETSC_MISSING_LAPACK_GESVD)
6111       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
6112       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
6113 #endif
6114     }
6115     for (k=0;k<nnsp_size;k++) {
6116       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
6117     }
6118     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
6119     /* free index sets of faces, edges and vertices */
6120     for (i=0;i<n_ISForFaces;i++) {
6121       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6122     }
6123     if (n_ISForFaces) {
6124       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6125     }
6126     for (i=0;i<n_ISForEdges;i++) {
6127       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6128     }
6129     if (n_ISForEdges) {
6130       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6131     }
6132     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6133   } else {
6134     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
6135 
6136     total_counts = 0;
6137     n_vertices = 0;
6138     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
6139       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
6140     }
6141     max_constraints = 0;
6142     total_counts_cc = 0;
6143     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6144       total_counts += pcbddc->adaptive_constraints_n[i];
6145       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
6146       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
6147     }
6148     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
6149     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
6150     constraints_idxs = pcbddc->adaptive_constraints_idxs;
6151     constraints_data = pcbddc->adaptive_constraints_data;
6152     /* constraints_n differs from pcbddc->adaptive_constraints_n */
6153     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
6154     total_counts_cc = 0;
6155     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6156       if (pcbddc->adaptive_constraints_n[i]) {
6157         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
6158       }
6159     }
6160 #if 0
6161     printf("Found %d totals (%d)\n",total_counts_cc,total_counts);
6162     for (i=0;i<total_counts_cc;i++) {
6163       printf("const %d, start %d",i,constraints_idxs_ptr[i]);
6164       printf(" end %d:\n",constraints_idxs_ptr[i+1]);
6165       for (j=constraints_idxs_ptr[i];j<constraints_idxs_ptr[i+1];j++) {
6166         printf(" %d",constraints_idxs[j]);
6167       }
6168       printf("\n");
6169       printf("number of cc: %d\n",constraints_n[i]);
6170     }
6171     for (i=0;i<n_vertices;i++) {
6172       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i]);
6173     }
6174     for (i=0;i<sub_schurs->n_subs;i++) {
6175       PetscPrintf(PETSC_COMM_SELF,"[%d] sub %d, edge %d, n %d\n",PetscGlobalRank,i,(PetscBool)PetscBTLookup(sub_schurs->is_edge,i),pcbddc->adaptive_constraints_n[i+n_vertices]);
6176     }
6177 #endif
6178 
6179     max_size_of_constraint = 0;
6180     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]);
6181     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
6182     /* Change of basis */
6183     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
6184     if (pcbddc->use_change_of_basis) {
6185       for (i=0;i<sub_schurs->n_subs;i++) {
6186         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
6187           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
6188         }
6189       }
6190     }
6191   }
6192   pcbddc->local_primal_size = total_counts;
6193   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6194 
6195   /* map constraints_idxs in boundary numbering */
6196   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
6197   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);
6198 
6199   /* Create constraint matrix */
6200   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6201   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
6202   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
6203 
6204   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
6205   /* determine if a QR strategy is needed for change of basis */
6206   qr_needed = PETSC_FALSE;
6207   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
6208   total_primal_vertices=0;
6209   pcbddc->local_primal_size_cc = 0;
6210   for (i=0;i<total_counts_cc;i++) {
6211     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6212     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
6213       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
6214       pcbddc->local_primal_size_cc += 1;
6215     } else if (PetscBTLookup(change_basis,i)) {
6216       for (k=0;k<constraints_n[i];k++) {
6217         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6218       }
6219       pcbddc->local_primal_size_cc += constraints_n[i];
6220       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
6221         PetscBTSet(qr_needed_idx,i);
6222         qr_needed = PETSC_TRUE;
6223       }
6224     } else {
6225       pcbddc->local_primal_size_cc += 1;
6226     }
6227   }
6228   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
6229   pcbddc->n_vertices = total_primal_vertices;
6230   /* permute indices in order to have a sorted set of vertices */
6231   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6232   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);
6233   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
6234   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
6235 
6236   /* nonzero structure of constraint matrix */
6237   /* and get reference dof for local constraints */
6238   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
6239   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
6240 
6241   j = total_primal_vertices;
6242   total_counts = total_primal_vertices;
6243   cum = total_primal_vertices;
6244   for (i=n_vertices;i<total_counts_cc;i++) {
6245     if (!PetscBTLookup(change_basis,i)) {
6246       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
6247       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
6248       cum++;
6249       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6250       for (k=0;k<constraints_n[i];k++) {
6251         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6252         nnz[j+k] = size_of_constraint;
6253       }
6254       j += constraints_n[i];
6255     }
6256   }
6257   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
6258   ierr = PetscFree(nnz);CHKERRQ(ierr);
6259 
6260   /* set values in constraint matrix */
6261   for (i=0;i<total_primal_vertices;i++) {
6262     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
6263   }
6264   total_counts = total_primal_vertices;
6265   for (i=n_vertices;i<total_counts_cc;i++) {
6266     if (!PetscBTLookup(change_basis,i)) {
6267       PetscInt *cols;
6268 
6269       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6270       cols = constraints_idxs+constraints_idxs_ptr[i];
6271       for (k=0;k<constraints_n[i];k++) {
6272         PetscInt    row = total_counts+k;
6273         PetscScalar *vals;
6274 
6275         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
6276         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6277       }
6278       total_counts += constraints_n[i];
6279     }
6280   }
6281   /* assembling */
6282   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6283   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6284   ierr = MatChop(pcbddc->ConstraintMatrix,PETSC_SMALL);CHKERRQ(ierr);
6285   ierr = MatSeqAIJCompress(pcbddc->ConstraintMatrix,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6286   ierr = MatViewFromOptions(pcbddc->ConstraintMatrix,NULL,"-pc_bddc_constraint_mat_view");CHKERRQ(ierr);
6287 
6288   /*
6289   ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
6290   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
6291   ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
6292   */
6293   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6294   if (pcbddc->use_change_of_basis) {
6295     /* dual and primal dofs on a single cc */
6296     PetscInt     dual_dofs,primal_dofs;
6297     /* working stuff for GEQRF */
6298     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
6299     PetscBLASInt lqr_work;
6300     /* working stuff for UNGQR */
6301     PetscScalar  *gqr_work,lgqr_work_t;
6302     PetscBLASInt lgqr_work;
6303     /* working stuff for TRTRS */
6304     PetscScalar  *trs_rhs;
6305     PetscBLASInt Blas_NRHS;
6306     /* pointers for values insertion into change of basis matrix */
6307     PetscInt     *start_rows,*start_cols;
6308     PetscScalar  *start_vals;
6309     /* working stuff for values insertion */
6310     PetscBT      is_primal;
6311     PetscInt     *aux_primal_numbering_B;
6312     /* matrix sizes */
6313     PetscInt     global_size,local_size;
6314     /* temporary change of basis */
6315     Mat          localChangeOfBasisMatrix;
6316     /* extra space for debugging */
6317     PetscScalar  *dbg_work;
6318 
6319     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6320     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6321     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6322     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6323     /* nonzeros for local mat */
6324     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6325     if (!pcbddc->benign_change || pcbddc->fake_change) {
6326       for (i=0;i<pcis->n;i++) nnz[i]=1;
6327     } else {
6328       const PetscInt *ii;
6329       PetscInt       n;
6330       PetscBool      flg_row;
6331       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6332       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6333       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6334     }
6335     for (i=n_vertices;i<total_counts_cc;i++) {
6336       if (PetscBTLookup(change_basis,i)) {
6337         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6338         if (PetscBTLookup(qr_needed_idx,i)) {
6339           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6340         } else {
6341           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6342           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6343         }
6344       }
6345     }
6346     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6347     ierr = PetscFree(nnz);CHKERRQ(ierr);
6348     /* Set interior change in the matrix */
6349     if (!pcbddc->benign_change || pcbddc->fake_change) {
6350       for (i=0;i<pcis->n;i++) {
6351         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6352       }
6353     } else {
6354       const PetscInt *ii,*jj;
6355       PetscScalar    *aa;
6356       PetscInt       n;
6357       PetscBool      flg_row;
6358       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6359       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6360       for (i=0;i<n;i++) {
6361         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6362       }
6363       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6364       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6365     }
6366 
6367     if (pcbddc->dbg_flag) {
6368       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6369       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6370     }
6371 
6372 
6373     /* Now we loop on the constraints which need a change of basis */
6374     /*
6375        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6376        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6377 
6378        Basic blocks of change of basis matrix T computed by
6379 
6380           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6381 
6382             | 1        0   ...        0         s_1/S |
6383             | 0        1   ...        0         s_2/S |
6384             |              ...                        |
6385             | 0        ...            1     s_{n-1}/S |
6386             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6387 
6388             with S = \sum_{i=1}^n s_i^2
6389             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6390                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6391 
6392           - QR decomposition of constraints otherwise
6393     */
6394     if (qr_needed) {
6395       /* space to store Q */
6396       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6397       /* array to store scaling factors for reflectors */
6398       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6399       /* first we issue queries for optimal work */
6400       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6401       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6402       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6403       lqr_work = -1;
6404       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6405       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6406       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6407       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6408       lgqr_work = -1;
6409       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6410       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6411       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6412       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6413       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6414       PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6415       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to ORGQR/UNGQR Lapack routine %d",(int)lierr);
6416       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6417       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6418       /* array to store rhs and solution of triangular solver */
6419       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6420       /* allocating workspace for check */
6421       if (pcbddc->dbg_flag) {
6422         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6423       }
6424     }
6425     /* array to store whether a node is primal or not */
6426     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6427     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6428     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6429     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);
6430     for (i=0;i<total_primal_vertices;i++) {
6431       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6432     }
6433     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6434 
6435     /* loop on constraints and see whether or not they need a change of basis and compute it */
6436     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6437       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6438       if (PetscBTLookup(change_basis,total_counts)) {
6439         /* get constraint info */
6440         primal_dofs = constraints_n[total_counts];
6441         dual_dofs = size_of_constraint-primal_dofs;
6442 
6443         if (pcbddc->dbg_flag) {
6444           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);
6445         }
6446 
6447         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6448 
6449           /* copy quadrature constraints for change of basis check */
6450           if (pcbddc->dbg_flag) {
6451             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6452           }
6453           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6454           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6455 
6456           /* compute QR decomposition of constraints */
6457           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6458           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6459           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6460           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6461           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6462           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6463           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6464 
6465           /* explictly compute R^-T */
6466           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
6467           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6468           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6469           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6470           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6471           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6472           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6473           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6474           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6475           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6476 
6477           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6478           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6479           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6480           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6481           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6482           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6483           PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6484           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in ORGQR/UNGQR Lapack routine %d",(int)lierr);
6485           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6486 
6487           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6488              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6489              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6490           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6491           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6492           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6493           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6494           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6495           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6496           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6497           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));
6498           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6499           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6500 
6501           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6502           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6503           /* insert cols for primal dofs */
6504           for (j=0;j<primal_dofs;j++) {
6505             start_vals = &qr_basis[j*size_of_constraint];
6506             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6507             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6508           }
6509           /* insert cols for dual dofs */
6510           for (j=0,k=0;j<dual_dofs;k++) {
6511             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6512               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6513               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6514               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6515               j++;
6516             }
6517           }
6518 
6519           /* check change of basis */
6520           if (pcbddc->dbg_flag) {
6521             PetscInt   ii,jj;
6522             PetscBool valid_qr=PETSC_TRUE;
6523             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6524             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6525             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6526             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6527             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6528             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6529             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6530             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));
6531             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6532             for (jj=0;jj<size_of_constraint;jj++) {
6533               for (ii=0;ii<primal_dofs;ii++) {
6534                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6535                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) valid_qr = PETSC_FALSE;
6536               }
6537             }
6538             if (!valid_qr) {
6539               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6540               for (jj=0;jj<size_of_constraint;jj++) {
6541                 for (ii=0;ii<primal_dofs;ii++) {
6542                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6543                     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]));
6544                   }
6545                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) {
6546                     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]));
6547                   }
6548                 }
6549               }
6550             } else {
6551               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6552             }
6553           }
6554         } else { /* simple transformation block */
6555           PetscInt    row,col;
6556           PetscScalar val,norm;
6557 
6558           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6559           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6560           for (j=0;j<size_of_constraint;j++) {
6561             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6562             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6563             if (!PetscBTLookup(is_primal,row_B)) {
6564               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6565               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6566               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6567             } else {
6568               for (k=0;k<size_of_constraint;k++) {
6569                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6570                 if (row != col) {
6571                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6572                 } else {
6573                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6574                 }
6575                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6576               }
6577             }
6578           }
6579           if (pcbddc->dbg_flag) {
6580             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6581           }
6582         }
6583       } else {
6584         if (pcbddc->dbg_flag) {
6585           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d does not need a change of basis (size %d)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6586         }
6587       }
6588     }
6589 
6590     /* free workspace */
6591     if (qr_needed) {
6592       if (pcbddc->dbg_flag) {
6593         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6594       }
6595       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6596       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6597       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6598       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6599       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6600     }
6601     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6602     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6603     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6604 
6605     /* assembling of global change of variable */
6606     if (!pcbddc->fake_change) {
6607       Mat      tmat;
6608       PetscInt bs;
6609 
6610       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6611       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6612       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6613       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6614       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6615       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6616       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6617       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6618       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6619       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6620       ierr = MatISGetMPIXAIJ(tmat,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6621       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6622       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6623       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6624       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6625       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6626       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6627       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6628 
6629       /* check */
6630       if (pcbddc->dbg_flag) {
6631         PetscReal error;
6632         Vec       x,x_change;
6633 
6634         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6635         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6636         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6637         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6638         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6639         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6640         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6641         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6642         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6643         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6644         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6645         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6646         if (error > PETSC_SMALL) {
6647           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
6648         }
6649         ierr = VecDestroy(&x);CHKERRQ(ierr);
6650         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6651       }
6652       /* adapt sub_schurs computed (if any) */
6653       if (pcbddc->use_deluxe_scaling) {
6654         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6655 
6656         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");
6657         if (sub_schurs && sub_schurs->S_Ej_all) {
6658           Mat                    S_new,tmat;
6659           IS                     is_all_N,is_V_Sall = NULL;
6660 
6661           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6662           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6663           if (pcbddc->deluxe_zerorows) {
6664             ISLocalToGlobalMapping NtoSall;
6665             IS                     is_V;
6666             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6667             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6668             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6669             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6670             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6671           }
6672           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6673           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6674           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6675           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6676           if (pcbddc->deluxe_zerorows) {
6677             const PetscScalar *array;
6678             const PetscInt    *idxs_V,*idxs_all;
6679             PetscInt          i,n_V;
6680 
6681             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6682             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6683             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6684             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6685             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6686             for (i=0;i<n_V;i++) {
6687               PetscScalar val;
6688               PetscInt    idx;
6689 
6690               idx = idxs_V[i];
6691               val = array[idxs_all[idxs_V[i]]];
6692               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6693             }
6694             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6695             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6696             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6697             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6698             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6699           }
6700           sub_schurs->S_Ej_all = S_new;
6701           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6702           if (sub_schurs->sum_S_Ej_all) {
6703             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6704             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6705             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6706             if (pcbddc->deluxe_zerorows) {
6707               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6708             }
6709             sub_schurs->sum_S_Ej_all = S_new;
6710             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6711           }
6712           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6713           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6714         }
6715         /* destroy any change of basis context in sub_schurs */
6716         if (sub_schurs && sub_schurs->change) {
6717           PetscInt i;
6718 
6719           for (i=0;i<sub_schurs->n_subs;i++) {
6720             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6721           }
6722           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6723         }
6724       }
6725       if (pcbddc->switch_static) { /* need to save the local change */
6726         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6727       } else {
6728         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6729       }
6730       /* determine if any process has changed the pressures locally */
6731       pcbddc->change_interior = pcbddc->benign_have_null;
6732     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6733       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6734       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6735       pcbddc->use_qr_single = qr_needed;
6736     }
6737   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6738     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6739       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6740       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6741     } else {
6742       Mat benign_global = NULL;
6743       if (pcbddc->benign_have_null) {
6744         Mat tmat;
6745 
6746         pcbddc->change_interior = PETSC_TRUE;
6747         ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6748         ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6749         ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6750         ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6751         ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6752         ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6753         ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6754         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6755         if (pcbddc->benign_change) {
6756           Mat M;
6757 
6758           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6759           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6760           ierr = MatISSetLocalMat(tmat,M);CHKERRQ(ierr);
6761           ierr = MatDestroy(&M);CHKERRQ(ierr);
6762         } else {
6763           Mat         eye;
6764           PetscScalar *array;
6765 
6766           ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6767           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&eye);CHKERRQ(ierr);
6768           for (i=0;i<pcis->n;i++) {
6769             ierr = MatSetValue(eye,i,i,array[i],INSERT_VALUES);CHKERRQ(ierr);
6770           }
6771           ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6772           ierr = MatAssemblyBegin(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6773           ierr = MatAssemblyEnd(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6774           ierr = MatISSetLocalMat(tmat,eye);CHKERRQ(ierr);
6775           ierr = MatDestroy(&eye);CHKERRQ(ierr);
6776         }
6777         ierr = MatISGetMPIXAIJ(tmat,MAT_INITIAL_MATRIX,&benign_global);CHKERRQ(ierr);
6778         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6779       }
6780       if (pcbddc->user_ChangeOfBasisMatrix) {
6781         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6782         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6783       } else if (pcbddc->benign_have_null) {
6784         pcbddc->ChangeOfBasisMatrix = benign_global;
6785       }
6786     }
6787     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6788       IS             is_global;
6789       const PetscInt *gidxs;
6790 
6791       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6792       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6793       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6794       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6795       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6796     }
6797   }
6798   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6799     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6800   }
6801 
6802   if (!pcbddc->fake_change) {
6803     /* add pressure dofs to set of primal nodes for numbering purposes */
6804     for (i=0;i<pcbddc->benign_n;i++) {
6805       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
6806       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
6807       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
6808       pcbddc->local_primal_size_cc++;
6809       pcbddc->local_primal_size++;
6810     }
6811 
6812     /* check if a new primal space has been introduced (also take into account benign trick) */
6813     pcbddc->new_primal_space_local = PETSC_TRUE;
6814     if (olocal_primal_size == pcbddc->local_primal_size) {
6815       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6816       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6817       if (!pcbddc->new_primal_space_local) {
6818         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6819         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6820       }
6821     }
6822     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
6823     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6824   }
6825   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
6826 
6827   /* flush dbg viewer */
6828   if (pcbddc->dbg_flag) {
6829     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6830   }
6831 
6832   /* free workspace */
6833   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
6834   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
6835   if (!pcbddc->adaptive_selection) {
6836     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
6837     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
6838   } else {
6839     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
6840                       pcbddc->adaptive_constraints_idxs_ptr,
6841                       pcbddc->adaptive_constraints_data_ptr,
6842                       pcbddc->adaptive_constraints_idxs,
6843                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
6844     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
6845     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
6846   }
6847   PetscFunctionReturn(0);
6848 }
6849 /* #undef PETSC_MISSING_LAPACK_GESVD */
6850 
6851 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
6852 {
6853   ISLocalToGlobalMapping map;
6854   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
6855   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
6856   PetscInt               i,N;
6857   PetscBool              rcsr = PETSC_FALSE;
6858   PetscErrorCode         ierr;
6859 
6860   PetscFunctionBegin;
6861   if (pcbddc->recompute_topography) {
6862     pcbddc->graphanalyzed = PETSC_FALSE;
6863     /* Reset previously computed graph */
6864     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
6865     /* Init local Graph struct */
6866     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
6867     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
6868     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
6869 
6870     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
6871       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6872     }
6873     /* Check validity of the csr graph passed in by the user */
6874     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);
6875 
6876     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
6877     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
6878       PetscInt  *xadj,*adjncy;
6879       PetscInt  nvtxs;
6880       PetscBool flg_row=PETSC_FALSE;
6881 
6882       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6883       if (flg_row) {
6884         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
6885         pcbddc->computed_rowadj = PETSC_TRUE;
6886       }
6887       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6888       rcsr = PETSC_TRUE;
6889     }
6890     if (pcbddc->dbg_flag) {
6891       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6892     }
6893 
6894     if (pcbddc->mat_graph->cdim && !pcbddc->mat_graph->cloc) {
6895       PetscReal    *lcoords;
6896       PetscInt     n;
6897       MPI_Datatype dimrealtype;
6898 
6899       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);
6900       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
6901       ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
6902       ierr = PetscMalloc1(pcbddc->mat_graph->cdim*n,&lcoords);CHKERRQ(ierr);
6903       ierr = MPI_Type_contiguous(pcbddc->mat_graph->cdim,MPIU_REAL,&dimrealtype);CHKERRQ(ierr);
6904       ierr = MPI_Type_commit(&dimrealtype);CHKERRQ(ierr);
6905       ierr = PetscSFBcastBegin(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
6906       ierr = PetscSFBcastEnd(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
6907       ierr = MPI_Type_free(&dimrealtype);CHKERRQ(ierr);
6908       ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
6909 
6910       pcbddc->mat_graph->coords = lcoords;
6911       pcbddc->mat_graph->cloc   = PETSC_TRUE;
6912       pcbddc->mat_graph->cnloc  = n;
6913     }
6914     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);
6915     pcbddc->mat_graph->active_coords = (PetscBool)(pcbddc->corner_selection && !pcbddc->corner_selected);
6916 
6917     /* Setup of Graph */
6918     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
6919     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6920 
6921     /* attach info on disconnected subdomains if present */
6922     if (pcbddc->n_local_subs) {
6923       PetscInt *local_subs;
6924 
6925       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
6926       for (i=0;i<pcbddc->n_local_subs;i++) {
6927         const PetscInt *idxs;
6928         PetscInt       nl,j;
6929 
6930         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
6931         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6932         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
6933         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6934       }
6935       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
6936       pcbddc->mat_graph->local_subs = local_subs;
6937     }
6938   }
6939 
6940   if (!pcbddc->graphanalyzed) {
6941     /* Graph's connected components analysis */
6942     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
6943     pcbddc->graphanalyzed = PETSC_TRUE;
6944   }
6945   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
6946   PetscFunctionReturn(0);
6947 }
6948 
6949 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
6950 {
6951   PetscInt       i,j;
6952   PetscScalar    *alphas;
6953   PetscErrorCode ierr;
6954 
6955   PetscFunctionBegin;
6956   if (!n) PetscFunctionReturn(0);
6957   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
6958   ierr = VecNormalize(vecs[0],NULL);CHKERRQ(ierr);
6959   for (i=1;i<n;i++) {
6960     ierr = VecMDot(vecs[i],i,vecs,alphas);CHKERRQ(ierr);
6961     for (j=0;j<i;j++) alphas[j] = PetscConj(-alphas[j]);
6962     ierr = VecMAXPY(vecs[i],i,alphas,vecs);CHKERRQ(ierr);
6963     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
6964   }
6965   ierr = PetscFree(alphas);CHKERRQ(ierr);
6966   PetscFunctionReturn(0);
6967 }
6968 
6969 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
6970 {
6971   Mat            A;
6972   PetscInt       n_neighs,*neighs,*n_shared,**shared;
6973   PetscMPIInt    size,rank,color;
6974   PetscInt       *xadj,*adjncy;
6975   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
6976   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
6977   PetscInt       void_procs,*procs_candidates = NULL;
6978   PetscInt       xadj_count,*count;
6979   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
6980   PetscSubcomm   psubcomm;
6981   MPI_Comm       subcomm;
6982   PetscErrorCode ierr;
6983 
6984   PetscFunctionBegin;
6985   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6986   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6987   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);
6988   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
6989   PetscValidLogicalCollectiveInt(mat,redprocs,3);
6990   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %d\n",*n_subdomains);
6991 
6992   if (have_void) *have_void = PETSC_FALSE;
6993   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
6994   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
6995   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
6996   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
6997   im_active = !!n;
6998   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6999   void_procs = size - active_procs;
7000   /* get ranks of of non-active processes in mat communicator */
7001   if (void_procs) {
7002     PetscInt ncand;
7003 
7004     if (have_void) *have_void = PETSC_TRUE;
7005     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
7006     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7007     for (i=0,ncand=0;i<size;i++) {
7008       if (!procs_candidates[i]) {
7009         procs_candidates[ncand++] = i;
7010       }
7011     }
7012     /* force n_subdomains to be not greater that the number of non-active processes */
7013     *n_subdomains = PetscMin(void_procs,*n_subdomains);
7014   }
7015 
7016   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
7017      number of subdomains requested 1 -> send to master or first candidate in voids  */
7018   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
7019   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
7020     PetscInt issize,isidx,dest;
7021     if (*n_subdomains == 1) dest = 0;
7022     else dest = rank;
7023     if (im_active) {
7024       issize = 1;
7025       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7026         isidx = procs_candidates[dest];
7027       } else {
7028         isidx = dest;
7029       }
7030     } else {
7031       issize = 0;
7032       isidx = -1;
7033     }
7034     if (*n_subdomains != 1) *n_subdomains = active_procs;
7035     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
7036     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7037     PetscFunctionReturn(0);
7038   }
7039   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
7040   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
7041   threshold = PetscMax(threshold,2);
7042 
7043   /* Get info on mapping */
7044   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7045 
7046   /* build local CSR graph of subdomains' connectivity */
7047   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
7048   xadj[0] = 0;
7049   xadj[1] = PetscMax(n_neighs-1,0);
7050   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
7051   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
7052   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
7053   for (i=1;i<n_neighs;i++)
7054     for (j=0;j<n_shared[i];j++)
7055       count[shared[i][j]] += 1;
7056 
7057   xadj_count = 0;
7058   for (i=1;i<n_neighs;i++) {
7059     for (j=0;j<n_shared[i];j++) {
7060       if (count[shared[i][j]] < threshold) {
7061         adjncy[xadj_count] = neighs[i];
7062         adjncy_wgt[xadj_count] = n_shared[i];
7063         xadj_count++;
7064         break;
7065       }
7066     }
7067   }
7068   xadj[1] = xadj_count;
7069   ierr = PetscFree(count);CHKERRQ(ierr);
7070   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7071   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7072 
7073   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
7074 
7075   /* Restrict work on active processes only */
7076   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
7077   if (void_procs) {
7078     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
7079     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
7080     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
7081     subcomm = PetscSubcommChild(psubcomm);
7082   } else {
7083     psubcomm = NULL;
7084     subcomm = PetscObjectComm((PetscObject)mat);
7085   }
7086 
7087   v_wgt = NULL;
7088   if (!color) {
7089     ierr = PetscFree(xadj);CHKERRQ(ierr);
7090     ierr = PetscFree(adjncy);CHKERRQ(ierr);
7091     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7092   } else {
7093     Mat             subdomain_adj;
7094     IS              new_ranks,new_ranks_contig;
7095     MatPartitioning partitioner;
7096     PetscInt        rstart=0,rend=0;
7097     PetscInt        *is_indices,*oldranks;
7098     PetscMPIInt     size;
7099     PetscBool       aggregate;
7100 
7101     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
7102     if (void_procs) {
7103       PetscInt prank = rank;
7104       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
7105       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
7106       for (i=0;i<xadj[1];i++) {
7107         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
7108       }
7109       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7110     } else {
7111       oldranks = NULL;
7112     }
7113     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
7114     if (aggregate) { /* TODO: all this part could be made more efficient */
7115       PetscInt    lrows,row,ncols,*cols;
7116       PetscMPIInt nrank;
7117       PetscScalar *vals;
7118 
7119       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
7120       lrows = 0;
7121       if (nrank<redprocs) {
7122         lrows = size/redprocs;
7123         if (nrank<size%redprocs) lrows++;
7124       }
7125       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
7126       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
7127       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7128       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7129       row = nrank;
7130       ncols = xadj[1]-xadj[0];
7131       cols = adjncy;
7132       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
7133       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
7134       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
7135       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7136       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7137       ierr = PetscFree(xadj);CHKERRQ(ierr);
7138       ierr = PetscFree(adjncy);CHKERRQ(ierr);
7139       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7140       ierr = PetscFree(vals);CHKERRQ(ierr);
7141       if (use_vwgt) {
7142         Vec               v;
7143         const PetscScalar *array;
7144         PetscInt          nl;
7145 
7146         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
7147         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
7148         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
7149         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
7150         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
7151         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
7152         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
7153         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
7154         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
7155         ierr = VecDestroy(&v);CHKERRQ(ierr);
7156       }
7157     } else {
7158       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
7159       if (use_vwgt) {
7160         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
7161         v_wgt[0] = n;
7162       }
7163     }
7164     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
7165 
7166     /* Partition */
7167     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
7168     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
7169     if (v_wgt) {
7170       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
7171     }
7172     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
7173     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
7174     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
7175     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
7176     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
7177 
7178     /* renumber new_ranks to avoid "holes" in new set of processors */
7179     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
7180     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
7181     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7182     if (!aggregate) {
7183       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7184 #if defined(PETSC_USE_DEBUG)
7185         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7186 #endif
7187         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
7188       } else if (oldranks) {
7189         ranks_send_to_idx[0] = oldranks[is_indices[0]];
7190       } else {
7191         ranks_send_to_idx[0] = is_indices[0];
7192       }
7193     } else {
7194       PetscInt    idx = 0;
7195       PetscMPIInt tag;
7196       MPI_Request *reqs;
7197 
7198       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
7199       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
7200       for (i=rstart;i<rend;i++) {
7201         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
7202       }
7203       ierr = MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
7204       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7205       ierr = PetscFree(reqs);CHKERRQ(ierr);
7206       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7207 #if defined(PETSC_USE_DEBUG)
7208         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7209 #endif
7210         ranks_send_to_idx[0] = procs_candidates[oldranks[idx]];
7211       } else if (oldranks) {
7212         ranks_send_to_idx[0] = oldranks[idx];
7213       } else {
7214         ranks_send_to_idx[0] = idx;
7215       }
7216     }
7217     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7218     /* clean up */
7219     ierr = PetscFree(oldranks);CHKERRQ(ierr);
7220     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
7221     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
7222     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
7223   }
7224   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
7225   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7226 
7227   /* assemble parallel IS for sends */
7228   i = 1;
7229   if (!color) i=0;
7230   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
7231   PetscFunctionReturn(0);
7232 }
7233 
7234 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
7235 
7236 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[])
7237 {
7238   Mat                    local_mat;
7239   IS                     is_sends_internal;
7240   PetscInt               rows,cols,new_local_rows;
7241   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
7242   PetscBool              ismatis,isdense,newisdense,destroy_mat;
7243   ISLocalToGlobalMapping l2gmap;
7244   PetscInt*              l2gmap_indices;
7245   const PetscInt*        is_indices;
7246   MatType                new_local_type;
7247   /* buffers */
7248   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
7249   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
7250   PetscInt               *recv_buffer_idxs_local;
7251   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
7252   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
7253   /* MPI */
7254   MPI_Comm               comm,comm_n;
7255   PetscSubcomm           subcomm;
7256   PetscMPIInt            n_sends,n_recvs,commsize;
7257   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
7258   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
7259   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
7260   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
7261   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
7262   PetscErrorCode         ierr;
7263 
7264   PetscFunctionBegin;
7265   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7266   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7267   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);
7268   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
7269   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
7270   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
7271   PetscValidLogicalCollectiveBool(mat,reuse,6);
7272   PetscValidLogicalCollectiveInt(mat,nis,8);
7273   PetscValidLogicalCollectiveInt(mat,nvecs,10);
7274   if (nvecs) {
7275     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
7276     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
7277   }
7278   /* further checks */
7279   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7280   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
7281   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
7282   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
7283   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
7284   if (reuse && *mat_n) {
7285     PetscInt mrows,mcols,mnrows,mncols;
7286     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
7287     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
7288     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
7289     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
7290     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
7291     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
7292     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
7293   }
7294   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
7295   PetscValidLogicalCollectiveInt(mat,bs,0);
7296 
7297   /* prepare IS for sending if not provided */
7298   if (!is_sends) {
7299     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
7300     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
7301   } else {
7302     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
7303     is_sends_internal = is_sends;
7304   }
7305 
7306   /* get comm */
7307   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
7308 
7309   /* compute number of sends */
7310   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
7311   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7312 
7313   /* compute number of receives */
7314   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
7315   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
7316   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
7317   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7318   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7319   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7320   ierr = PetscFree(iflags);CHKERRQ(ierr);
7321 
7322   /* restrict comm if requested */
7323   subcomm = 0;
7324   destroy_mat = PETSC_FALSE;
7325   if (restrict_comm) {
7326     PetscMPIInt color,subcommsize;
7327 
7328     color = 0;
7329     if (restrict_full) {
7330       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7331     } else {
7332       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7333     }
7334     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
7335     subcommsize = commsize - subcommsize;
7336     /* check if reuse has been requested */
7337     if (reuse) {
7338       if (*mat_n) {
7339         PetscMPIInt subcommsize2;
7340         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
7341         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7342         comm_n = PetscObjectComm((PetscObject)*mat_n);
7343       } else {
7344         comm_n = PETSC_COMM_SELF;
7345       }
7346     } else { /* MAT_INITIAL_MATRIX */
7347       PetscMPIInt rank;
7348 
7349       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
7350       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7351       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7352       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7353       comm_n = PetscSubcommChild(subcomm);
7354     }
7355     /* flag to destroy *mat_n if not significative */
7356     if (color) destroy_mat = PETSC_TRUE;
7357   } else {
7358     comm_n = comm;
7359   }
7360 
7361   /* prepare send/receive buffers */
7362   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
7363   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
7364   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
7365   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
7366   if (nis) {
7367     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
7368   }
7369 
7370   /* Get data from local matrices */
7371   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7372     /* TODO: See below some guidelines on how to prepare the local buffers */
7373     /*
7374        send_buffer_vals should contain the raw values of the local matrix
7375        send_buffer_idxs should contain:
7376        - MatType_PRIVATE type
7377        - PetscInt        size_of_l2gmap
7378        - PetscInt        global_row_indices[size_of_l2gmap]
7379        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7380     */
7381   else {
7382     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7383     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7384     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7385     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7386     send_buffer_idxs[1] = i;
7387     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7388     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
7389     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7390     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7391     for (i=0;i<n_sends;i++) {
7392       ilengths_vals[is_indices[i]] = len*len;
7393       ilengths_idxs[is_indices[i]] = len+2;
7394     }
7395   }
7396   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7397   /* additional is (if any) */
7398   if (nis) {
7399     PetscMPIInt psum;
7400     PetscInt j;
7401     for (j=0,psum=0;j<nis;j++) {
7402       PetscInt plen;
7403       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7404       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7405       psum += len+1; /* indices + lenght */
7406     }
7407     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7408     for (j=0,psum=0;j<nis;j++) {
7409       PetscInt plen;
7410       const PetscInt *is_array_idxs;
7411       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7412       send_buffer_idxs_is[psum] = plen;
7413       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7414       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
7415       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7416       psum += plen+1; /* indices + lenght */
7417     }
7418     for (i=0;i<n_sends;i++) {
7419       ilengths_idxs_is[is_indices[i]] = psum;
7420     }
7421     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7422   }
7423   ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7424 
7425   buf_size_idxs = 0;
7426   buf_size_vals = 0;
7427   buf_size_idxs_is = 0;
7428   buf_size_vecs = 0;
7429   for (i=0;i<n_recvs;i++) {
7430     buf_size_idxs += (PetscInt)olengths_idxs[i];
7431     buf_size_vals += (PetscInt)olengths_vals[i];
7432     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7433     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7434   }
7435   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7436   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7437   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7438   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7439 
7440   /* get new tags for clean communications */
7441   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7442   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7443   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7444   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7445 
7446   /* allocate for requests */
7447   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7448   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7449   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7450   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7451   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7452   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7453   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7454   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7455 
7456   /* communications */
7457   ptr_idxs = recv_buffer_idxs;
7458   ptr_vals = recv_buffer_vals;
7459   ptr_idxs_is = recv_buffer_idxs_is;
7460   ptr_vecs = recv_buffer_vecs;
7461   for (i=0;i<n_recvs;i++) {
7462     source_dest = onodes[i];
7463     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7464     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7465     ptr_idxs += olengths_idxs[i];
7466     ptr_vals += olengths_vals[i];
7467     if (nis) {
7468       source_dest = onodes_is[i];
7469       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);
7470       ptr_idxs_is += olengths_idxs_is[i];
7471     }
7472     if (nvecs) {
7473       source_dest = onodes[i];
7474       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7475       ptr_vecs += olengths_idxs[i]-2;
7476     }
7477   }
7478   for (i=0;i<n_sends;i++) {
7479     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7480     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7481     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7482     if (nis) {
7483       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);
7484     }
7485     if (nvecs) {
7486       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7487       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7488     }
7489   }
7490   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7491   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7492 
7493   /* assemble new l2g map */
7494   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7495   ptr_idxs = recv_buffer_idxs;
7496   new_local_rows = 0;
7497   for (i=0;i<n_recvs;i++) {
7498     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7499     ptr_idxs += olengths_idxs[i];
7500   }
7501   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7502   ptr_idxs = recv_buffer_idxs;
7503   new_local_rows = 0;
7504   for (i=0;i<n_recvs;i++) {
7505     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
7506     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7507     ptr_idxs += olengths_idxs[i];
7508   }
7509   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7510   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7511   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7512 
7513   /* infer new local matrix type from received local matrices type */
7514   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7515   /* 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) */
7516   if (n_recvs) {
7517     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7518     ptr_idxs = recv_buffer_idxs;
7519     for (i=0;i<n_recvs;i++) {
7520       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7521         new_local_type_private = MATAIJ_PRIVATE;
7522         break;
7523       }
7524       ptr_idxs += olengths_idxs[i];
7525     }
7526     switch (new_local_type_private) {
7527       case MATDENSE_PRIVATE:
7528         new_local_type = MATSEQAIJ;
7529         bs = 1;
7530         break;
7531       case MATAIJ_PRIVATE:
7532         new_local_type = MATSEQAIJ;
7533         bs = 1;
7534         break;
7535       case MATBAIJ_PRIVATE:
7536         new_local_type = MATSEQBAIJ;
7537         break;
7538       case MATSBAIJ_PRIVATE:
7539         new_local_type = MATSEQSBAIJ;
7540         break;
7541       default:
7542         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7543         break;
7544     }
7545   } else { /* by default, new_local_type is seqaij */
7546     new_local_type = MATSEQAIJ;
7547     bs = 1;
7548   }
7549 
7550   /* create MATIS object if needed */
7551   if (!reuse) {
7552     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7553     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7554   } else {
7555     /* it also destroys the local matrices */
7556     if (*mat_n) {
7557       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7558     } else { /* this is a fake object */
7559       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7560     }
7561   }
7562   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7563   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7564 
7565   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7566 
7567   /* Global to local map of received indices */
7568   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7569   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7570   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7571 
7572   /* restore attributes -> type of incoming data and its size */
7573   buf_size_idxs = 0;
7574   for (i=0;i<n_recvs;i++) {
7575     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7576     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7577     buf_size_idxs += (PetscInt)olengths_idxs[i];
7578   }
7579   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7580 
7581   /* set preallocation */
7582   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7583   if (!newisdense) {
7584     PetscInt *new_local_nnz=0;
7585 
7586     ptr_idxs = recv_buffer_idxs_local;
7587     if (n_recvs) {
7588       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7589     }
7590     for (i=0;i<n_recvs;i++) {
7591       PetscInt j;
7592       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7593         for (j=0;j<*(ptr_idxs+1);j++) {
7594           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7595         }
7596       } else {
7597         /* TODO */
7598       }
7599       ptr_idxs += olengths_idxs[i];
7600     }
7601     if (new_local_nnz) {
7602       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7603       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7604       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7605       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7606       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7607       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7608     } else {
7609       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7610     }
7611     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7612   } else {
7613     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7614   }
7615 
7616   /* set values */
7617   ptr_vals = recv_buffer_vals;
7618   ptr_idxs = recv_buffer_idxs_local;
7619   for (i=0;i<n_recvs;i++) {
7620     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7621       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7622       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7623       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7624       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7625       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7626     } else {
7627       /* TODO */
7628     }
7629     ptr_idxs += olengths_idxs[i];
7630     ptr_vals += olengths_vals[i];
7631   }
7632   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7633   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7634   ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7635   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7636   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7637   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7638 
7639 #if 0
7640   if (!restrict_comm) { /* check */
7641     Vec       lvec,rvec;
7642     PetscReal infty_error;
7643 
7644     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7645     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7646     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7647     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7648     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7649     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7650     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7651     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7652     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7653   }
7654 #endif
7655 
7656   /* assemble new additional is (if any) */
7657   if (nis) {
7658     PetscInt **temp_idxs,*count_is,j,psum;
7659 
7660     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7661     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7662     ptr_idxs = recv_buffer_idxs_is;
7663     psum = 0;
7664     for (i=0;i<n_recvs;i++) {
7665       for (j=0;j<nis;j++) {
7666         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7667         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7668         psum += plen;
7669         ptr_idxs += plen+1; /* shift pointer to received data */
7670       }
7671     }
7672     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7673     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7674     for (i=1;i<nis;i++) {
7675       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7676     }
7677     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7678     ptr_idxs = recv_buffer_idxs_is;
7679     for (i=0;i<n_recvs;i++) {
7680       for (j=0;j<nis;j++) {
7681         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7682         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7683         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7684         ptr_idxs += plen+1; /* shift pointer to received data */
7685       }
7686     }
7687     for (i=0;i<nis;i++) {
7688       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7689       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7690       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7691     }
7692     ierr = PetscFree(count_is);CHKERRQ(ierr);
7693     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7694     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7695   }
7696   /* free workspace */
7697   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7698   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7699   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7700   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7701   if (isdense) {
7702     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7703     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7704     ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7705   } else {
7706     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7707   }
7708   if (nis) {
7709     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7710     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7711   }
7712 
7713   if (nvecs) {
7714     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7715     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7716     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7717     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7718     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7719     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7720     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7721     /* set values */
7722     ptr_vals = recv_buffer_vecs;
7723     ptr_idxs = recv_buffer_idxs_local;
7724     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7725     for (i=0;i<n_recvs;i++) {
7726       PetscInt j;
7727       for (j=0;j<*(ptr_idxs+1);j++) {
7728         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7729       }
7730       ptr_idxs += olengths_idxs[i];
7731       ptr_vals += olengths_idxs[i]-2;
7732     }
7733     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7734     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7735     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7736   }
7737 
7738   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7739   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7740   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7741   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7742   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7743   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7744   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7745   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7746   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7747   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7748   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7749   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7750   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7751   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7752   ierr = PetscFree(onodes);CHKERRQ(ierr);
7753   if (nis) {
7754     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7755     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7756     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7757   }
7758   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7759   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7760     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7761     for (i=0;i<nis;i++) {
7762       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7763     }
7764     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7765       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7766     }
7767     *mat_n = NULL;
7768   }
7769   PetscFunctionReturn(0);
7770 }
7771 
7772 /* temporary hack into ksp private data structure */
7773 #include <petsc/private/kspimpl.h>
7774 
7775 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7776 {
7777   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7778   PC_IS                  *pcis = (PC_IS*)pc->data;
7779   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7780   Mat                    coarsedivudotp = NULL;
7781   Mat                    coarseG,t_coarse_mat_is;
7782   MatNullSpace           CoarseNullSpace = NULL;
7783   ISLocalToGlobalMapping coarse_islg;
7784   IS                     coarse_is,*isarray;
7785   PetscInt               i,im_active=-1,active_procs=-1;
7786   PetscInt               nis,nisdofs,nisneu,nisvert;
7787   PC                     pc_temp;
7788   PCType                 coarse_pc_type;
7789   KSPType                coarse_ksp_type;
7790   PetscBool              multilevel_requested,multilevel_allowed;
7791   PetscBool              coarse_reuse;
7792   PetscInt               ncoarse,nedcfield;
7793   PetscBool              compute_vecs = PETSC_FALSE;
7794   PetscScalar            *array;
7795   MatReuse               coarse_mat_reuse;
7796   PetscBool              restr, full_restr, have_void;
7797   PetscMPIInt            commsize;
7798   PetscErrorCode         ierr;
7799 
7800   PetscFunctionBegin;
7801   /* Assign global numbering to coarse dofs */
7802   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 */
7803     PetscInt ocoarse_size;
7804     compute_vecs = PETSC_TRUE;
7805 
7806     pcbddc->new_primal_space = PETSC_TRUE;
7807     ocoarse_size = pcbddc->coarse_size;
7808     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
7809     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
7810     /* see if we can avoid some work */
7811     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
7812       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
7813       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
7814         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
7815         coarse_reuse = PETSC_FALSE;
7816       } else { /* we can safely reuse already computed coarse matrix */
7817         coarse_reuse = PETSC_TRUE;
7818       }
7819     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
7820       coarse_reuse = PETSC_FALSE;
7821     }
7822     /* reset any subassembling information */
7823     if (!coarse_reuse || pcbddc->recompute_topography) {
7824       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7825     }
7826   } else { /* primal space is unchanged, so we can reuse coarse matrix */
7827     coarse_reuse = PETSC_TRUE;
7828   }
7829   /* assemble coarse matrix */
7830   if (coarse_reuse && pcbddc->coarse_ksp) {
7831     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
7832     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
7833     coarse_mat_reuse = MAT_REUSE_MATRIX;
7834   } else {
7835     coarse_mat = NULL;
7836     coarse_mat_reuse = MAT_INITIAL_MATRIX;
7837   }
7838 
7839   /* creates temporary l2gmap and IS for coarse indexes */
7840   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
7841   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
7842 
7843   /* creates temporary MATIS object for coarse matrix */
7844   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
7845   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7846   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
7847   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7848   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);
7849   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
7850   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7851   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7852   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
7853 
7854   /* count "active" (i.e. with positive local size) and "void" processes */
7855   im_active = !!(pcis->n);
7856   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7857 
7858   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
7859   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
7860   /* full_restr : just use the receivers from the subassembling pattern */
7861   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&commsize);CHKERRQ(ierr);
7862   coarse_mat_is = NULL;
7863   multilevel_allowed = PETSC_FALSE;
7864   multilevel_requested = PETSC_FALSE;
7865   pcbddc->coarse_eqs_per_proc = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
7866   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
7867   if (multilevel_requested) {
7868     ncoarse = active_procs/pcbddc->coarsening_ratio;
7869     restr = PETSC_FALSE;
7870     full_restr = PETSC_FALSE;
7871   } else {
7872     ncoarse = pcbddc->coarse_size/pcbddc->coarse_eqs_per_proc;
7873     restr = PETSC_TRUE;
7874     full_restr = PETSC_TRUE;
7875   }
7876   if (!pcbddc->coarse_size || commsize == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
7877   ncoarse = PetscMax(1,ncoarse);
7878   if (!pcbddc->coarse_subassembling) {
7879     if (pcbddc->coarsening_ratio > 1) {
7880       if (multilevel_requested) {
7881         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7882       } else {
7883         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7884       }
7885     } else {
7886       PetscMPIInt rank;
7887       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
7888       have_void = (active_procs == (PetscInt)commsize) ? PETSC_FALSE : PETSC_TRUE;
7889       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7890     }
7891   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
7892     PetscInt    psum;
7893     if (pcbddc->coarse_ksp) psum = 1;
7894     else psum = 0;
7895     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7896     if (ncoarse < commsize) have_void = PETSC_TRUE;
7897   }
7898   /* determine if we can go multilevel */
7899   if (multilevel_requested) {
7900     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
7901     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
7902   }
7903   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
7904 
7905   /* dump subassembling pattern */
7906   if (pcbddc->dbg_flag && multilevel_allowed) {
7907     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
7908   }
7909 
7910   /* compute dofs splitting and neumann boundaries for coarse dofs */
7911   nedcfield = -1;
7912   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal)) { /* protects from unneded computations */
7913     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
7914     const PetscInt         *idxs;
7915     ISLocalToGlobalMapping tmap;
7916 
7917     /* create map between primal indices (in local representative ordering) and local primal numbering */
7918     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
7919     /* allocate space for temporary storage */
7920     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
7921     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
7922     /* allocate for IS array */
7923     nisdofs = pcbddc->n_ISForDofsLocal;
7924     if (pcbddc->nedclocal) {
7925       if (pcbddc->nedfield > -1) {
7926         nedcfield = pcbddc->nedfield;
7927       } else {
7928         nedcfield = 0;
7929         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%d)",nisdofs);
7930         nisdofs = 1;
7931       }
7932     }
7933     nisneu = !!pcbddc->NeumannBoundariesLocal;
7934     nisvert = 0; /* nisvert is not used */
7935     nis = nisdofs + nisneu + nisvert;
7936     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
7937     /* dofs splitting */
7938     for (i=0;i<nisdofs;i++) {
7939       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
7940       if (nedcfield != i) {
7941         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
7942         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7943         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7944         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7945       } else {
7946         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
7947         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7948         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7949         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %d != %d\n",tsize,nout);
7950         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7951       }
7952       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7953       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7954       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
7955     }
7956     /* neumann boundaries */
7957     if (pcbddc->NeumannBoundariesLocal) {
7958       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
7959       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
7960       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7961       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7962       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7963       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7964       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
7965       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
7966     }
7967     /* free memory */
7968     ierr = PetscFree(tidxs);CHKERRQ(ierr);
7969     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
7970     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
7971   } else {
7972     nis = 0;
7973     nisdofs = 0;
7974     nisneu = 0;
7975     nisvert = 0;
7976     isarray = NULL;
7977   }
7978   /* destroy no longer needed map */
7979   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
7980 
7981   /* subassemble */
7982   if (multilevel_allowed) {
7983     Vec       vp[1];
7984     PetscInt  nvecs = 0;
7985     PetscBool reuse,reuser;
7986 
7987     if (coarse_mat) reuse = PETSC_TRUE;
7988     else reuse = PETSC_FALSE;
7989     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7990     vp[0] = NULL;
7991     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
7992       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
7993       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
7994       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
7995       nvecs = 1;
7996 
7997       if (pcbddc->divudotp) {
7998         Mat      B,loc_divudotp;
7999         Vec      v,p;
8000         IS       dummy;
8001         PetscInt np;
8002 
8003         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
8004         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
8005         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
8006         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
8007         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
8008         ierr = VecSet(p,1.);CHKERRQ(ierr);
8009         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
8010         ierr = VecDestroy(&p);CHKERRQ(ierr);
8011         ierr = MatDestroy(&B);CHKERRQ(ierr);
8012         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
8013         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
8014         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
8015         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
8016         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
8017         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8018         ierr = VecDestroy(&v);CHKERRQ(ierr);
8019       }
8020     }
8021     if (reuser) {
8022       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8023     } else {
8024       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8025     }
8026     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
8027       PetscScalar *arraym,*arrayv;
8028       PetscInt    nl;
8029       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
8030       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
8031       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8032       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
8033       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
8034       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
8035       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8036       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
8037     } else {
8038       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
8039     }
8040   } else {
8041     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
8042   }
8043   if (coarse_mat_is || coarse_mat) {
8044     PetscMPIInt size;
8045     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)coarse_mat_is),&size);CHKERRQ(ierr);
8046     if (!multilevel_allowed) {
8047       ierr = MatISGetMPIXAIJ(coarse_mat_is,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
8048     } else {
8049       Mat A;
8050 
8051       /* if this matrix is present, it means we are not reusing the coarse matrix */
8052       if (coarse_mat_is) {
8053         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
8054         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
8055         coarse_mat = coarse_mat_is;
8056       }
8057       /* be sure we don't have MatSeqDENSE as local mat */
8058       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
8059       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
8060     }
8061   }
8062   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
8063   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
8064 
8065   /* create local to global scatters for coarse problem */
8066   if (compute_vecs) {
8067     PetscInt lrows;
8068     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
8069     if (coarse_mat) {
8070       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
8071     } else {
8072       lrows = 0;
8073     }
8074     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
8075     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
8076     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
8077     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8078     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8079   }
8080   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
8081 
8082   /* set defaults for coarse KSP and PC */
8083   if (multilevel_allowed) {
8084     coarse_ksp_type = KSPRICHARDSON;
8085     coarse_pc_type = PCBDDC;
8086   } else {
8087     coarse_ksp_type = KSPPREONLY;
8088     coarse_pc_type = PCREDUNDANT;
8089   }
8090 
8091   /* print some info if requested */
8092   if (pcbddc->dbg_flag) {
8093     if (!multilevel_allowed) {
8094       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8095       if (multilevel_requested) {
8096         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);
8097       } else if (pcbddc->max_levels) {
8098         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
8099       }
8100       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8101     }
8102   }
8103 
8104   /* communicate coarse discrete gradient */
8105   coarseG = NULL;
8106   if (pcbddc->nedcG && multilevel_allowed) {
8107     MPI_Comm ccomm;
8108     if (coarse_mat) {
8109       ccomm = PetscObjectComm((PetscObject)coarse_mat);
8110     } else {
8111       ccomm = MPI_COMM_NULL;
8112     }
8113     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
8114   }
8115 
8116   /* create the coarse KSP object only once with defaults */
8117   if (coarse_mat) {
8118     PetscBool   isredundant,isnn,isbddc;
8119     PetscViewer dbg_viewer = NULL;
8120 
8121     if (pcbddc->dbg_flag) {
8122       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
8123       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8124     }
8125     if (!pcbddc->coarse_ksp) {
8126       char   prefix[256],str_level[16];
8127       size_t len;
8128 
8129       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
8130       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8131       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
8132       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
8133       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8134       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
8135       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
8136       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8137       /* TODO is this logic correct? should check for coarse_mat type */
8138       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8139       /* prefix */
8140       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
8141       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
8142       if (!pcbddc->current_level) {
8143         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,sizeof(prefix));CHKERRQ(ierr);
8144         ierr = PetscStrlcat(prefix,"pc_bddc_coarse_",sizeof(prefix));CHKERRQ(ierr);
8145       } else {
8146         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
8147         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
8148         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
8149         /* Nonstandard use of PetscStrncpy() to copy only a portion of the string */
8150         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
8151         ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
8152         ierr = PetscStrlcat(prefix,str_level,sizeof(prefix));CHKERRQ(ierr);
8153       }
8154       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
8155       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8156       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8157       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8158       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8159       /* allow user customization */
8160       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
8161     }
8162     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8163     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8164     if (nisdofs) {
8165       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
8166       for (i=0;i<nisdofs;i++) {
8167         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8168       }
8169     }
8170     if (nisneu) {
8171       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
8172       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
8173     }
8174     if (nisvert) {
8175       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
8176       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
8177     }
8178     if (coarseG) {
8179       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
8180     }
8181 
8182     /* get some info after set from options */
8183     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8184     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
8185     if (isbddc && !multilevel_allowed) {
8186       ierr   = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8187       isbddc = PETSC_FALSE;
8188     }
8189     /* multilevel cannot be done with coarse PCs different from BDDC or NN */
8190     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
8191     if (multilevel_requested && multilevel_allowed && !isbddc && !isnn) {
8192       ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8193       isbddc = PETSC_TRUE;
8194     }
8195     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
8196     if (isredundant) {
8197       KSP inner_ksp;
8198       PC  inner_pc;
8199 
8200       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
8201       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
8202     }
8203 
8204     /* parameters which miss an API */
8205     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8206     if (isbddc) {
8207       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
8208 
8209       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
8210       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
8211       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
8212       if (pcbddc_coarse->benign_saddle_point) {
8213         Mat                    coarsedivudotp_is;
8214         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
8215         IS                     row,col;
8216         const PetscInt         *gidxs;
8217         PetscInt               n,st,M,N;
8218 
8219         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
8220         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
8221         st   = st-n;
8222         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
8223         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
8224         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
8225         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8226         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
8227         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8228         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
8229         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
8230         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
8231         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
8232         ierr = ISDestroy(&row);CHKERRQ(ierr);
8233         ierr = ISDestroy(&col);CHKERRQ(ierr);
8234         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
8235         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
8236         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
8237         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
8238         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
8239         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
8240         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
8241         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8242         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
8243         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
8244         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
8245         if (pcbddc->adaptive_threshold[0] == 0.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
8246       }
8247     }
8248 
8249     /* propagate symmetry info of coarse matrix */
8250     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
8251     if (pc->pmat->symmetric_set) {
8252       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
8253     }
8254     if (pc->pmat->hermitian_set) {
8255       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
8256     }
8257     if (pc->pmat->spd_set) {
8258       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
8259     }
8260     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
8261       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
8262     }
8263     /* set operators */
8264     ierr = MatViewFromOptions(coarse_mat,(PetscObject)pc,"-pc_bddc_coarse_mat_view");CHKERRQ(ierr);
8265     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8266     if (pcbddc->dbg_flag) {
8267       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8268     }
8269   }
8270   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
8271   ierr = PetscFree(isarray);CHKERRQ(ierr);
8272 #if 0
8273   {
8274     PetscViewer viewer;
8275     char filename[256];
8276     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
8277     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
8278     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
8279     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
8280     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
8281     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
8282   }
8283 #endif
8284 
8285   if (pcbddc->coarse_ksp) {
8286     Vec crhs,csol;
8287 
8288     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
8289     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
8290     if (!csol) {
8291       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
8292     }
8293     if (!crhs) {
8294       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
8295     }
8296   }
8297   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8298 
8299   /* compute null space for coarse solver if the benign trick has been requested */
8300   if (pcbddc->benign_null) {
8301 
8302     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
8303     for (i=0;i<pcbddc->benign_n;i++) {
8304       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
8305     }
8306     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
8307     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
8308     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8309     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8310     if (coarse_mat) {
8311       Vec         nullv;
8312       PetscScalar *array,*array2;
8313       PetscInt    nl;
8314 
8315       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
8316       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
8317       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8318       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
8319       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
8320       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
8321       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8322       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
8323       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
8324       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
8325     }
8326   }
8327 
8328   if (pcbddc->coarse_ksp) {
8329     PetscBool ispreonly;
8330 
8331     if (CoarseNullSpace) {
8332       PetscBool isnull;
8333       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
8334       if (isnull) {
8335         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
8336       }
8337       /* TODO: add local nullspaces (if any) */
8338     }
8339     /* setup coarse ksp */
8340     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
8341     /* Check coarse problem if in debug mode or if solving with an iterative method */
8342     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
8343     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
8344       KSP       check_ksp;
8345       KSPType   check_ksp_type;
8346       PC        check_pc;
8347       Vec       check_vec,coarse_vec;
8348       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8349       PetscInt  its;
8350       PetscBool compute_eigs;
8351       PetscReal *eigs_r,*eigs_c;
8352       PetscInt  neigs;
8353       const char *prefix;
8354 
8355       /* Create ksp object suitable for estimation of extreme eigenvalues */
8356       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
8357       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8358       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8359       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
8360       /* prevent from setup unneeded object */
8361       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
8362       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
8363       if (ispreonly) {
8364         check_ksp_type = KSPPREONLY;
8365         compute_eigs = PETSC_FALSE;
8366       } else {
8367         check_ksp_type = KSPGMRES;
8368         compute_eigs = PETSC_TRUE;
8369       }
8370       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
8371       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
8372       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
8373       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
8374       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
8375       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
8376       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
8377       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
8378       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
8379       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
8380       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
8381       /* create random vec */
8382       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
8383       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8384       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8385       /* solve coarse problem */
8386       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8387       /* set eigenvalue estimation if preonly has not been requested */
8388       if (compute_eigs) {
8389         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8390         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8391         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8392         if (neigs) {
8393           lambda_max = eigs_r[neigs-1];
8394           lambda_min = eigs_r[0];
8395           if (pcbddc->use_coarse_estimates) {
8396             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8397               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8398               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8399             }
8400           }
8401         }
8402       }
8403 
8404       /* check coarse problem residual error */
8405       if (pcbddc->dbg_flag) {
8406         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8407         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8408         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8409         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8410         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8411         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8412         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8413         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8414         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8415         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8416         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8417         if (CoarseNullSpace) {
8418           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8419         }
8420         if (compute_eigs) {
8421           PetscReal          lambda_max_s,lambda_min_s;
8422           KSPConvergedReason reason;
8423           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8424           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8425           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8426           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8427           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);
8428           for (i=0;i<neigs;i++) {
8429             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8430           }
8431         }
8432         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8433         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8434       }
8435       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8436       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8437       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8438       if (compute_eigs) {
8439         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8440         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8441       }
8442     }
8443   }
8444   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8445   /* print additional info */
8446   if (pcbddc->dbg_flag) {
8447     /* waits until all processes reaches this point */
8448     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8449     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
8450     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8451   }
8452 
8453   /* free memory */
8454   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8455   PetscFunctionReturn(0);
8456 }
8457 
8458 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8459 {
8460   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8461   PC_IS*         pcis = (PC_IS*)pc->data;
8462   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8463   IS             subset,subset_mult,subset_n;
8464   PetscInt       local_size,coarse_size=0;
8465   PetscInt       *local_primal_indices=NULL;
8466   const PetscInt *t_local_primal_indices;
8467   PetscErrorCode ierr;
8468 
8469   PetscFunctionBegin;
8470   /* Compute global number of coarse dofs */
8471   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8472   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8473   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8474   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8475   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8476   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8477   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8478   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8479   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8480   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);
8481   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8482   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8483   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
8484   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8485   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8486 
8487   /* check numbering */
8488   if (pcbddc->dbg_flag) {
8489     PetscScalar coarsesum,*array,*array2;
8490     PetscInt    i;
8491     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8492 
8493     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8494     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8495     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8496     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8497     /* counter */
8498     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8499     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8500     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8501     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8502     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8503     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8504     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8505     for (i=0;i<pcbddc->local_primal_size;i++) {
8506       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8507     }
8508     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8509     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8510     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8511     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8512     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8513     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8514     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8515     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8516     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8517     for (i=0;i<pcis->n;i++) {
8518       if (array[i] != 0.0 && array[i] != array2[i]) {
8519         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8520         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8521         set_error = PETSC_TRUE;
8522         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8523         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);
8524       }
8525     }
8526     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8527     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8528     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8529     for (i=0;i<pcis->n;i++) {
8530       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8531     }
8532     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8533     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8534     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8535     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8536     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8537     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8538     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8539       PetscInt *gidxs;
8540 
8541       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8542       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8543       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8544       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8545       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8546       for (i=0;i<pcbddc->local_primal_size;i++) {
8547         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);
8548       }
8549       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8550       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8551     }
8552     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8553     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8554     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8555   }
8556   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
8557   /* get back data */
8558   *coarse_size_n = coarse_size;
8559   *local_primal_indices_n = local_primal_indices;
8560   PetscFunctionReturn(0);
8561 }
8562 
8563 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8564 {
8565   IS             localis_t;
8566   PetscInt       i,lsize,*idxs,n;
8567   PetscScalar    *vals;
8568   PetscErrorCode ierr;
8569 
8570   PetscFunctionBegin;
8571   /* get indices in local ordering exploiting local to global map */
8572   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8573   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8574   for (i=0;i<lsize;i++) vals[i] = 1.0;
8575   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8576   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8577   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8578   if (idxs) { /* multilevel guard */
8579     ierr = VecSetOption(gwork,VEC_IGNORE_NEGATIVE_INDICES,PETSC_TRUE);CHKERRQ(ierr);
8580     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8581   }
8582   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8583   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8584   ierr = PetscFree(vals);CHKERRQ(ierr);
8585   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8586   /* now compute set in local ordering */
8587   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8588   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8589   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8590   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8591   for (i=0,lsize=0;i<n;i++) {
8592     if (PetscRealPart(vals[i]) > 0.5) {
8593       lsize++;
8594     }
8595   }
8596   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8597   for (i=0,lsize=0;i<n;i++) {
8598     if (PetscRealPart(vals[i]) > 0.5) {
8599       idxs[lsize++] = i;
8600     }
8601   }
8602   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8603   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8604   *localis = localis_t;
8605   PetscFunctionReturn(0);
8606 }
8607 
8608 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8609 {
8610   PC_IS               *pcis=(PC_IS*)pc->data;
8611   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8612   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8613   Mat                 S_j;
8614   PetscInt            *used_xadj,*used_adjncy;
8615   PetscBool           free_used_adj;
8616   PetscErrorCode      ierr;
8617 
8618   PetscFunctionBegin;
8619   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8620   free_used_adj = PETSC_FALSE;
8621   if (pcbddc->sub_schurs_layers == -1) {
8622     used_xadj = NULL;
8623     used_adjncy = NULL;
8624   } else {
8625     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8626       used_xadj = pcbddc->mat_graph->xadj;
8627       used_adjncy = pcbddc->mat_graph->adjncy;
8628     } else if (pcbddc->computed_rowadj) {
8629       used_xadj = pcbddc->mat_graph->xadj;
8630       used_adjncy = pcbddc->mat_graph->adjncy;
8631     } else {
8632       PetscBool      flg_row=PETSC_FALSE;
8633       const PetscInt *xadj,*adjncy;
8634       PetscInt       nvtxs;
8635 
8636       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8637       if (flg_row) {
8638         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8639         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8640         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8641         free_used_adj = PETSC_TRUE;
8642       } else {
8643         pcbddc->sub_schurs_layers = -1;
8644         used_xadj = NULL;
8645         used_adjncy = NULL;
8646       }
8647       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8648     }
8649   }
8650 
8651   /* setup sub_schurs data */
8652   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8653   if (!sub_schurs->schur_explicit) {
8654     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8655     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8656     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);
8657   } else {
8658     Mat       change = NULL;
8659     Vec       scaling = NULL;
8660     IS        change_primal = NULL, iP;
8661     PetscInt  benign_n;
8662     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8663     PetscBool isseqaij,need_change = PETSC_FALSE;
8664     PetscBool discrete_harmonic = PETSC_FALSE;
8665 
8666     if (!pcbddc->use_vertices && reuse_solvers) {
8667       PetscInt n_vertices;
8668 
8669       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8670       reuse_solvers = (PetscBool)!n_vertices;
8671     }
8672     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8673     if (!isseqaij) {
8674       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8675       if (matis->A == pcbddc->local_mat) {
8676         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8677         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8678       } else {
8679         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8680       }
8681     }
8682     if (!pcbddc->benign_change_explicit) {
8683       benign_n = pcbddc->benign_n;
8684     } else {
8685       benign_n = 0;
8686     }
8687     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
8688        We need a global reduction to avoid possible deadlocks.
8689        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
8690     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
8691       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
8692       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8693       need_change = (PetscBool)(!need_change);
8694     }
8695     /* If the user defines additional constraints, we import them here.
8696        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 */
8697     if (need_change) {
8698       PC_IS   *pcisf;
8699       PC_BDDC *pcbddcf;
8700       PC      pcf;
8701 
8702       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
8703       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
8704       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
8705       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
8706 
8707       /* hacks */
8708       pcisf                        = (PC_IS*)pcf->data;
8709       pcisf->is_B_local            = pcis->is_B_local;
8710       pcisf->vec1_N                = pcis->vec1_N;
8711       pcisf->BtoNmap               = pcis->BtoNmap;
8712       pcisf->n                     = pcis->n;
8713       pcisf->n_B                   = pcis->n_B;
8714       pcbddcf                      = (PC_BDDC*)pcf->data;
8715       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
8716       pcbddcf->mat_graph           = pcbddc->mat_graph;
8717       pcbddcf->use_faces           = PETSC_TRUE;
8718       pcbddcf->use_change_of_basis = PETSC_TRUE;
8719       pcbddcf->use_change_on_faces = PETSC_TRUE;
8720       pcbddcf->use_qr_single       = PETSC_TRUE;
8721       pcbddcf->fake_change         = PETSC_TRUE;
8722 
8723       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
8724       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
8725       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
8726       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
8727       change = pcbddcf->ConstraintMatrix;
8728       pcbddcf->ConstraintMatrix = NULL;
8729 
8730       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
8731       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
8732       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
8733       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
8734       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
8735       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
8736       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
8737       pcf->ops->destroy = NULL;
8738       pcf->ops->reset   = NULL;
8739       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
8740     }
8741     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
8742 
8743     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
8744     if (iP) {
8745       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
8746       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
8747       ierr = PetscOptionsEnd();CHKERRQ(ierr);
8748     }
8749     if (discrete_harmonic) {
8750       Mat A;
8751       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
8752       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
8753       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
8754       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);
8755       ierr = MatDestroy(&A);CHKERRQ(ierr);
8756     } else {
8757       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);
8758     }
8759     ierr = MatDestroy(&change);CHKERRQ(ierr);
8760     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
8761   }
8762   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8763 
8764   /* free adjacency */
8765   if (free_used_adj) {
8766     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
8767   }
8768   PetscFunctionReturn(0);
8769 }
8770 
8771 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
8772 {
8773   PC_IS               *pcis=(PC_IS*)pc->data;
8774   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8775   PCBDDCGraph         graph;
8776   PetscErrorCode      ierr;
8777 
8778   PetscFunctionBegin;
8779   /* attach interface graph for determining subsets */
8780   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
8781     IS       verticesIS,verticescomm;
8782     PetscInt vsize,*idxs;
8783 
8784     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8785     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
8786     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8787     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
8788     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8789     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8790     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
8791     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
8792     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
8793     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
8794     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
8795   } else {
8796     graph = pcbddc->mat_graph;
8797   }
8798   /* print some info */
8799   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
8800     IS       vertices;
8801     PetscInt nv,nedges,nfaces;
8802     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
8803     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8804     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
8805     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8806     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
8807     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
8808     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
8809     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
8810     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8811     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8812     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8813   }
8814 
8815   /* sub_schurs init */
8816   if (!pcbddc->sub_schurs) {
8817     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
8818   }
8819   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);
8820 
8821   /* free graph struct */
8822   if (pcbddc->sub_schurs_rebuild) {
8823     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
8824   }
8825   PetscFunctionReturn(0);
8826 }
8827 
8828 PetscErrorCode PCBDDCCheckOperator(PC pc)
8829 {
8830   PC_IS               *pcis=(PC_IS*)pc->data;
8831   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8832   PetscErrorCode      ierr;
8833 
8834   PetscFunctionBegin;
8835   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
8836     IS             zerodiag = NULL;
8837     Mat            S_j,B0_B=NULL;
8838     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
8839     PetscScalar    *p0_check,*array,*array2;
8840     PetscReal      norm;
8841     PetscInt       i;
8842 
8843     /* B0 and B0_B */
8844     if (zerodiag) {
8845       IS       dummy;
8846 
8847       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
8848       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
8849       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
8850       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8851     }
8852     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
8853     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
8854     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
8855     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8856     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8857     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8858     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8859     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
8860     /* S_j */
8861     ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8862     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8863 
8864     /* mimic vector in \widetilde{W}_\Gamma */
8865     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
8866     /* continuous in primal space */
8867     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
8868     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8869     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8870     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8871     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
8872     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
8873     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8874     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8875     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8876     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8877     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8878     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8879     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
8880     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
8881 
8882     /* assemble rhs for coarse problem */
8883     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
8884     /* local with Schur */
8885     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
8886     if (zerodiag) {
8887       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8888       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
8889       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8890       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
8891     }
8892     /* sum on primal nodes the local contributions */
8893     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8894     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8895     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8896     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8897     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
8898     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8899     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8900     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
8901     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8902     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8903     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8904     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8905     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8906     /* scale primal nodes (BDDC sums contibutions) */
8907     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
8908     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8909     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8910     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8911     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8912     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8913     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8914     /* global: \widetilde{B0}_B w_\Gamma */
8915     if (zerodiag) {
8916       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
8917       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8918       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
8919       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8920     }
8921     /* BDDC */
8922     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
8923     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
8924 
8925     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
8926     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
8927     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
8928     PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);
8929     for (i=0;i<pcbddc->benign_n;i++) {
8930       PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%d] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));
8931     }
8932     ierr = PetscFree(p0_check);CHKERRQ(ierr);
8933     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
8934     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
8935     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
8936     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8937     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
8938   }
8939   PetscFunctionReturn(0);
8940 }
8941 
8942 #include <../src/mat/impls/aij/mpi/mpiaij.h>
8943 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
8944 {
8945   Mat            At;
8946   IS             rows;
8947   PetscInt       rst,ren;
8948   PetscErrorCode ierr;
8949   PetscLayout    rmap;
8950 
8951   PetscFunctionBegin;
8952   rst = ren = 0;
8953   if (ccomm != MPI_COMM_NULL) {
8954     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
8955     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
8956     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
8957     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
8958     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
8959   }
8960   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
8961   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
8962   ierr = ISDestroy(&rows);CHKERRQ(ierr);
8963 
8964   if (ccomm != MPI_COMM_NULL) {
8965     Mat_MPIAIJ *a,*b;
8966     IS         from,to;
8967     Vec        gvec;
8968     PetscInt   lsize;
8969 
8970     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
8971     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
8972     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
8973     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
8974     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
8975     a    = (Mat_MPIAIJ*)At->data;
8976     b    = (Mat_MPIAIJ*)(*B)->data;
8977     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
8978     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
8979     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
8980     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
8981     b->A = a->A;
8982     b->B = a->B;
8983 
8984     b->donotstash      = a->donotstash;
8985     b->roworiented     = a->roworiented;
8986     b->rowindices      = 0;
8987     b->rowvalues       = 0;
8988     b->getrowactive    = PETSC_FALSE;
8989 
8990     (*B)->rmap         = rmap;
8991     (*B)->factortype   = A->factortype;
8992     (*B)->assembled    = PETSC_TRUE;
8993     (*B)->insertmode   = NOT_SET_VALUES;
8994     (*B)->preallocated = PETSC_TRUE;
8995 
8996     if (a->colmap) {
8997 #if defined(PETSC_USE_CTABLE)
8998       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
8999 #else
9000       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
9001       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9002       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9003 #endif
9004     } else b->colmap = 0;
9005     if (a->garray) {
9006       PetscInt len;
9007       len  = a->B->cmap->n;
9008       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
9009       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
9010       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
9011     } else b->garray = 0;
9012 
9013     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
9014     b->lvec = a->lvec;
9015     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
9016 
9017     /* cannot use VecScatterCopy */
9018     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
9019     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
9020     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
9021     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
9022     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
9023     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
9024     ierr = ISDestroy(&from);CHKERRQ(ierr);
9025     ierr = ISDestroy(&to);CHKERRQ(ierr);
9026     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
9027   }
9028   ierr = MatDestroy(&At);CHKERRQ(ierr);
9029   PetscFunctionReturn(0);
9030 }
9031