xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision f3ad2dabeeec4f28c60c2ec01c2e17bf1d1407a7)
1 #include <../src/mat/impls/aij/seq/aij.h>
2 #include <../src/ksp/pc/impls/bddc/bddc.h>
3 #include <../src/ksp/pc/impls/bddc/bddcprivate.h>
4 #include <../src/mat/impls/dense/seq/dense.h>
5 #include <petscdmplex.h>
6 #include <petscblaslapack.h>
7 #include <petsc/private/sfimpl.h>
8 #include <petsc/private/dmpleximpl.h>
9 #include <petscdmda.h>
10 
11 static PetscErrorCode MatMPIAIJRestrict(Mat,MPI_Comm,Mat*);
12 
13 /* if range is true,  it returns B s.t. span{B} = range(A)
14    if range is false, it returns B s.t. range(B) _|_ range(A) */
15 PetscErrorCode MatDenseOrthogonalRangeOrComplement(Mat A, PetscBool range, PetscInt lw, PetscScalar *work, PetscReal *rwork, Mat *B)
16 {
17 #if !defined(PETSC_USE_COMPLEX)
18   PetscScalar    *uwork,*data,*U, ds = 0.;
19   PetscReal      *sing;
20   PetscBLASInt   bM,bN,lwork,lierr,di = 1;
21   PetscInt       ulw,i,nr,nc,n;
22   PetscErrorCode ierr;
23 
24   PetscFunctionBegin;
25 #if defined(PETSC_MISSING_LAPACK_GESVD)
26   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"LAPACK _GESVD not available");
27 #else
28   ierr = MatGetSize(A,&nr,&nc);CHKERRQ(ierr);
29   if (!nr || !nc) PetscFunctionReturn(0);
30 
31   /* workspace */
32   if (!work) {
33     ulw  = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc));
34     ierr = PetscMalloc1(ulw,&uwork);CHKERRQ(ierr);
35   } else {
36     ulw   = lw;
37     uwork = work;
38   }
39   n = PetscMin(nr,nc);
40   if (!rwork) {
41     ierr = PetscMalloc1(n,&sing);CHKERRQ(ierr);
42   } else {
43     sing = rwork;
44   }
45 
46   /* SVD */
47   ierr = PetscMalloc1(nr*nr,&U);CHKERRQ(ierr);
48   ierr = PetscBLASIntCast(nr,&bM);CHKERRQ(ierr);
49   ierr = PetscBLASIntCast(nc,&bN);CHKERRQ(ierr);
50   ierr = PetscBLASIntCast(ulw,&lwork);CHKERRQ(ierr);
51   ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr);
52   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
53   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr));
54   ierr = PetscFPTrapPop();CHKERRQ(ierr);
55   if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
56   ierr = MatDenseRestoreArray(A,&data);CHKERRQ(ierr);
57   for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break;
58   if (!rwork) {
59     ierr = PetscFree(sing);CHKERRQ(ierr);
60   }
61   if (!work) {
62     ierr = PetscFree(uwork);CHKERRQ(ierr);
63   }
64   /* create B */
65   if (!range) {
66     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B);CHKERRQ(ierr);
67     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
68     ierr = PetscMemcpy(data,U+nr*i,(nr-i)*nr*sizeof(PetscScalar));CHKERRQ(ierr);
69   } else {
70     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,i,NULL,B);CHKERRQ(ierr);
71     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
72     ierr = PetscMemcpy(data,U,i*nr*sizeof(PetscScalar));CHKERRQ(ierr);
73   }
74   ierr = MatDenseRestoreArray(*B,&data);CHKERRQ(ierr);
75   ierr = PetscFree(U);CHKERRQ(ierr);
76 #endif
77 #else /* PETSC_USE_COMPLEX */
78   PetscFunctionBegin;
79   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented for complexes");
80 #endif
81   PetscFunctionReturn(0);
82 }
83 
84 /* TODO REMOVE */
85 #if defined(PRINT_GDET)
86 static int inc = 0;
87 static int lev = 0;
88 #endif
89 
90 PetscErrorCode PCBDDCComputeNedelecChangeEdge(Mat lG, IS edge, IS extrow, IS extcol, IS corners, Mat* Gins, Mat* GKins, PetscScalar cvals[2], PetscScalar *work, PetscReal *rwork)
91 {
92   PetscErrorCode ierr;
93   Mat            GE,GEd;
94   PetscInt       rsize,csize,esize;
95   PetscScalar    *ptr;
96 
97   PetscFunctionBegin;
98   ierr = ISGetSize(edge,&esize);CHKERRQ(ierr);
99   if (!esize) PetscFunctionReturn(0);
100   ierr = ISGetSize(extrow,&rsize);CHKERRQ(ierr);
101   ierr = ISGetSize(extcol,&csize);CHKERRQ(ierr);
102 
103   /* gradients */
104   ptr  = work + 5*esize;
105   ierr = MatCreateSubMatrix(lG,extrow,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
106   ierr = MatCreateSeqDense(PETSC_COMM_SELF,rsize,csize,ptr,Gins);CHKERRQ(ierr);
107   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,Gins);CHKERRQ(ierr);
108   ierr = MatDestroy(&GE);CHKERRQ(ierr);
109 
110   /* constants */
111   ptr += rsize*csize;
112   ierr = MatCreateSeqDense(PETSC_COMM_SELF,esize,csize,ptr,&GEd);CHKERRQ(ierr);
113   ierr = MatCreateSubMatrix(lG,edge,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
114   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,&GEd);CHKERRQ(ierr);
115   ierr = MatDestroy(&GE);CHKERRQ(ierr);
116   ierr = MatDenseOrthogonalRangeOrComplement(GEd,PETSC_FALSE,5*esize,work,rwork,GKins);CHKERRQ(ierr);
117   ierr = MatDestroy(&GEd);CHKERRQ(ierr);
118 
119   if (corners) {
120     Mat            GEc;
121     PetscScalar    *vals,v;
122 
123     ierr = MatCreateSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr);
124     ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr);
125     ierr = MatDenseGetArray(GEd,&vals);CHKERRQ(ierr);
126     /* v    = PetscAbsScalar(vals[0]) */;
127     v    = 1.;
128     cvals[0] = vals[0]/v;
129     cvals[1] = vals[1]/v;
130     ierr = MatDenseRestoreArray(GEd,&vals);CHKERRQ(ierr);
131     ierr = MatScale(*GKins,1./v);CHKERRQ(ierr);
132 #if defined(PRINT_GDET)
133     {
134       PetscViewer viewer;
135       char filename[256];
136       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
137       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
138       ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
139       ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr);
140       ierr = MatView(GEc,viewer);CHKERRQ(ierr);
141       ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr);
142       ierr = MatView(*GKins,viewer);CHKERRQ(ierr);
143       ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr);
144       ierr = MatView(GEd,viewer);CHKERRQ(ierr);
145       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
146     }
147 #endif
148     ierr = MatDestroy(&GEd);CHKERRQ(ierr);
149     ierr = MatDestroy(&GEc);CHKERRQ(ierr);
150   }
151 
152   PetscFunctionReturn(0);
153 }
154 
155 PetscErrorCode PCBDDCNedelecSupport(PC pc)
156 {
157   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
158   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
159   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
160   Vec                    tvec;
161   PetscSF                sfv;
162   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
163   MPI_Comm               comm;
164   IS                     lned,primals,allprimals,nedfieldlocal;
165   IS                     *eedges,*extrows,*extcols,*alleedges;
166   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
167   PetscScalar            *vals,*work;
168   PetscReal              *rwork;
169   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
170   PetscInt               ne,nv,Lv,order,n,field;
171   PetscInt               n_neigh,*neigh,*n_shared,**shared;
172   PetscInt               i,j,extmem,cum,maxsize,nee;
173   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
174   PetscInt               *sfvleaves,*sfvroots;
175   PetscInt               *corners,*cedges;
176   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
177 #if defined(PETSC_USE_DEBUG)
178   PetscInt               *emarks;
179 #endif
180   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
181   PetscErrorCode         ierr;
182 
183   PetscFunctionBegin;
184   /* If the discrete gradient is defined for a subset of dofs and global is true,
185      it assumes G is given in global ordering for all the dofs.
186      Otherwise, the ordering is global for the Nedelec field */
187   order      = pcbddc->nedorder;
188   conforming = pcbddc->conforming;
189   field      = pcbddc->nedfield;
190   global     = pcbddc->nedglobal;
191   setprimal  = PETSC_FALSE;
192   print      = PETSC_FALSE;
193   singular   = PETSC_FALSE;
194 
195   /* Command line customization */
196   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
197   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
198   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
199   ierr = PetscOptionsInt("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
200   /* print debug info TODO: to be removed */
201   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
202   ierr = PetscOptionsEnd();CHKERRQ(ierr);
203 
204   /* Return if there are no edges in the decomposition and the problem is not singular */
205   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
206   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
207   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
208   if (!singular) {
209     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
210     lrc[0] = PETSC_FALSE;
211     for (i=0;i<n;i++) {
212       if (PetscRealPart(vals[i]) > 2.) {
213         lrc[0] = PETSC_TRUE;
214         break;
215       }
216     }
217     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
218     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
219     if (!lrc[1]) PetscFunctionReturn(0);
220   }
221 
222   /* Get Nedelec field */
223   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
224   if (pcbddc->n_ISForDofsLocal && field >= pcbddc->n_ISForDofsLocal) SETERRQ2(comm,PETSC_ERR_USER,"Invalid field for Nedelec %d: number of fields is %d",field,pcbddc->n_ISForDofsLocal);
225   if (pcbddc->n_ISForDofsLocal && field >= 0) {
226     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
227     nedfieldlocal = pcbddc->ISForDofsLocal[field];
228     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
229   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
230     ne            = n;
231     nedfieldlocal = NULL;
232     global        = PETSC_TRUE;
233   } else if (field == PETSC_DECIDE) {
234     PetscInt rst,ren,*idx;
235 
236     ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
237     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
238     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
239     for (i=rst;i<ren;i++) {
240       PetscInt nc;
241 
242       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
243       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
244       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
245     }
246     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
247     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
248     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
249     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
250     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
251   } else {
252     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
253   }
254 
255   /* Sanity checks */
256   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
257   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
258   if (order && ne%order) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"The number of local edge dofs %d it's not a multiple of the order %d",ne,order);
259 
260   /* Just set primal dofs and return */
261   if (setprimal) {
262     IS       enedfieldlocal;
263     PetscInt *eidxs;
264 
265     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
266     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
267     if (nedfieldlocal) {
268       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
269       for (i=0,cum=0;i<ne;i++) {
270         if (PetscRealPart(vals[idxs[i]]) > 2.) {
271           eidxs[cum++] = idxs[i];
272         }
273       }
274       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
275     } else {
276       for (i=0,cum=0;i<ne;i++) {
277         if (PetscRealPart(vals[i]) > 2.) {
278           eidxs[cum++] = i;
279         }
280       }
281     }
282     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
283     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
284     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
285     ierr = PetscFree(eidxs);CHKERRQ(ierr);
286     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
287     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
288     PetscFunctionReturn(0);
289   }
290 
291   /* Compute some l2g maps */
292   if (nedfieldlocal) {
293     IS is;
294 
295     /* need to map from the local Nedelec field to local numbering */
296     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
297     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
298     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
299     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
300     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
301     if (global) {
302       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
303       el2g = al2g;
304     } else {
305       IS gis;
306 
307       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
308       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
309       ierr = ISDestroy(&gis);CHKERRQ(ierr);
310     }
311     ierr = ISDestroy(&is);CHKERRQ(ierr);
312   } else {
313     /* restore default */
314     pcbddc->nedfield = -1;
315     /* one ref for the destruction of al2g, one for el2g */
316     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
317     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
318     el2g = al2g;
319     fl2g = NULL;
320   }
321 
322   /* Start communication to drop connections for interior edges (for cc analysis only) */
323   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
324   ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
325   if (nedfieldlocal) {
326     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
327     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
328     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
329   } else {
330     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
331   }
332   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
333   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
334 
335   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
336     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
337     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
338     if (global) {
339       PetscInt rst;
340 
341       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
342       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
343         if (matis->sf_rootdata[i] < 2) {
344           matis->sf_rootdata[cum++] = i + rst;
345         }
346       }
347       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
348       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
349     } else {
350       PetscInt *tbz;
351 
352       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
353       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
354       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
355       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
356       for (i=0,cum=0;i<ne;i++)
357         if (matis->sf_leafdata[idxs[i]] == 1)
358           tbz[cum++] = i;
359       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
360       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
361       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
362       ierr = PetscFree(tbz);CHKERRQ(ierr);
363     }
364   } else { /* we need the entire G to infer the nullspace */
365     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
366     G    = pcbddc->discretegradient;
367   }
368 
369   /* Extract subdomain relevant rows of G */
370   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
371   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
372   ierr = MatCreateSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
373   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
374   ierr = ISDestroy(&lned);CHKERRQ(ierr);
375   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
376   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
377   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
378 
379   /* SF for nodal dofs communications */
380   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
381   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
382   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
383   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
384   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
385   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
386   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
387   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
388   i    = singular ? 2 : 1;
389   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
390 
391   /* Destroy temporary G created in MATIS format and modified G */
392   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
393   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
394   ierr = MatDestroy(&G);CHKERRQ(ierr);
395 
396   if (print) {
397     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
398     ierr = MatView(lG,NULL);CHKERRQ(ierr);
399   }
400 
401   /* Save lG for values insertion in change of basis */
402   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
403 
404   /* Analyze the edge-nodes connections (duplicate lG) */
405   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
406   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
407   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
408   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
409   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
410   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
411   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
412   /* need to import the boundary specification to ensure the
413      proper detection of coarse edges' endpoints */
414   if (pcbddc->DirichletBoundariesLocal) {
415     IS is;
416 
417     if (fl2g) {
418       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
419     } else {
420       is = pcbddc->DirichletBoundariesLocal;
421     }
422     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
423     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
424     for (i=0;i<cum;i++) {
425       if (idxs[i] >= 0) {
426         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
427         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
428       }
429     }
430     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
431     if (fl2g) {
432       ierr = ISDestroy(&is);CHKERRQ(ierr);
433     }
434   }
435   if (pcbddc->NeumannBoundariesLocal) {
436     IS is;
437 
438     if (fl2g) {
439       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
440     } else {
441       is = pcbddc->NeumannBoundariesLocal;
442     }
443     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
444     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
445     for (i=0;i<cum;i++) {
446       if (idxs[i] >= 0) {
447         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
448       }
449     }
450     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
451     if (fl2g) {
452       ierr = ISDestroy(&is);CHKERRQ(ierr);
453     }
454   }
455 
456   /* Count neighs per dof */
457   ierr = ISLocalToGlobalMappingGetNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
458   ierr = ISLocalToGlobalMappingGetNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
459 
460   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
461      for proper detection of coarse edges' endpoints */
462   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
463   for (i=0;i<ne;i++) {
464     if ((ecount[i] > 2 && !PetscBTLookup(btbd,i)) || (ecount[i] == 2 && PetscBTLookup(btb,i))) {
465       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
466     }
467   }
468   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
469   if (!conforming) {
470     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
471     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
472   }
473   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
474   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
475   cum  = 0;
476   for (i=0;i<ne;i++) {
477     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
478     if (!PetscBTLookup(btee,i)) {
479       marks[cum++] = i;
480       continue;
481     }
482     /* set badly connected edge dofs as primal */
483     if (!conforming) {
484       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
485         marks[cum++] = i;
486         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
487         for (j=ii[i];j<ii[i+1];j++) {
488           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
489         }
490       } else {
491         /* every edge dofs should be connected trough a certain number of nodal dofs
492            to other edge dofs belonging to coarse edges
493            - at most 2 endpoints
494            - order-1 interior nodal dofs
495            - no undefined nodal dofs (nconn < order)
496         */
497         PetscInt ends = 0,ints = 0, undef = 0;
498         for (j=ii[i];j<ii[i+1];j++) {
499           PetscInt v = jj[j],k;
500           PetscInt nconn = iit[v+1]-iit[v];
501           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
502           if (nconn > order) ends++;
503           else if (nconn == order) ints++;
504           else undef++;
505         }
506         if (undef || ends > 2 || ints != order -1) {
507           marks[cum++] = i;
508           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
509           for (j=ii[i];j<ii[i+1];j++) {
510             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
511           }
512         }
513       }
514     }
515     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
516     if (!order && ii[i+1] != ii[i]) {
517       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
518       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
519     }
520   }
521   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
522   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
523   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
524   if (!conforming) {
525     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
526     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
527   }
528   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
529 
530   /* identify splitpoints and corner candidates */
531   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
532   if (print) {
533     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
534     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
535     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
536     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
537   }
538   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
539   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
540   for (i=0;i<nv;i++) {
541     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
542     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
543     if (!order) { /* variable order */
544       PetscReal vorder = 0.;
545 
546       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
547       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
548       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%d)",vorder,test);
549       ord  = 1;
550     }
551 #if defined(PETSC_USE_DEBUG)
552     if (test%ord) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected number of edge dofs %d connected with nodal dof %d with order %d",test,i,ord);
553 #endif
554     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
555       if (PetscBTLookup(btbd,jj[j])) {
556         bdir = PETSC_TRUE;
557         break;
558       }
559       if (vc != ecount[jj[j]]) {
560         sneighs = PETSC_FALSE;
561       } else {
562         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
563         for (k=0;k<vc;k++) {
564           if (vn[k] != en[k]) {
565             sneighs = PETSC_FALSE;
566             break;
567           }
568         }
569       }
570     }
571     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
572       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %d (%d %d %d)\n",i,!sneighs,test >= 3*ord,bdir);
573       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
574     } else if (test == ord) {
575       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
576         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %d\n",i);
577         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
578       } else {
579         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %d\n",i);
580         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
581       }
582     }
583   }
584   ierr = ISLocalToGlobalMappingRestoreNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
585   ierr = ISLocalToGlobalMappingRestoreNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
586   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
587 
588   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
589   if (order != 1) {
590     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
591     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
592     for (i=0;i<nv;i++) {
593       if (PetscBTLookup(btvcand,i)) {
594         PetscBool found = PETSC_FALSE;
595         for (j=ii[i];j<ii[i+1] && !found;j++) {
596           PetscInt k,e = jj[j];
597           if (PetscBTLookup(bte,e)) continue;
598           for (k=iit[e];k<iit[e+1];k++) {
599             PetscInt v = jjt[k];
600             if (v != i && PetscBTLookup(btvcand,v)) {
601               found = PETSC_TRUE;
602               break;
603             }
604           }
605         }
606         if (!found) {
607           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d CLEARED\n",i);
608           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
609         } else {
610           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d ACCEPTED\n",i);
611         }
612       }
613     }
614     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
615   }
616   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
617   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
618   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
619 
620   /* Get the local G^T explicitly */
621   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
622   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
623   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
624 
625   /* Mark interior nodal dofs */
626   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
627   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
628   for (i=1;i<n_neigh;i++) {
629     for (j=0;j<n_shared[i];j++) {
630       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
631     }
632   }
633   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
634 
635   /* communicate corners and splitpoints */
636   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
637   ierr = PetscMemzero(sfvleaves,nv*sizeof(PetscInt));CHKERRQ(ierr);
638   ierr = PetscMemzero(sfvroots,Lv*sizeof(PetscInt));CHKERRQ(ierr);
639   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
640 
641   if (print) {
642     IS tbz;
643 
644     cum = 0;
645     for (i=0;i<nv;i++)
646       if (sfvleaves[i])
647         vmarks[cum++] = i;
648 
649     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
650     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
651     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
652     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
653   }
654 
655   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
656   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
657   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
658   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
659 
660   /* Zero rows of lGt corresponding to identified corners
661      and interior nodal dofs */
662   cum = 0;
663   for (i=0;i<nv;i++) {
664     if (sfvleaves[i]) {
665       vmarks[cum++] = i;
666       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
667     }
668     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
669   }
670   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
671   if (print) {
672     IS tbz;
673 
674     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
675     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
676     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
677     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
678   }
679   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
680   ierr = PetscFree(vmarks);CHKERRQ(ierr);
681   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
682   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
683 
684   /* Recompute G */
685   ierr = MatDestroy(&lG);CHKERRQ(ierr);
686   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
687   if (print) {
688     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
689     ierr = MatView(lG,NULL);CHKERRQ(ierr);
690     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
691     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
692   }
693 
694   /* Get primal dofs (if any) */
695   cum = 0;
696   for (i=0;i<ne;i++) {
697     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
698   }
699   if (fl2g) {
700     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
701   }
702   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
703   if (print) {
704     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
705     ierr = ISView(primals,NULL);CHKERRQ(ierr);
706   }
707   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
708   /* TODO: what if the user passed in some of them ?  */
709   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
710   ierr = ISDestroy(&primals);CHKERRQ(ierr);
711 
712   /* Compute edge connectivity */
713   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
714   ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr);
715   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
716   if (fl2g) {
717     PetscBT   btf;
718     PetscInt  *iia,*jja,*iiu,*jju;
719     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
720 
721     /* create CSR for all local dofs */
722     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
723     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
724       if (pcbddc->mat_graph->nvtxs_csr != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid size of CSR graph %d. Should be %d\n",pcbddc->mat_graph->nvtxs_csr,n);
725       iiu = pcbddc->mat_graph->xadj;
726       jju = pcbddc->mat_graph->adjncy;
727     } else if (pcbddc->use_local_adj) {
728       rest = PETSC_TRUE;
729       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
730     } else {
731       free   = PETSC_TRUE;
732       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
733       iiu[0] = 0;
734       for (i=0;i<n;i++) {
735         iiu[i+1] = i+1;
736         jju[i]   = -1;
737       }
738     }
739 
740     /* import sizes of CSR */
741     iia[0] = 0;
742     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
743 
744     /* overwrite entries corresponding to the Nedelec field */
745     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
746     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
747     for (i=0;i<ne;i++) {
748       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
749       iia[idxs[i]+1] = ii[i+1]-ii[i];
750     }
751 
752     /* iia in CSR */
753     for (i=0;i<n;i++) iia[i+1] += iia[i];
754 
755     /* jja in CSR */
756     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
757     for (i=0;i<n;i++)
758       if (!PetscBTLookup(btf,i))
759         for (j=0;j<iiu[i+1]-iiu[i];j++)
760           jja[iia[i]+j] = jju[iiu[i]+j];
761 
762     /* map edge dofs connectivity */
763     if (jj) {
764       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
765       for (i=0;i<ne;i++) {
766         PetscInt e = idxs[i];
767         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
768       }
769     }
770     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
771     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
772     if (rest) {
773       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
774     }
775     if (free) {
776       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
777     }
778     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
779   } else {
780     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
781   }
782 
783   /* Analyze interface for edge dofs */
784   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
785   pcbddc->mat_graph->twodim = PETSC_FALSE;
786 
787   /* Get coarse edges in the edge space */
788   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
789   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
790 
791   if (fl2g) {
792     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
793     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
794     for (i=0;i<nee;i++) {
795       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
796     }
797   } else {
798     eedges  = alleedges;
799     primals = allprimals;
800   }
801 
802   /* Mark fine edge dofs with their coarse edge id */
803   ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
804   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
805   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
806   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
807   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
808   if (print) {
809     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
810     ierr = ISView(primals,NULL);CHKERRQ(ierr);
811   }
812 
813   maxsize = 0;
814   for (i=0;i<nee;i++) {
815     PetscInt size,mark = i+1;
816 
817     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
818     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
819     for (j=0;j<size;j++) marks[idxs[j]] = mark;
820     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
821     maxsize = PetscMax(maxsize,size);
822   }
823 
824   /* Find coarse edge endpoints */
825   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
826   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
827   for (i=0;i<nee;i++) {
828     PetscInt mark = i+1,size;
829 
830     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
831     if (!size && nedfieldlocal) continue;
832     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
833     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
834     if (print) {
835       PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %d\n",i);
836       ISView(eedges[i],NULL);
837     }
838     for (j=0;j<size;j++) {
839       PetscInt k, ee = idxs[j];
840       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %d\n",ee);
841       for (k=ii[ee];k<ii[ee+1];k++) {
842         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %d\n",jj[k]);
843         if (PetscBTLookup(btv,jj[k])) {
844           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %d\n",jj[k]);
845         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
846           PetscInt  k2;
847           PetscBool corner = PETSC_FALSE;
848           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
849             if (print) PetscPrintf(PETSC_COMM_SELF,"        INSPECTING %d: mark %d (ref mark %d), boundary %d\n",jjt[k2],marks[jjt[k2]],mark,!!PetscBTLookup(btb,jjt[k2]));
850             /* it's a corner if either is connected with an edge dof belonging to a different cc or
851                if the edge dof lie on the natural part of the boundary */
852             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
853               corner = PETSC_TRUE;
854               break;
855             }
856           }
857           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
858             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %d\n",jj[k]);
859             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
860           } else {
861             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
862           }
863         }
864       }
865     }
866     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
867   }
868   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
869   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
870   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
871 
872   /* Reset marked primal dofs */
873   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
874   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
875   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
876   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
877 
878   /* Now use the initial lG */
879   ierr = MatDestroy(&lG);CHKERRQ(ierr);
880   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
881   lG   = lGinit;
882   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
883 
884   /* Compute extended cols indices */
885   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
886   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
887   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
888   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
889   i   *= maxsize;
890   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
891   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
892   eerr = PETSC_FALSE;
893   for (i=0;i<nee;i++) {
894     PetscInt size,found = 0;
895 
896     cum  = 0;
897     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
898     if (!size && nedfieldlocal) continue;
899     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
900     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
901     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
902     for (j=0;j<size;j++) {
903       PetscInt k,ee = idxs[j];
904       for (k=ii[ee];k<ii[ee+1];k++) {
905         PetscInt vv = jj[k];
906         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
907         else if (!PetscBTLookupSet(btvc,vv)) found++;
908       }
909     }
910     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
911     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
912     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
913     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
914     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
915     /* it may happen that endpoints are not defined at this point
916        if it is the case, mark this edge for a second pass */
917     if (cum != size -1 || found != 2) {
918       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
919       if (print) {
920         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
921         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
922         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
923         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
924       }
925       eerr = PETSC_TRUE;
926     }
927   }
928   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
929   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
930   if (done) {
931     PetscInt *newprimals;
932 
933     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
934     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
935     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
936     ierr = PetscMemcpy(newprimals,idxs,cum*sizeof(PetscInt));CHKERRQ(ierr);
937     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
938     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
939     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %d)\n",eerr);
940     for (i=0;i<nee;i++) {
941       PetscBool has_candidates = PETSC_FALSE;
942       if (PetscBTLookup(bter,i)) {
943         PetscInt size,mark = i+1;
944 
945         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
946         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
947         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
948         for (j=0;j<size;j++) {
949           PetscInt k,ee = idxs[j];
950           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %d [%d %d)\n",ee,ii[ee],ii[ee+1]);
951           for (k=ii[ee];k<ii[ee+1];k++) {
952             /* set all candidates located on the edge as corners */
953             if (PetscBTLookup(btvcand,jj[k])) {
954               PetscInt k2,vv = jj[k];
955               has_candidates = PETSC_TRUE;
956               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %d\n",vv);
957               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
958               /* set all edge dofs connected to candidate as primals */
959               for (k2=iit[vv];k2<iit[vv+1];k2++) {
960                 if (marks[jjt[k2]] == mark) {
961                   PetscInt k3,ee2 = jjt[k2];
962                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %d\n",ee2);
963                   newprimals[cum++] = ee2;
964                   /* finally set the new corners */
965                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
966                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %d\n",jj[k3]);
967                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
968                   }
969                 }
970               }
971             } else {
972               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %d\n",jj[k]);
973             }
974           }
975         }
976         if (!has_candidates) { /* circular edge */
977           PetscInt k, ee = idxs[0],*tmarks;
978 
979           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
980           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %d\n",i);
981           for (k=ii[ee];k<ii[ee+1];k++) {
982             PetscInt k2;
983             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %d\n",jj[k]);
984             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
985             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
986           }
987           for (j=0;j<size;j++) {
988             if (tmarks[idxs[j]] > 1) {
989               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %d\n",idxs[j]);
990               newprimals[cum++] = idxs[j];
991             }
992           }
993           ierr = PetscFree(tmarks);CHKERRQ(ierr);
994         }
995         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
996       }
997       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
998     }
999     ierr = PetscFree(extcols);CHKERRQ(ierr);
1000     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1001     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1002     if (fl2g) {
1003       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1004       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1005       for (i=0;i<nee;i++) {
1006         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1007       }
1008       ierr = PetscFree(eedges);CHKERRQ(ierr);
1009     }
1010     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1011     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1012     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1013     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1014     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1015     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1016     pcbddc->mat_graph->twodim = PETSC_FALSE;
1017     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1018     if (fl2g) {
1019       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1020       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1021       for (i=0;i<nee;i++) {
1022         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1023       }
1024     } else {
1025       eedges  = alleedges;
1026       primals = allprimals;
1027     }
1028     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1029 
1030     /* Mark again */
1031     ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
1032     for (i=0;i<nee;i++) {
1033       PetscInt size,mark = i+1;
1034 
1035       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1036       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1037       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1038       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1039     }
1040     if (print) {
1041       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1042       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1043     }
1044 
1045     /* Recompute extended cols */
1046     eerr = PETSC_FALSE;
1047     for (i=0;i<nee;i++) {
1048       PetscInt size;
1049 
1050       cum  = 0;
1051       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1052       if (!size && nedfieldlocal) continue;
1053       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1054       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1055       for (j=0;j<size;j++) {
1056         PetscInt k,ee = idxs[j];
1057         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1058       }
1059       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1060       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1061       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1062       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1063       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1064       if (cum != size -1) {
1065         if (print) {
1066           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1067           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1068           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1069           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1070         }
1071         eerr = PETSC_TRUE;
1072       }
1073     }
1074   }
1075   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1076   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1077   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1078   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1079   /* an error should not occur at this point */
1080   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1081 
1082   /* Check the number of endpoints */
1083   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1084   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1085   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1086   for (i=0;i<nee;i++) {
1087     PetscInt size, found = 0, gc[2];
1088 
1089     /* init with defaults */
1090     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1091     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1092     if (!size && nedfieldlocal) continue;
1093     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1094     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1095     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1096     for (j=0;j<size;j++) {
1097       PetscInt k,ee = idxs[j];
1098       for (k=ii[ee];k<ii[ee+1];k++) {
1099         PetscInt vv = jj[k];
1100         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1101           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %d\n",i);
1102           corners[i*2+found++] = vv;
1103         }
1104       }
1105     }
1106     if (found != 2) {
1107       PetscInt e;
1108       if (fl2g) {
1109         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1110       } else {
1111         e = idxs[0];
1112       }
1113       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %d corners for edge %d (astart %d, estart %d)\n",found,i,e,idxs[0]);
1114     }
1115 
1116     /* get primal dof index on this coarse edge */
1117     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1118     if (gc[0] > gc[1]) {
1119       PetscInt swap  = corners[2*i];
1120       corners[2*i]   = corners[2*i+1];
1121       corners[2*i+1] = swap;
1122     }
1123     cedges[i] = idxs[size-1];
1124     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1125     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %d: ce %d, corners (%d,%d)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1126   }
1127   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1128   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1129 
1130 #if defined(PETSC_USE_DEBUG)
1131   /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1132      not interfere with neighbouring coarse edges */
1133   ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1134   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1135   for (i=0;i<nv;i++) {
1136     PetscInt emax = 0,eemax = 0;
1137 
1138     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1139     ierr = PetscMemzero(emarks,(nee+1)*sizeof(PetscInt));CHKERRQ(ierr);
1140     for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1141     for (j=1;j<nee+1;j++) {
1142       if (emax < emarks[j]) {
1143         emax = emarks[j];
1144         eemax = j;
1145       }
1146     }
1147     /* not relevant for edges */
1148     if (!eemax) continue;
1149 
1150     for (j=ii[i];j<ii[i+1];j++) {
1151       if (marks[jj[j]] && marks[jj[j]] != eemax) {
1152         SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_SUP,"Found 2 coarse edges (id %d and %d) connected through the %d nodal dof at edge dof %d\n",marks[jj[j]]-1,eemax,i,jj[j]);
1153       }
1154     }
1155   }
1156   ierr = PetscFree(emarks);CHKERRQ(ierr);
1157   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1158 #endif
1159 
1160   /* Compute extended rows indices for edge blocks of the change of basis */
1161   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1162   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1163   extmem *= maxsize;
1164   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1165   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1166   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1167   for (i=0;i<nv;i++) {
1168     PetscInt mark = 0,size,start;
1169 
1170     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1171     for (j=ii[i];j<ii[i+1];j++)
1172       if (marks[jj[j]] && !mark)
1173         mark = marks[jj[j]];
1174 
1175     /* not relevant */
1176     if (!mark) continue;
1177 
1178     /* import extended row */
1179     mark--;
1180     start = mark*extmem+extrowcum[mark];
1181     size = ii[i+1]-ii[i];
1182     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %d > %d",extrowcum[mark] + size,extmem);
1183     ierr = PetscMemcpy(extrow+start,jj+ii[i],size*sizeof(PetscInt));CHKERRQ(ierr);
1184     extrowcum[mark] += size;
1185   }
1186   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1187   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1188   ierr = PetscFree(marks);CHKERRQ(ierr);
1189 
1190   /* Compress extrows */
1191   cum  = 0;
1192   for (i=0;i<nee;i++) {
1193     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1194     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1195     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1196     cum  = PetscMax(cum,size);
1197   }
1198   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1199   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1200   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1201 
1202   /* Workspace for lapack inner calls and VecSetValues */
1203   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1204 
1205   /* Create change of basis matrix (preallocation can be improved) */
1206   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1207   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1208                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1209   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1210   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1211   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1212   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1213   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1214   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1215   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1216 
1217   /* Defaults to identity */
1218   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1219   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1220   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1221   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1222 
1223   /* Create discrete gradient for the coarser level if needed */
1224   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1225   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1226   if (pcbddc->current_level < pcbddc->max_levels) {
1227     ISLocalToGlobalMapping cel2g,cvl2g;
1228     IS                     wis,gwis;
1229     PetscInt               cnv,cne;
1230 
1231     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1232     if (fl2g) {
1233       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1234     } else {
1235       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1236       pcbddc->nedclocal = wis;
1237     }
1238     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1239     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1240     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1241     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1242     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1243     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1244 
1245     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1246     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1247     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1248     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1249     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1250     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1251     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1252 
1253     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1254     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1255     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1256     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1257     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1258     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1259     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1260     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1261   }
1262   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1263 
1264 #if defined(PRINT_GDET)
1265   inc = 0;
1266   lev = pcbddc->current_level;
1267 #endif
1268 
1269   /* Insert values in the change of basis matrix */
1270   for (i=0;i<nee;i++) {
1271     Mat         Gins = NULL, GKins = NULL;
1272     IS          cornersis = NULL;
1273     PetscScalar cvals[2];
1274 
1275     if (pcbddc->nedcG) {
1276       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1277     }
1278     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1279     if (Gins && GKins) {
1280       PetscScalar    *data;
1281       const PetscInt *rows,*cols;
1282       PetscInt       nrh,nch,nrc,ncc;
1283 
1284       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1285       /* H1 */
1286       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1287       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1288       ierr = MatDenseGetArray(Gins,&data);CHKERRQ(ierr);
1289       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1290       ierr = MatDenseRestoreArray(Gins,&data);CHKERRQ(ierr);
1291       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1292       /* complement */
1293       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1294       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %d",i);
1295       if (ncc + nch != nrc) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"The sum of the number of columns of GKins %d and Gins %d does not match %d for coarse edge %d",ncc,nch,nrc,i);
1296       if (ncc != 1 && pcbddc->nedcG) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot generate the coarse discrete gradient for coarse edge %d with ncc %d",i,ncc);
1297       ierr = MatDenseGetArray(GKins,&data);CHKERRQ(ierr);
1298       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1299       ierr = MatDenseRestoreArray(GKins,&data);CHKERRQ(ierr);
1300 
1301       /* coarse discrete gradient */
1302       if (pcbddc->nedcG) {
1303         PetscInt cols[2];
1304 
1305         cols[0] = 2*i;
1306         cols[1] = 2*i+1;
1307         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1308       }
1309       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1310     }
1311     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1312     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1313     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1314     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1315     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1316   }
1317   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1318 
1319   /* Start assembling */
1320   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1321   if (pcbddc->nedcG) {
1322     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1323   }
1324 
1325   /* Free */
1326   if (fl2g) {
1327     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1328     for (i=0;i<nee;i++) {
1329       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1330     }
1331     ierr = PetscFree(eedges);CHKERRQ(ierr);
1332   }
1333 
1334   /* hack mat_graph with primal dofs on the coarse edges */
1335   {
1336     PCBDDCGraph graph   = pcbddc->mat_graph;
1337     PetscInt    *oqueue = graph->queue;
1338     PetscInt    *ocptr  = graph->cptr;
1339     PetscInt    ncc,*idxs;
1340 
1341     /* find first primal edge */
1342     if (pcbddc->nedclocal) {
1343       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1344     } else {
1345       if (fl2g) {
1346         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1347       }
1348       idxs = cedges;
1349     }
1350     cum = 0;
1351     while (cum < nee && cedges[cum] < 0) cum++;
1352 
1353     /* adapt connected components */
1354     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1355     graph->cptr[0] = 0;
1356     for (i=0,ncc=0;i<graph->ncc;i++) {
1357       PetscInt lc = ocptr[i+1]-ocptr[i];
1358       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1359         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1360         graph->queue[graph->cptr[ncc]] = cedges[cum];
1361         ncc++;
1362         lc--;
1363         cum++;
1364         while (cum < nee && cedges[cum] < 0) cum++;
1365       }
1366       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1367       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1368       ncc++;
1369     }
1370     graph->ncc = ncc;
1371     if (pcbddc->nedclocal) {
1372       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1373     }
1374     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1375   }
1376   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1377   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1378   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1379   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1380 
1381   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1382   ierr = PetscFree(extrow);CHKERRQ(ierr);
1383   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1384   ierr = PetscFree(corners);CHKERRQ(ierr);
1385   ierr = PetscFree(cedges);CHKERRQ(ierr);
1386   ierr = PetscFree(extrows);CHKERRQ(ierr);
1387   ierr = PetscFree(extcols);CHKERRQ(ierr);
1388   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1389 
1390   /* Complete assembling */
1391   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1392   if (pcbddc->nedcG) {
1393     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1394 #if 0
1395     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1396     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1397 #endif
1398   }
1399 
1400   /* set change of basis */
1401   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1402   ierr = MatDestroy(&T);CHKERRQ(ierr);
1403 
1404   PetscFunctionReturn(0);
1405 }
1406 
1407 /* the near-null space of BDDC carries information on quadrature weights,
1408    and these can be collinear -> so cheat with MatNullSpaceCreate
1409    and create a suitable set of basis vectors first */
1410 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1411 {
1412   PetscErrorCode ierr;
1413   PetscInt       i;
1414 
1415   PetscFunctionBegin;
1416   for (i=0;i<nvecs;i++) {
1417     PetscInt first,last;
1418 
1419     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1420     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1421     if (i>=first && i < last) {
1422       PetscScalar *data;
1423       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1424       if (!has_const) {
1425         data[i-first] = 1.;
1426       } else {
1427         data[2*i-first] = 1./PetscSqrtReal(2.);
1428         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1429       }
1430       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1431     }
1432     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1433   }
1434   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1435   for (i=0;i<nvecs;i++) { /* reset vectors */
1436     PetscInt first,last;
1437     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1438     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1439     if (i>=first && i < last) {
1440       PetscScalar *data;
1441       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1442       if (!has_const) {
1443         data[i-first] = 0.;
1444       } else {
1445         data[2*i-first] = 0.;
1446         data[2*i-first+1] = 0.;
1447       }
1448       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1449     }
1450     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1451     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1452   }
1453   PetscFunctionReturn(0);
1454 }
1455 
1456 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1457 {
1458   Mat                    loc_divudotp;
1459   Vec                    p,v,vins,quad_vec,*quad_vecs;
1460   ISLocalToGlobalMapping map;
1461   PetscScalar            *vals;
1462   const PetscScalar      *array;
1463   PetscInt               i,maxneighs,maxsize;
1464   PetscInt               n_neigh,*neigh,*n_shared,**shared;
1465   PetscMPIInt            rank;
1466   PetscErrorCode         ierr;
1467 
1468   PetscFunctionBegin;
1469   ierr = ISLocalToGlobalMappingGetInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1470   ierr = MPIU_Allreduce(&n_neigh,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1471   if (!maxneighs) {
1472     ierr  = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1473     *nnsp = NULL;
1474     PetscFunctionReturn(0);
1475   }
1476   maxsize = 0;
1477   for (i=0;i<n_neigh;i++) maxsize = PetscMax(n_shared[i],maxsize);
1478   ierr = PetscMalloc1(maxsize,&vals);CHKERRQ(ierr);
1479   /* create vectors to hold quadrature weights */
1480   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1481   if (!transpose) {
1482     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1483   } else {
1484     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1485   }
1486   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1487   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1488   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1489   for (i=0;i<maxneighs;i++) {
1490     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1491     ierr = VecSetLocalToGlobalMapping(quad_vecs[i],map);CHKERRQ(ierr);
1492   }
1493 
1494   /* compute local quad vec */
1495   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1496   if (!transpose) {
1497     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1498   } else {
1499     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1500   }
1501   ierr = VecSet(p,1.);CHKERRQ(ierr);
1502   if (!transpose) {
1503     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1504   } else {
1505     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1506   }
1507   if (vl2l) {
1508     Mat        lA;
1509     VecScatter sc;
1510 
1511     ierr = MatISGetLocalMat(A,&lA);CHKERRQ(ierr);
1512     ierr = MatCreateVecs(lA,&vins,NULL);CHKERRQ(ierr);
1513     ierr = VecScatterCreate(v,vl2l,vins,NULL,&sc);CHKERRQ(ierr);
1514     ierr = VecScatterBegin(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1515     ierr = VecScatterEnd(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1516     ierr = VecScatterDestroy(&sc);CHKERRQ(ierr);
1517   } else {
1518     vins = v;
1519   }
1520   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1521   ierr = VecDestroy(&p);CHKERRQ(ierr);
1522 
1523   /* insert in global quadrature vecs */
1524   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1525   for (i=0;i<n_neigh;i++) {
1526     const PetscInt    *idxs;
1527     PetscInt          idx,nn,j;
1528 
1529     idxs = shared[i];
1530     nn   = n_shared[i];
1531     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1532     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1533     idx  = -(idx+1);
1534     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1535   }
1536   ierr = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1537   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1538   if (vl2l) {
1539     ierr = VecDestroy(&vins);CHKERRQ(ierr);
1540   }
1541   ierr = VecDestroy(&v);CHKERRQ(ierr);
1542   ierr = PetscFree(vals);CHKERRQ(ierr);
1543 
1544   /* assemble near null space */
1545   for (i=0;i<maxneighs;i++) {
1546     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1547   }
1548   for (i=0;i<maxneighs;i++) {
1549     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1550     ierr = VecViewFromOptions(quad_vecs[i],NULL,"-pc_bddc_quad_vecs_view");CHKERRQ(ierr);
1551     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1552   }
1553   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1554   PetscFunctionReturn(0);
1555 }
1556 
1557 PetscErrorCode PCBDDCAddPrimalVerticesLocalIS(PC pc, IS primalv)
1558 {
1559   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1560   PetscErrorCode ierr;
1561 
1562   PetscFunctionBegin;
1563   if (primalv) {
1564     if (pcbddc->user_primal_vertices_local) {
1565       IS list[2], newp;
1566 
1567       list[0] = primalv;
1568       list[1] = pcbddc->user_primal_vertices_local;
1569       ierr = ISConcatenate(PetscObjectComm((PetscObject)pc),2,list,&newp);CHKERRQ(ierr);
1570       ierr = ISSortRemoveDups(newp);CHKERRQ(ierr);
1571       ierr = ISDestroy(&list[1]);CHKERRQ(ierr);
1572       pcbddc->user_primal_vertices_local = newp;
1573     } else {
1574       ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1575     }
1576   }
1577   PetscFunctionReturn(0);
1578 }
1579 
1580 static PetscErrorCode func_coords_private(PetscInt dim, PetscReal t, const PetscReal X[], PetscInt Nf, PetscScalar *out, void *ctx)
1581 {
1582   PetscInt f, *comp  = (PetscInt *)ctx;
1583 
1584   PetscFunctionBegin;
1585   for (f=0;f<Nf;f++) out[f] = X[*comp];
1586   PetscFunctionReturn(0);
1587 }
1588 
1589 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1590 {
1591   PetscErrorCode ierr;
1592   Vec            local,global;
1593   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1594   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1595   PetscBool      monolithic = PETSC_FALSE;
1596 
1597   PetscFunctionBegin;
1598   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC topology options","PC");CHKERRQ(ierr);
1599   ierr = PetscOptionsBool("-pc_bddc_monolithic","Discard any information on dofs splitting",NULL,monolithic,&monolithic,NULL);CHKERRQ(ierr);
1600   ierr = PetscOptionsEnd();CHKERRQ(ierr);
1601   /* need to convert from global to local topology information and remove references to information in global ordering */
1602   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1603   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1604   if (monolithic) { /* just get block size to properly compute vertices */
1605     if (pcbddc->vertex_size == 1) {
1606       ierr = MatGetBlockSize(pc->pmat,&pcbddc->vertex_size);CHKERRQ(ierr);
1607     }
1608     goto boundary;
1609   }
1610 
1611   if (pcbddc->user_provided_isfordofs) {
1612     if (pcbddc->n_ISForDofs) {
1613       PetscInt i;
1614       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1615       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1616         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1617         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1618       }
1619       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1620       pcbddc->n_ISForDofs = 0;
1621       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1622     }
1623   } else {
1624     if (!pcbddc->n_ISForDofsLocal) { /* field split not present */
1625       DM dm;
1626 
1627       ierr = PCGetDM(pc, &dm);CHKERRQ(ierr);
1628       if (!dm) {
1629         ierr = MatGetDM(pc->pmat, &dm);CHKERRQ(ierr);
1630       }
1631       if (dm) {
1632         IS      *fields;
1633         PetscInt nf,i;
1634         ierr = DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL);CHKERRQ(ierr);
1635         ierr = PetscMalloc1(nf,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1636         for (i=0;i<nf;i++) {
1637           ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1638           ierr = ISDestroy(&fields[i]);CHKERRQ(ierr);
1639         }
1640         ierr = PetscFree(fields);CHKERRQ(ierr);
1641         pcbddc->n_ISForDofsLocal = nf;
1642       } else { /* See if MATIS has fields attached by the conversion from MatNest */
1643         PetscContainer   c;
1644 
1645         ierr = PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c);CHKERRQ(ierr);
1646         if (c) {
1647           MatISLocalFields lf;
1648           ierr = PetscContainerGetPointer(c,(void**)&lf);CHKERRQ(ierr);
1649           ierr = PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf);CHKERRQ(ierr);
1650         } else { /* fallback, create the default fields if bs > 1 */
1651           PetscInt i, n = matis->A->rmap->n;
1652           ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1653           if (i > 1) {
1654             pcbddc->n_ISForDofsLocal = i;
1655             ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1656             for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1657               ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1658             }
1659           }
1660         }
1661       }
1662     } else {
1663       PetscInt i;
1664       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1665         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1666       }
1667     }
1668   }
1669 
1670 boundary:
1671   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1672     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1673   } else if (pcbddc->DirichletBoundariesLocal) {
1674     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1675   }
1676   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1677     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1678   } else if (pcbddc->NeumannBoundariesLocal) {
1679     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1680   }
1681   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1682     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1683   }
1684   ierr = VecDestroy(&global);CHKERRQ(ierr);
1685   ierr = VecDestroy(&local);CHKERRQ(ierr);
1686   /* detect local disconnected subdomains if requested (use matis->A) */
1687   if (pcbddc->detect_disconnected) {
1688     IS        primalv = NULL;
1689     PetscInt  i;
1690     PetscBool filter = pcbddc->detect_disconnected_filter;
1691 
1692     for (i=0;i<pcbddc->n_local_subs;i++) {
1693       ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
1694     }
1695     ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
1696     ierr = PCBDDCDetectDisconnectedComponents(pc,filter,&pcbddc->n_local_subs,&pcbddc->local_subs,&primalv);CHKERRQ(ierr);
1697     ierr = PCBDDCAddPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1698     ierr = ISDestroy(&primalv);CHKERRQ(ierr);
1699   }
1700   /* early stage corner detection */
1701   {
1702     DM dm;
1703 
1704     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1705     if (dm) {
1706       PetscBool isda;
1707 
1708       ierr = PetscObjectTypeCompare((PetscObject)dm,DMDA,&isda);CHKERRQ(ierr);
1709       if (isda) {
1710         ISLocalToGlobalMapping l2l;
1711         IS                     corners;
1712         Mat                    lA;
1713 
1714         ierr = DMDAGetSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1715         ierr = MatISGetLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1716         ierr = MatGetLocalToGlobalMapping(lA,&l2l,NULL);CHKERRQ(ierr);
1717         ierr = MatISRestoreLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1718         if (l2l && corners) {
1719           const PetscInt *idx;
1720           PetscInt       bs,*idxout,n;
1721 
1722           ierr = ISLocalToGlobalMappingGetBlockSize(l2l,&bs);CHKERRQ(ierr);
1723           ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
1724           ierr = ISGetIndices(corners,&idx);CHKERRQ(ierr);
1725           ierr = PetscMalloc1(n,&idxout);CHKERRQ(ierr);
1726           ierr = ISLocalToGlobalMappingApplyBlock(l2l,n,idx,idxout);CHKERRQ(ierr);
1727           ierr = ISRestoreIndices(corners,&idx);CHKERRQ(ierr);
1728           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1729           ierr = ISCreateBlock(PetscObjectComm((PetscObject)pc),bs,n,idxout,PETSC_OWN_POINTER,&corners);CHKERRQ(ierr);
1730           ierr = PCBDDCAddPrimalVerticesLocalIS(pc,corners);CHKERRQ(ierr);
1731           ierr = ISDestroy(&corners);CHKERRQ(ierr);
1732           pcbddc->corner_selected = PETSC_TRUE;
1733         } else if (corners) { /* not from DMDA */
1734           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1735         }
1736       }
1737     }
1738   }
1739   if (pcbddc->corner_selection && !pcbddc->mat_graph->cdim) {
1740     DM dm;
1741 
1742     ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
1743     if (!dm) {
1744       ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1745     }
1746     if (dm) {
1747       Vec            vcoords;
1748       PetscSection   section;
1749       PetscReal      *coords;
1750       PetscInt       d,cdim,nl,nf,**ctxs;
1751       PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *);
1752 
1753       ierr = DMGetCoordinateDim(dm,&cdim);CHKERRQ(ierr);
1754       ierr = DMGetDefaultSection(dm,&section);CHKERRQ(ierr);
1755       ierr = PetscSectionGetNumFields(section,&nf);CHKERRQ(ierr);
1756       ierr = DMCreateGlobalVector(dm,&vcoords);CHKERRQ(ierr);
1757       ierr = VecGetLocalSize(vcoords,&nl);CHKERRQ(ierr);
1758       ierr = PetscMalloc1(nl*cdim,&coords);CHKERRQ(ierr);
1759       ierr = PetscMalloc2(nf,&funcs,nf,&ctxs);CHKERRQ(ierr);
1760       ierr = PetscMalloc1(nf,&ctxs[0]);CHKERRQ(ierr);
1761       for (d=0;d<nf;d++) funcs[d] = func_coords_private;
1762       for (d=1;d<nf;d++) ctxs[d] = ctxs[d-1] + 1;
1763       for (d=0;d<cdim;d++) {
1764         PetscInt          i;
1765         const PetscScalar *v;
1766 
1767         for (i=0;i<nf;i++) ctxs[i][0] = d;
1768         ierr = DMProjectFunction(dm,0.0,funcs,(void**)ctxs,INSERT_VALUES,vcoords);CHKERRQ(ierr);
1769         ierr = VecGetArrayRead(vcoords,&v);CHKERRQ(ierr);
1770         for (i=0;i<nl;i++) coords[i*cdim+d] = PetscRealPart(v[i]);
1771         ierr = VecRestoreArrayRead(vcoords,&v);CHKERRQ(ierr);
1772       }
1773       ierr = VecDestroy(&vcoords);CHKERRQ(ierr);
1774       ierr = PCSetCoordinates(pc,cdim,nl,coords);CHKERRQ(ierr);
1775       ierr = PetscFree(coords);CHKERRQ(ierr);
1776       ierr = PetscFree(ctxs[0]);CHKERRQ(ierr);
1777       ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr);
1778     }
1779   }
1780   PetscFunctionReturn(0);
1781 }
1782 
1783 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1784 {
1785   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1786   PetscErrorCode  ierr;
1787   IS              nis;
1788   const PetscInt  *idxs;
1789   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1790   PetscBool       *ld;
1791 
1792   PetscFunctionBegin;
1793   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1794   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
1795   if (mop == MPI_LAND) {
1796     /* init rootdata with true */
1797     ld   = (PetscBool*) matis->sf_rootdata;
1798     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1799   } else {
1800     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscBool));CHKERRQ(ierr);
1801   }
1802   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscBool));CHKERRQ(ierr);
1803   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1804   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1805   ld   = (PetscBool*) matis->sf_leafdata;
1806   for (i=0;i<nd;i++)
1807     if (-1 < idxs[i] && idxs[i] < n)
1808       ld[idxs[i]] = PETSC_TRUE;
1809   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1810   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1811   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1812   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1813   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1814   if (mop == MPI_LAND) {
1815     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1816   } else {
1817     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1818   }
1819   for (i=0,nnd=0;i<n;i++)
1820     if (ld[i])
1821       nidxs[nnd++] = i;
1822   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1823   ierr = ISDestroy(is);CHKERRQ(ierr);
1824   *is  = nis;
1825   PetscFunctionReturn(0);
1826 }
1827 
1828 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1829 {
1830   PC_IS             *pcis = (PC_IS*)(pc->data);
1831   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1832   PetscErrorCode    ierr;
1833 
1834   PetscFunctionBegin;
1835   if (!pcbddc->benign_have_null) {
1836     PetscFunctionReturn(0);
1837   }
1838   if (pcbddc->ChangeOfBasisMatrix) {
1839     Vec swap;
1840 
1841     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1842     swap = pcbddc->work_change;
1843     pcbddc->work_change = r;
1844     r = swap;
1845   }
1846   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1847   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1848   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1849   ierr = VecSet(z,0.);CHKERRQ(ierr);
1850   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1851   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1852   if (pcbddc->ChangeOfBasisMatrix) {
1853     pcbddc->work_change = r;
1854     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1855     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1856   }
1857   PetscFunctionReturn(0);
1858 }
1859 
1860 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1861 {
1862   PCBDDCBenignMatMult_ctx ctx;
1863   PetscErrorCode          ierr;
1864   PetscBool               apply_right,apply_left,reset_x;
1865 
1866   PetscFunctionBegin;
1867   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1868   if (transpose) {
1869     apply_right = ctx->apply_left;
1870     apply_left = ctx->apply_right;
1871   } else {
1872     apply_right = ctx->apply_right;
1873     apply_left = ctx->apply_left;
1874   }
1875   reset_x = PETSC_FALSE;
1876   if (apply_right) {
1877     const PetscScalar *ax;
1878     PetscInt          nl,i;
1879 
1880     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1881     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1882     ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr);
1883     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1884     for (i=0;i<ctx->benign_n;i++) {
1885       PetscScalar    sum,val;
1886       const PetscInt *idxs;
1887       PetscInt       nz,j;
1888       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1889       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1890       sum = 0.;
1891       if (ctx->apply_p0) {
1892         val = ctx->work[idxs[nz-1]];
1893         for (j=0;j<nz-1;j++) {
1894           sum += ctx->work[idxs[j]];
1895           ctx->work[idxs[j]] += val;
1896         }
1897       } else {
1898         for (j=0;j<nz-1;j++) {
1899           sum += ctx->work[idxs[j]];
1900         }
1901       }
1902       ctx->work[idxs[nz-1]] -= sum;
1903       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1904     }
1905     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1906     reset_x = PETSC_TRUE;
1907   }
1908   if (transpose) {
1909     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1910   } else {
1911     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1912   }
1913   if (reset_x) {
1914     ierr = VecResetArray(x);CHKERRQ(ierr);
1915   }
1916   if (apply_left) {
1917     PetscScalar *ay;
1918     PetscInt    i;
1919 
1920     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1921     for (i=0;i<ctx->benign_n;i++) {
1922       PetscScalar    sum,val;
1923       const PetscInt *idxs;
1924       PetscInt       nz,j;
1925       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1926       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1927       val = -ay[idxs[nz-1]];
1928       if (ctx->apply_p0) {
1929         sum = 0.;
1930         for (j=0;j<nz-1;j++) {
1931           sum += ay[idxs[j]];
1932           ay[idxs[j]] += val;
1933         }
1934         ay[idxs[nz-1]] += sum;
1935       } else {
1936         for (j=0;j<nz-1;j++) {
1937           ay[idxs[j]] += val;
1938         }
1939         ay[idxs[nz-1]] = 0.;
1940       }
1941       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1942     }
1943     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
1944   }
1945   PetscFunctionReturn(0);
1946 }
1947 
1948 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
1949 {
1950   PetscErrorCode ierr;
1951 
1952   PetscFunctionBegin;
1953   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
1954   PetscFunctionReturn(0);
1955 }
1956 
1957 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
1958 {
1959   PetscErrorCode ierr;
1960 
1961   PetscFunctionBegin;
1962   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
1963   PetscFunctionReturn(0);
1964 }
1965 
1966 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
1967 {
1968   PC_IS                   *pcis = (PC_IS*)pc->data;
1969   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
1970   PCBDDCBenignMatMult_ctx ctx;
1971   PetscErrorCode          ierr;
1972 
1973   PetscFunctionBegin;
1974   if (!restore) {
1975     Mat                A_IB,A_BI;
1976     PetscScalar        *work;
1977     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
1978 
1979     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
1980     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
1981     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
1982     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
1983     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
1984     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
1985     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
1986     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
1987     ierr = PetscNew(&ctx);CHKERRQ(ierr);
1988     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
1989     ctx->apply_left = PETSC_TRUE;
1990     ctx->apply_right = PETSC_FALSE;
1991     ctx->apply_p0 = PETSC_FALSE;
1992     ctx->benign_n = pcbddc->benign_n;
1993     if (reuse) {
1994       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
1995       ctx->free = PETSC_FALSE;
1996     } else { /* TODO: could be optimized for successive solves */
1997       ISLocalToGlobalMapping N_to_D;
1998       PetscInt               i;
1999 
2000       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
2001       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2002       for (i=0;i<pcbddc->benign_n;i++) {
2003         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2004       }
2005       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
2006       ctx->free = PETSC_TRUE;
2007     }
2008     ctx->A = pcis->A_IB;
2009     ctx->work = work;
2010     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
2011     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2012     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2013     pcis->A_IB = A_IB;
2014 
2015     /* A_BI as A_IB^T */
2016     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
2017     pcbddc->benign_original_mat = pcis->A_BI;
2018     pcis->A_BI = A_BI;
2019   } else {
2020     if (!pcbddc->benign_original_mat) {
2021       PetscFunctionReturn(0);
2022     }
2023     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
2024     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
2025     pcis->A_IB = ctx->A;
2026     ctx->A = NULL;
2027     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
2028     pcis->A_BI = pcbddc->benign_original_mat;
2029     pcbddc->benign_original_mat = NULL;
2030     if (ctx->free) {
2031       PetscInt i;
2032       for (i=0;i<ctx->benign_n;i++) {
2033         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2034       }
2035       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2036     }
2037     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
2038     ierr = PetscFree(ctx);CHKERRQ(ierr);
2039   }
2040   PetscFunctionReturn(0);
2041 }
2042 
2043 /* used just in bddc debug mode */
2044 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
2045 {
2046   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
2047   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
2048   Mat            An;
2049   PetscErrorCode ierr;
2050 
2051   PetscFunctionBegin;
2052   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
2053   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
2054   if (is1) {
2055     ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
2056     ierr = MatDestroy(&An);CHKERRQ(ierr);
2057   } else {
2058     *B = An;
2059   }
2060   PetscFunctionReturn(0);
2061 }
2062 
2063 /* TODO: add reuse flag */
2064 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2065 {
2066   Mat            Bt;
2067   PetscScalar    *a,*bdata;
2068   const PetscInt *ii,*ij;
2069   PetscInt       m,n,i,nnz,*bii,*bij;
2070   PetscBool      flg_row;
2071   PetscErrorCode ierr;
2072 
2073   PetscFunctionBegin;
2074   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2075   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2076   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2077   nnz = n;
2078   for (i=0;i<ii[n];i++) {
2079     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2080   }
2081   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2082   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2083   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2084   nnz = 0;
2085   bii[0] = 0;
2086   for (i=0;i<n;i++) {
2087     PetscInt j;
2088     for (j=ii[i];j<ii[i+1];j++) {
2089       PetscScalar entry = a[j];
2090       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || (n == m && ij[j] == i)) {
2091         bij[nnz] = ij[j];
2092         bdata[nnz] = entry;
2093         nnz++;
2094       }
2095     }
2096     bii[i+1] = nnz;
2097   }
2098   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2099   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2100   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2101   {
2102     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2103     b->free_a = PETSC_TRUE;
2104     b->free_ij = PETSC_TRUE;
2105   }
2106   if (*B == A) {
2107     ierr = MatDestroy(&A);CHKERRQ(ierr);
2108   }
2109   *B = Bt;
2110   PetscFunctionReturn(0);
2111 }
2112 
2113 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscBool filter, PetscInt *ncc, IS* cc[], IS* primalv)
2114 {
2115   Mat                    B = NULL;
2116   DM                     dm;
2117   IS                     is_dummy,*cc_n;
2118   ISLocalToGlobalMapping l2gmap_dummy;
2119   PCBDDCGraph            graph;
2120   PetscInt               *xadj_filtered = NULL,*adjncy_filtered = NULL;
2121   PetscInt               i,n;
2122   PetscInt               *xadj,*adjncy;
2123   PetscBool              isplex = PETSC_FALSE;
2124   PetscErrorCode         ierr;
2125 
2126   PetscFunctionBegin;
2127   if (ncc) *ncc = 0;
2128   if (cc) *cc = NULL;
2129   if (primalv) *primalv = NULL;
2130   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2131   ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
2132   if (!dm) {
2133     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
2134   }
2135   if (dm) {
2136     ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr);
2137   }
2138   if (filter) isplex = PETSC_FALSE;
2139 
2140   if (isplex) { /* this code has been modified from plexpartition.c */
2141     PetscInt       p, pStart, pEnd, a, adjSize, idx, size, nroots;
2142     PetscInt      *adj = NULL;
2143     IS             cellNumbering;
2144     const PetscInt *cellNum;
2145     PetscBool      useCone, useClosure;
2146     PetscSection   section;
2147     PetscSegBuffer adjBuffer;
2148     PetscSF        sfPoint;
2149     PetscErrorCode ierr;
2150 
2151     PetscFunctionBegin;
2152     ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
2153     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2154     ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
2155     /* Build adjacency graph via a section/segbuffer */
2156     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &section);CHKERRQ(ierr);
2157     ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
2158     ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr);
2159     /* Always use FVM adjacency to create partitioner graph */
2160     ierr = DMPlexGetAdjacencyUseCone(dm, &useCone);CHKERRQ(ierr);
2161     ierr = DMPlexGetAdjacencyUseClosure(dm, &useClosure);CHKERRQ(ierr);
2162     ierr = DMPlexSetAdjacencyUseCone(dm, PETSC_TRUE);CHKERRQ(ierr);
2163     ierr = DMPlexSetAdjacencyUseClosure(dm, PETSC_FALSE);CHKERRQ(ierr);
2164     ierr = DMPlexGetCellNumbering(dm, &cellNumbering);CHKERRQ(ierr);
2165     ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr);
2166     for (n = 0, p = pStart; p < pEnd; p++) {
2167       /* Skip non-owned cells in parallel (ParMetis expects no overlap) */
2168       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2169       adjSize = PETSC_DETERMINE;
2170       ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr);
2171       for (a = 0; a < adjSize; ++a) {
2172         const PetscInt point = adj[a];
2173         if (pStart <= point && point < pEnd) {
2174           PetscInt *PETSC_RESTRICT pBuf;
2175           ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr);
2176           ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr);
2177           *pBuf = point;
2178         }
2179       }
2180       n++;
2181     }
2182     ierr = DMPlexSetAdjacencyUseCone(dm, useCone);CHKERRQ(ierr);
2183     ierr = DMPlexSetAdjacencyUseClosure(dm, useClosure);CHKERRQ(ierr);
2184     /* Derive CSR graph from section/segbuffer */
2185     ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
2186     ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
2187     ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr);
2188     for (idx = 0, p = pStart; p < pEnd; p++) {
2189       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2190       ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr);
2191     }
2192     xadj[n] = size;
2193     ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr);
2194     /* Clean up */
2195     ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr);
2196     ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
2197     ierr = PetscFree(adj);CHKERRQ(ierr);
2198     graph->xadj = xadj;
2199     graph->adjncy = adjncy;
2200   } else {
2201     Mat       A;
2202     PetscBool isseqaij, flg_row;
2203 
2204     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2205     if (!A->rmap->N || !A->cmap->N) {
2206       ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2207       PetscFunctionReturn(0);
2208     }
2209     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2210     if (!isseqaij && filter) {
2211       PetscBool isseqdense;
2212 
2213       ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2214       if (!isseqdense) {
2215         ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2216       } else { /* TODO: rectangular case and LDA */
2217         PetscScalar *array;
2218         PetscReal   chop=1.e-6;
2219 
2220         ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2221         ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2222         ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2223         for (i=0;i<n;i++) {
2224           PetscInt j;
2225           for (j=i+1;j<n;j++) {
2226             PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2227             if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2228             if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2229           }
2230         }
2231         ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2232         ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2233       }
2234     } else {
2235       ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
2236       B = A;
2237     }
2238     ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2239 
2240     /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2241     if (filter) {
2242       PetscScalar *data;
2243       PetscInt    j,cum;
2244 
2245       ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2246       ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2247       cum = 0;
2248       for (i=0;i<n;i++) {
2249         PetscInt t;
2250 
2251         for (j=xadj[i];j<xadj[i+1];j++) {
2252           if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2253             continue;
2254           }
2255           adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2256         }
2257         t = xadj_filtered[i];
2258         xadj_filtered[i] = cum;
2259         cum += t;
2260       }
2261       ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2262       graph->xadj = xadj_filtered;
2263       graph->adjncy = adjncy_filtered;
2264     } else {
2265       graph->xadj = xadj;
2266       graph->adjncy = adjncy;
2267     }
2268   }
2269   /* compute local connected components using PCBDDCGraph */
2270   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2271   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2272   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2273   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2274   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2275   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2276   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2277 
2278   /* partial clean up */
2279   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2280   if (B) {
2281     PetscBool flg_row;
2282     ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2283     ierr = MatDestroy(&B);CHKERRQ(ierr);
2284   }
2285   if (isplex) {
2286     ierr = PetscFree(xadj);CHKERRQ(ierr);
2287     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2288   }
2289 
2290   /* get back data */
2291   if (isplex) {
2292     if (ncc) *ncc = graph->ncc;
2293     if (cc || primalv) {
2294       Mat          A;
2295       PetscBT      btv,btvt;
2296       PetscSection subSection;
2297       PetscInt     *ids,cum,cump,*cids,*pids;
2298 
2299       ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr);
2300       ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2301       ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr);
2302       ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr);
2303       ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr);
2304 
2305       cids[0] = 0;
2306       for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) {
2307         PetscInt j;
2308 
2309         ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr);
2310         for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) {
2311           PetscInt k, size, *closure = NULL, cell = graph->queue[j];
2312 
2313           ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2314           for (k = 0; k < 2*size; k += 2) {
2315             PetscInt s, p = closure[k], off, dof, cdof;
2316 
2317             ierr = PetscSectionGetConstraintDof(subSection, p, &cdof);CHKERRQ(ierr);
2318             ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr);
2319             ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr);
2320             for (s = 0; s < dof-cdof; s++) {
2321               if (PetscBTLookupSet(btvt,off+s)) continue;
2322               if (!PetscBTLookup(btv,off+s)) {
2323                 ids[cum++] = off+s;
2324               } else { /* cross-vertex */
2325                 pids[cump++] = off+s;
2326               }
2327             }
2328           }
2329           ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2330         }
2331         cids[i+1] = cum;
2332         /* mark dofs as already assigned */
2333         for (j = cids[i]; j < cids[i+1]; j++) {
2334           ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr);
2335         }
2336       }
2337       if (cc) {
2338         ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2339         for (i = 0; i < graph->ncc; i++) {
2340           ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2341         }
2342         *cc = cc_n;
2343       }
2344       if (primalv) {
2345         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr);
2346       }
2347       ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr);
2348       ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
2349       ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr);
2350     }
2351   } else {
2352     if (ncc) *ncc = graph->ncc;
2353     if (cc) {
2354       ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2355       for (i=0;i<graph->ncc;i++) {
2356         ierr = ISCreateGeneral(PETSC_COMM_SELF,graph->cptr[i+1]-graph->cptr[i],graph->queue+graph->cptr[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2357       }
2358       *cc = cc_n;
2359     }
2360   }
2361   /* clean up graph */
2362   graph->xadj = 0;
2363   graph->adjncy = 0;
2364   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2365   PetscFunctionReturn(0);
2366 }
2367 
2368 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2369 {
2370   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2371   PC_IS*         pcis = (PC_IS*)(pc->data);
2372   IS             dirIS = NULL;
2373   PetscInt       i;
2374   PetscErrorCode ierr;
2375 
2376   PetscFunctionBegin;
2377   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2378   if (zerodiag) {
2379     Mat            A;
2380     Vec            vec3_N;
2381     PetscScalar    *vals;
2382     const PetscInt *idxs;
2383     PetscInt       nz,*count;
2384 
2385     /* p0 */
2386     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2387     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2388     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2389     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2390     for (i=0;i<nz;i++) vals[i] = 1.;
2391     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2392     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2393     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2394     /* v_I */
2395     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2396     for (i=0;i<nz;i++) vals[i] = 0.;
2397     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2398     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2399     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2400     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2401     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2402     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2403     if (dirIS) {
2404       PetscInt n;
2405 
2406       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2407       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2408       for (i=0;i<n;i++) vals[i] = 0.;
2409       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2410       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2411     }
2412     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2413     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2414     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2415     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2416     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2417     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2418     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2419     if (PetscAbsScalar(vals[0]) > 1.e-1) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Benign trick can not be applied! b(v_I,p_0) = %1.6e (should be numerically 0.)",PetscAbsScalar(vals[0]));
2420     ierr = PetscFree(vals);CHKERRQ(ierr);
2421     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2422 
2423     /* there should not be any pressure dofs lying on the interface */
2424     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2425     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2426     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2427     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2428     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2429     for (i=0;i<nz;i++) if (count[idxs[i]]) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Benign trick can not be applied! pressure dof %d is an interface dof",idxs[i]);
2430     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2431     ierr = PetscFree(count);CHKERRQ(ierr);
2432   }
2433   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2434 
2435   /* check PCBDDCBenignGetOrSetP0 */
2436   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2437   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2438   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2439   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2440   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2441   for (i=0;i<pcbddc->benign_n;i++) {
2442     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2443     if (val != -PetscGlobalRank-i) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error testing PCBDDCBenignGetOrSetP0! Found %g at %d instead of %g\n",PetscRealPart(pcbddc->benign_p0[i]),i,-PetscGlobalRank-i);
2444   }
2445   PetscFunctionReturn(0);
2446 }
2447 
2448 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, IS *zerodiaglocal)
2449 {
2450   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2451   IS             pressures,zerodiag,zerodiag_save,*zerodiag_subs;
2452   PetscInt       nz,n;
2453   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2454   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2455   PetscErrorCode ierr;
2456 
2457   PetscFunctionBegin;
2458   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2459   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2460   for (n=0;n<pcbddc->benign_n;n++) {
2461     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2462   }
2463   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2464   pcbddc->benign_n = 0;
2465 
2466   /* if a local info on dofs is present, uses the last field for "pressures" (or fid by command line)
2467      otherwise, it uses only zerodiagonal dofs (ok if the pressure block is all zero; it could fail if it is not)
2468      Checks if all the pressure dofs in each subdomain have a zero diagonal
2469      If not, a change of basis on pressures is not needed
2470      since the local Schur complements are already SPD
2471   */
2472   has_null_pressures = PETSC_TRUE;
2473   have_null = PETSC_TRUE;
2474   if (pcbddc->n_ISForDofsLocal) {
2475     IS       iP = NULL;
2476     PetscInt npl,*idxs,p = pcbddc->n_ISForDofsLocal-1;
2477 
2478     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2479     ierr = PetscOptionsInt("-pc_bddc_pressure_field","Field id for pressures",NULL,p,&p,NULL);CHKERRQ(ierr);
2480     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2481     if (p < 0 || p > pcbddc->n_ISForDofsLocal-1) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %D",p);
2482     /* Dofs splitting for BDDC cannot have PETSC_COMM_SELF, so create a sequential IS */
2483     ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[p],&npl);CHKERRQ(ierr);
2484     ierr = ISGetIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2485     ierr = ISCreateGeneral(PETSC_COMM_SELF,npl,idxs,PETSC_COPY_VALUES,&pressures);CHKERRQ(ierr);
2486     ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2487     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2488     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2489     if (iP) {
2490       IS newpressures;
2491 
2492       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2493       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2494       pressures = newpressures;
2495     }
2496     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2497     if (!sorted) {
2498       ierr = ISSort(pressures);CHKERRQ(ierr);
2499     }
2500   } else {
2501     pressures = NULL;
2502   }
2503   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2504   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2505   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2506   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2507   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2508   if (!sorted) {
2509     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2510   }
2511   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2512   zerodiag_save = zerodiag;
2513   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2514   if (!nz) {
2515     if (n) have_null = PETSC_FALSE;
2516     has_null_pressures = PETSC_FALSE;
2517     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2518   }
2519   recompute_zerodiag = PETSC_FALSE;
2520   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2521   zerodiag_subs    = NULL;
2522   pcbddc->benign_n = 0;
2523   n_interior_dofs  = 0;
2524   interior_dofs    = NULL;
2525   nneu             = 0;
2526   if (pcbddc->NeumannBoundariesLocal) {
2527     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2528   }
2529   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2530   if (checkb) { /* need to compute interior nodes */
2531     PetscInt n,i,j;
2532     PetscInt n_neigh,*neigh,*n_shared,**shared;
2533     PetscInt *iwork;
2534 
2535     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2536     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2537     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2538     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2539     for (i=1;i<n_neigh;i++)
2540       for (j=0;j<n_shared[i];j++)
2541           iwork[shared[i][j]] += 1;
2542     for (i=0;i<n;i++)
2543       if (!iwork[i])
2544         interior_dofs[n_interior_dofs++] = i;
2545     ierr = PetscFree(iwork);CHKERRQ(ierr);
2546     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2547   }
2548   if (has_null_pressures) {
2549     IS             *subs;
2550     PetscInt       nsubs,i,j,nl;
2551     const PetscInt *idxs;
2552     PetscScalar    *array;
2553     Vec            *work;
2554     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2555 
2556     subs  = pcbddc->local_subs;
2557     nsubs = pcbddc->n_local_subs;
2558     /* these vectors are needed to check if the constant on pressures is in the kernel of the local operator B (i.e. B(v_I,p0) should be zero) */
2559     if (checkb) {
2560       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2561       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2562       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2563       /* work[0] = 1_p */
2564       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2565       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2566       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2567       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2568       /* work[0] = 1_v */
2569       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2570       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2571       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2572       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2573       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2574     }
2575     if (nsubs > 1) {
2576       ierr = PetscCalloc1(nsubs,&zerodiag_subs);CHKERRQ(ierr);
2577       for (i=0;i<nsubs;i++) {
2578         ISLocalToGlobalMapping l2g;
2579         IS                     t_zerodiag_subs;
2580         PetscInt               nl;
2581 
2582         ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2583         ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,zerodiag,&t_zerodiag_subs);CHKERRQ(ierr);
2584         ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2585         if (nl) {
2586           PetscBool valid = PETSC_TRUE;
2587 
2588           if (checkb) {
2589             ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2590             ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2591             ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2592             ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2593             for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2594             ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2595             ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2596             ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2597             ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2598             ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2599             ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2600             for (j=0;j<n_interior_dofs;j++) {
2601               if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2602                 valid = PETSC_FALSE;
2603                 break;
2604               }
2605             }
2606             ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2607           }
2608           if (valid && nneu) {
2609             const PetscInt *idxs;
2610             PetscInt       nzb;
2611 
2612             ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2613             ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2614             ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2615             if (nzb) valid = PETSC_FALSE;
2616           }
2617           if (valid && pressures) {
2618             IS t_pressure_subs;
2619             ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2620             ierr = ISEqual(t_pressure_subs,t_zerodiag_subs,&valid);CHKERRQ(ierr);
2621             ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2622           }
2623           if (valid) {
2624             ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[pcbddc->benign_n]);CHKERRQ(ierr);
2625             pcbddc->benign_n++;
2626           } else {
2627             recompute_zerodiag = PETSC_TRUE;
2628           }
2629         }
2630         ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2631         ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2632       }
2633     } else { /* there's just one subdomain (or zero if they have not been detected */
2634       PetscBool valid = PETSC_TRUE;
2635 
2636       if (nneu) valid = PETSC_FALSE;
2637       if (valid && pressures) {
2638         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2639       }
2640       if (valid && checkb) {
2641         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2642         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2643         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2644         for (j=0;j<n_interior_dofs;j++) {
2645           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2646             valid = PETSC_FALSE;
2647             break;
2648           }
2649         }
2650         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2651       }
2652       if (valid) {
2653         pcbddc->benign_n = 1;
2654         ierr = PetscMalloc1(pcbddc->benign_n,&zerodiag_subs);CHKERRQ(ierr);
2655         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2656         zerodiag_subs[0] = zerodiag;
2657       }
2658     }
2659     if (checkb) {
2660       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2661     }
2662   }
2663   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2664 
2665   if (!pcbddc->benign_n) {
2666     PetscInt n;
2667 
2668     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2669     recompute_zerodiag = PETSC_FALSE;
2670     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2671     if (n) {
2672       has_null_pressures = PETSC_FALSE;
2673       have_null = PETSC_FALSE;
2674     }
2675   }
2676 
2677   /* final check for null pressures */
2678   if (zerodiag && pressures) {
2679     PetscInt nz,np;
2680     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2681     ierr = ISGetLocalSize(pressures,&np);CHKERRQ(ierr);
2682     if (nz != np) have_null = PETSC_FALSE;
2683   }
2684 
2685   if (recompute_zerodiag) {
2686     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2687     if (pcbddc->benign_n == 1) {
2688       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2689       zerodiag = zerodiag_subs[0];
2690     } else {
2691       PetscInt i,nzn,*new_idxs;
2692 
2693       nzn = 0;
2694       for (i=0;i<pcbddc->benign_n;i++) {
2695         PetscInt ns;
2696         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2697         nzn += ns;
2698       }
2699       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2700       nzn = 0;
2701       for (i=0;i<pcbddc->benign_n;i++) {
2702         PetscInt ns,*idxs;
2703         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2704         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2705         ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr);
2706         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2707         nzn += ns;
2708       }
2709       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2710       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2711     }
2712     have_null = PETSC_FALSE;
2713   }
2714 
2715   /* Prepare matrix to compute no-net-flux */
2716   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2717     Mat                    A,loc_divudotp;
2718     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2719     IS                     row,col,isused = NULL;
2720     PetscInt               M,N,n,st,n_isused;
2721 
2722     if (pressures) {
2723       isused = pressures;
2724     } else {
2725       isused = zerodiag_save;
2726     }
2727     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2728     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2729     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2730     if (!isused && n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"Don't know how to extract div u dot p! Please provide the pressure field");
2731     n_isused = 0;
2732     if (isused) {
2733       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2734     }
2735     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2736     st = st-n_isused;
2737     if (n) {
2738       const PetscInt *gidxs;
2739 
2740       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2741       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2742       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2743       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2744       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2745       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2746     } else {
2747       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2748       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2749       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2750     }
2751     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2752     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2753     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2754     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2755     ierr = ISDestroy(&row);CHKERRQ(ierr);
2756     ierr = ISDestroy(&col);CHKERRQ(ierr);
2757     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2758     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2759     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2760     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2761     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2762     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2763     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2764     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2765     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2766     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2767   }
2768   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2769 
2770   /* change of basis and p0 dofs */
2771   if (has_null_pressures) {
2772     IS             zerodiagc;
2773     const PetscInt *idxs,*idxsc;
2774     PetscInt       i,s,*nnz;
2775 
2776     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2777     ierr = ISComplement(zerodiag,0,n,&zerodiagc);CHKERRQ(ierr);
2778     ierr = ISGetIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2779     /* local change of basis for pressures */
2780     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2781     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2782     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2783     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2784     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2785     for (i=0;i<n-nz;i++) nnz[idxsc[i]] = 1; /* identity on velocities plus pressure dofs for non-singular subdomains */
2786     for (i=0;i<pcbddc->benign_n;i++) {
2787       PetscInt nzs,j;
2788 
2789       ierr = ISGetLocalSize(zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2790       ierr = ISGetIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2791       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2792       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2793       ierr = ISRestoreIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2794     }
2795     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2796     ierr = PetscFree(nnz);CHKERRQ(ierr);
2797     /* set identity on velocities */
2798     for (i=0;i<n-nz;i++) {
2799       ierr = MatSetValue(pcbddc->benign_change,idxsc[i],idxsc[i],1.,INSERT_VALUES);CHKERRQ(ierr);
2800     }
2801     ierr = ISRestoreIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2802     ierr = ISDestroy(&zerodiagc);CHKERRQ(ierr);
2803     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2804     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2805     /* set change on pressures */
2806     for (s=0;s<pcbddc->benign_n;s++) {
2807       PetscScalar *array;
2808       PetscInt    nzs;
2809 
2810       ierr = ISGetLocalSize(zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2811       ierr = ISGetIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2812       for (i=0;i<nzs-1;i++) {
2813         PetscScalar vals[2];
2814         PetscInt    cols[2];
2815 
2816         cols[0] = idxs[i];
2817         cols[1] = idxs[nzs-1];
2818         vals[0] = 1.;
2819         vals[1] = 1.;
2820         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2821       }
2822       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2823       for (i=0;i<nzs-1;i++) array[i] = -1.;
2824       array[nzs-1] = 1.;
2825       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2826       /* store local idxs for p0 */
2827       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2828       ierr = ISRestoreIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2829       ierr = PetscFree(array);CHKERRQ(ierr);
2830     }
2831     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2832     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2833     /* project if needed */
2834     if (pcbddc->benign_change_explicit) {
2835       Mat M;
2836 
2837       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2838       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2839       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2840       ierr = MatDestroy(&M);CHKERRQ(ierr);
2841     }
2842     /* store global idxs for p0 */
2843     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2844   }
2845   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2846   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2847 
2848   /* determines if the coarse solver will be singular or not */
2849   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2850   /* determines if the problem has subdomains with 0 pressure block */
2851   have_null = (PetscBool)(!!pcbddc->benign_n);
2852   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2853   *zerodiaglocal = zerodiag;
2854   PetscFunctionReturn(0);
2855 }
2856 
2857 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2858 {
2859   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2860   PetscScalar    *array;
2861   PetscErrorCode ierr;
2862 
2863   PetscFunctionBegin;
2864   if (!pcbddc->benign_sf) {
2865     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
2866     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2867   }
2868   if (get) {
2869     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2870     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2871     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2872     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2873   } else {
2874     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
2875     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2876     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2877     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
2878   }
2879   PetscFunctionReturn(0);
2880 }
2881 
2882 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
2883 {
2884   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2885   PetscErrorCode ierr;
2886 
2887   PetscFunctionBegin;
2888   /* TODO: add error checking
2889     - avoid nested pop (or push) calls.
2890     - cannot push before pop.
2891     - cannot call this if pcbddc->local_mat is NULL
2892   */
2893   if (!pcbddc->benign_n) {
2894     PetscFunctionReturn(0);
2895   }
2896   if (pop) {
2897     if (pcbddc->benign_change_explicit) {
2898       IS       is_p0;
2899       MatReuse reuse;
2900 
2901       /* extract B_0 */
2902       reuse = MAT_INITIAL_MATRIX;
2903       if (pcbddc->benign_B0) {
2904         reuse = MAT_REUSE_MATRIX;
2905       }
2906       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
2907       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
2908       /* remove rows and cols from local problem */
2909       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
2910       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
2911       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
2912       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
2913     } else {
2914       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
2915       PetscScalar *vals;
2916       PetscInt    i,n,*idxs_ins;
2917 
2918       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
2919       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
2920       if (!pcbddc->benign_B0) {
2921         PetscInt *nnz;
2922         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
2923         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
2924         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2925         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
2926         for (i=0;i<pcbddc->benign_n;i++) {
2927           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
2928           nnz[i] = n - nnz[i];
2929         }
2930         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
2931         ierr = PetscFree(nnz);CHKERRQ(ierr);
2932       }
2933 
2934       for (i=0;i<pcbddc->benign_n;i++) {
2935         PetscScalar *array;
2936         PetscInt    *idxs,j,nz,cum;
2937 
2938         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
2939         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
2940         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2941         for (j=0;j<nz;j++) vals[j] = 1.;
2942         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2943         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
2944         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
2945         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
2946         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2947         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2948         cum = 0;
2949         for (j=0;j<n;j++) {
2950           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
2951             vals[cum] = array[j];
2952             idxs_ins[cum] = j;
2953             cum++;
2954           }
2955         }
2956         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
2957         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2958         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2959       }
2960       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2961       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2962       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
2963     }
2964   } else { /* push */
2965     if (pcbddc->benign_change_explicit) {
2966       PetscInt i;
2967 
2968       for (i=0;i<pcbddc->benign_n;i++) {
2969         PetscScalar *B0_vals;
2970         PetscInt    *B0_cols,B0_ncol;
2971 
2972         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2973         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2974         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2975         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
2976         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2977       }
2978       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2979       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2980     } else {
2981       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!\n");
2982     }
2983   }
2984   PetscFunctionReturn(0);
2985 }
2986 
2987 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
2988 {
2989   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
2990   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
2991   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
2992   PetscBLASInt    *B_iwork,*B_ifail;
2993   PetscScalar     *work,lwork;
2994   PetscScalar     *St,*S,*eigv;
2995   PetscScalar     *Sarray,*Starray;
2996   PetscReal       *eigs,thresh,lthresh,uthresh;
2997   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
2998   PetscBool       allocated_S_St;
2999 #if defined(PETSC_USE_COMPLEX)
3000   PetscReal       *rwork;
3001 #endif
3002   PetscErrorCode  ierr;
3003 
3004   PetscFunctionBegin;
3005   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
3006   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
3007   if (sub_schurs->n_subs && (!sub_schurs->is_symmetric)) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_SUP,"Adaptive selection not yet implemented for this matrix pencil (herm %d, symm %d, posdef %d)",sub_schurs->is_hermitian,sub_schurs->is_symmetric,sub_schurs->is_posdef);
3008 
3009   if (pcbddc->dbg_flag) {
3010     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3011     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3012     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
3013     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
3014   }
3015 
3016   if (pcbddc->dbg_flag) {
3017     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %d (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);
3018   }
3019 
3020   /* max size of subsets */
3021   mss = 0;
3022   for (i=0;i<sub_schurs->n_subs;i++) {
3023     PetscInt subset_size;
3024 
3025     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3026     mss = PetscMax(mss,subset_size);
3027   }
3028 
3029   /* min/max and threshold */
3030   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
3031   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
3032   nmax = PetscMax(nmin,nmax);
3033   allocated_S_St = PETSC_FALSE;
3034   if (nmin || !sub_schurs->is_posdef) { /* XXX */
3035     allocated_S_St = PETSC_TRUE;
3036   }
3037 
3038   /* allocate lapack workspace */
3039   cum = cum2 = 0;
3040   maxneigs = 0;
3041   for (i=0;i<sub_schurs->n_subs;i++) {
3042     PetscInt n,subset_size;
3043 
3044     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3045     n = PetscMin(subset_size,nmax);
3046     cum += subset_size;
3047     cum2 += subset_size*n;
3048     maxneigs = PetscMax(maxneigs,n);
3049   }
3050   if (mss) {
3051     if (sub_schurs->is_symmetric) {
3052       PetscBLASInt B_itype = 1;
3053       PetscBLASInt B_N = mss;
3054       PetscReal    zero = 0.0;
3055       PetscReal    eps = 0.0; /* dlamch? */
3056 
3057       B_lwork = -1;
3058       S = NULL;
3059       St = NULL;
3060       eigs = NULL;
3061       eigv = NULL;
3062       B_iwork = NULL;
3063       B_ifail = NULL;
3064 #if defined(PETSC_USE_COMPLEX)
3065       rwork = NULL;
3066 #endif
3067       thresh = 1.0;
3068       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3069 #if defined(PETSC_USE_COMPLEX)
3070       PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_dummyint,&B_dummyint,&eps,&B_neigs,eigs,eigv,&B_N,&lwork,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3071 #else
3072       PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_dummyint,&B_dummyint,&eps,&B_neigs,eigs,eigv,&B_N,&lwork,&B_lwork,B_iwork,B_ifail,&B_ierr));
3073 #endif
3074       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3075       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3076     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3077   } else {
3078     lwork = 0;
3079   }
3080 
3081   nv = 0;
3082   if (sub_schurs->is_vertices && pcbddc->use_vertices) { /* complement set of active subsets, each entry is a vertex (boundary made by active subsets, vertices and dirichlet dofs) */
3083     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
3084   }
3085   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
3086   if (allocated_S_St) {
3087     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
3088   }
3089   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
3090 #if defined(PETSC_USE_COMPLEX)
3091   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
3092 #endif
3093   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3094                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3095                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3096                       nv+cum,&pcbddc->adaptive_constraints_idxs,
3097                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
3098   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
3099 
3100   maxneigs = 0;
3101   cum = cumarray = 0;
3102   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3103   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3104   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3105     const PetscInt *idxs;
3106 
3107     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3108     for (cum=0;cum<nv;cum++) {
3109       pcbddc->adaptive_constraints_n[cum] = 1;
3110       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3111       pcbddc->adaptive_constraints_data[cum] = 1.0;
3112       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3113       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3114     }
3115     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3116   }
3117 
3118   if (mss) { /* multilevel */
3119     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3120     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3121   }
3122 
3123   lthresh = pcbddc->adaptive_threshold[0];
3124   uthresh = pcbddc->adaptive_threshold[1];
3125   for (i=0;i<sub_schurs->n_subs;i++) {
3126     const PetscInt *idxs;
3127     PetscReal      upper,lower;
3128     PetscInt       j,subset_size,eigs_start = 0;
3129     PetscBLASInt   B_N;
3130     PetscBool      same_data = PETSC_FALSE;
3131     PetscBool      scal = PETSC_FALSE;
3132 
3133     if (pcbddc->use_deluxe_scaling) {
3134       upper = PETSC_MAX_REAL;
3135       lower = uthresh;
3136     } else {
3137       if (!sub_schurs->is_posdef) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented without deluxe scaling");
3138       upper = 1./uthresh;
3139       lower = 0.;
3140     }
3141     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3142     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3143     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
3144     /* this is experimental: we assume the dofs have been properly grouped to have
3145        the diagonal blocks Schur complements either positive or negative definite (true for Stokes) */
3146     if (!sub_schurs->is_posdef) {
3147       Mat T;
3148 
3149       for (j=0;j<subset_size;j++) {
3150         if (PetscRealPart(*(Sarray+cumarray+j*(subset_size+1))) < 0.0) {
3151           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Sarray+cumarray,&T);CHKERRQ(ierr);
3152           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3153           ierr = MatDestroy(&T);CHKERRQ(ierr);
3154           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Starray+cumarray,&T);CHKERRQ(ierr);
3155           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3156           ierr = MatDestroy(&T);CHKERRQ(ierr);
3157           if (sub_schurs->change_primal_sub) {
3158             PetscInt       nz,k;
3159             const PetscInt *idxs;
3160 
3161             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nz);CHKERRQ(ierr);
3162             ierr = ISGetIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3163             for (k=0;k<nz;k++) {
3164               *( Sarray + cumarray + idxs[k]*(subset_size+1)) *= -1.0;
3165               *(Starray + cumarray + idxs[k]*(subset_size+1))  = 0.0;
3166             }
3167             ierr = ISRestoreIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3168           }
3169           scal = PETSC_TRUE;
3170           break;
3171         }
3172       }
3173     }
3174 
3175     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3176       if (sub_schurs->is_symmetric) {
3177         PetscInt j,k;
3178         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */
3179           ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3180           ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3181         }
3182         for (j=0;j<subset_size;j++) {
3183           for (k=j;k<subset_size;k++) {
3184             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3185             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3186           }
3187         }
3188       } else {
3189         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3190         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3191       }
3192     } else {
3193       S = Sarray + cumarray;
3194       St = Starray + cumarray;
3195     }
3196     /* see if we can save some work */
3197     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3198       ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr);
3199     }
3200 
3201     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3202       B_neigs = 0;
3203     } else {
3204       if (sub_schurs->is_symmetric) {
3205         PetscBLASInt B_itype = 1;
3206         PetscBLASInt B_IL, B_IU;
3207         PetscReal    eps = -1.0; /* dlamch? */
3208         PetscInt     nmin_s;
3209         PetscBool    compute_range;
3210 
3211         B_neigs = 0;
3212         compute_range = (PetscBool)!same_data;
3213         if (nmin >= subset_size) compute_range = PETSC_FALSE;
3214 
3215         if (pcbddc->dbg_flag) {
3216           PetscInt nc = 0;
3217 
3218           if (sub_schurs->change_primal_sub) {
3219             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nc);CHKERRQ(ierr);
3220           }
3221           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Computing for sub %d/%d size %d count %d fid %d (range %d) (change %d).\n",i,sub_schurs->n_subs,subset_size,pcbddc->mat_graph->count[idxs[0]]+1,pcbddc->mat_graph->which_dof[idxs[0]],compute_range,nc);CHKERRQ(ierr);
3222         }
3223 
3224         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3225         if (compute_range) {
3226 
3227           /* ask for eigenvalues larger than thresh */
3228           if (sub_schurs->is_posdef) {
3229 #if defined(PETSC_USE_COMPLEX)
3230             PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3231 #else
3232             PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3233 #endif
3234           } else { /* no theory so far, but it works nicely */
3235             PetscInt  recipe = 0,recipe_m = 1;
3236             PetscReal bb[2];
3237 
3238             ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe",&recipe,NULL);CHKERRQ(ierr);
3239             switch (recipe) {
3240             case 0:
3241               if (scal) { bb[0] = PETSC_MIN_REAL; bb[1] = lthresh; }
3242               else { bb[0] = uthresh; bb[1] = PETSC_MAX_REAL; }
3243 #if defined(PETSC_USE_COMPLEX)
3244               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3245 #else
3246               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3247 #endif
3248               break;
3249             case 1:
3250               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh*lthresh;
3251 #if defined(PETSC_USE_COMPLEX)
3252               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3253 #else
3254               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3255 #endif
3256               if (!scal) {
3257                 PetscBLASInt B_neigs2 = 0;
3258 
3259                 bb[0] = PetscMax(lthresh*lthresh,uthresh); bb[1] = PETSC_MAX_REAL;
3260                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3261                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3262 #if defined(PETSC_USE_COMPLEX)
3263                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3264 #else
3265                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3266 #endif
3267                 B_neigs += B_neigs2;
3268               }
3269               break;
3270             case 2:
3271               if (scal) {
3272                 bb[0] = PETSC_MIN_REAL;
3273                 bb[1] = 0;
3274 #if defined(PETSC_USE_COMPLEX)
3275                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3276 #else
3277                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3278 #endif
3279               } else {
3280                 PetscBLASInt B_neigs2 = 0;
3281                 PetscBool    import = PETSC_FALSE;
3282 
3283                 lthresh = PetscMax(lthresh,0.0);
3284                 if (lthresh > 0.0) {
3285                   bb[0] = PETSC_MIN_REAL;
3286                   bb[1] = lthresh*lthresh;
3287 
3288                   import = PETSC_TRUE;
3289 #if defined(PETSC_USE_COMPLEX)
3290                   PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3291 #else
3292                   PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3293 #endif
3294                 }
3295                 bb[0] = PetscMax(lthresh*lthresh,uthresh);
3296                 bb[1] = PETSC_MAX_REAL;
3297                 if (import) {
3298                   ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3299                   ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3300                 }
3301 #if defined(PETSC_USE_COMPLEX)
3302                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3303 #else
3304                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3305 #endif
3306                 B_neigs += B_neigs2;
3307               }
3308               break;
3309             case 3:
3310               if (scal) {
3311                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min_scal",&recipe_m,NULL);CHKERRQ(ierr);
3312               } else {
3313                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min",&recipe_m,NULL);CHKERRQ(ierr);
3314               }
3315               if (!scal) {
3316                 bb[0] = uthresh;
3317                 bb[1] = PETSC_MAX_REAL;
3318 #if defined(PETSC_USE_COMPLEX)
3319                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3320 #else
3321                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3322 #endif
3323               }
3324               if (recipe_m > 0 && B_N - B_neigs > 0) {
3325                 PetscBLASInt B_neigs2 = 0;
3326 
3327                 B_IL = 1;
3328                 ierr = PetscBLASIntCast(PetscMin(recipe_m,B_N - B_neigs),&B_IU);CHKERRQ(ierr);
3329                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3330                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3331 #if defined(PETSC_USE_COMPLEX)
3332                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3333 #else
3334                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3335 #endif
3336                 B_neigs += B_neigs2;
3337               }
3338               break;
3339             case 4:
3340               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh;
3341 #if defined(PETSC_USE_COMPLEX)
3342               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3343 #else
3344               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3345 #endif
3346               {
3347                 PetscBLASInt B_neigs2 = 0;
3348 
3349                 bb[0] = PetscMax(lthresh+PETSC_SMALL,uthresh); bb[1] = PETSC_MAX_REAL;
3350                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3351                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3352 #if defined(PETSC_USE_COMPLEX)
3353                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3354 #else
3355                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3356 #endif
3357                 B_neigs += B_neigs2;
3358               }
3359               break;
3360             case 5: /* same as before: first compute all eigenvalues, then filter */
3361 #if defined(PETSC_USE_COMPLEX)
3362               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","A","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3363 #else
3364               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","A","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3365 #endif
3366               {
3367                 PetscInt e,k,ne;
3368                 for (e=0,ne=0;e<B_neigs;e++) {
3369                   if (eigs[e] < lthresh || eigs[e] > uthresh) {
3370                     for (k=0;k<B_N;k++) S[ne*B_N+k] = eigv[e*B_N+k];
3371                     eigs[ne] = eigs[e];
3372                     ne++;
3373                   }
3374                 }
3375                 ierr = PetscMemcpy(eigv,S,B_N*ne*sizeof(PetscScalar));CHKERRQ(ierr);
3376                 B_neigs = ne;
3377               }
3378               break;
3379             default:
3380               SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Unknown recipe %D",recipe);
3381               break;
3382             }
3383           }
3384         } else if (!same_data) { /* this is just to see all the eigenvalues */
3385           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3386           B_IL = 1;
3387 #if defined(PETSC_USE_COMPLEX)
3388           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3389 #else
3390           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3391 #endif
3392         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3393           PetscInt k;
3394           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3395           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3396           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3397           nmin = nmax;
3398           ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr);
3399           for (k=0;k<nmax;k++) {
3400             eigs[k] = 1./PETSC_SMALL;
3401             eigv[k*(subset_size+1)] = 1.0;
3402           }
3403         }
3404         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3405         if (B_ierr) {
3406           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3407           else if (B_ierr <= B_N) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %d eigenvalues failed to converge",(int)B_ierr);
3408           else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: leading minor of order %d is not positive definite",(int)B_ierr-B_N-1);
3409         }
3410 
3411         if (B_neigs > nmax) {
3412           if (pcbddc->dbg_flag) {
3413             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %d.\n",B_neigs,nmax);CHKERRQ(ierr);
3414           }
3415           if (pcbddc->use_deluxe_scaling) eigs_start = scal ? 0 : B_neigs-nmax;
3416           B_neigs = nmax;
3417         }
3418 
3419         nmin_s = PetscMin(nmin,B_N);
3420         if (B_neigs < nmin_s) {
3421           PetscBLASInt B_neigs2 = 0;
3422 
3423           if (pcbddc->use_deluxe_scaling) {
3424             if (scal) {
3425               B_IU = nmin_s;
3426               B_IL = B_neigs + 1;
3427             } else {
3428               B_IL = B_N - nmin_s + 1;
3429               B_IU = B_N - B_neigs;
3430             }
3431           } else {
3432             B_IL = B_neigs + 1;
3433             B_IU = nmin_s;
3434           }
3435           if (pcbddc->dbg_flag) {
3436             PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, less than minimum required %d. Asking for %d to %d incl (fortran like)\n",B_neigs,nmin,B_IL,B_IU);
3437           }
3438           if (sub_schurs->is_symmetric) {
3439             PetscInt j,k;
3440             for (j=0;j<subset_size;j++) {
3441               for (k=j;k<subset_size;k++) {
3442                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3443                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3444               }
3445             }
3446           } else {
3447             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3448             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3449           }
3450           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3451 #if defined(PETSC_USE_COMPLEX)
3452           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*subset_size,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3453 #else
3454           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*subset_size,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3455 #endif
3456           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3457           B_neigs += B_neigs2;
3458         }
3459         if (B_ierr) {
3460           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3461           else if (B_ierr <= B_N) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %d eigenvalues failed to converge",(int)B_ierr);
3462           else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: leading minor of order %d is not positive definite",(int)B_ierr-B_N-1);
3463         }
3464         if (pcbddc->dbg_flag) {
3465           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3466           for (j=0;j<B_neigs;j++) {
3467             if (eigs[j] == 0.0) {
3468               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3469             } else {
3470               if (pcbddc->use_deluxe_scaling) {
3471                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3472               } else {
3473                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3474               }
3475             }
3476           }
3477         }
3478       } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3479     }
3480     /* change the basis back to the original one */
3481     if (sub_schurs->change) {
3482       Mat change,phi,phit;
3483 
3484       if (pcbddc->dbg_flag > 2) {
3485         PetscInt ii;
3486         for (ii=0;ii<B_neigs;ii++) {
3487           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3488           for (j=0;j<B_N;j++) {
3489 #if defined(PETSC_USE_COMPLEX)
3490             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3491             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3492             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3493 #else
3494             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3495 #endif
3496           }
3497         }
3498       }
3499       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3500       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3501       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3502       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3503       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3504       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3505     }
3506     maxneigs = PetscMax(B_neigs,maxneigs);
3507     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3508     if (B_neigs) {
3509       ierr = PetscMemcpy(pcbddc->adaptive_constraints_data+pcbddc->adaptive_constraints_data_ptr[cum],eigv+eigs_start*subset_size,B_neigs*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3510 
3511       if (pcbddc->dbg_flag > 1) {
3512         PetscInt ii;
3513         for (ii=0;ii<B_neigs;ii++) {
3514           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3515           for (j=0;j<B_N;j++) {
3516 #if defined(PETSC_USE_COMPLEX)
3517             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3518             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3519             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3520 #else
3521             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3522 #endif
3523           }
3524         }
3525       }
3526       ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
3527       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3528       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3529       cum++;
3530     }
3531     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3532     /* shift for next computation */
3533     cumarray += subset_size*subset_size;
3534   }
3535   if (pcbddc->dbg_flag) {
3536     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3537   }
3538 
3539   if (mss) {
3540     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3541     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3542     /* destroy matrices (junk) */
3543     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3544     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3545   }
3546   if (allocated_S_St) {
3547     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3548   }
3549   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3550 #if defined(PETSC_USE_COMPLEX)
3551   ierr = PetscFree(rwork);CHKERRQ(ierr);
3552 #endif
3553   if (pcbddc->dbg_flag) {
3554     PetscInt maxneigs_r;
3555     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3556     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %d\n",maxneigs_r);CHKERRQ(ierr);
3557   }
3558   PetscFunctionReturn(0);
3559 }
3560 
3561 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3562 {
3563   PetscScalar    *coarse_submat_vals;
3564   PetscErrorCode ierr;
3565 
3566   PetscFunctionBegin;
3567   /* Setup local scatters R_to_B and (optionally) R_to_D */
3568   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3569   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3570 
3571   /* Setup local neumann solver ksp_R */
3572   /* PCBDDCSetUpLocalScatters should be called first! */
3573   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3574 
3575   /*
3576      Setup local correction and local part of coarse basis.
3577      Gives back the dense local part of the coarse matrix in column major ordering
3578   */
3579   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3580 
3581   /* Compute total number of coarse nodes and setup coarse solver */
3582   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3583 
3584   /* free */
3585   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3586   PetscFunctionReturn(0);
3587 }
3588 
3589 PetscErrorCode PCBDDCResetCustomization(PC pc)
3590 {
3591   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3592   PetscErrorCode ierr;
3593 
3594   PetscFunctionBegin;
3595   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3596   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3597   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3598   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3599   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3600   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3601   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3602   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3603   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3604   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3605   PetscFunctionReturn(0);
3606 }
3607 
3608 PetscErrorCode PCBDDCResetTopography(PC pc)
3609 {
3610   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3611   PetscInt       i;
3612   PetscErrorCode ierr;
3613 
3614   PetscFunctionBegin;
3615   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3616   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3617   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3618   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3619   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3620   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3621   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3622   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3623   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3624   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3625   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3626   for (i=0;i<pcbddc->n_local_subs;i++) {
3627     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3628   }
3629   pcbddc->n_local_subs = 0;
3630   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3631   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3632   pcbddc->graphanalyzed        = PETSC_FALSE;
3633   pcbddc->recompute_topography = PETSC_TRUE;
3634   pcbddc->corner_selected      = PETSC_FALSE;
3635   PetscFunctionReturn(0);
3636 }
3637 
3638 PetscErrorCode PCBDDCResetSolvers(PC pc)
3639 {
3640   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3641   PetscErrorCode ierr;
3642 
3643   PetscFunctionBegin;
3644   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3645   if (pcbddc->coarse_phi_B) {
3646     PetscScalar *array;
3647     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3648     ierr = PetscFree(array);CHKERRQ(ierr);
3649   }
3650   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3651   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3652   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3653   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3654   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3655   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3656   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3657   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3658   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3659   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3660   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3661   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3662   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3663   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3664   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3665   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3666   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3667   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3668   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3669   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3670   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3671   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3672   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3673   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3674   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3675   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3676   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3677   if (pcbddc->benign_zerodiag_subs) {
3678     PetscInt i;
3679     for (i=0;i<pcbddc->benign_n;i++) {
3680       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3681     }
3682     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3683   }
3684   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3685   PetscFunctionReturn(0);
3686 }
3687 
3688 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3689 {
3690   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3691   PC_IS          *pcis = (PC_IS*)pc->data;
3692   VecType        impVecType;
3693   PetscInt       n_constraints,n_R,old_size;
3694   PetscErrorCode ierr;
3695 
3696   PetscFunctionBegin;
3697   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3698   n_R = pcis->n - pcbddc->n_vertices;
3699   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3700   /* local work vectors (try to avoid unneeded work)*/
3701   /* R nodes */
3702   old_size = -1;
3703   if (pcbddc->vec1_R) {
3704     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3705   }
3706   if (n_R != old_size) {
3707     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3708     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3709     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3710     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3711     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3712     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3713   }
3714   /* local primal dofs */
3715   old_size = -1;
3716   if (pcbddc->vec1_P) {
3717     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3718   }
3719   if (pcbddc->local_primal_size != old_size) {
3720     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3721     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3722     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3723     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3724   }
3725   /* local explicit constraints */
3726   old_size = -1;
3727   if (pcbddc->vec1_C) {
3728     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3729   }
3730   if (n_constraints && n_constraints != old_size) {
3731     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3732     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3733     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3734     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3735   }
3736   PetscFunctionReturn(0);
3737 }
3738 
3739 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3740 {
3741   PetscErrorCode  ierr;
3742   /* pointers to pcis and pcbddc */
3743   PC_IS*          pcis = (PC_IS*)pc->data;
3744   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3745   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3746   /* submatrices of local problem */
3747   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3748   /* submatrices of local coarse problem */
3749   Mat             S_VV,S_CV,S_VC,S_CC;
3750   /* working matrices */
3751   Mat             C_CR;
3752   /* additional working stuff */
3753   PC              pc_R;
3754   Mat             F,Brhs = NULL;
3755   Vec             dummy_vec;
3756   PetscBool       isLU,isCHOL,isILU,need_benign_correction,sparserhs;
3757   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3758   PetscScalar     *work;
3759   PetscInt        *idx_V_B;
3760   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3761   PetscInt        i,n_R,n_D,n_B;
3762 
3763   /* some shortcuts to scalars */
3764   PetscScalar     one=1.0,m_one=-1.0;
3765 
3766   PetscFunctionBegin;
3767   if (!pcbddc->symmetric_primal && pcbddc->benign_n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Non-symmetric primal basis computation with benign trick not yet implemented");
3768 
3769   /* Set Non-overlapping dimensions */
3770   n_vertices = pcbddc->n_vertices;
3771   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3772   n_B = pcis->n_B;
3773   n_D = pcis->n - n_B;
3774   n_R = pcis->n - n_vertices;
3775 
3776   /* vertices in boundary numbering */
3777   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3778   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3779   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",n_vertices,i);
3780 
3781   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3782   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3783   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3784   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3785   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3786   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3787   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3788   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3789   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3790   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3791 
3792   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3793   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3794   ierr = PCSetUp(pc_R);CHKERRQ(ierr);
3795   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3796   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3797   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3798   lda_rhs = n_R;
3799   need_benign_correction = PETSC_FALSE;
3800   if (isLU || isILU || isCHOL) {
3801     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3802   } else if (sub_schurs && sub_schurs->reuse_solver) {
3803     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3804     MatFactorType      type;
3805 
3806     F = reuse_solver->F;
3807     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3808     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3809     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3810     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3811   } else {
3812     F = NULL;
3813   }
3814 
3815   /* determine if we can use a sparse right-hand side */
3816   sparserhs = PETSC_FALSE;
3817   if (F) {
3818     MatSolverType solver;
3819 
3820     ierr = MatFactorGetSolverType(F,&solver);CHKERRQ(ierr);
3821     ierr = PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs);CHKERRQ(ierr);
3822   }
3823 
3824   /* allocate workspace */
3825   n = 0;
3826   if (n_constraints) {
3827     n += lda_rhs*n_constraints;
3828   }
3829   if (n_vertices) {
3830     n = PetscMax(2*lda_rhs*n_vertices,n);
3831     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3832   }
3833   if (!pcbddc->symmetric_primal) {
3834     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3835   }
3836   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3837 
3838   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3839   dummy_vec = NULL;
3840   if (need_benign_correction && lda_rhs != n_R && F) {
3841     ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,lda_rhs,work,&dummy_vec);CHKERRQ(ierr);
3842   }
3843 
3844   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3845   if (n_constraints) {
3846     Mat         M3,C_B;
3847     IS          is_aux;
3848     PetscScalar *array,*array2;
3849 
3850     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3851     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3852 
3853     /* Extract constraints on R nodes: C_{CR}  */
3854     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
3855     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
3856     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
3857 
3858     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
3859     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
3860     if (!sparserhs) {
3861       ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
3862       for (i=0;i<n_constraints;i++) {
3863         const PetscScalar *row_cmat_values;
3864         const PetscInt    *row_cmat_indices;
3865         PetscInt          size_of_constraint,j;
3866 
3867         ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3868         for (j=0;j<size_of_constraint;j++) {
3869           work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
3870         }
3871         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3872       }
3873       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs);CHKERRQ(ierr);
3874     } else {
3875       Mat tC_CR;
3876 
3877       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
3878       if (lda_rhs != n_R) {
3879         PetscScalar *aa;
3880         PetscInt    r,*ii,*jj;
3881         PetscBool   done;
3882 
3883         ierr = MatGetRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3884         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
3885         ierr = MatSeqAIJGetArray(C_CR,&aa);CHKERRQ(ierr);
3886         ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR);CHKERRQ(ierr);
3887         ierr = MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3888         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
3889       } else {
3890         ierr  = PetscObjectReference((PetscObject)C_CR);CHKERRQ(ierr);
3891         tC_CR = C_CR;
3892       }
3893       ierr = MatCreateTranspose(tC_CR,&Brhs);CHKERRQ(ierr);
3894       ierr = MatDestroy(&tC_CR);CHKERRQ(ierr);
3895     }
3896     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
3897     if (F) {
3898       if (need_benign_correction) {
3899         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3900 
3901         /* rhs is already zero on interior dofs, no need to change the rhs */
3902         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
3903       }
3904       ierr = MatMatSolve(F,Brhs,local_auxmat2_R);CHKERRQ(ierr);
3905       if (need_benign_correction) {
3906         PetscScalar        *marr;
3907         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3908 
3909         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3910         if (lda_rhs != n_R) {
3911           for (i=0;i<n_constraints;i++) {
3912             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3913             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3914             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3915           }
3916         } else {
3917           for (i=0;i<n_constraints;i++) {
3918             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3919             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3920             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3921           }
3922         }
3923         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3924       }
3925     } else {
3926       PetscScalar *marr;
3927 
3928       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3929       for (i=0;i<n_constraints;i++) {
3930         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3931         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
3932         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3933         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3934         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3935       }
3936       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3937     }
3938     if (sparserhs) {
3939       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
3940     }
3941     ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
3942     if (!pcbddc->switch_static) {
3943       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3944       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3945       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3946       for (i=0;i<n_constraints;i++) {
3947         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
3948         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
3949         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3950         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3951         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3952         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3953       }
3954       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3955       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3956       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3957     } else {
3958       if (lda_rhs != n_R) {
3959         IS dummy;
3960 
3961         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
3962         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3963         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
3964       } else {
3965         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
3966         pcbddc->local_auxmat2 = local_auxmat2_R;
3967       }
3968       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3969     }
3970     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3971     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
3972     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
3973     if (isCHOL) {
3974       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
3975     } else {
3976       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
3977     }
3978     ierr = MatSeqDenseInvertFactors_Private(M3);CHKERRQ(ierr);
3979     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
3980     ierr = MatMatMult(M3,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
3981     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
3982     ierr = MatCopy(M3,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
3983     ierr = MatDestroy(&M3);CHKERRQ(ierr);
3984   }
3985 
3986   /* Get submatrices from subdomain matrix */
3987   if (n_vertices) {
3988     IS        is_aux;
3989     PetscBool isseqaij;
3990 
3991     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
3992       IS tis;
3993 
3994       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
3995       ierr = ISSort(tis);CHKERRQ(ierr);
3996       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
3997       ierr = ISDestroy(&tis);CHKERRQ(ierr);
3998     } else {
3999       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
4000     }
4001     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
4002     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
4003     ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4004     if (!isseqaij) { /* MatMatMult(A_VR,A_RRmA_RV) below will raise an error */
4005       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4006     }
4007     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
4008     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4009   }
4010 
4011   /* Matrix of coarse basis functions (local) */
4012   if (pcbddc->coarse_phi_B) {
4013     PetscInt on_B,on_primal,on_D=n_D;
4014     if (pcbddc->coarse_phi_D) {
4015       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
4016     }
4017     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
4018     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
4019       PetscScalar *marray;
4020 
4021       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
4022       ierr = PetscFree(marray);CHKERRQ(ierr);
4023       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4024       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4025       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4026       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4027     }
4028   }
4029 
4030   if (!pcbddc->coarse_phi_B) {
4031     PetscScalar *marr;
4032 
4033     /* memory size */
4034     n = n_B*pcbddc->local_primal_size;
4035     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
4036     if (!pcbddc->symmetric_primal) n *= 2;
4037     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
4038     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4039     marr += n_B*pcbddc->local_primal_size;
4040     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4041       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4042       marr += n_D*pcbddc->local_primal_size;
4043     }
4044     if (!pcbddc->symmetric_primal) {
4045       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4046       marr += n_B*pcbddc->local_primal_size;
4047       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4048         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4049       }
4050     } else {
4051       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
4052       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
4053       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4054         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
4055         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
4056       }
4057     }
4058   }
4059 
4060   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
4061   p0_lidx_I = NULL;
4062   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
4063     const PetscInt *idxs;
4064 
4065     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4066     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
4067     for (i=0;i<pcbddc->benign_n;i++) {
4068       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
4069     }
4070     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4071   }
4072 
4073   /* vertices */
4074   if (n_vertices) {
4075     PetscBool restoreavr = PETSC_FALSE;
4076 
4077     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
4078 
4079     if (n_R) {
4080       Mat          A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
4081       PetscBLASInt B_N,B_one = 1;
4082       PetscScalar  *x,*y;
4083 
4084       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
4085       if (need_benign_correction) {
4086         ISLocalToGlobalMapping RtoN;
4087         IS                     is_p0;
4088         PetscInt               *idxs_p0,n;
4089 
4090         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
4091         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
4092         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
4093         if (n != pcbddc->benign_n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in R numbering for benign p0! %d != %d\n",n,pcbddc->benign_n);
4094         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
4095         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
4096         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
4097         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
4098       }
4099 
4100       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4101       if (!sparserhs || need_benign_correction) {
4102         if (lda_rhs == n_R) {
4103           ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4104         } else {
4105           PetscScalar    *av,*array;
4106           const PetscInt *xadj,*adjncy;
4107           PetscInt       n;
4108           PetscBool      flg_row;
4109 
4110           array = work+lda_rhs*n_vertices;
4111           ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
4112           ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4113           ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4114           ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
4115           for (i=0;i<n;i++) {
4116             PetscInt j;
4117             for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
4118           }
4119           ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4120           ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4121           ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
4122         }
4123         if (need_benign_correction) {
4124           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4125           PetscScalar        *marr;
4126 
4127           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
4128           /* need \Phi^T A_RV = (I+L)A_RV, L given by
4129 
4130                  | 0 0  0 | (V)
4131              L = | 0 0 -1 | (P-p0)
4132                  | 0 0 -1 | (p0)
4133 
4134           */
4135           for (i=0;i<reuse_solver->benign_n;i++) {
4136             const PetscScalar *vals;
4137             const PetscInt    *idxs,*idxs_zero;
4138             PetscInt          n,j,nz;
4139 
4140             ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4141             ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4142             ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4143             for (j=0;j<n;j++) {
4144               PetscScalar val = vals[j];
4145               PetscInt    k,col = idxs[j];
4146               for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
4147             }
4148             ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4149             ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4150           }
4151           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
4152         }
4153         ierr = PetscObjectReference((PetscObject)A_RV);CHKERRQ(ierr);
4154         Brhs = A_RV;
4155       } else {
4156         Mat tA_RVT,A_RVT;
4157 
4158         if (!pcbddc->symmetric_primal) {
4159           /* A_RV already scaled by -1 */
4160           ierr = MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT);CHKERRQ(ierr);
4161         } else {
4162           restoreavr = PETSC_TRUE;
4163           ierr  = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4164           ierr  = PetscObjectReference((PetscObject)A_VR);CHKERRQ(ierr);
4165           A_RVT = A_VR;
4166         }
4167         if (lda_rhs != n_R) {
4168           PetscScalar *aa;
4169           PetscInt    r,*ii,*jj;
4170           PetscBool   done;
4171 
4172           ierr = MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4173           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4174           ierr = MatSeqAIJGetArray(A_RVT,&aa);CHKERRQ(ierr);
4175           ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT);CHKERRQ(ierr);
4176           ierr = MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4177           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4178         } else {
4179           ierr   = PetscObjectReference((PetscObject)A_RVT);CHKERRQ(ierr);
4180           tA_RVT = A_RVT;
4181         }
4182         ierr = MatCreateTranspose(tA_RVT,&Brhs);CHKERRQ(ierr);
4183         ierr = MatDestroy(&tA_RVT);CHKERRQ(ierr);
4184         ierr = MatDestroy(&A_RVT);CHKERRQ(ierr);
4185       }
4186       if (F) {
4187         /* need to correct the rhs */
4188         if (need_benign_correction) {
4189           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4190           PetscScalar        *marr;
4191 
4192           ierr = MatDenseGetArray(Brhs,&marr);CHKERRQ(ierr);
4193           if (lda_rhs != n_R) {
4194             for (i=0;i<n_vertices;i++) {
4195               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4196               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4197               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4198             }
4199           } else {
4200             for (i=0;i<n_vertices;i++) {
4201               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4202               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4203               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4204             }
4205           }
4206           ierr = MatDenseRestoreArray(Brhs,&marr);CHKERRQ(ierr);
4207         }
4208         ierr = MatMatSolve(F,Brhs,A_RRmA_RV);CHKERRQ(ierr);
4209         if (restoreavr) {
4210           ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4211         }
4212         /* need to correct the solution */
4213         if (need_benign_correction) {
4214           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4215           PetscScalar        *marr;
4216 
4217           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4218           if (lda_rhs != n_R) {
4219             for (i=0;i<n_vertices;i++) {
4220               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4221               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4222               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4223             }
4224           } else {
4225             for (i=0;i<n_vertices;i++) {
4226               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4227               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4228               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4229             }
4230           }
4231           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4232         }
4233       } else {
4234         ierr = MatDenseGetArray(Brhs,&y);CHKERRQ(ierr);
4235         for (i=0;i<n_vertices;i++) {
4236           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
4237           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
4238           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4239           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4240           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4241         }
4242         ierr = MatDenseRestoreArray(Brhs,&y);CHKERRQ(ierr);
4243       }
4244       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4245       ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4246       /* S_VV and S_CV */
4247       if (n_constraints) {
4248         Mat B;
4249 
4250         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
4251         for (i=0;i<n_vertices;i++) {
4252           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4253           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
4254           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4255           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4256           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4257           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4258         }
4259         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4260         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
4261         ierr = MatDestroy(&B);CHKERRQ(ierr);
4262         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4263         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4264         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
4265         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
4266         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
4267         ierr = MatDestroy(&B);CHKERRQ(ierr);
4268       }
4269       if (lda_rhs != n_R) {
4270         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4271         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4272         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
4273       }
4274       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
4275       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
4276       if (need_benign_correction) {
4277         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4278         PetscScalar      *marr,*sums;
4279 
4280         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
4281         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
4282         for (i=0;i<reuse_solver->benign_n;i++) {
4283           const PetscScalar *vals;
4284           const PetscInt    *idxs,*idxs_zero;
4285           PetscInt          n,j,nz;
4286 
4287           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4288           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4289           for (j=0;j<n_vertices;j++) {
4290             PetscInt k;
4291             sums[j] = 0.;
4292             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
4293           }
4294           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4295           for (j=0;j<n;j++) {
4296             PetscScalar val = vals[j];
4297             PetscInt k;
4298             for (k=0;k<n_vertices;k++) {
4299               marr[idxs[j]+k*n_vertices] += val*sums[k];
4300             }
4301           }
4302           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4303           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4304         }
4305         ierr = PetscFree(sums);CHKERRQ(ierr);
4306         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
4307         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
4308       }
4309       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4310       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
4311       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
4312       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
4313       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4314       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
4315       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
4316       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4317       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
4318     } else {
4319       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4320     }
4321     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
4322 
4323     /* coarse basis functions */
4324     for (i=0;i<n_vertices;i++) {
4325       PetscScalar *y;
4326 
4327       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4328       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4329       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4330       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4331       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4332       y[n_B*i+idx_V_B[i]] = 1.0;
4333       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4334       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4335 
4336       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4337         PetscInt j;
4338 
4339         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4340         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4341         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4342         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4343         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4344         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4345         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4346       }
4347       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4348     }
4349     /* if n_R == 0 the object is not destroyed */
4350     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4351   }
4352   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4353 
4354   if (n_constraints) {
4355     Mat B;
4356 
4357     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4358     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4359     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4360     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4361     if (n_vertices) {
4362       if (isCHOL || need_benign_correction) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4363         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4364       } else {
4365         Mat S_VCt;
4366 
4367         if (lda_rhs != n_R) {
4368           ierr = MatDestroy(&B);CHKERRQ(ierr);
4369           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4370           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4371         }
4372         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4373         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4374         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4375       }
4376     }
4377     ierr = MatDestroy(&B);CHKERRQ(ierr);
4378     /* coarse basis functions */
4379     for (i=0;i<n_constraints;i++) {
4380       PetscScalar *y;
4381 
4382       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4383       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4384       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4385       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4386       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4387       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4388       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4389       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4390         PetscInt j;
4391 
4392         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4393         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4394         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4395         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4396         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4397         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4398         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4399       }
4400       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4401     }
4402   }
4403   if (n_constraints) {
4404     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4405   }
4406   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4407 
4408   /* coarse matrix entries relative to B_0 */
4409   if (pcbddc->benign_n) {
4410     Mat         B0_B,B0_BPHI;
4411     IS          is_dummy;
4412     PetscScalar *data;
4413     PetscInt    j;
4414 
4415     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4416     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4417     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4418     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4419     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4420     ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr);
4421     for (j=0;j<pcbddc->benign_n;j++) {
4422       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4423       for (i=0;i<pcbddc->local_primal_size;i++) {
4424         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4425         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4426       }
4427     }
4428     ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr);
4429     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4430     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4431   }
4432 
4433   /* compute other basis functions for non-symmetric problems */
4434   if (!pcbddc->symmetric_primal) {
4435     Mat         B_V=NULL,B_C=NULL;
4436     PetscScalar *marray;
4437 
4438     if (n_constraints) {
4439       Mat S_CCT,C_CRT;
4440 
4441       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4442       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4443       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4444       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4445       if (n_vertices) {
4446         Mat S_VCT;
4447 
4448         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4449         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4450         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4451       }
4452       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4453     } else {
4454       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4455     }
4456     if (n_vertices && n_R) {
4457       PetscScalar    *av,*marray;
4458       const PetscInt *xadj,*adjncy;
4459       PetscInt       n;
4460       PetscBool      flg_row;
4461 
4462       /* B_V = B_V - A_VR^T */
4463       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4464       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4465       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4466       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4467       for (i=0;i<n;i++) {
4468         PetscInt j;
4469         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4470       }
4471       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4472       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4473       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4474     }
4475 
4476     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4477     if (n_vertices) {
4478       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4479       for (i=0;i<n_vertices;i++) {
4480         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4481         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4482         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4483         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4484         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4485       }
4486       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4487     }
4488     if (B_C) {
4489       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4490       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4491         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4492         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4493         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4494         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4495         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4496       }
4497       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4498     }
4499     /* coarse basis functions */
4500     for (i=0;i<pcbddc->local_primal_size;i++) {
4501       PetscScalar *y;
4502 
4503       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4504       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4505       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4506       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4507       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4508       if (i<n_vertices) {
4509         y[n_B*i+idx_V_B[i]] = 1.0;
4510       }
4511       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4512       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4513 
4514       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4515         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4516         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4517         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4518         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4519         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4520         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4521       }
4522       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4523     }
4524     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4525     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4526   }
4527 
4528   /* free memory */
4529   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4530   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4531   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4532   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4533   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4534   ierr = PetscFree(work);CHKERRQ(ierr);
4535   if (n_vertices) {
4536     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4537   }
4538   if (n_constraints) {
4539     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4540   }
4541   /* Checking coarse_sub_mat and coarse basis functios */
4542   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4543   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4544   if (pcbddc->dbg_flag) {
4545     Mat         coarse_sub_mat;
4546     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4547     Mat         coarse_phi_D,coarse_phi_B;
4548     Mat         coarse_psi_D,coarse_psi_B;
4549     Mat         A_II,A_BB,A_IB,A_BI;
4550     Mat         C_B,CPHI;
4551     IS          is_dummy;
4552     Vec         mones;
4553     MatType     checkmattype=MATSEQAIJ;
4554     PetscReal   real_value;
4555 
4556     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4557       Mat A;
4558       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4559       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4560       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4561       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4562       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4563       ierr = MatDestroy(&A);CHKERRQ(ierr);
4564     } else {
4565       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4566       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4567       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4568       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4569     }
4570     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4571     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4572     if (!pcbddc->symmetric_primal) {
4573       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4574       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4575     }
4576     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4577 
4578     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4579     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4580     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4581     if (!pcbddc->symmetric_primal) {
4582       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4583       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4584       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4585       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4586       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4587       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4588       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4589       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4590       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4591       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4592       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4593       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4594     } else {
4595       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4596       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4597       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4598       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4599       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4600       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4601       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4602       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4603     }
4604     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4605     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4606     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4607     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4608     if (pcbddc->benign_n) {
4609       Mat         B0_B,B0_BPHI;
4610       PetscScalar *data,*data2;
4611       PetscInt    j;
4612 
4613       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4614       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4615       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4616       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4617       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4618       ierr = MatDenseGetArray(B0_BPHI,&data2);CHKERRQ(ierr);
4619       for (j=0;j<pcbddc->benign_n;j++) {
4620         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4621         for (i=0;i<pcbddc->local_primal_size;i++) {
4622           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4623           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4624         }
4625       }
4626       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4627       ierr = MatDenseRestoreArray(B0_BPHI,&data2);CHKERRQ(ierr);
4628       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4629       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4630       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4631     }
4632 #if 0
4633   {
4634     PetscViewer viewer;
4635     char filename[256];
4636     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4637     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4638     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4639     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4640     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4641     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4642     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4643     if (pcbddc->coarse_phi_B) {
4644       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4645       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4646     }
4647     if (pcbddc->coarse_phi_D) {
4648       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4649       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4650     }
4651     if (pcbddc->coarse_psi_B) {
4652       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4653       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4654     }
4655     if (pcbddc->coarse_psi_D) {
4656       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4657       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4658     }
4659     ierr = PetscObjectSetName((PetscObject)pcbddc->local_mat,"A");CHKERRQ(ierr);
4660     ierr = MatView(pcbddc->local_mat,viewer);CHKERRQ(ierr);
4661     ierr = PetscObjectSetName((PetscObject)pcbddc->ConstraintMatrix,"C");CHKERRQ(ierr);
4662     ierr = MatView(pcbddc->ConstraintMatrix,viewer);CHKERRQ(ierr);
4663     ierr = PetscObjectSetName((PetscObject)pcis->is_I_local,"I");CHKERRQ(ierr);
4664     ierr = ISView(pcis->is_I_local,viewer);CHKERRQ(ierr);
4665     ierr = PetscObjectSetName((PetscObject)pcis->is_B_local,"B");CHKERRQ(ierr);
4666     ierr = ISView(pcis->is_B_local,viewer);CHKERRQ(ierr);
4667     ierr = PetscObjectSetName((PetscObject)pcbddc->is_R_local,"R");CHKERRQ(ierr);
4668     ierr = ISView(pcbddc->is_R_local,viewer);CHKERRQ(ierr);
4669     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4670   }
4671 #endif
4672     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4673     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4674     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4675     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4676 
4677     /* check constraints */
4678     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4679     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4680     if (!pcbddc->benign_n) { /* TODO: add benign case */
4681       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4682     } else {
4683       PetscScalar *data;
4684       Mat         tmat;
4685       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4686       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4687       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4688       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4689       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4690     }
4691     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4692     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4693     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4694     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4695     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4696     if (!pcbddc->symmetric_primal) {
4697       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4698       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4699       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4700       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4701       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4702     }
4703     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4704     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4705     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4706     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4707     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4708     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4709     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4710     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4711     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4712     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4713     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4714     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4715     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4716     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4717     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4718     if (!pcbddc->symmetric_primal) {
4719       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4720       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4721     }
4722     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4723   }
4724   /* get back data */
4725   *coarse_submat_vals_n = coarse_submat_vals;
4726   PetscFunctionReturn(0);
4727 }
4728 
4729 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4730 {
4731   Mat            *work_mat;
4732   IS             isrow_s,iscol_s;
4733   PetscBool      rsorted,csorted;
4734   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4735   PetscErrorCode ierr;
4736 
4737   PetscFunctionBegin;
4738   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4739   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4740   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4741   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4742 
4743   if (!rsorted) {
4744     const PetscInt *idxs;
4745     PetscInt *idxs_sorted,i;
4746 
4747     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4748     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4749     for (i=0;i<rsize;i++) {
4750       idxs_perm_r[i] = i;
4751     }
4752     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4753     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4754     for (i=0;i<rsize;i++) {
4755       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4756     }
4757     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4758     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4759   } else {
4760     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4761     isrow_s = isrow;
4762   }
4763 
4764   if (!csorted) {
4765     if (isrow == iscol) {
4766       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4767       iscol_s = isrow_s;
4768     } else {
4769       const PetscInt *idxs;
4770       PetscInt       *idxs_sorted,i;
4771 
4772       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4773       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4774       for (i=0;i<csize;i++) {
4775         idxs_perm_c[i] = i;
4776       }
4777       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4778       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4779       for (i=0;i<csize;i++) {
4780         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4781       }
4782       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4783       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4784     }
4785   } else {
4786     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4787     iscol_s = iscol;
4788   }
4789 
4790   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4791 
4792   if (!rsorted || !csorted) {
4793     Mat      new_mat;
4794     IS       is_perm_r,is_perm_c;
4795 
4796     if (!rsorted) {
4797       PetscInt *idxs_r,i;
4798       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4799       for (i=0;i<rsize;i++) {
4800         idxs_r[idxs_perm_r[i]] = i;
4801       }
4802       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4803       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4804     } else {
4805       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4806     }
4807     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4808 
4809     if (!csorted) {
4810       if (isrow_s == iscol_s) {
4811         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4812         is_perm_c = is_perm_r;
4813       } else {
4814         PetscInt *idxs_c,i;
4815         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4816         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4817         for (i=0;i<csize;i++) {
4818           idxs_c[idxs_perm_c[i]] = i;
4819         }
4820         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4821         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4822       }
4823     } else {
4824       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4825     }
4826     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4827 
4828     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4829     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4830     work_mat[0] = new_mat;
4831     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4832     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4833   }
4834 
4835   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4836   *B = work_mat[0];
4837   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4838   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4839   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4840   PetscFunctionReturn(0);
4841 }
4842 
4843 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
4844 {
4845   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
4846   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4847   Mat            new_mat,lA;
4848   IS             is_local,is_global;
4849   PetscInt       local_size;
4850   PetscBool      isseqaij;
4851   PetscErrorCode ierr;
4852 
4853   PetscFunctionBegin;
4854   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4855   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
4856   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
4857   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
4858   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
4859   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
4860   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
4861 
4862   /* check */
4863   if (pcbddc->dbg_flag) {
4864     Vec       x,x_change;
4865     PetscReal error;
4866 
4867     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
4868     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
4869     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
4870     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4871     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4872     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
4873     if (!pcbddc->change_interior) {
4874       const PetscScalar *x,*y,*v;
4875       PetscReal         lerror = 0.;
4876       PetscInt          i;
4877 
4878       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
4879       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
4880       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
4881       for (i=0;i<local_size;i++)
4882         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
4883           lerror = PetscAbsScalar(x[i]-y[i]);
4884       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
4885       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
4886       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
4887       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4888       if (error > PETSC_SMALL) {
4889         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4890           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e\n",error);
4891         } else {
4892           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e\n",error);
4893         }
4894       }
4895     }
4896     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4897     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4898     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
4899     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
4900     if (error > PETSC_SMALL) {
4901       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4902         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
4903       } else {
4904         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e\n",error);
4905       }
4906     }
4907     ierr = VecDestroy(&x);CHKERRQ(ierr);
4908     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
4909   }
4910 
4911   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
4912   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
4913 
4914   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
4915   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4916   if (isseqaij) {
4917     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4918     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4919     if (lA) {
4920       Mat work;
4921       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4922       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4923       ierr = MatDestroy(&work);CHKERRQ(ierr);
4924     }
4925   } else {
4926     Mat work_mat;
4927 
4928     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4929     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4930     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4931     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
4932     if (lA) {
4933       Mat work;
4934       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4935       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4936       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4937       ierr = MatDestroy(&work);CHKERRQ(ierr);
4938     }
4939   }
4940   if (matis->A->symmetric_set) {
4941     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
4942 #if !defined(PETSC_USE_COMPLEX)
4943     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
4944 #endif
4945   }
4946   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
4947   PetscFunctionReturn(0);
4948 }
4949 
4950 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
4951 {
4952   PC_IS*          pcis = (PC_IS*)(pc->data);
4953   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
4954   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4955   PetscInt        *idx_R_local=NULL;
4956   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
4957   PetscInt        vbs,bs;
4958   PetscBT         bitmask=NULL;
4959   PetscErrorCode  ierr;
4960 
4961   PetscFunctionBegin;
4962   /*
4963     No need to setup local scatters if
4964       - primal space is unchanged
4965         AND
4966       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
4967         AND
4968       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
4969   */
4970   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
4971     PetscFunctionReturn(0);
4972   }
4973   /* destroy old objects */
4974   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
4975   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
4976   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
4977   /* Set Non-overlapping dimensions */
4978   n_B = pcis->n_B;
4979   n_D = pcis->n - n_B;
4980   n_vertices = pcbddc->n_vertices;
4981 
4982   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
4983 
4984   /* create auxiliary bitmask and allocate workspace */
4985   if (!sub_schurs || !sub_schurs->reuse_solver) {
4986     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
4987     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
4988     for (i=0;i<n_vertices;i++) {
4989       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
4990     }
4991 
4992     for (i=0, n_R=0; i<pcis->n; i++) {
4993       if (!PetscBTLookup(bitmask,i)) {
4994         idx_R_local[n_R++] = i;
4995       }
4996     }
4997   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
4998     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4999 
5000     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5001     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
5002   }
5003 
5004   /* Block code */
5005   vbs = 1;
5006   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
5007   if (bs>1 && !(n_vertices%bs)) {
5008     PetscBool is_blocked = PETSC_TRUE;
5009     PetscInt  *vary;
5010     if (!sub_schurs || !sub_schurs->reuse_solver) {
5011       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
5012       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
5013       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
5014       /* it is ok to check this way since local_primal_ref_node are always sorted by local numbering and idx_R_local is obtained as a complement */
5015       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
5016       for (i=0; i<pcis->n/bs; i++) {
5017         if (vary[i]!=0 && vary[i]!=bs) {
5018           is_blocked = PETSC_FALSE;
5019           break;
5020         }
5021       }
5022       ierr = PetscFree(vary);CHKERRQ(ierr);
5023     } else {
5024       /* Verify directly the R set */
5025       for (i=0; i<n_R/bs; i++) {
5026         PetscInt j,node=idx_R_local[bs*i];
5027         for (j=1; j<bs; j++) {
5028           if (node != idx_R_local[bs*i+j]-j) {
5029             is_blocked = PETSC_FALSE;
5030             break;
5031           }
5032         }
5033       }
5034     }
5035     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
5036       vbs = bs;
5037       for (i=0;i<n_R/vbs;i++) {
5038         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
5039       }
5040     }
5041   }
5042   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
5043   if (sub_schurs && sub_schurs->reuse_solver) {
5044     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5045 
5046     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5047     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
5048     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
5049     reuse_solver->is_R = pcbddc->is_R_local;
5050   } else {
5051     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
5052   }
5053 
5054   /* print some info if requested */
5055   if (pcbddc->dbg_flag) {
5056     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5057     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5058     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5059     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
5060     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
5061     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"r_size = %d, v_size = %d, constraints = %d, local_primal_size = %d\n",n_R,n_vertices,pcbddc->local_primal_size-n_vertices-pcbddc->benign_n,pcbddc->local_primal_size);CHKERRQ(ierr);
5062     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5063   }
5064 
5065   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
5066   if (!sub_schurs || !sub_schurs->reuse_solver) {
5067     IS       is_aux1,is_aux2;
5068     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
5069 
5070     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5071     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
5072     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
5073     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5074     for (i=0; i<n_D; i++) {
5075       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
5076     }
5077     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5078     for (i=0, j=0; i<n_R; i++) {
5079       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
5080         aux_array1[j++] = i;
5081       }
5082     }
5083     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5084     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5085     for (i=0, j=0; i<n_B; i++) {
5086       if (!PetscBTLookup(bitmask,is_indices[i])) {
5087         aux_array2[j++] = i;
5088       }
5089     }
5090     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5091     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
5092     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
5093     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5094     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
5095 
5096     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5097       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
5098       for (i=0, j=0; i<n_R; i++) {
5099         if (PetscBTLookup(bitmask,idx_R_local[i])) {
5100           aux_array1[j++] = i;
5101         }
5102       }
5103       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5104       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5105       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5106     }
5107     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
5108     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5109   } else {
5110     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5111     IS                 tis;
5112     PetscInt           schur_size;
5113 
5114     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
5115     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
5116     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
5117     ierr = ISDestroy(&tis);CHKERRQ(ierr);
5118     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5119       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
5120       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5121       ierr = ISDestroy(&tis);CHKERRQ(ierr);
5122     }
5123   }
5124   PetscFunctionReturn(0);
5125 }
5126 
5127 
5128 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
5129 {
5130   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
5131   PC_IS          *pcis = (PC_IS*)pc->data;
5132   PC             pc_temp;
5133   Mat            A_RR;
5134   MatReuse       reuse;
5135   PetscScalar    m_one = -1.0;
5136   PetscReal      value;
5137   PetscInt       n_D,n_R;
5138   PetscBool      check_corr,issbaij;
5139   PetscErrorCode ierr;
5140   /* prefixes stuff */
5141   char           dir_prefix[256],neu_prefix[256],str_level[16];
5142   size_t         len;
5143 
5144   PetscFunctionBegin;
5145 
5146   /* compute prefixes */
5147   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
5148   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
5149   if (!pcbddc->current_level) {
5150     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,sizeof(dir_prefix));CHKERRQ(ierr);
5151     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,sizeof(neu_prefix));CHKERRQ(ierr);
5152     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5153     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5154   } else {
5155     ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
5156     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
5157     len -= 15; /* remove "pc_bddc_coarse_" */
5158     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
5159     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
5160     /* Nonstandard use of PetscStrncpy() to only copy a portion of the input string */
5161     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5162     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5163     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5164     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5165     ierr = PetscStrlcat(dir_prefix,str_level,sizeof(dir_prefix));CHKERRQ(ierr);
5166     ierr = PetscStrlcat(neu_prefix,str_level,sizeof(neu_prefix));CHKERRQ(ierr);
5167   }
5168 
5169   /* DIRICHLET PROBLEM */
5170   if (dirichlet) {
5171     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5172     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
5173       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented\n");
5174       if (pcbddc->dbg_flag) {
5175         Mat    A_IIn;
5176 
5177         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
5178         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
5179         pcis->A_II = A_IIn;
5180       }
5181     }
5182     if (pcbddc->local_mat->symmetric_set) {
5183       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
5184     }
5185     /* Matrix for Dirichlet problem is pcis->A_II */
5186     n_D = pcis->n - pcis->n_B;
5187     if (!pcbddc->ksp_D) { /* create object if not yet build */
5188       void (*f)(void) = 0;
5189 
5190       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
5191       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
5192       /* default */
5193       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
5194       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
5195       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5196       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5197       if (issbaij) {
5198         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5199       } else {
5200         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5201       }
5202       /* Allow user's customization */
5203       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
5204       ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5205       if (f && pcbddc->mat_graph->cloc) {
5206         PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5207         const PetscInt *idxs;
5208         PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5209 
5210         ierr = ISGetLocalSize(pcis->is_I_local,&nl);CHKERRQ(ierr);
5211         ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5212         ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5213         for (i=0;i<nl;i++) {
5214           for (d=0;d<cdim;d++) {
5215             scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5216           }
5217         }
5218         ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5219         ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5220         ierr = PetscFree(scoords);CHKERRQ(ierr);
5221       }
5222     }
5223     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
5224     if (sub_schurs && sub_schurs->reuse_solver) {
5225       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5226 
5227       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
5228     }
5229     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5230     if (!n_D) {
5231       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5232       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5233     }
5234     /* set ksp_D into pcis data */
5235     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
5236     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
5237     pcis->ksp_D = pcbddc->ksp_D;
5238   }
5239 
5240   /* NEUMANN PROBLEM */
5241   A_RR = 0;
5242   if (neumann) {
5243     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5244     PetscInt        ibs,mbs;
5245     PetscBool       issbaij, reuse_neumann_solver;
5246     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
5247 
5248     reuse_neumann_solver = PETSC_FALSE;
5249     if (sub_schurs && sub_schurs->reuse_solver) {
5250       IS iP;
5251 
5252       reuse_neumann_solver = PETSC_TRUE;
5253       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
5254       if (iP) reuse_neumann_solver = PETSC_FALSE;
5255     }
5256     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
5257     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
5258     if (pcbddc->ksp_R) { /* already created ksp */
5259       PetscInt nn_R;
5260       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
5261       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5262       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
5263       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
5264         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
5265         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5266         reuse = MAT_INITIAL_MATRIX;
5267       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5268         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5269           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5270           reuse = MAT_INITIAL_MATRIX;
5271         } else { /* safe to reuse the matrix */
5272           reuse = MAT_REUSE_MATRIX;
5273         }
5274       }
5275       /* last check */
5276       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5277         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5278         reuse = MAT_INITIAL_MATRIX;
5279       }
5280     } else { /* first time, so we need to create the matrix */
5281       reuse = MAT_INITIAL_MATRIX;
5282     }
5283     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
5284     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5285     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5286     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5287     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5288       if (matis->A == pcbddc->local_mat) {
5289         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5290         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5291       } else {
5292         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5293       }
5294     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5295       if (matis->A == pcbddc->local_mat) {
5296         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5297         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5298       } else {
5299         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5300       }
5301     }
5302     /* extract A_RR */
5303     if (reuse_neumann_solver) {
5304       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5305 
5306       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5307         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5308         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5309           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5310         } else {
5311           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5312         }
5313       } else {
5314         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5315         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5316         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5317       }
5318     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5319       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5320     }
5321     if (pcbddc->local_mat->symmetric_set) {
5322       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
5323     }
5324     if (!pcbddc->ksp_R) { /* create object if not present */
5325       void (*f)(void) = 0;
5326 
5327       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5328       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5329       /* default */
5330       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5331       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5332       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5333       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5334       if (issbaij) {
5335         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5336       } else {
5337         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5338       }
5339       /* Allow user's customization */
5340       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5341       ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5342       if (f && pcbddc->mat_graph->cloc) {
5343         PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5344         const PetscInt *idxs;
5345         PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5346 
5347         ierr = ISGetLocalSize(pcbddc->is_R_local,&nl);CHKERRQ(ierr);
5348         ierr = ISGetIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5349         ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5350         for (i=0;i<nl;i++) {
5351           for (d=0;d<cdim;d++) {
5352             scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5353           }
5354         }
5355         ierr = ISRestoreIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5356         ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5357         ierr = PetscFree(scoords);CHKERRQ(ierr);
5358       }
5359     }
5360     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5361     if (!n_R) {
5362       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5363       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5364     }
5365     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5366     /* Reuse solver if it is present */
5367     if (reuse_neumann_solver) {
5368       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5369 
5370       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5371     }
5372   }
5373 
5374   if (pcbddc->dbg_flag) {
5375     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5376     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5377     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5378   }
5379 
5380   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5381   check_corr = PETSC_FALSE;
5382   if (pcbddc->NullSpace_corr[0]) {
5383     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5384   }
5385   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5386     check_corr = PETSC_TRUE;
5387     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5388   }
5389   if (neumann && pcbddc->NullSpace_corr[2]) {
5390     check_corr = PETSC_TRUE;
5391     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5392   }
5393   /* check Dirichlet and Neumann solvers */
5394   if (pcbddc->dbg_flag) {
5395     if (dirichlet) { /* Dirichlet */
5396       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5397       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5398       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5399       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5400       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5401       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Dirichlet solve (%s) = % 1.14e \n",PetscGlobalRank,((PetscObject)(pcbddc->ksp_D))->prefix,value);CHKERRQ(ierr);
5402       if (check_corr) {
5403         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_TRUE);CHKERRQ(ierr);
5404       }
5405       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5406     }
5407     if (neumann) { /* Neumann */
5408       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5409       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5410       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5411       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5412       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5413       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Neumann solve (%s) = % 1.14e\n",PetscGlobalRank,((PetscObject)(pcbddc->ksp_R))->prefix,value);CHKERRQ(ierr);
5414       if (check_corr) {
5415         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_FALSE);CHKERRQ(ierr);
5416       }
5417       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5418     }
5419   }
5420   /* free Neumann problem's matrix */
5421   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5422   PetscFunctionReturn(0);
5423 }
5424 
5425 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5426 {
5427   PetscErrorCode  ierr;
5428   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5429   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5430   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5431 
5432   PetscFunctionBegin;
5433   if (!reuse_solver) {
5434     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5435   }
5436   if (!pcbddc->switch_static) {
5437     if (applytranspose && pcbddc->local_auxmat1) {
5438       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5439       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5440     }
5441     if (!reuse_solver) {
5442       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5443       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5444     } else {
5445       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5446 
5447       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5448       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5449     }
5450   } else {
5451     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5452     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5453     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5454     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5455     if (applytranspose && pcbddc->local_auxmat1) {
5456       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5457       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5458       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5459       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5460     }
5461   }
5462   if (!reuse_solver || pcbddc->switch_static) {
5463     if (applytranspose) {
5464       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5465     } else {
5466       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5467     }
5468   } else {
5469     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5470 
5471     if (applytranspose) {
5472       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5473     } else {
5474       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5475     }
5476   }
5477   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5478   if (!pcbddc->switch_static) {
5479     if (!reuse_solver) {
5480       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5481       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5482     } else {
5483       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5484 
5485       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5486       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5487     }
5488     if (!applytranspose && pcbddc->local_auxmat1) {
5489       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5490       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5491     }
5492   } else {
5493     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5494     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5495     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5496     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5497     if (!applytranspose && pcbddc->local_auxmat1) {
5498       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5499       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5500     }
5501     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5502     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5503     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5504     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5505   }
5506   PetscFunctionReturn(0);
5507 }
5508 
5509 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5510 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5511 {
5512   PetscErrorCode ierr;
5513   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5514   PC_IS*            pcis = (PC_IS*)  (pc->data);
5515   const PetscScalar zero = 0.0;
5516 
5517   PetscFunctionBegin;
5518   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5519   if (!pcbddc->benign_apply_coarse_only) {
5520     if (applytranspose) {
5521       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5522       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5523     } else {
5524       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5525       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5526     }
5527   } else {
5528     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5529   }
5530 
5531   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5532   if (pcbddc->benign_n) {
5533     PetscScalar *array;
5534     PetscInt    j;
5535 
5536     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5537     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5538     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5539   }
5540 
5541   /* start communications from local primal nodes to rhs of coarse solver */
5542   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5543   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5544   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5545 
5546   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5547   if (pcbddc->coarse_ksp) {
5548     Mat          coarse_mat;
5549     Vec          rhs,sol;
5550     MatNullSpace nullsp;
5551     PetscBool    isbddc = PETSC_FALSE;
5552 
5553     if (pcbddc->benign_have_null) {
5554       PC        coarse_pc;
5555 
5556       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5557       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5558       /* we need to propagate to coarser levels the need for a possible benign correction */
5559       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5560         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5561         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5562         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5563       }
5564     }
5565     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5566     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5567     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5568     ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5569     if (nullsp) {
5570       ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5571     }
5572     if (applytranspose) {
5573       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5574       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5575     } else {
5576       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5577         PC        coarse_pc;
5578 
5579         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5580         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5581         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5582         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5583       } else {
5584         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5585       }
5586     }
5587     /* we don't need the benign correction at coarser levels anymore */
5588     if (pcbddc->benign_have_null && isbddc) {
5589       PC        coarse_pc;
5590       PC_BDDC*  coarsepcbddc;
5591 
5592       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5593       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5594       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5595       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5596     }
5597     if (nullsp) {
5598       ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5599     }
5600   }
5601 
5602   /* Local solution on R nodes */
5603   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5604     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5605   }
5606   /* communications from coarse sol to local primal nodes */
5607   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5608   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5609 
5610   /* Sum contributions from the two levels */
5611   if (!pcbddc->benign_apply_coarse_only) {
5612     if (applytranspose) {
5613       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5614       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5615     } else {
5616       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5617       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5618     }
5619     /* store p0 */
5620     if (pcbddc->benign_n) {
5621       PetscScalar *array;
5622       PetscInt    j;
5623 
5624       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5625       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5626       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5627     }
5628   } else { /* expand the coarse solution */
5629     if (applytranspose) {
5630       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5631     } else {
5632       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5633     }
5634   }
5635   PetscFunctionReturn(0);
5636 }
5637 
5638 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5639 {
5640   PetscErrorCode ierr;
5641   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5642   PetscScalar    *array;
5643   Vec            from,to;
5644 
5645   PetscFunctionBegin;
5646   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5647     from = pcbddc->coarse_vec;
5648     to = pcbddc->vec1_P;
5649     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5650       Vec tvec;
5651 
5652       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5653       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5654       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5655       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5656       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5657       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5658     }
5659   } else { /* from local to global -> put data in coarse right hand side */
5660     from = pcbddc->vec1_P;
5661     to = pcbddc->coarse_vec;
5662   }
5663   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5664   PetscFunctionReturn(0);
5665 }
5666 
5667 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5668 {
5669   PetscErrorCode ierr;
5670   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5671   PetscScalar    *array;
5672   Vec            from,to;
5673 
5674   PetscFunctionBegin;
5675   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5676     from = pcbddc->coarse_vec;
5677     to = pcbddc->vec1_P;
5678   } else { /* from local to global -> put data in coarse right hand side */
5679     from = pcbddc->vec1_P;
5680     to = pcbddc->coarse_vec;
5681   }
5682   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5683   if (smode == SCATTER_FORWARD) {
5684     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5685       Vec tvec;
5686 
5687       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5688       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5689       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5690       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5691     }
5692   } else {
5693     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5694      ierr = VecResetArray(from);CHKERRQ(ierr);
5695     }
5696   }
5697   PetscFunctionReturn(0);
5698 }
5699 
5700 /* uncomment for testing purposes */
5701 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5702 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5703 {
5704   PetscErrorCode    ierr;
5705   PC_IS*            pcis = (PC_IS*)(pc->data);
5706   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5707   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5708   /* one and zero */
5709   PetscScalar       one=1.0,zero=0.0;
5710   /* space to store constraints and their local indices */
5711   PetscScalar       *constraints_data;
5712   PetscInt          *constraints_idxs,*constraints_idxs_B;
5713   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5714   PetscInt          *constraints_n;
5715   /* iterators */
5716   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5717   /* BLAS integers */
5718   PetscBLASInt      lwork,lierr;
5719   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5720   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5721   /* reuse */
5722   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5723   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5724   /* change of basis */
5725   PetscBool         qr_needed;
5726   PetscBT           change_basis,qr_needed_idx;
5727   /* auxiliary stuff */
5728   PetscInt          *nnz,*is_indices;
5729   PetscInt          ncc;
5730   /* some quantities */
5731   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5732   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5733   PetscReal         tol; /* tolerance for retaining eigenmodes */
5734 
5735   PetscFunctionBegin;
5736   tol  = PetscSqrtReal(PETSC_SMALL);
5737   /* Destroy Mat objects computed previously */
5738   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5739   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5740   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5741   /* save info on constraints from previous setup (if any) */
5742   olocal_primal_size = pcbddc->local_primal_size;
5743   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5744   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5745   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5746   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5747   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5748   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5749 
5750   if (!pcbddc->adaptive_selection) {
5751     IS           ISForVertices,*ISForFaces,*ISForEdges;
5752     MatNullSpace nearnullsp;
5753     const Vec    *nearnullvecs;
5754     Vec          *localnearnullsp;
5755     PetscScalar  *array;
5756     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5757     PetscBool    nnsp_has_cnst;
5758     /* LAPACK working arrays for SVD or POD */
5759     PetscBool    skip_lapack,boolforchange;
5760     PetscScalar  *work;
5761     PetscReal    *singular_vals;
5762 #if defined(PETSC_USE_COMPLEX)
5763     PetscReal    *rwork;
5764 #endif
5765 #if defined(PETSC_MISSING_LAPACK_GESVD)
5766     PetscScalar  *temp_basis,*correlation_mat;
5767 #else
5768     PetscBLASInt dummy_int=1;
5769     PetscScalar  dummy_scalar=1.;
5770 #endif
5771 
5772     /* Get index sets for faces, edges and vertices from graph */
5773     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
5774     /* print some info */
5775     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
5776       PetscInt nv;
5777 
5778       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
5779       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
5780       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5781       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5782       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
5783       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
5784       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
5785       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5786       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5787     }
5788 
5789     /* free unneeded index sets */
5790     if (!pcbddc->use_vertices) {
5791       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5792     }
5793     if (!pcbddc->use_edges) {
5794       for (i=0;i<n_ISForEdges;i++) {
5795         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5796       }
5797       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5798       n_ISForEdges = 0;
5799     }
5800     if (!pcbddc->use_faces) {
5801       for (i=0;i<n_ISForFaces;i++) {
5802         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5803       }
5804       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5805       n_ISForFaces = 0;
5806     }
5807 
5808     /* check if near null space is attached to global mat */
5809     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
5810     if (nearnullsp) {
5811       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
5812       /* remove any stored info */
5813       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
5814       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5815       /* store information for BDDC solver reuse */
5816       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
5817       pcbddc->onearnullspace = nearnullsp;
5818       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5819       for (i=0;i<nnsp_size;i++) {
5820         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
5821       }
5822     } else { /* if near null space is not provided BDDC uses constants by default */
5823       nnsp_size = 0;
5824       nnsp_has_cnst = PETSC_TRUE;
5825     }
5826     /* get max number of constraints on a single cc */
5827     max_constraints = nnsp_size;
5828     if (nnsp_has_cnst) max_constraints++;
5829 
5830     /*
5831          Evaluate maximum storage size needed by the procedure
5832          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
5833          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
5834          There can be multiple constraints per connected component
5835                                                                                                                                                            */
5836     n_vertices = 0;
5837     if (ISForVertices) {
5838       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
5839     }
5840     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
5841     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
5842 
5843     total_counts = n_ISForFaces+n_ISForEdges;
5844     total_counts *= max_constraints;
5845     total_counts += n_vertices;
5846     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
5847 
5848     total_counts = 0;
5849     max_size_of_constraint = 0;
5850     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
5851       IS used_is;
5852       if (i<n_ISForEdges) {
5853         used_is = ISForEdges[i];
5854       } else {
5855         used_is = ISForFaces[i-n_ISForEdges];
5856       }
5857       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
5858       total_counts += j;
5859       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
5860     }
5861     ierr = PetscMalloc3(total_counts*max_constraints+n_vertices,&constraints_data,total_counts+n_vertices,&constraints_idxs,total_counts+n_vertices,&constraints_idxs_B);CHKERRQ(ierr);
5862 
5863     /* get local part of global near null space vectors */
5864     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
5865     for (k=0;k<nnsp_size;k++) {
5866       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
5867       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5868       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5869     }
5870 
5871     /* whether or not to skip lapack calls */
5872     skip_lapack = PETSC_TRUE;
5873     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
5874 
5875     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
5876     if (!skip_lapack) {
5877       PetscScalar temp_work;
5878 
5879 #if defined(PETSC_MISSING_LAPACK_GESVD)
5880       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
5881       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
5882       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
5883       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
5884 #if defined(PETSC_USE_COMPLEX)
5885       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
5886 #endif
5887       /* now we evaluate the optimal workspace using query with lwork=-1 */
5888       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5889       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
5890       lwork = -1;
5891       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5892 #if !defined(PETSC_USE_COMPLEX)
5893       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
5894 #else
5895       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
5896 #endif
5897       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5898       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
5899 #else /* on missing GESVD */
5900       /* SVD */
5901       PetscInt max_n,min_n;
5902       max_n = max_size_of_constraint;
5903       min_n = max_constraints;
5904       if (max_size_of_constraint < max_constraints) {
5905         min_n = max_size_of_constraint;
5906         max_n = max_constraints;
5907       }
5908       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
5909 #if defined(PETSC_USE_COMPLEX)
5910       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
5911 #endif
5912       /* now we evaluate the optimal workspace using query with lwork=-1 */
5913       lwork = -1;
5914       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
5915       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
5916       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
5917       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5918 #if !defined(PETSC_USE_COMPLEX)
5919       PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,&constraints_data[0],&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,&temp_work,&lwork,&lierr));
5920 #else
5921       PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,&constraints_data[0],&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,&temp_work,&lwork,rwork,&lierr));
5922 #endif
5923       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5924       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
5925 #endif /* on missing GESVD */
5926       /* Allocate optimal workspace */
5927       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
5928       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
5929     }
5930     /* Now we can loop on constraining sets */
5931     total_counts = 0;
5932     constraints_idxs_ptr[0] = 0;
5933     constraints_data_ptr[0] = 0;
5934     /* vertices */
5935     if (n_vertices) {
5936       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5937       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5938       for (i=0;i<n_vertices;i++) {
5939         constraints_n[total_counts] = 1;
5940         constraints_data[total_counts] = 1.0;
5941         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
5942         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
5943         total_counts++;
5944       }
5945       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5946       n_vertices = total_counts;
5947     }
5948 
5949     /* edges and faces */
5950     total_counts_cc = total_counts;
5951     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
5952       IS        used_is;
5953       PetscBool idxs_copied = PETSC_FALSE;
5954 
5955       if (ncc<n_ISForEdges) {
5956         used_is = ISForEdges[ncc];
5957         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
5958       } else {
5959         used_is = ISForFaces[ncc-n_ISForEdges];
5960         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
5961       }
5962       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
5963 
5964       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
5965       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5966       /* change of basis should not be performed on local periodic nodes */
5967       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
5968       if (nnsp_has_cnst) {
5969         PetscScalar quad_value;
5970 
5971         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5972         idxs_copied = PETSC_TRUE;
5973 
5974         if (!pcbddc->use_nnsp_true) {
5975           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
5976         } else {
5977           quad_value = 1.0;
5978         }
5979         for (j=0;j<size_of_constraint;j++) {
5980           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
5981         }
5982         temp_constraints++;
5983         total_counts++;
5984       }
5985       for (k=0;k<nnsp_size;k++) {
5986         PetscReal real_value;
5987         PetscScalar *ptr_to_data;
5988 
5989         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5990         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
5991         for (j=0;j<size_of_constraint;j++) {
5992           ptr_to_data[j] = array[is_indices[j]];
5993         }
5994         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5995         /* check if array is null on the connected component */
5996         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5997         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
5998         if (real_value > tol*size_of_constraint) { /* keep indices and values */
5999           temp_constraints++;
6000           total_counts++;
6001           if (!idxs_copied) {
6002             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
6003             idxs_copied = PETSC_TRUE;
6004           }
6005         }
6006       }
6007       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6008       valid_constraints = temp_constraints;
6009       if (!pcbddc->use_nnsp_true && temp_constraints) {
6010         if (temp_constraints == 1) { /* just normalize the constraint */
6011           PetscScalar norm,*ptr_to_data;
6012 
6013           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6014           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6015           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
6016           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
6017           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
6018         } else { /* perform SVD */
6019           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6020 
6021 #if defined(PETSC_MISSING_LAPACK_GESVD)
6022           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
6023              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
6024              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
6025                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
6026                 from that computed using LAPACKgesvd
6027              -> This is due to a different computation of eigenvectors in LAPACKheev
6028              -> The quality of the POD-computed basis will be the same */
6029           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
6030           /* Store upper triangular part of correlation matrix */
6031           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6032           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6033           for (j=0;j<temp_constraints;j++) {
6034             for (k=0;k<j+1;k++) {
6035               PetscStackCallBLAS("BLASdot",correlation_mat[j*temp_constraints+k] = BLASdot_(&Blas_N,ptr_to_data+k*size_of_constraint,&Blas_one,ptr_to_data+j*size_of_constraint,&Blas_one));
6036             }
6037           }
6038           /* compute eigenvalues and eigenvectors of correlation matrix */
6039           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6040           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
6041 #if !defined(PETSC_USE_COMPLEX)
6042           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
6043 #else
6044           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
6045 #endif
6046           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6047           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
6048           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
6049           j = 0;
6050           while (j < temp_constraints && singular_vals[j] < tol) j++;
6051           total_counts = total_counts-j;
6052           valid_constraints = temp_constraints-j;
6053           /* scale and copy POD basis into used quadrature memory */
6054           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6055           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6056           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
6057           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6058           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
6059           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6060           if (j<temp_constraints) {
6061             PetscInt ii;
6062             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
6063             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6064             PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&Blas_M,&Blas_N,&Blas_K,&one,ptr_to_data,&Blas_LDA,correlation_mat,&Blas_LDB,&zero,temp_basis,&Blas_LDC));
6065             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6066             for (k=0;k<temp_constraints-j;k++) {
6067               for (ii=0;ii<size_of_constraint;ii++) {
6068                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
6069               }
6070             }
6071           }
6072 #else  /* on missing GESVD */
6073           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6074           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6075           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6076           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6077 #if !defined(PETSC_USE_COMPLEX)
6078           PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,ptr_to_data,&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,work,&lwork,&lierr));
6079 #else
6080           PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,ptr_to_data,&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,work,&lwork,rwork,&lierr));
6081 #endif
6082           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
6083           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6084           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
6085           k = temp_constraints;
6086           if (k > size_of_constraint) k = size_of_constraint;
6087           j = 0;
6088           while (j < k && singular_vals[k-j-1] < tol) j++;
6089           valid_constraints = k-j;
6090           total_counts = total_counts-temp_constraints+valid_constraints;
6091 #endif /* on missing GESVD */
6092         }
6093       }
6094       /* update pointers information */
6095       if (valid_constraints) {
6096         constraints_n[total_counts_cc] = valid_constraints;
6097         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
6098         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
6099         /* set change_of_basis flag */
6100         if (boolforchange) {
6101           PetscBTSet(change_basis,total_counts_cc);
6102         }
6103         total_counts_cc++;
6104       }
6105     }
6106     /* free workspace */
6107     if (!skip_lapack) {
6108       ierr = PetscFree(work);CHKERRQ(ierr);
6109 #if defined(PETSC_USE_COMPLEX)
6110       ierr = PetscFree(rwork);CHKERRQ(ierr);
6111 #endif
6112       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
6113 #if defined(PETSC_MISSING_LAPACK_GESVD)
6114       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
6115       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
6116 #endif
6117     }
6118     for (k=0;k<nnsp_size;k++) {
6119       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
6120     }
6121     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
6122     /* free index sets of faces, edges and vertices */
6123     for (i=0;i<n_ISForFaces;i++) {
6124       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6125     }
6126     if (n_ISForFaces) {
6127       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6128     }
6129     for (i=0;i<n_ISForEdges;i++) {
6130       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6131     }
6132     if (n_ISForEdges) {
6133       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6134     }
6135     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6136   } else {
6137     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
6138 
6139     total_counts = 0;
6140     n_vertices = 0;
6141     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
6142       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
6143     }
6144     max_constraints = 0;
6145     total_counts_cc = 0;
6146     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6147       total_counts += pcbddc->adaptive_constraints_n[i];
6148       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
6149       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
6150     }
6151     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
6152     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
6153     constraints_idxs = pcbddc->adaptive_constraints_idxs;
6154     constraints_data = pcbddc->adaptive_constraints_data;
6155     /* constraints_n differs from pcbddc->adaptive_constraints_n */
6156     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
6157     total_counts_cc = 0;
6158     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6159       if (pcbddc->adaptive_constraints_n[i]) {
6160         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
6161       }
6162     }
6163 #if 0
6164     printf("Found %d totals (%d)\n",total_counts_cc,total_counts);
6165     for (i=0;i<total_counts_cc;i++) {
6166       printf("const %d, start %d",i,constraints_idxs_ptr[i]);
6167       printf(" end %d:\n",constraints_idxs_ptr[i+1]);
6168       for (j=constraints_idxs_ptr[i];j<constraints_idxs_ptr[i+1];j++) {
6169         printf(" %d",constraints_idxs[j]);
6170       }
6171       printf("\n");
6172       printf("number of cc: %d\n",constraints_n[i]);
6173     }
6174     for (i=0;i<n_vertices;i++) {
6175       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i]);
6176     }
6177     for (i=0;i<sub_schurs->n_subs;i++) {
6178       PetscPrintf(PETSC_COMM_SELF,"[%d] sub %d, edge %d, n %d\n",PetscGlobalRank,i,(PetscBool)PetscBTLookup(sub_schurs->is_edge,i),pcbddc->adaptive_constraints_n[i+n_vertices]);
6179     }
6180 #endif
6181 
6182     max_size_of_constraint = 0;
6183     for (i=0;i<total_counts_cc;i++) max_size_of_constraint = PetscMax(max_size_of_constraint,constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i]);
6184     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
6185     /* Change of basis */
6186     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
6187     if (pcbddc->use_change_of_basis) {
6188       for (i=0;i<sub_schurs->n_subs;i++) {
6189         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
6190           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
6191         }
6192       }
6193     }
6194   }
6195   pcbddc->local_primal_size = total_counts;
6196   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6197 
6198   /* map constraints_idxs in boundary numbering */
6199   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
6200   if (i != constraints_idxs_ptr[total_counts_cc]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for constraints indices %D != %D\n",constraints_idxs_ptr[total_counts_cc],i);
6201 
6202   /* Create constraint matrix */
6203   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6204   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
6205   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
6206 
6207   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
6208   /* determine if a QR strategy is needed for change of basis */
6209   qr_needed = PETSC_FALSE;
6210   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
6211   total_primal_vertices=0;
6212   pcbddc->local_primal_size_cc = 0;
6213   for (i=0;i<total_counts_cc;i++) {
6214     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6215     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
6216       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
6217       pcbddc->local_primal_size_cc += 1;
6218     } else if (PetscBTLookup(change_basis,i)) {
6219       for (k=0;k<constraints_n[i];k++) {
6220         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6221       }
6222       pcbddc->local_primal_size_cc += constraints_n[i];
6223       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
6224         PetscBTSet(qr_needed_idx,i);
6225         qr_needed = PETSC_TRUE;
6226       }
6227     } else {
6228       pcbddc->local_primal_size_cc += 1;
6229     }
6230   }
6231   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
6232   pcbddc->n_vertices = total_primal_vertices;
6233   /* permute indices in order to have a sorted set of vertices */
6234   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6235   ierr = PetscMalloc2(pcbddc->local_primal_size_cc+pcbddc->benign_n,&pcbddc->local_primal_ref_node,pcbddc->local_primal_size_cc+pcbddc->benign_n,&pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
6236   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
6237   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
6238 
6239   /* nonzero structure of constraint matrix */
6240   /* and get reference dof for local constraints */
6241   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
6242   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
6243 
6244   j = total_primal_vertices;
6245   total_counts = total_primal_vertices;
6246   cum = total_primal_vertices;
6247   for (i=n_vertices;i<total_counts_cc;i++) {
6248     if (!PetscBTLookup(change_basis,i)) {
6249       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
6250       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
6251       cum++;
6252       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6253       for (k=0;k<constraints_n[i];k++) {
6254         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6255         nnz[j+k] = size_of_constraint;
6256       }
6257       j += constraints_n[i];
6258     }
6259   }
6260   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
6261   ierr = PetscFree(nnz);CHKERRQ(ierr);
6262 
6263   /* set values in constraint matrix */
6264   for (i=0;i<total_primal_vertices;i++) {
6265     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
6266   }
6267   total_counts = total_primal_vertices;
6268   for (i=n_vertices;i<total_counts_cc;i++) {
6269     if (!PetscBTLookup(change_basis,i)) {
6270       PetscInt *cols;
6271 
6272       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6273       cols = constraints_idxs+constraints_idxs_ptr[i];
6274       for (k=0;k<constraints_n[i];k++) {
6275         PetscInt    row = total_counts+k;
6276         PetscScalar *vals;
6277 
6278         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
6279         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6280       }
6281       total_counts += constraints_n[i];
6282     }
6283   }
6284   /* assembling */
6285   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6286   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6287   ierr = MatChop(pcbddc->ConstraintMatrix,PETSC_SMALL);CHKERRQ(ierr);
6288   ierr = MatSeqAIJCompress(pcbddc->ConstraintMatrix,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6289   ierr = MatViewFromOptions(pcbddc->ConstraintMatrix,NULL,"-pc_bddc_constraint_mat_view");CHKERRQ(ierr);
6290 
6291   /*
6292   ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
6293   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
6294   ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
6295   */
6296   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6297   if (pcbddc->use_change_of_basis) {
6298     /* dual and primal dofs on a single cc */
6299     PetscInt     dual_dofs,primal_dofs;
6300     /* working stuff for GEQRF */
6301     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
6302     PetscBLASInt lqr_work;
6303     /* working stuff for UNGQR */
6304     PetscScalar  *gqr_work,lgqr_work_t;
6305     PetscBLASInt lgqr_work;
6306     /* working stuff for TRTRS */
6307     PetscScalar  *trs_rhs;
6308     PetscBLASInt Blas_NRHS;
6309     /* pointers for values insertion into change of basis matrix */
6310     PetscInt     *start_rows,*start_cols;
6311     PetscScalar  *start_vals;
6312     /* working stuff for values insertion */
6313     PetscBT      is_primal;
6314     PetscInt     *aux_primal_numbering_B;
6315     /* matrix sizes */
6316     PetscInt     global_size,local_size;
6317     /* temporary change of basis */
6318     Mat          localChangeOfBasisMatrix;
6319     /* extra space for debugging */
6320     PetscScalar  *dbg_work;
6321 
6322     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6323     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6324     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6325     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6326     /* nonzeros for local mat */
6327     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6328     if (!pcbddc->benign_change || pcbddc->fake_change) {
6329       for (i=0;i<pcis->n;i++) nnz[i]=1;
6330     } else {
6331       const PetscInt *ii;
6332       PetscInt       n;
6333       PetscBool      flg_row;
6334       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6335       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6336       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6337     }
6338     for (i=n_vertices;i<total_counts_cc;i++) {
6339       if (PetscBTLookup(change_basis,i)) {
6340         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6341         if (PetscBTLookup(qr_needed_idx,i)) {
6342           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6343         } else {
6344           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6345           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6346         }
6347       }
6348     }
6349     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6350     ierr = PetscFree(nnz);CHKERRQ(ierr);
6351     /* Set interior change in the matrix */
6352     if (!pcbddc->benign_change || pcbddc->fake_change) {
6353       for (i=0;i<pcis->n;i++) {
6354         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6355       }
6356     } else {
6357       const PetscInt *ii,*jj;
6358       PetscScalar    *aa;
6359       PetscInt       n;
6360       PetscBool      flg_row;
6361       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6362       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6363       for (i=0;i<n;i++) {
6364         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6365       }
6366       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6367       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6368     }
6369 
6370     if (pcbddc->dbg_flag) {
6371       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6372       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6373     }
6374 
6375 
6376     /* Now we loop on the constraints which need a change of basis */
6377     /*
6378        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6379        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6380 
6381        Basic blocks of change of basis matrix T computed by
6382 
6383           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6384 
6385             | 1        0   ...        0         s_1/S |
6386             | 0        1   ...        0         s_2/S |
6387             |              ...                        |
6388             | 0        ...            1     s_{n-1}/S |
6389             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6390 
6391             with S = \sum_{i=1}^n s_i^2
6392             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6393                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6394 
6395           - QR decomposition of constraints otherwise
6396     */
6397     if (qr_needed) {
6398       /* space to store Q */
6399       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6400       /* array to store scaling factors for reflectors */
6401       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6402       /* first we issue queries for optimal work */
6403       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6404       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6405       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6406       lqr_work = -1;
6407       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6408       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6409       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6410       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6411       lgqr_work = -1;
6412       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6413       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6414       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6415       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6416       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6417       PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6418       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to ORGQR/UNGQR Lapack routine %d",(int)lierr);
6419       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6420       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6421       /* array to store rhs and solution of triangular solver */
6422       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6423       /* allocating workspace for check */
6424       if (pcbddc->dbg_flag) {
6425         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6426       }
6427     }
6428     /* array to store whether a node is primal or not */
6429     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6430     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6431     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6432     if (i != total_primal_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",total_primal_vertices,i);
6433     for (i=0;i<total_primal_vertices;i++) {
6434       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6435     }
6436     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6437 
6438     /* loop on constraints and see whether or not they need a change of basis and compute it */
6439     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6440       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6441       if (PetscBTLookup(change_basis,total_counts)) {
6442         /* get constraint info */
6443         primal_dofs = constraints_n[total_counts];
6444         dual_dofs = size_of_constraint-primal_dofs;
6445 
6446         if (pcbddc->dbg_flag) {
6447           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraints %d: %d need a change of basis (size %d)\n",total_counts,primal_dofs,size_of_constraint);CHKERRQ(ierr);
6448         }
6449 
6450         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6451 
6452           /* copy quadrature constraints for change of basis check */
6453           if (pcbddc->dbg_flag) {
6454             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6455           }
6456           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6457           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6458 
6459           /* compute QR decomposition of constraints */
6460           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6461           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6462           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6463           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6464           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6465           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6466           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6467 
6468           /* explictly compute R^-T */
6469           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
6470           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6471           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6472           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6473           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6474           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6475           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6476           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6477           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6478           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6479 
6480           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6481           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6482           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6483           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6484           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6485           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6486           PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6487           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in ORGQR/UNGQR Lapack routine %d",(int)lierr);
6488           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6489 
6490           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6491              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6492              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6493           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6494           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6495           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6496           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6497           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6498           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6499           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6500           PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&Blas_M,&Blas_N,&Blas_K,&one,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&zero,constraints_data+constraints_data_ptr[total_counts],&Blas_LDC));
6501           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6502           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6503 
6504           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6505           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6506           /* insert cols for primal dofs */
6507           for (j=0;j<primal_dofs;j++) {
6508             start_vals = &qr_basis[j*size_of_constraint];
6509             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6510             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6511           }
6512           /* insert cols for dual dofs */
6513           for (j=0,k=0;j<dual_dofs;k++) {
6514             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6515               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6516               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6517               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6518               j++;
6519             }
6520           }
6521 
6522           /* check change of basis */
6523           if (pcbddc->dbg_flag) {
6524             PetscInt   ii,jj;
6525             PetscBool valid_qr=PETSC_TRUE;
6526             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6527             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6528             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6529             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6530             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6531             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6532             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6533             PetscStackCallBLAS("BLASgemm",BLASgemm_("T","N",&Blas_M,&Blas_N,&Blas_K,&one,dbg_work,&Blas_LDA,qr_basis,&Blas_LDB,&zero,&dbg_work[size_of_constraint*primal_dofs],&Blas_LDC));
6534             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6535             for (jj=0;jj<size_of_constraint;jj++) {
6536               for (ii=0;ii<primal_dofs;ii++) {
6537                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6538                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) valid_qr = PETSC_FALSE;
6539               }
6540             }
6541             if (!valid_qr) {
6542               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6543               for (jj=0;jj<size_of_constraint;jj++) {
6544                 for (ii=0;ii<primal_dofs;ii++) {
6545                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6546                     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\tQr basis function %d is not orthogonal to constraint %d (%1.14e)!\n",jj,ii,PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]));
6547                   }
6548                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) {
6549                     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\tQr basis function %d is not unitary w.r.t constraint %d (%1.14e)!\n",jj,ii,PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]));
6550                   }
6551                 }
6552               }
6553             } else {
6554               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6555             }
6556           }
6557         } else { /* simple transformation block */
6558           PetscInt    row,col;
6559           PetscScalar val,norm;
6560 
6561           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6562           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6563           for (j=0;j<size_of_constraint;j++) {
6564             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6565             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6566             if (!PetscBTLookup(is_primal,row_B)) {
6567               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6568               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6569               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6570             } else {
6571               for (k=0;k<size_of_constraint;k++) {
6572                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6573                 if (row != col) {
6574                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6575                 } else {
6576                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6577                 }
6578                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6579               }
6580             }
6581           }
6582           if (pcbddc->dbg_flag) {
6583             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6584           }
6585         }
6586       } else {
6587         if (pcbddc->dbg_flag) {
6588           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d does not need a change of basis (size %d)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6589         }
6590       }
6591     }
6592 
6593     /* free workspace */
6594     if (qr_needed) {
6595       if (pcbddc->dbg_flag) {
6596         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6597       }
6598       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6599       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6600       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6601       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6602       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6603     }
6604     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6605     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6606     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6607 
6608     /* assembling of global change of variable */
6609     if (!pcbddc->fake_change) {
6610       Mat      tmat;
6611       PetscInt bs;
6612 
6613       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6614       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6615       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6616       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6617       ierr = MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6618       ierr = MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6619       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6620       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6621       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6622       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6623       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6624       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6625       ierr = MatConvert(tmat,MATAIJ,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6626       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6627       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6628       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6629       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6630       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6631       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6632       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6633 
6634       /* check */
6635       if (pcbddc->dbg_flag) {
6636         PetscReal error;
6637         Vec       x,x_change;
6638 
6639         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6640         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6641         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6642         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6643         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6644         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6645         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6646         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6647         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6648         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6649         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6650         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6651         if (error > PETSC_SMALL) {
6652           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
6653         }
6654         ierr = VecDestroy(&x);CHKERRQ(ierr);
6655         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6656       }
6657       /* adapt sub_schurs computed (if any) */
6658       if (pcbddc->use_deluxe_scaling) {
6659         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6660 
6661         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");
6662         if (sub_schurs && sub_schurs->S_Ej_all) {
6663           Mat                    S_new,tmat;
6664           IS                     is_all_N,is_V_Sall = NULL;
6665 
6666           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6667           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6668           if (pcbddc->deluxe_zerorows) {
6669             ISLocalToGlobalMapping NtoSall;
6670             IS                     is_V;
6671             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6672             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6673             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6674             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6675             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6676           }
6677           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6678           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6679           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6680           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6681           if (pcbddc->deluxe_zerorows) {
6682             const PetscScalar *array;
6683             const PetscInt    *idxs_V,*idxs_all;
6684             PetscInt          i,n_V;
6685 
6686             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6687             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6688             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6689             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6690             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6691             for (i=0;i<n_V;i++) {
6692               PetscScalar val;
6693               PetscInt    idx;
6694 
6695               idx = idxs_V[i];
6696               val = array[idxs_all[idxs_V[i]]];
6697               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6698             }
6699             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6700             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6701             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6702             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6703             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6704           }
6705           sub_schurs->S_Ej_all = S_new;
6706           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6707           if (sub_schurs->sum_S_Ej_all) {
6708             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6709             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6710             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6711             if (pcbddc->deluxe_zerorows) {
6712               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6713             }
6714             sub_schurs->sum_S_Ej_all = S_new;
6715             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6716           }
6717           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6718           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6719         }
6720         /* destroy any change of basis context in sub_schurs */
6721         if (sub_schurs && sub_schurs->change) {
6722           PetscInt i;
6723 
6724           for (i=0;i<sub_schurs->n_subs;i++) {
6725             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6726           }
6727           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6728         }
6729       }
6730       if (pcbddc->switch_static) { /* need to save the local change */
6731         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6732       } else {
6733         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6734       }
6735       /* determine if any process has changed the pressures locally */
6736       pcbddc->change_interior = pcbddc->benign_have_null;
6737     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6738       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6739       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6740       pcbddc->use_qr_single = qr_needed;
6741     }
6742   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6743     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6744       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6745       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6746     } else {
6747       Mat benign_global = NULL;
6748       if (pcbddc->benign_have_null) {
6749         Mat tmat;
6750 
6751         pcbddc->change_interior = PETSC_TRUE;
6752         ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6753         ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6754         ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6755         ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6756         ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6757         ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6758         ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6759         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6760         if (pcbddc->benign_change) {
6761           Mat M;
6762 
6763           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6764           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6765           ierr = MatISSetLocalMat(tmat,M);CHKERRQ(ierr);
6766           ierr = MatDestroy(&M);CHKERRQ(ierr);
6767         } else {
6768           Mat         eye;
6769           PetscScalar *array;
6770 
6771           ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6772           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&eye);CHKERRQ(ierr);
6773           for (i=0;i<pcis->n;i++) {
6774             ierr = MatSetValue(eye,i,i,array[i],INSERT_VALUES);CHKERRQ(ierr);
6775           }
6776           ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6777           ierr = MatAssemblyBegin(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6778           ierr = MatAssemblyEnd(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6779           ierr = MatISSetLocalMat(tmat,eye);CHKERRQ(ierr);
6780           ierr = MatDestroy(&eye);CHKERRQ(ierr);
6781         }
6782         ierr = MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6783         ierr = MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6784         ierr = MatConvert(tmat,MATAIJ,MAT_INITIAL_MATRIX,&benign_global);CHKERRQ(ierr);
6785         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6786       }
6787       if (pcbddc->user_ChangeOfBasisMatrix) {
6788         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6789         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6790       } else if (pcbddc->benign_have_null) {
6791         pcbddc->ChangeOfBasisMatrix = benign_global;
6792       }
6793     }
6794     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6795       IS             is_global;
6796       const PetscInt *gidxs;
6797 
6798       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6799       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6800       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6801       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6802       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6803     }
6804   }
6805   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6806     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6807   }
6808 
6809   if (!pcbddc->fake_change) {
6810     /* add pressure dofs to set of primal nodes for numbering purposes */
6811     for (i=0;i<pcbddc->benign_n;i++) {
6812       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
6813       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
6814       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
6815       pcbddc->local_primal_size_cc++;
6816       pcbddc->local_primal_size++;
6817     }
6818 
6819     /* check if a new primal space has been introduced (also take into account benign trick) */
6820     pcbddc->new_primal_space_local = PETSC_TRUE;
6821     if (olocal_primal_size == pcbddc->local_primal_size) {
6822       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6823       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6824       if (!pcbddc->new_primal_space_local) {
6825         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6826         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6827       }
6828     }
6829     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
6830     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6831   }
6832   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
6833 
6834   /* flush dbg viewer */
6835   if (pcbddc->dbg_flag) {
6836     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6837   }
6838 
6839   /* free workspace */
6840   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
6841   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
6842   if (!pcbddc->adaptive_selection) {
6843     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
6844     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
6845   } else {
6846     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
6847                       pcbddc->adaptive_constraints_idxs_ptr,
6848                       pcbddc->adaptive_constraints_data_ptr,
6849                       pcbddc->adaptive_constraints_idxs,
6850                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
6851     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
6852     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
6853   }
6854   PetscFunctionReturn(0);
6855 }
6856 /* #undef PETSC_MISSING_LAPACK_GESVD */
6857 
6858 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
6859 {
6860   ISLocalToGlobalMapping map;
6861   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
6862   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
6863   PetscInt               i,N;
6864   PetscBool              rcsr = PETSC_FALSE;
6865   PetscErrorCode         ierr;
6866 
6867   PetscFunctionBegin;
6868   if (pcbddc->recompute_topography) {
6869     pcbddc->graphanalyzed = PETSC_FALSE;
6870     /* Reset previously computed graph */
6871     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
6872     /* Init local Graph struct */
6873     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
6874     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
6875     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
6876 
6877     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
6878       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6879     }
6880     /* Check validity of the csr graph passed in by the user */
6881     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);
6882 
6883     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
6884     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
6885       PetscInt  *xadj,*adjncy;
6886       PetscInt  nvtxs;
6887       PetscBool flg_row=PETSC_FALSE;
6888 
6889       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6890       if (flg_row) {
6891         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
6892         pcbddc->computed_rowadj = PETSC_TRUE;
6893       }
6894       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6895       rcsr = PETSC_TRUE;
6896     }
6897     if (pcbddc->dbg_flag) {
6898       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6899     }
6900 
6901     if (pcbddc->mat_graph->cdim && !pcbddc->mat_graph->cloc) {
6902       PetscReal    *lcoords;
6903       PetscInt     n;
6904       MPI_Datatype dimrealtype;
6905 
6906       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);
6907       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
6908       ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
6909       ierr = PetscMalloc1(pcbddc->mat_graph->cdim*n,&lcoords);CHKERRQ(ierr);
6910       ierr = MPI_Type_contiguous(pcbddc->mat_graph->cdim,MPIU_REAL,&dimrealtype);CHKERRQ(ierr);
6911       ierr = MPI_Type_commit(&dimrealtype);CHKERRQ(ierr);
6912       ierr = PetscSFBcastBegin(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
6913       ierr = PetscSFBcastEnd(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
6914       ierr = MPI_Type_free(&dimrealtype);CHKERRQ(ierr);
6915       ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
6916 
6917       pcbddc->mat_graph->coords = lcoords;
6918       pcbddc->mat_graph->cloc   = PETSC_TRUE;
6919       pcbddc->mat_graph->cnloc  = n;
6920     }
6921     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);
6922     pcbddc->mat_graph->active_coords = (PetscBool)(pcbddc->corner_selection && !pcbddc->corner_selected);
6923 
6924     /* Setup of Graph */
6925     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
6926     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6927 
6928     /* attach info on disconnected subdomains if present */
6929     if (pcbddc->n_local_subs) {
6930       PetscInt *local_subs;
6931 
6932       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
6933       for (i=0;i<pcbddc->n_local_subs;i++) {
6934         const PetscInt *idxs;
6935         PetscInt       nl,j;
6936 
6937         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
6938         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6939         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
6940         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6941       }
6942       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
6943       pcbddc->mat_graph->local_subs = local_subs;
6944     }
6945   }
6946 
6947   if (!pcbddc->graphanalyzed) {
6948     /* Graph's connected components analysis */
6949     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
6950     pcbddc->graphanalyzed = PETSC_TRUE;
6951   }
6952   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
6953   PetscFunctionReturn(0);
6954 }
6955 
6956 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
6957 {
6958   PetscInt       i,j;
6959   PetscScalar    *alphas;
6960   PetscErrorCode ierr;
6961 
6962   PetscFunctionBegin;
6963   if (!n) PetscFunctionReturn(0);
6964   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
6965   ierr = VecNormalize(vecs[0],NULL);CHKERRQ(ierr);
6966   for (i=1;i<n;i++) {
6967     ierr = VecMDot(vecs[i],i,vecs,alphas);CHKERRQ(ierr);
6968     for (j=0;j<i;j++) alphas[j] = PetscConj(-alphas[j]);
6969     ierr = VecMAXPY(vecs[i],i,alphas,vecs);CHKERRQ(ierr);
6970     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
6971   }
6972   ierr = PetscFree(alphas);CHKERRQ(ierr);
6973   PetscFunctionReturn(0);
6974 }
6975 
6976 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
6977 {
6978   Mat            A;
6979   PetscInt       n_neighs,*neighs,*n_shared,**shared;
6980   PetscMPIInt    size,rank,color;
6981   PetscInt       *xadj,*adjncy;
6982   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
6983   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
6984   PetscInt       void_procs,*procs_candidates = NULL;
6985   PetscInt       xadj_count,*count;
6986   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
6987   PetscSubcomm   psubcomm;
6988   MPI_Comm       subcomm;
6989   PetscErrorCode ierr;
6990 
6991   PetscFunctionBegin;
6992   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6993   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6994   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);
6995   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
6996   PetscValidLogicalCollectiveInt(mat,redprocs,3);
6997   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %d\n",*n_subdomains);
6998 
6999   if (have_void) *have_void = PETSC_FALSE;
7000   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
7001   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
7002   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
7003   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
7004   im_active = !!n;
7005   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7006   void_procs = size - active_procs;
7007   /* get ranks of of non-active processes in mat communicator */
7008   if (void_procs) {
7009     PetscInt ncand;
7010 
7011     if (have_void) *have_void = PETSC_TRUE;
7012     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
7013     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7014     for (i=0,ncand=0;i<size;i++) {
7015       if (!procs_candidates[i]) {
7016         procs_candidates[ncand++] = i;
7017       }
7018     }
7019     /* force n_subdomains to be not greater that the number of non-active processes */
7020     *n_subdomains = PetscMin(void_procs,*n_subdomains);
7021   }
7022 
7023   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
7024      number of subdomains requested 1 -> send to master or first candidate in voids  */
7025   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
7026   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
7027     PetscInt issize,isidx,dest;
7028     if (*n_subdomains == 1) dest = 0;
7029     else dest = rank;
7030     if (im_active) {
7031       issize = 1;
7032       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7033         isidx = procs_candidates[dest];
7034       } else {
7035         isidx = dest;
7036       }
7037     } else {
7038       issize = 0;
7039       isidx = -1;
7040     }
7041     if (*n_subdomains != 1) *n_subdomains = active_procs;
7042     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
7043     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7044     PetscFunctionReturn(0);
7045   }
7046   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
7047   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
7048   threshold = PetscMax(threshold,2);
7049 
7050   /* Get info on mapping */
7051   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7052 
7053   /* build local CSR graph of subdomains' connectivity */
7054   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
7055   xadj[0] = 0;
7056   xadj[1] = PetscMax(n_neighs-1,0);
7057   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
7058   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
7059   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
7060   for (i=1;i<n_neighs;i++)
7061     for (j=0;j<n_shared[i];j++)
7062       count[shared[i][j]] += 1;
7063 
7064   xadj_count = 0;
7065   for (i=1;i<n_neighs;i++) {
7066     for (j=0;j<n_shared[i];j++) {
7067       if (count[shared[i][j]] < threshold) {
7068         adjncy[xadj_count] = neighs[i];
7069         adjncy_wgt[xadj_count] = n_shared[i];
7070         xadj_count++;
7071         break;
7072       }
7073     }
7074   }
7075   xadj[1] = xadj_count;
7076   ierr = PetscFree(count);CHKERRQ(ierr);
7077   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7078   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7079 
7080   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
7081 
7082   /* Restrict work on active processes only */
7083   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
7084   if (void_procs) {
7085     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
7086     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
7087     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
7088     subcomm = PetscSubcommChild(psubcomm);
7089   } else {
7090     psubcomm = NULL;
7091     subcomm = PetscObjectComm((PetscObject)mat);
7092   }
7093 
7094   v_wgt = NULL;
7095   if (!color) {
7096     ierr = PetscFree(xadj);CHKERRQ(ierr);
7097     ierr = PetscFree(adjncy);CHKERRQ(ierr);
7098     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7099   } else {
7100     Mat             subdomain_adj;
7101     IS              new_ranks,new_ranks_contig;
7102     MatPartitioning partitioner;
7103     PetscInt        rstart=0,rend=0;
7104     PetscInt        *is_indices,*oldranks;
7105     PetscMPIInt     size;
7106     PetscBool       aggregate;
7107 
7108     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
7109     if (void_procs) {
7110       PetscInt prank = rank;
7111       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
7112       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
7113       for (i=0;i<xadj[1];i++) {
7114         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
7115       }
7116       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7117     } else {
7118       oldranks = NULL;
7119     }
7120     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
7121     if (aggregate) { /* TODO: all this part could be made more efficient */
7122       PetscInt    lrows,row,ncols,*cols;
7123       PetscMPIInt nrank;
7124       PetscScalar *vals;
7125 
7126       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
7127       lrows = 0;
7128       if (nrank<redprocs) {
7129         lrows = size/redprocs;
7130         if (nrank<size%redprocs) lrows++;
7131       }
7132       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
7133       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
7134       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7135       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7136       row = nrank;
7137       ncols = xadj[1]-xadj[0];
7138       cols = adjncy;
7139       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
7140       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
7141       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
7142       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7143       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7144       ierr = PetscFree(xadj);CHKERRQ(ierr);
7145       ierr = PetscFree(adjncy);CHKERRQ(ierr);
7146       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7147       ierr = PetscFree(vals);CHKERRQ(ierr);
7148       if (use_vwgt) {
7149         Vec               v;
7150         const PetscScalar *array;
7151         PetscInt          nl;
7152 
7153         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
7154         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
7155         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
7156         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
7157         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
7158         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
7159         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
7160         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
7161         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
7162         ierr = VecDestroy(&v);CHKERRQ(ierr);
7163       }
7164     } else {
7165       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
7166       if (use_vwgt) {
7167         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
7168         v_wgt[0] = n;
7169       }
7170     }
7171     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
7172 
7173     /* Partition */
7174     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
7175     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
7176     if (v_wgt) {
7177       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
7178     }
7179     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
7180     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
7181     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
7182     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
7183     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
7184 
7185     /* renumber new_ranks to avoid "holes" in new set of processors */
7186     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
7187     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
7188     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7189     if (!aggregate) {
7190       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7191 #if defined(PETSC_USE_DEBUG)
7192         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7193 #endif
7194         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
7195       } else if (oldranks) {
7196         ranks_send_to_idx[0] = oldranks[is_indices[0]];
7197       } else {
7198         ranks_send_to_idx[0] = is_indices[0];
7199       }
7200     } else {
7201       PetscInt    idx = 0;
7202       PetscMPIInt tag;
7203       MPI_Request *reqs;
7204 
7205       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
7206       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
7207       for (i=rstart;i<rend;i++) {
7208         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
7209       }
7210       ierr = MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
7211       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7212       ierr = PetscFree(reqs);CHKERRQ(ierr);
7213       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7214 #if defined(PETSC_USE_DEBUG)
7215         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7216 #endif
7217         ranks_send_to_idx[0] = procs_candidates[oldranks[idx]];
7218       } else if (oldranks) {
7219         ranks_send_to_idx[0] = oldranks[idx];
7220       } else {
7221         ranks_send_to_idx[0] = idx;
7222       }
7223     }
7224     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7225     /* clean up */
7226     ierr = PetscFree(oldranks);CHKERRQ(ierr);
7227     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
7228     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
7229     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
7230   }
7231   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
7232   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7233 
7234   /* assemble parallel IS for sends */
7235   i = 1;
7236   if (!color) i=0;
7237   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
7238   PetscFunctionReturn(0);
7239 }
7240 
7241 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
7242 
7243 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[])
7244 {
7245   Mat                    local_mat;
7246   IS                     is_sends_internal;
7247   PetscInt               rows,cols,new_local_rows;
7248   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
7249   PetscBool              ismatis,isdense,newisdense,destroy_mat;
7250   ISLocalToGlobalMapping l2gmap;
7251   PetscInt*              l2gmap_indices;
7252   const PetscInt*        is_indices;
7253   MatType                new_local_type;
7254   /* buffers */
7255   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
7256   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
7257   PetscInt               *recv_buffer_idxs_local;
7258   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
7259   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
7260   /* MPI */
7261   MPI_Comm               comm,comm_n;
7262   PetscSubcomm           subcomm;
7263   PetscMPIInt            n_sends,n_recvs,commsize;
7264   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
7265   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
7266   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
7267   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
7268   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
7269   PetscErrorCode         ierr;
7270 
7271   PetscFunctionBegin;
7272   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7273   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7274   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);
7275   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
7276   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
7277   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
7278   PetscValidLogicalCollectiveBool(mat,reuse,6);
7279   PetscValidLogicalCollectiveInt(mat,nis,8);
7280   PetscValidLogicalCollectiveInt(mat,nvecs,10);
7281   if (nvecs) {
7282     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
7283     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
7284   }
7285   /* further checks */
7286   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7287   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
7288   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
7289   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
7290   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
7291   if (reuse && *mat_n) {
7292     PetscInt mrows,mcols,mnrows,mncols;
7293     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
7294     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
7295     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
7296     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
7297     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
7298     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
7299     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
7300   }
7301   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
7302   PetscValidLogicalCollectiveInt(mat,bs,0);
7303 
7304   /* prepare IS for sending if not provided */
7305   if (!is_sends) {
7306     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
7307     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
7308   } else {
7309     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
7310     is_sends_internal = is_sends;
7311   }
7312 
7313   /* get comm */
7314   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
7315 
7316   /* compute number of sends */
7317   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
7318   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7319 
7320   /* compute number of receives */
7321   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
7322   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
7323   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
7324   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7325   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7326   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7327   ierr = PetscFree(iflags);CHKERRQ(ierr);
7328 
7329   /* restrict comm if requested */
7330   subcomm = 0;
7331   destroy_mat = PETSC_FALSE;
7332   if (restrict_comm) {
7333     PetscMPIInt color,subcommsize;
7334 
7335     color = 0;
7336     if (restrict_full) {
7337       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7338     } else {
7339       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7340     }
7341     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
7342     subcommsize = commsize - subcommsize;
7343     /* check if reuse has been requested */
7344     if (reuse) {
7345       if (*mat_n) {
7346         PetscMPIInt subcommsize2;
7347         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
7348         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7349         comm_n = PetscObjectComm((PetscObject)*mat_n);
7350       } else {
7351         comm_n = PETSC_COMM_SELF;
7352       }
7353     } else { /* MAT_INITIAL_MATRIX */
7354       PetscMPIInt rank;
7355 
7356       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
7357       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7358       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7359       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7360       comm_n = PetscSubcommChild(subcomm);
7361     }
7362     /* flag to destroy *mat_n if not significative */
7363     if (color) destroy_mat = PETSC_TRUE;
7364   } else {
7365     comm_n = comm;
7366   }
7367 
7368   /* prepare send/receive buffers */
7369   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
7370   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
7371   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
7372   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
7373   if (nis) {
7374     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
7375   }
7376 
7377   /* Get data from local matrices */
7378   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7379     /* TODO: See below some guidelines on how to prepare the local buffers */
7380     /*
7381        send_buffer_vals should contain the raw values of the local matrix
7382        send_buffer_idxs should contain:
7383        - MatType_PRIVATE type
7384        - PetscInt        size_of_l2gmap
7385        - PetscInt        global_row_indices[size_of_l2gmap]
7386        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7387     */
7388   else {
7389     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7390     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7391     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7392     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7393     send_buffer_idxs[1] = i;
7394     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7395     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
7396     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7397     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7398     for (i=0;i<n_sends;i++) {
7399       ilengths_vals[is_indices[i]] = len*len;
7400       ilengths_idxs[is_indices[i]] = len+2;
7401     }
7402   }
7403   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7404   /* additional is (if any) */
7405   if (nis) {
7406     PetscMPIInt psum;
7407     PetscInt j;
7408     for (j=0,psum=0;j<nis;j++) {
7409       PetscInt plen;
7410       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7411       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7412       psum += len+1; /* indices + lenght */
7413     }
7414     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7415     for (j=0,psum=0;j<nis;j++) {
7416       PetscInt plen;
7417       const PetscInt *is_array_idxs;
7418       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7419       send_buffer_idxs_is[psum] = plen;
7420       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7421       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
7422       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7423       psum += plen+1; /* indices + lenght */
7424     }
7425     for (i=0;i<n_sends;i++) {
7426       ilengths_idxs_is[is_indices[i]] = psum;
7427     }
7428     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7429   }
7430   ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7431 
7432   buf_size_idxs = 0;
7433   buf_size_vals = 0;
7434   buf_size_idxs_is = 0;
7435   buf_size_vecs = 0;
7436   for (i=0;i<n_recvs;i++) {
7437     buf_size_idxs += (PetscInt)olengths_idxs[i];
7438     buf_size_vals += (PetscInt)olengths_vals[i];
7439     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7440     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7441   }
7442   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7443   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7444   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7445   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7446 
7447   /* get new tags for clean communications */
7448   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7449   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7450   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7451   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7452 
7453   /* allocate for requests */
7454   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7455   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7456   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7457   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7458   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7459   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7460   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7461   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7462 
7463   /* communications */
7464   ptr_idxs = recv_buffer_idxs;
7465   ptr_vals = recv_buffer_vals;
7466   ptr_idxs_is = recv_buffer_idxs_is;
7467   ptr_vecs = recv_buffer_vecs;
7468   for (i=0;i<n_recvs;i++) {
7469     source_dest = onodes[i];
7470     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7471     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7472     ptr_idxs += olengths_idxs[i];
7473     ptr_vals += olengths_vals[i];
7474     if (nis) {
7475       source_dest = onodes_is[i];
7476       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);
7477       ptr_idxs_is += olengths_idxs_is[i];
7478     }
7479     if (nvecs) {
7480       source_dest = onodes[i];
7481       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7482       ptr_vecs += olengths_idxs[i]-2;
7483     }
7484   }
7485   for (i=0;i<n_sends;i++) {
7486     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7487     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7488     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7489     if (nis) {
7490       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);
7491     }
7492     if (nvecs) {
7493       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7494       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7495     }
7496   }
7497   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7498   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7499 
7500   /* assemble new l2g map */
7501   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7502   ptr_idxs = recv_buffer_idxs;
7503   new_local_rows = 0;
7504   for (i=0;i<n_recvs;i++) {
7505     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7506     ptr_idxs += olengths_idxs[i];
7507   }
7508   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7509   ptr_idxs = recv_buffer_idxs;
7510   new_local_rows = 0;
7511   for (i=0;i<n_recvs;i++) {
7512     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
7513     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7514     ptr_idxs += olengths_idxs[i];
7515   }
7516   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7517   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7518   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7519 
7520   /* infer new local matrix type from received local matrices type */
7521   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7522   /* 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) */
7523   if (n_recvs) {
7524     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7525     ptr_idxs = recv_buffer_idxs;
7526     for (i=0;i<n_recvs;i++) {
7527       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7528         new_local_type_private = MATAIJ_PRIVATE;
7529         break;
7530       }
7531       ptr_idxs += olengths_idxs[i];
7532     }
7533     switch (new_local_type_private) {
7534       case MATDENSE_PRIVATE:
7535         new_local_type = MATSEQAIJ;
7536         bs = 1;
7537         break;
7538       case MATAIJ_PRIVATE:
7539         new_local_type = MATSEQAIJ;
7540         bs = 1;
7541         break;
7542       case MATBAIJ_PRIVATE:
7543         new_local_type = MATSEQBAIJ;
7544         break;
7545       case MATSBAIJ_PRIVATE:
7546         new_local_type = MATSEQSBAIJ;
7547         break;
7548       default:
7549         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7550         break;
7551     }
7552   } else { /* by default, new_local_type is seqaij */
7553     new_local_type = MATSEQAIJ;
7554     bs = 1;
7555   }
7556 
7557   /* create MATIS object if needed */
7558   if (!reuse) {
7559     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7560     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7561   } else {
7562     /* it also destroys the local matrices */
7563     if (*mat_n) {
7564       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7565     } else { /* this is a fake object */
7566       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7567     }
7568   }
7569   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7570   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7571 
7572   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7573 
7574   /* Global to local map of received indices */
7575   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7576   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7577   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7578 
7579   /* restore attributes -> type of incoming data and its size */
7580   buf_size_idxs = 0;
7581   for (i=0;i<n_recvs;i++) {
7582     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7583     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7584     buf_size_idxs += (PetscInt)olengths_idxs[i];
7585   }
7586   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7587 
7588   /* set preallocation */
7589   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7590   if (!newisdense) {
7591     PetscInt *new_local_nnz=0;
7592 
7593     ptr_idxs = recv_buffer_idxs_local;
7594     if (n_recvs) {
7595       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7596     }
7597     for (i=0;i<n_recvs;i++) {
7598       PetscInt j;
7599       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7600         for (j=0;j<*(ptr_idxs+1);j++) {
7601           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7602         }
7603       } else {
7604         /* TODO */
7605       }
7606       ptr_idxs += olengths_idxs[i];
7607     }
7608     if (new_local_nnz) {
7609       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7610       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7611       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7612       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7613       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7614       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7615     } else {
7616       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7617     }
7618     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7619   } else {
7620     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7621   }
7622 
7623   /* set values */
7624   ptr_vals = recv_buffer_vals;
7625   ptr_idxs = recv_buffer_idxs_local;
7626   for (i=0;i<n_recvs;i++) {
7627     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7628       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7629       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7630       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7631       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7632       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7633     } else {
7634       /* TODO */
7635     }
7636     ptr_idxs += olengths_idxs[i];
7637     ptr_vals += olengths_vals[i];
7638   }
7639   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7640   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7641   ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7642   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7643   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7644   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7645 
7646 #if 0
7647   if (!restrict_comm) { /* check */
7648     Vec       lvec,rvec;
7649     PetscReal infty_error;
7650 
7651     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7652     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7653     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7654     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7655     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7656     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7657     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7658     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7659     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7660   }
7661 #endif
7662 
7663   /* assemble new additional is (if any) */
7664   if (nis) {
7665     PetscInt **temp_idxs,*count_is,j,psum;
7666 
7667     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7668     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7669     ptr_idxs = recv_buffer_idxs_is;
7670     psum = 0;
7671     for (i=0;i<n_recvs;i++) {
7672       for (j=0;j<nis;j++) {
7673         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7674         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7675         psum += plen;
7676         ptr_idxs += plen+1; /* shift pointer to received data */
7677       }
7678     }
7679     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7680     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7681     for (i=1;i<nis;i++) {
7682       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7683     }
7684     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7685     ptr_idxs = recv_buffer_idxs_is;
7686     for (i=0;i<n_recvs;i++) {
7687       for (j=0;j<nis;j++) {
7688         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7689         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7690         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7691         ptr_idxs += plen+1; /* shift pointer to received data */
7692       }
7693     }
7694     for (i=0;i<nis;i++) {
7695       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7696       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7697       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7698     }
7699     ierr = PetscFree(count_is);CHKERRQ(ierr);
7700     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7701     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7702   }
7703   /* free workspace */
7704   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7705   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7706   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7707   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7708   if (isdense) {
7709     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7710     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7711     ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7712   } else {
7713     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7714   }
7715   if (nis) {
7716     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7717     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7718   }
7719 
7720   if (nvecs) {
7721     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7722     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7723     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7724     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7725     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7726     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7727     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7728     /* set values */
7729     ptr_vals = recv_buffer_vecs;
7730     ptr_idxs = recv_buffer_idxs_local;
7731     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7732     for (i=0;i<n_recvs;i++) {
7733       PetscInt j;
7734       for (j=0;j<*(ptr_idxs+1);j++) {
7735         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7736       }
7737       ptr_idxs += olengths_idxs[i];
7738       ptr_vals += olengths_idxs[i]-2;
7739     }
7740     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7741     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7742     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7743   }
7744 
7745   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7746   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7747   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7748   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7749   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7750   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7751   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7752   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7753   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7754   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7755   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7756   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7757   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7758   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7759   ierr = PetscFree(onodes);CHKERRQ(ierr);
7760   if (nis) {
7761     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7762     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7763     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7764   }
7765   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7766   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7767     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7768     for (i=0;i<nis;i++) {
7769       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7770     }
7771     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7772       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7773     }
7774     *mat_n = NULL;
7775   }
7776   PetscFunctionReturn(0);
7777 }
7778 
7779 /* temporary hack into ksp private data structure */
7780 #include <petsc/private/kspimpl.h>
7781 
7782 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7783 {
7784   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7785   PC_IS                  *pcis = (PC_IS*)pc->data;
7786   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7787   Mat                    coarsedivudotp = NULL;
7788   Mat                    coarseG,t_coarse_mat_is;
7789   MatNullSpace           CoarseNullSpace = NULL;
7790   ISLocalToGlobalMapping coarse_islg;
7791   IS                     coarse_is,*isarray;
7792   PetscInt               i,im_active=-1,active_procs=-1;
7793   PetscInt               nis,nisdofs,nisneu,nisvert;
7794   PC                     pc_temp;
7795   PCType                 coarse_pc_type;
7796   KSPType                coarse_ksp_type;
7797   PetscBool              multilevel_requested,multilevel_allowed;
7798   PetscBool              coarse_reuse;
7799   PetscInt               ncoarse,nedcfield;
7800   PetscBool              compute_vecs = PETSC_FALSE;
7801   PetscScalar            *array;
7802   MatReuse               coarse_mat_reuse;
7803   PetscBool              restr, full_restr, have_void;
7804   PetscMPIInt            commsize;
7805   PetscErrorCode         ierr;
7806 
7807   PetscFunctionBegin;
7808   /* Assign global numbering to coarse dofs */
7809   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 */
7810     PetscInt ocoarse_size;
7811     compute_vecs = PETSC_TRUE;
7812 
7813     pcbddc->new_primal_space = PETSC_TRUE;
7814     ocoarse_size = pcbddc->coarse_size;
7815     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
7816     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
7817     /* see if we can avoid some work */
7818     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
7819       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
7820       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
7821         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
7822         coarse_reuse = PETSC_FALSE;
7823       } else { /* we can safely reuse already computed coarse matrix */
7824         coarse_reuse = PETSC_TRUE;
7825       }
7826     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
7827       coarse_reuse = PETSC_FALSE;
7828     }
7829     /* reset any subassembling information */
7830     if (!coarse_reuse || pcbddc->recompute_topography) {
7831       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7832     }
7833   } else { /* primal space is unchanged, so we can reuse coarse matrix */
7834     coarse_reuse = PETSC_TRUE;
7835   }
7836   /* assemble coarse matrix */
7837   if (coarse_reuse && pcbddc->coarse_ksp) {
7838     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
7839     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
7840     coarse_mat_reuse = MAT_REUSE_MATRIX;
7841   } else {
7842     coarse_mat = NULL;
7843     coarse_mat_reuse = MAT_INITIAL_MATRIX;
7844   }
7845 
7846   /* creates temporary l2gmap and IS for coarse indexes */
7847   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
7848   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
7849 
7850   /* creates temporary MATIS object for coarse matrix */
7851   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
7852   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7853   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
7854   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7855   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);
7856   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
7857   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7858   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7859   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
7860 
7861   /* count "active" (i.e. with positive local size) and "void" processes */
7862   im_active = !!(pcis->n);
7863   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7864 
7865   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
7866   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
7867   /* full_restr : just use the receivers from the subassembling pattern */
7868   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&commsize);CHKERRQ(ierr);
7869   coarse_mat_is = NULL;
7870   multilevel_allowed = PETSC_FALSE;
7871   multilevel_requested = PETSC_FALSE;
7872   pcbddc->coarse_eqs_per_proc = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
7873   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
7874   if (multilevel_requested) {
7875     ncoarse = active_procs/pcbddc->coarsening_ratio;
7876     restr = PETSC_FALSE;
7877     full_restr = PETSC_FALSE;
7878   } else {
7879     ncoarse = pcbddc->coarse_size/pcbddc->coarse_eqs_per_proc;
7880     restr = PETSC_TRUE;
7881     full_restr = PETSC_TRUE;
7882   }
7883   if (!pcbddc->coarse_size || commsize == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
7884   ncoarse = PetscMax(1,ncoarse);
7885   if (!pcbddc->coarse_subassembling) {
7886     if (pcbddc->coarsening_ratio > 1) {
7887       if (multilevel_requested) {
7888         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7889       } else {
7890         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7891       }
7892     } else {
7893       PetscMPIInt rank;
7894       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
7895       have_void = (active_procs == (PetscInt)commsize) ? PETSC_FALSE : PETSC_TRUE;
7896       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7897     }
7898   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
7899     PetscInt    psum;
7900     if (pcbddc->coarse_ksp) psum = 1;
7901     else psum = 0;
7902     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7903     if (ncoarse < commsize) have_void = PETSC_TRUE;
7904   }
7905   /* determine if we can go multilevel */
7906   if (multilevel_requested) {
7907     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
7908     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
7909   }
7910   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
7911 
7912   /* dump subassembling pattern */
7913   if (pcbddc->dbg_flag && multilevel_allowed) {
7914     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
7915   }
7916 
7917   /* compute dofs splitting and neumann boundaries for coarse dofs */
7918   nedcfield = -1;
7919   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal)) { /* protects from unneded computations */
7920     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
7921     const PetscInt         *idxs;
7922     ISLocalToGlobalMapping tmap;
7923 
7924     /* create map between primal indices (in local representative ordering) and local primal numbering */
7925     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
7926     /* allocate space for temporary storage */
7927     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
7928     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
7929     /* allocate for IS array */
7930     nisdofs = pcbddc->n_ISForDofsLocal;
7931     if (pcbddc->nedclocal) {
7932       if (pcbddc->nedfield > -1) {
7933         nedcfield = pcbddc->nedfield;
7934       } else {
7935         nedcfield = 0;
7936         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%d)",nisdofs);
7937         nisdofs = 1;
7938       }
7939     }
7940     nisneu = !!pcbddc->NeumannBoundariesLocal;
7941     nisvert = 0; /* nisvert is not used */
7942     nis = nisdofs + nisneu + nisvert;
7943     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
7944     /* dofs splitting */
7945     for (i=0;i<nisdofs;i++) {
7946       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
7947       if (nedcfield != i) {
7948         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
7949         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7950         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7951         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7952       } else {
7953         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
7954         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7955         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7956         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %d != %d\n",tsize,nout);
7957         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7958       }
7959       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7960       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7961       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
7962     }
7963     /* neumann boundaries */
7964     if (pcbddc->NeumannBoundariesLocal) {
7965       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
7966       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
7967       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7968       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7969       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7970       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7971       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
7972       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
7973     }
7974     /* free memory */
7975     ierr = PetscFree(tidxs);CHKERRQ(ierr);
7976     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
7977     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
7978   } else {
7979     nis = 0;
7980     nisdofs = 0;
7981     nisneu = 0;
7982     nisvert = 0;
7983     isarray = NULL;
7984   }
7985   /* destroy no longer needed map */
7986   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
7987 
7988   /* subassemble */
7989   if (multilevel_allowed) {
7990     Vec       vp[1];
7991     PetscInt  nvecs = 0;
7992     PetscBool reuse,reuser;
7993 
7994     if (coarse_mat) reuse = PETSC_TRUE;
7995     else reuse = PETSC_FALSE;
7996     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7997     vp[0] = NULL;
7998     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
7999       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
8000       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
8001       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
8002       nvecs = 1;
8003 
8004       if (pcbddc->divudotp) {
8005         Mat      B,loc_divudotp;
8006         Vec      v,p;
8007         IS       dummy;
8008         PetscInt np;
8009 
8010         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
8011         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
8012         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
8013         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
8014         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
8015         ierr = VecSet(p,1.);CHKERRQ(ierr);
8016         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
8017         ierr = VecDestroy(&p);CHKERRQ(ierr);
8018         ierr = MatDestroy(&B);CHKERRQ(ierr);
8019         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
8020         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
8021         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
8022         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
8023         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
8024         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8025         ierr = VecDestroy(&v);CHKERRQ(ierr);
8026       }
8027     }
8028     if (reuser) {
8029       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8030     } else {
8031       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8032     }
8033     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
8034       PetscScalar *arraym,*arrayv;
8035       PetscInt    nl;
8036       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
8037       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
8038       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8039       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
8040       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
8041       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
8042       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8043       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
8044     } else {
8045       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
8046     }
8047   } else {
8048     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
8049   }
8050   if (coarse_mat_is || coarse_mat) {
8051     PetscMPIInt size;
8052     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)coarse_mat_is),&size);CHKERRQ(ierr);
8053     if (!multilevel_allowed) {
8054       ierr = MatConvert(coarse_mat_is,MATAIJ,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
8055     } else {
8056       Mat A;
8057 
8058       /* if this matrix is present, it means we are not reusing the coarse matrix */
8059       if (coarse_mat_is) {
8060         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
8061         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
8062         coarse_mat = coarse_mat_is;
8063       }
8064       /* be sure we don't have MatSeqDENSE as local mat */
8065       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
8066       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
8067     }
8068   }
8069   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
8070   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
8071 
8072   /* create local to global scatters for coarse problem */
8073   if (compute_vecs) {
8074     PetscInt lrows;
8075     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
8076     if (coarse_mat) {
8077       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
8078     } else {
8079       lrows = 0;
8080     }
8081     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
8082     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
8083     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
8084     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8085     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8086   }
8087   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
8088 
8089   /* set defaults for coarse KSP and PC */
8090   if (multilevel_allowed) {
8091     coarse_ksp_type = KSPRICHARDSON;
8092     coarse_pc_type = PCBDDC;
8093   } else {
8094     coarse_ksp_type = KSPPREONLY;
8095     coarse_pc_type = PCREDUNDANT;
8096   }
8097 
8098   /* print some info if requested */
8099   if (pcbddc->dbg_flag) {
8100     if (!multilevel_allowed) {
8101       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8102       if (multilevel_requested) {
8103         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);
8104       } else if (pcbddc->max_levels) {
8105         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
8106       }
8107       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8108     }
8109   }
8110 
8111   /* communicate coarse discrete gradient */
8112   coarseG = NULL;
8113   if (pcbddc->nedcG && multilevel_allowed) {
8114     MPI_Comm ccomm;
8115     if (coarse_mat) {
8116       ccomm = PetscObjectComm((PetscObject)coarse_mat);
8117     } else {
8118       ccomm = MPI_COMM_NULL;
8119     }
8120     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
8121   }
8122 
8123   /* create the coarse KSP object only once with defaults */
8124   if (coarse_mat) {
8125     PetscBool   isredundant,isnn,isbddc;
8126     PetscViewer dbg_viewer = NULL;
8127 
8128     if (pcbddc->dbg_flag) {
8129       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
8130       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8131     }
8132     if (!pcbddc->coarse_ksp) {
8133       char   prefix[256],str_level[16];
8134       size_t len;
8135 
8136       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
8137       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8138       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
8139       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
8140       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8141       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
8142       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
8143       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8144       /* TODO is this logic correct? should check for coarse_mat type */
8145       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8146       /* prefix */
8147       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
8148       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
8149       if (!pcbddc->current_level) {
8150         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,sizeof(prefix));CHKERRQ(ierr);
8151         ierr = PetscStrlcat(prefix,"pc_bddc_coarse_",sizeof(prefix));CHKERRQ(ierr);
8152       } else {
8153         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
8154         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
8155         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
8156         /* Nonstandard use of PetscStrncpy() to copy only a portion of the string */
8157         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
8158         ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
8159         ierr = PetscStrlcat(prefix,str_level,sizeof(prefix));CHKERRQ(ierr);
8160       }
8161       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
8162       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8163       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8164       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8165       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8166       /* allow user customization */
8167       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
8168     }
8169     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8170     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8171     if (nisdofs) {
8172       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
8173       for (i=0;i<nisdofs;i++) {
8174         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8175       }
8176     }
8177     if (nisneu) {
8178       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
8179       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
8180     }
8181     if (nisvert) {
8182       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
8183       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
8184     }
8185     if (coarseG) {
8186       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
8187     }
8188 
8189     /* get some info after set from options */
8190     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8191     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
8192     if (isbddc && !multilevel_allowed) {
8193       ierr   = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8194       isbddc = PETSC_FALSE;
8195     }
8196     /* multilevel cannot be done with coarse PCs different from BDDC or NN */
8197     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
8198     if (multilevel_requested && multilevel_allowed && !isbddc && !isnn) {
8199       ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8200       isbddc = PETSC_TRUE;
8201     }
8202     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
8203     if (isredundant) {
8204       KSP inner_ksp;
8205       PC  inner_pc;
8206 
8207       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
8208       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
8209     }
8210 
8211     /* parameters which miss an API */
8212     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8213     if (isbddc) {
8214       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
8215 
8216       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
8217       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
8218       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
8219       if (pcbddc_coarse->benign_saddle_point) {
8220         Mat                    coarsedivudotp_is;
8221         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
8222         IS                     row,col;
8223         const PetscInt         *gidxs;
8224         PetscInt               n,st,M,N;
8225 
8226         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
8227         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
8228         st   = st-n;
8229         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
8230         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
8231         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
8232         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8233         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
8234         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8235         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
8236         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
8237         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
8238         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
8239         ierr = ISDestroy(&row);CHKERRQ(ierr);
8240         ierr = ISDestroy(&col);CHKERRQ(ierr);
8241         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
8242         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
8243         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
8244         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
8245         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
8246         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
8247         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
8248         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8249         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
8250         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
8251         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
8252         if (pcbddc->adaptive_threshold[0] == 0.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
8253       }
8254     }
8255 
8256     /* propagate symmetry info of coarse matrix */
8257     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
8258     if (pc->pmat->symmetric_set) {
8259       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
8260     }
8261     if (pc->pmat->hermitian_set) {
8262       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
8263     }
8264     if (pc->pmat->spd_set) {
8265       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
8266     }
8267     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
8268       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
8269     }
8270     /* set operators */
8271     ierr = MatViewFromOptions(coarse_mat,(PetscObject)pc,"-pc_bddc_coarse_mat_view");CHKERRQ(ierr);
8272     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8273     if (pcbddc->dbg_flag) {
8274       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8275     }
8276   }
8277   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
8278   ierr = PetscFree(isarray);CHKERRQ(ierr);
8279 #if 0
8280   {
8281     PetscViewer viewer;
8282     char filename[256];
8283     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
8284     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
8285     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
8286     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
8287     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
8288     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
8289   }
8290 #endif
8291 
8292   if (pcbddc->coarse_ksp) {
8293     Vec crhs,csol;
8294 
8295     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
8296     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
8297     if (!csol) {
8298       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
8299     }
8300     if (!crhs) {
8301       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
8302     }
8303   }
8304   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8305 
8306   /* compute null space for coarse solver if the benign trick has been requested */
8307   if (pcbddc->benign_null) {
8308 
8309     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
8310     for (i=0;i<pcbddc->benign_n;i++) {
8311       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
8312     }
8313     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
8314     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
8315     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8316     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8317     if (coarse_mat) {
8318       Vec         nullv;
8319       PetscScalar *array,*array2;
8320       PetscInt    nl;
8321 
8322       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
8323       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
8324       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8325       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
8326       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
8327       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
8328       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8329       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
8330       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
8331       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
8332     }
8333   }
8334 
8335   if (pcbddc->coarse_ksp) {
8336     PetscBool ispreonly;
8337 
8338     if (CoarseNullSpace) {
8339       PetscBool isnull;
8340       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
8341       if (isnull) {
8342         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
8343       }
8344       /* TODO: add local nullspaces (if any) */
8345     }
8346     /* setup coarse ksp */
8347     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
8348     /* Check coarse problem if in debug mode or if solving with an iterative method */
8349     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
8350     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
8351       KSP       check_ksp;
8352       KSPType   check_ksp_type;
8353       PC        check_pc;
8354       Vec       check_vec,coarse_vec;
8355       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8356       PetscInt  its;
8357       PetscBool compute_eigs;
8358       PetscReal *eigs_r,*eigs_c;
8359       PetscInt  neigs;
8360       const char *prefix;
8361 
8362       /* Create ksp object suitable for estimation of extreme eigenvalues */
8363       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
8364       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8365       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8366       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
8367       /* prevent from setup unneeded object */
8368       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
8369       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
8370       if (ispreonly) {
8371         check_ksp_type = KSPPREONLY;
8372         compute_eigs = PETSC_FALSE;
8373       } else {
8374         check_ksp_type = KSPGMRES;
8375         compute_eigs = PETSC_TRUE;
8376       }
8377       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
8378       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
8379       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
8380       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
8381       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
8382       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
8383       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
8384       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
8385       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
8386       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
8387       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
8388       /* create random vec */
8389       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
8390       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8391       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8392       /* solve coarse problem */
8393       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8394       /* set eigenvalue estimation if preonly has not been requested */
8395       if (compute_eigs) {
8396         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8397         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8398         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8399         if (neigs) {
8400           lambda_max = eigs_r[neigs-1];
8401           lambda_min = eigs_r[0];
8402           if (pcbddc->use_coarse_estimates) {
8403             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8404               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8405               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8406             }
8407           }
8408         }
8409       }
8410 
8411       /* check coarse problem residual error */
8412       if (pcbddc->dbg_flag) {
8413         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8414         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8415         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8416         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8417         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8418         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8419         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8420         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8421         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8422         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8423         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8424         if (CoarseNullSpace) {
8425           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8426         }
8427         if (compute_eigs) {
8428           PetscReal          lambda_max_s,lambda_min_s;
8429           KSPConvergedReason reason;
8430           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8431           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8432           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8433           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8434           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);
8435           for (i=0;i<neigs;i++) {
8436             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8437           }
8438         }
8439         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8440         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8441       }
8442       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8443       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8444       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8445       if (compute_eigs) {
8446         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8447         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8448       }
8449     }
8450   }
8451   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8452   /* print additional info */
8453   if (pcbddc->dbg_flag) {
8454     /* waits until all processes reaches this point */
8455     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8456     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
8457     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8458   }
8459 
8460   /* free memory */
8461   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8462   PetscFunctionReturn(0);
8463 }
8464 
8465 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8466 {
8467   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8468   PC_IS*         pcis = (PC_IS*)pc->data;
8469   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8470   IS             subset,subset_mult,subset_n;
8471   PetscInt       local_size,coarse_size=0;
8472   PetscInt       *local_primal_indices=NULL;
8473   const PetscInt *t_local_primal_indices;
8474   PetscErrorCode ierr;
8475 
8476   PetscFunctionBegin;
8477   /* Compute global number of coarse dofs */
8478   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8479   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8480   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8481   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8482   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8483   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8484   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8485   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8486   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8487   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);
8488   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8489   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8490   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
8491   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8492   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8493 
8494   /* check numbering */
8495   if (pcbddc->dbg_flag) {
8496     PetscScalar coarsesum,*array,*array2;
8497     PetscInt    i;
8498     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8499 
8500     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8501     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8502     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8503     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8504     /* counter */
8505     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8506     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8507     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8508     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8509     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8510     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8511     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8512     for (i=0;i<pcbddc->local_primal_size;i++) {
8513       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8514     }
8515     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8516     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8517     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8518     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8519     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8520     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8521     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8522     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8523     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8524     for (i=0;i<pcis->n;i++) {
8525       if (array[i] != 0.0 && array[i] != array2[i]) {
8526         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8527         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8528         set_error = PETSC_TRUE;
8529         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8530         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);
8531       }
8532     }
8533     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8534     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8535     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8536     for (i=0;i<pcis->n;i++) {
8537       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8538     }
8539     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8540     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8541     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8542     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8543     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8544     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8545     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8546       PetscInt *gidxs;
8547 
8548       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8549       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8550       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8551       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8552       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8553       for (i=0;i<pcbddc->local_primal_size;i++) {
8554         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);
8555       }
8556       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8557       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8558     }
8559     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8560     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8561     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8562   }
8563   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
8564   /* get back data */
8565   *coarse_size_n = coarse_size;
8566   *local_primal_indices_n = local_primal_indices;
8567   PetscFunctionReturn(0);
8568 }
8569 
8570 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8571 {
8572   IS             localis_t;
8573   PetscInt       i,lsize,*idxs,n;
8574   PetscScalar    *vals;
8575   PetscErrorCode ierr;
8576 
8577   PetscFunctionBegin;
8578   /* get indices in local ordering exploiting local to global map */
8579   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8580   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8581   for (i=0;i<lsize;i++) vals[i] = 1.0;
8582   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8583   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8584   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8585   if (idxs) { /* multilevel guard */
8586     ierr = VecSetOption(gwork,VEC_IGNORE_NEGATIVE_INDICES,PETSC_TRUE);CHKERRQ(ierr);
8587     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8588   }
8589   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8590   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8591   ierr = PetscFree(vals);CHKERRQ(ierr);
8592   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8593   /* now compute set in local ordering */
8594   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8595   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8596   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8597   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8598   for (i=0,lsize=0;i<n;i++) {
8599     if (PetscRealPart(vals[i]) > 0.5) {
8600       lsize++;
8601     }
8602   }
8603   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8604   for (i=0,lsize=0;i<n;i++) {
8605     if (PetscRealPart(vals[i]) > 0.5) {
8606       idxs[lsize++] = i;
8607     }
8608   }
8609   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8610   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8611   *localis = localis_t;
8612   PetscFunctionReturn(0);
8613 }
8614 
8615 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8616 {
8617   PC_IS               *pcis=(PC_IS*)pc->data;
8618   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8619   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8620   Mat                 S_j;
8621   PetscInt            *used_xadj,*used_adjncy;
8622   PetscBool           free_used_adj;
8623   PetscErrorCode      ierr;
8624 
8625   PetscFunctionBegin;
8626   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8627   free_used_adj = PETSC_FALSE;
8628   if (pcbddc->sub_schurs_layers == -1) {
8629     used_xadj = NULL;
8630     used_adjncy = NULL;
8631   } else {
8632     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8633       used_xadj = pcbddc->mat_graph->xadj;
8634       used_adjncy = pcbddc->mat_graph->adjncy;
8635     } else if (pcbddc->computed_rowadj) {
8636       used_xadj = pcbddc->mat_graph->xadj;
8637       used_adjncy = pcbddc->mat_graph->adjncy;
8638     } else {
8639       PetscBool      flg_row=PETSC_FALSE;
8640       const PetscInt *xadj,*adjncy;
8641       PetscInt       nvtxs;
8642 
8643       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8644       if (flg_row) {
8645         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8646         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8647         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8648         free_used_adj = PETSC_TRUE;
8649       } else {
8650         pcbddc->sub_schurs_layers = -1;
8651         used_xadj = NULL;
8652         used_adjncy = NULL;
8653       }
8654       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8655     }
8656   }
8657 
8658   /* setup sub_schurs data */
8659   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8660   if (!sub_schurs->schur_explicit) {
8661     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8662     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8663     ierr = PCBDDCSubSchursSetUp(sub_schurs,NULL,S_j,PETSC_FALSE,used_xadj,used_adjncy,pcbddc->sub_schurs_layers,NULL,pcbddc->adaptive_selection,PETSC_FALSE,PETSC_FALSE,0,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
8664   } else {
8665     Mat       change = NULL;
8666     Vec       scaling = NULL;
8667     IS        change_primal = NULL, iP;
8668     PetscInt  benign_n;
8669     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8670     PetscBool isseqaij,need_change = PETSC_FALSE;
8671     PetscBool discrete_harmonic = PETSC_FALSE;
8672 
8673     if (!pcbddc->use_vertices && reuse_solvers) {
8674       PetscInt n_vertices;
8675 
8676       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8677       reuse_solvers = (PetscBool)!n_vertices;
8678     }
8679     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8680     if (!isseqaij) {
8681       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8682       if (matis->A == pcbddc->local_mat) {
8683         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8684         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8685       } else {
8686         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8687       }
8688     }
8689     if (!pcbddc->benign_change_explicit) {
8690       benign_n = pcbddc->benign_n;
8691     } else {
8692       benign_n = 0;
8693     }
8694     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
8695        We need a global reduction to avoid possible deadlocks.
8696        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
8697     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
8698       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
8699       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8700       need_change = (PetscBool)(!need_change);
8701     }
8702     /* If the user defines additional constraints, we import them here.
8703        We need to compute the change of basis according to the quadrature weights attached to pmat via MatSetNearNullSpace, and this could not be done (at the moment) without some hacking */
8704     if (need_change) {
8705       PC_IS   *pcisf;
8706       PC_BDDC *pcbddcf;
8707       PC      pcf;
8708 
8709       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
8710       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
8711       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
8712       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
8713 
8714       /* hacks */
8715       pcisf                        = (PC_IS*)pcf->data;
8716       pcisf->is_B_local            = pcis->is_B_local;
8717       pcisf->vec1_N                = pcis->vec1_N;
8718       pcisf->BtoNmap               = pcis->BtoNmap;
8719       pcisf->n                     = pcis->n;
8720       pcisf->n_B                   = pcis->n_B;
8721       pcbddcf                      = (PC_BDDC*)pcf->data;
8722       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
8723       pcbddcf->mat_graph           = pcbddc->mat_graph;
8724       pcbddcf->use_faces           = PETSC_TRUE;
8725       pcbddcf->use_change_of_basis = PETSC_TRUE;
8726       pcbddcf->use_change_on_faces = PETSC_TRUE;
8727       pcbddcf->use_qr_single       = PETSC_TRUE;
8728       pcbddcf->fake_change         = PETSC_TRUE;
8729 
8730       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
8731       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
8732       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
8733       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
8734       change = pcbddcf->ConstraintMatrix;
8735       pcbddcf->ConstraintMatrix = NULL;
8736 
8737       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
8738       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
8739       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
8740       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
8741       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
8742       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
8743       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
8744       pcf->ops->destroy = NULL;
8745       pcf->ops->reset   = NULL;
8746       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
8747     }
8748     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
8749 
8750     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
8751     if (iP) {
8752       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
8753       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
8754       ierr = PetscOptionsEnd();CHKERRQ(ierr);
8755     }
8756     if (discrete_harmonic) {
8757       Mat A;
8758       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
8759       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
8760       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
8761       ierr = PCBDDCSubSchursSetUp(sub_schurs,A,S_j,pcbddc->sub_schurs_exact_schur,used_xadj,used_adjncy,pcbddc->sub_schurs_layers,scaling,pcbddc->adaptive_selection,reuse_solvers,pcbddc->benign_saddle_point,benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_zerodiag_subs,change,change_primal);CHKERRQ(ierr);
8762       ierr = MatDestroy(&A);CHKERRQ(ierr);
8763     } else {
8764       ierr = PCBDDCSubSchursSetUp(sub_schurs,pcbddc->local_mat,S_j,pcbddc->sub_schurs_exact_schur,used_xadj,used_adjncy,pcbddc->sub_schurs_layers,scaling,pcbddc->adaptive_selection,reuse_solvers,pcbddc->benign_saddle_point,benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_zerodiag_subs,change,change_primal);CHKERRQ(ierr);
8765     }
8766     ierr = MatDestroy(&change);CHKERRQ(ierr);
8767     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
8768   }
8769   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8770 
8771   /* free adjacency */
8772   if (free_used_adj) {
8773     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
8774   }
8775   PetscFunctionReturn(0);
8776 }
8777 
8778 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
8779 {
8780   PC_IS               *pcis=(PC_IS*)pc->data;
8781   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8782   PCBDDCGraph         graph;
8783   PetscErrorCode      ierr;
8784 
8785   PetscFunctionBegin;
8786   /* attach interface graph for determining subsets */
8787   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
8788     IS       verticesIS,verticescomm;
8789     PetscInt vsize,*idxs;
8790 
8791     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8792     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
8793     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8794     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
8795     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8796     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8797     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
8798     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
8799     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
8800     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
8801     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
8802   } else {
8803     graph = pcbddc->mat_graph;
8804   }
8805   /* print some info */
8806   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
8807     IS       vertices;
8808     PetscInt nv,nedges,nfaces;
8809     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
8810     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8811     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
8812     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8813     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
8814     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
8815     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
8816     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
8817     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8818     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8819     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8820   }
8821 
8822   /* sub_schurs init */
8823   if (!pcbddc->sub_schurs) {
8824     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
8825   }
8826   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);
8827 
8828   /* free graph struct */
8829   if (pcbddc->sub_schurs_rebuild) {
8830     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
8831   }
8832   PetscFunctionReturn(0);
8833 }
8834 
8835 PetscErrorCode PCBDDCCheckOperator(PC pc)
8836 {
8837   PC_IS               *pcis=(PC_IS*)pc->data;
8838   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8839   PetscErrorCode      ierr;
8840 
8841   PetscFunctionBegin;
8842   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
8843     IS             zerodiag = NULL;
8844     Mat            S_j,B0_B=NULL;
8845     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
8846     PetscScalar    *p0_check,*array,*array2;
8847     PetscReal      norm;
8848     PetscInt       i;
8849 
8850     /* B0 and B0_B */
8851     if (zerodiag) {
8852       IS       dummy;
8853 
8854       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
8855       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
8856       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
8857       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8858     }
8859     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
8860     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
8861     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
8862     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8863     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8864     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8865     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8866     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
8867     /* S_j */
8868     ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8869     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8870 
8871     /* mimic vector in \widetilde{W}_\Gamma */
8872     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
8873     /* continuous in primal space */
8874     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
8875     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8876     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8877     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8878     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
8879     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
8880     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8881     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8882     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8883     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8884     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8885     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8886     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
8887     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
8888 
8889     /* assemble rhs for coarse problem */
8890     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
8891     /* local with Schur */
8892     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
8893     if (zerodiag) {
8894       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8895       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
8896       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8897       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
8898     }
8899     /* sum on primal nodes the local contributions */
8900     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8901     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8902     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8903     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8904     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
8905     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8906     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8907     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
8908     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8909     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8910     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8911     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8912     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8913     /* scale primal nodes (BDDC sums contibutions) */
8914     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
8915     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8916     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8917     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8918     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8919     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8920     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8921     /* global: \widetilde{B0}_B w_\Gamma */
8922     if (zerodiag) {
8923       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
8924       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8925       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
8926       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8927     }
8928     /* BDDC */
8929     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
8930     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
8931 
8932     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
8933     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
8934     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
8935     PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);
8936     for (i=0;i<pcbddc->benign_n;i++) {
8937       PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%d] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));
8938     }
8939     ierr = PetscFree(p0_check);CHKERRQ(ierr);
8940     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
8941     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
8942     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
8943     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8944     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
8945   }
8946   PetscFunctionReturn(0);
8947 }
8948 
8949 #include <../src/mat/impls/aij/mpi/mpiaij.h>
8950 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
8951 {
8952   Mat            At;
8953   IS             rows;
8954   PetscInt       rst,ren;
8955   PetscErrorCode ierr;
8956   PetscLayout    rmap;
8957 
8958   PetscFunctionBegin;
8959   rst = ren = 0;
8960   if (ccomm != MPI_COMM_NULL) {
8961     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
8962     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
8963     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
8964     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
8965     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
8966   }
8967   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
8968   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
8969   ierr = ISDestroy(&rows);CHKERRQ(ierr);
8970 
8971   if (ccomm != MPI_COMM_NULL) {
8972     Mat_MPIAIJ *a,*b;
8973     IS         from,to;
8974     Vec        gvec;
8975     PetscInt   lsize;
8976 
8977     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
8978     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
8979     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
8980     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
8981     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
8982     a    = (Mat_MPIAIJ*)At->data;
8983     b    = (Mat_MPIAIJ*)(*B)->data;
8984     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
8985     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
8986     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
8987     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
8988     b->A = a->A;
8989     b->B = a->B;
8990 
8991     b->donotstash      = a->donotstash;
8992     b->roworiented     = a->roworiented;
8993     b->rowindices      = 0;
8994     b->rowvalues       = 0;
8995     b->getrowactive    = PETSC_FALSE;
8996 
8997     (*B)->rmap         = rmap;
8998     (*B)->factortype   = A->factortype;
8999     (*B)->assembled    = PETSC_TRUE;
9000     (*B)->insertmode   = NOT_SET_VALUES;
9001     (*B)->preallocated = PETSC_TRUE;
9002 
9003     if (a->colmap) {
9004 #if defined(PETSC_USE_CTABLE)
9005       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
9006 #else
9007       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
9008       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9009       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9010 #endif
9011     } else b->colmap = 0;
9012     if (a->garray) {
9013       PetscInt len;
9014       len  = a->B->cmap->n;
9015       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
9016       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
9017       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
9018     } else b->garray = 0;
9019 
9020     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
9021     b->lvec = a->lvec;
9022     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
9023 
9024     /* cannot use VecScatterCopy */
9025     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
9026     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
9027     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
9028     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
9029     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
9030     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
9031     ierr = ISDestroy(&from);CHKERRQ(ierr);
9032     ierr = ISDestroy(&to);CHKERRQ(ierr);
9033     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
9034   }
9035   ierr = MatDestroy(&At);CHKERRQ(ierr);
9036   PetscFunctionReturn(0);
9037 }
9038