xref: /petsc/src/ksp/pc/impls/bddc/bddc.c (revision e1167bb9d4c93d6d15d1e8df66428f61aeb30d5f)
1 /* TODOLIST
2    DofSplitting and DM attached to pc?
3    Change SetNeumannBoundaries to SetNeumannBoundariesLocal and provide new SetNeumannBoundaries (same Dirichlet)
4      - change prec_type to switch_inexact_prec_type
5    Inexact solvers: global preconditioner application is ready, ask to developers (Jed?) on how to best implement Dohrmann's approach (PCSHELL?)
6    change how to deal with the coarse problem (PCBDDCSetCoarseEnvironment):
7      - simplify coarse problem structure -> PCBDDC or PCREDUDANT, nothing else -> same comm for all levels?
8      - remove coarse enums and allow use of PCBDDCGetCoarseKSP
9      - remove metis dependency -> use MatPartitioning for multilevel -> Assemble serial adjacency in ManageLocalBoundaries?
10    code refactoring:
11      - pick up better names for static functions
12    change options structure:
13      - insert BDDC into MG framework?
14    provide other ops? Ask to developers
15    remove all unused printf
16    man pages
17 */
18 
19 /* ----------------------------------------------------------------------------------------------------------------------------------------------
20    Implementation of BDDC preconditioner based on:
21    C. Dohrmann "An approximate BDDC preconditioner", Numerical Linear Algebra with Applications Volume 14, Issue 2, pages 149-168, March 2007
22    ---------------------------------------------------------------------------------------------------------------------------------------------- */
23 
24 #include "bddc.h" /*I "petscpc.h" I*/  /* includes for fortran wrappers */
25 #include <petscblaslapack.h>
26 /* -------------------------------------------------------------------------- */
27 #undef __FUNCT__
28 #define __FUNCT__ "PCSetFromOptions_BDDC"
29 PetscErrorCode PCSetFromOptions_BDDC(PC pc)
30 {
31   PC_BDDC         *pcbddc = (PC_BDDC*)pc->data;
32   PetscErrorCode ierr;
33 
34   PetscFunctionBegin;
35   ierr = PetscOptionsHead("BDDC options");CHKERRQ(ierr);
36   /* Verbose debugging of main data structures */
37   ierr = PetscOptionsBool("-pc_bddc_check_all"       ,"Verbose (debugging) output for PCBDDC"                       ,"none",pcbddc->dbg_flag      ,&pcbddc->dbg_flag      ,PETSC_NULL);CHKERRQ(ierr);
38   /* Some customization for default primal space */
39   ierr = PetscOptionsBool("-pc_bddc_vertices_only"   ,"Use only vertices in coarse space (i.e. discard constraints)","none",pcbddc->vertices_flag   ,&pcbddc->vertices_flag   ,PETSC_NULL);CHKERRQ(ierr);
40   ierr = PetscOptionsBool("-pc_bddc_constraints_only","Use only constraints in coarse space (i.e. discard vertices)","none",pcbddc->constraints_flag,&pcbddc->constraints_flag,PETSC_NULL);CHKERRQ(ierr);
41   ierr = PetscOptionsBool("-pc_bddc_faces_only"      ,"Use only faces among constraints of coarse space (i.e. discard edges)"         ,"none",pcbddc->faces_flag      ,&pcbddc->faces_flag      ,PETSC_NULL);CHKERRQ(ierr);
42   ierr = PetscOptionsBool("-pc_bddc_edges_only"      ,"Use only edges among constraints of coarse space (i.e. discard faces)"         ,"none",pcbddc->edges_flag      ,&pcbddc->edges_flag      ,PETSC_NULL);CHKERRQ(ierr);
43   /* Coarse solver context */
44   static const char * const avail_coarse_problems[] = {"sequential","replicated","parallel","multilevel","CoarseProblemType","PC_BDDC_",0}; /*order of choiches depends on ENUM defined in bddc.h */
45   ierr = PetscOptionsEnum("-pc_bddc_coarse_problem_type","Set coarse problem type","none",avail_coarse_problems,(PetscEnum)pcbddc->coarse_problem_type,(PetscEnum*)&pcbddc->coarse_problem_type,PETSC_NULL);CHKERRQ(ierr);
46   /* Two different application of BDDC to the whole set of dofs, internal and interface */
47   ierr = PetscOptionsBool("-pc_bddc_switch_preconditioning_type","Switch between M_2 (default) and M_3 preconditioners (as defined by Dohrmann)","none",pcbddc->prec_type,&pcbddc->prec_type,PETSC_NULL);CHKERRQ(ierr);
48   ierr = PetscOptionsBool("-pc_bddc_use_change_of_basis","Use change of basis approach for primal space","none",pcbddc->usechangeofbasis,&pcbddc->usechangeofbasis,PETSC_NULL);CHKERRQ(ierr);
49   ierr = PetscOptionsBool("-pc_bddc_use_change_on_faces","Use change of basis approach for face constraints","none",pcbddc->usechangeonfaces,&pcbddc->usechangeonfaces,PETSC_NULL);CHKERRQ(ierr);
50   pcbddc->usechangeonfaces = pcbddc->usechangeonfaces && pcbddc->usechangeofbasis;
51   ierr = PetscOptionsInt("-pc_bddc_coarsening_ratio","Set coarsening ratio used in multilevel coarsening","none",pcbddc->coarsening_ratio,&pcbddc->coarsening_ratio,PETSC_NULL);CHKERRQ(ierr);
52   ierr = PetscOptionsInt("-pc_bddc_max_levels","Set maximum number of levels for multilevel","none",pcbddc->max_levels,&pcbddc->max_levels,PETSC_NULL);CHKERRQ(ierr);
53   ierr = PetscOptionsTail();CHKERRQ(ierr);
54   PetscFunctionReturn(0);
55 }
56 /* -------------------------------------------------------------------------- */
57 EXTERN_C_BEGIN
58 #undef __FUNCT__
59 #define __FUNCT__ "PCBDDCSetCoarseProblemType_BDDC"
60 static PetscErrorCode PCBDDCSetCoarseProblemType_BDDC(PC pc, CoarseProblemType CPT)
61 {
62   PC_BDDC  *pcbddc = (PC_BDDC*)pc->data;
63 
64   PetscFunctionBegin;
65   pcbddc->coarse_problem_type = CPT;
66   PetscFunctionReturn(0);
67 }
68 EXTERN_C_END
69 #undef __FUNCT__
70 #define __FUNCT__ "PCBDDCSetCoarseProblemType"
71 /*@
72  PCBDDCSetCoarseProblemType - Set coarse problem type in PCBDDC.
73 
74    Not collective
75 
76    Input Parameters:
77 +  pc - the preconditioning context
78 -  CoarseProblemType - pick a better name and explain what this is
79 
80    Level: intermediate
81 
82    Notes:
83    Not collective but all procs must call with same arguments.
84 
85 .seealso: PCBDDC
86 @*/
87 PetscErrorCode PCBDDCSetCoarseProblemType(PC pc, CoarseProblemType CPT)
88 {
89   PetscErrorCode ierr;
90 
91   PetscFunctionBegin;
92   PetscValidHeaderSpecific(pc,PC_CLASSID,1);
93   ierr = PetscTryMethod(pc,"PCBDDCSetCoarseProblemType_C",(PC,CoarseProblemType),(pc,CPT));CHKERRQ(ierr);
94   PetscFunctionReturn(0);
95 }
96 /* -------------------------------------------------------------------------- */
97 EXTERN_C_BEGIN
98 #undef __FUNCT__
99 #define __FUNCT__ "PCBDDCSetCoarseningRatio_BDDC"
100 static PetscErrorCode PCBDDCSetCoarseningRatio_BDDC(PC pc,PetscInt k)
101 {
102   PC_BDDC  *pcbddc = (PC_BDDC*)pc->data;
103 
104   PetscFunctionBegin;
105   pcbddc->coarsening_ratio=k;
106   PetscFunctionReturn(0);
107 }
108 EXTERN_C_END
109 #undef __FUNCT__
110 #define __FUNCT__ "PCBDDCSetCoarseningRatio"
111 /*@
112  PCBDDCSetCoarseningRatio - Set coarsening ratio used in multilevel coarsening
113 
114    Logically collective on PC
115 
116    Input Parameters:
117 +  pc - the preconditioning context
118 -  k - coarsening ratio
119 
120    Approximatively k subdomains at the finer level will be aggregated into a single subdomain at the coarser level.
121 
122    Level: intermediate
123 
124    Notes:
125 
126 .seealso: PCBDDC
127 @*/
128 PetscErrorCode PCBDDCSetCoarseningRatio(PC pc,PetscInt k)
129 {
130   PetscErrorCode ierr;
131 
132   PetscFunctionBegin;
133   PetscValidHeaderSpecific(pc,PC_CLASSID,1);
134   ierr = PetscTryMethod(pc,"PCBDDCSetCoarseningRatio_C",(PC,PetscInt),(pc,k));CHKERRQ(ierr);
135   PetscFunctionReturn(0);
136 }
137 /* -------------------------------------------------------------------------- */
138 EXTERN_C_BEGIN
139 #undef __FUNCT__
140 #define __FUNCT__ "PCBDDCSetMaxLevels_BDDC"
141 static PetscErrorCode PCBDDCSetMaxLevels_BDDC(PC pc,PetscInt max_levels)
142 {
143   PC_BDDC  *pcbddc = (PC_BDDC*)pc->data;
144 
145   PetscFunctionBegin;
146   pcbddc->max_levels=max_levels;
147   PetscFunctionReturn(0);
148 }
149 EXTERN_C_END
150 #undef __FUNCT__
151 #define __FUNCT__ "PCBDDCSetMaxLevels"
152 /*@
153  PCBDDCSetMaxLevels - Sets the maximum number of levels within the multilevel approach.
154 
155    Logically collective on PC
156 
157    Input Parameters:
158 +  pc - the preconditioning context
159 -  max_levels - the maximum number of levels
160 
161    Default value is 1, i.e. coarse problem will be solved inexactly with one application
162    of PCBDDC preconditioner if the multilevel approach is requested.
163 
164    Level: intermediate
165 
166    Notes:
167 
168 .seealso: PCBDDC
169 @*/
170 PetscErrorCode PCBDDCSetMaxLevels(PC pc,PetscInt max_levels)
171 {
172   PetscErrorCode ierr;
173 
174   PetscFunctionBegin;
175   PetscValidHeaderSpecific(pc,PC_CLASSID,1);
176   ierr = PetscTryMethod(pc,"PCBDDCSetMaxLevels_C",(PC,PetscInt),(pc,max_levels));CHKERRQ(ierr);
177   PetscFunctionReturn(0);
178 }
179 /* -------------------------------------------------------------------------- */
180 EXTERN_C_BEGIN
181 #undef __FUNCT__
182 #define __FUNCT__ "PCBDDCSetNullSpace_BDDC"
183 static PetscErrorCode PCBDDCSetNullSpace_BDDC(PC pc,MatNullSpace NullSpace)
184 {
185   PC_BDDC  *pcbddc = (PC_BDDC*)pc->data;
186   PetscErrorCode ierr;
187 
188   PetscFunctionBegin;
189   ierr = PetscObjectReference((PetscObject)NullSpace);CHKERRQ(ierr);
190   ierr = MatNullSpaceDestroy(&pcbddc->NullSpace);CHKERRQ(ierr);
191   pcbddc->NullSpace=NullSpace;
192   PetscFunctionReturn(0);
193 }
194 EXTERN_C_END
195 #undef __FUNCT__
196 #define __FUNCT__ "PCBDDCSetNullSpace"
197 /*@
198  PCBDDCSetNullSpace - Set NullSpace of global operator of BDDC preconditioned mat.
199 
200    Logically collective on PC and MatNullSpace
201 
202    Input Parameters:
203 +  pc - the preconditioning context
204 -  NullSpace - Null space of the linear operator to be preconditioned.
205 
206    Level: intermediate
207 
208    Notes:
209 
210 .seealso: PCBDDC
211 @*/
212 PetscErrorCode PCBDDCSetNullSpace(PC pc,MatNullSpace NullSpace)
213 {
214   PetscErrorCode ierr;
215 
216   PetscFunctionBegin;
217   PetscValidHeaderSpecific(pc,PC_CLASSID,1);
218   ierr = PetscTryMethod(pc,"PCBDDCSetNullSpace_C",(PC,MatNullSpace),(pc,NullSpace));CHKERRQ(ierr);
219   PetscFunctionReturn(0);
220 }
221 /* -------------------------------------------------------------------------- */
222 EXTERN_C_BEGIN
223 #undef __FUNCT__
224 #define __FUNCT__ "PCBDDCSetDirichletBoundaries_BDDC"
225 static PetscErrorCode PCBDDCSetDirichletBoundaries_BDDC(PC pc,IS DirichletBoundaries)
226 {
227   PC_BDDC  *pcbddc = (PC_BDDC*)pc->data;
228   PetscErrorCode ierr;
229 
230   PetscFunctionBegin;
231   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
232   ierr = PetscObjectReference((PetscObject)DirichletBoundaries);CHKERRQ(ierr);
233   pcbddc->DirichletBoundaries=DirichletBoundaries;
234   PetscFunctionReturn(0);
235 }
236 EXTERN_C_END
237 #undef __FUNCT__
238 #define __FUNCT__ "PCBDDCSetDirichletBoundaries"
239 /*@
240  PCBDDCSetDirichletBoundaries - Set index set defining subdomain part (in local ordering)
241                               of Dirichlet boundaries for the global problem.
242 
243    Not collective
244 
245    Input Parameters:
246 +  pc - the preconditioning context
247 -  DirichletBoundaries - sequential index set defining the subdomain part of Dirichlet boundaries (can be PETSC_NULL)
248 
249    Level: intermediate
250 
251    Notes:
252 
253 .seealso: PCBDDC
254 @*/
255 PetscErrorCode PCBDDCSetDirichletBoundaries(PC pc,IS DirichletBoundaries)
256 {
257   PetscErrorCode ierr;
258 
259   PetscFunctionBegin;
260   PetscValidHeaderSpecific(pc,PC_CLASSID,1);
261   ierr = PetscTryMethod(pc,"PCBDDCSetDirichletBoundaries_C",(PC,IS),(pc,DirichletBoundaries));CHKERRQ(ierr);
262   PetscFunctionReturn(0);
263 }
264 /* -------------------------------------------------------------------------- */
265 EXTERN_C_BEGIN
266 #undef __FUNCT__
267 #define __FUNCT__ "PCBDDCSetNeumannBoundaries_BDDC"
268 static PetscErrorCode PCBDDCSetNeumannBoundaries_BDDC(PC pc,IS NeumannBoundaries)
269 {
270   PC_BDDC  *pcbddc = (PC_BDDC*)pc->data;
271   PetscErrorCode ierr;
272 
273   PetscFunctionBegin;
274   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
275   ierr = PetscObjectReference((PetscObject)NeumannBoundaries);CHKERRQ(ierr);
276   pcbddc->NeumannBoundaries=NeumannBoundaries;
277   PetscFunctionReturn(0);
278 }
279 EXTERN_C_END
280 #undef __FUNCT__
281 #define __FUNCT__ "PCBDDCSetNeumannBoundaries"
282 /*@
283  PCBDDCSetNeumannBoundaries - Set index set defining subdomain part (in local ordering)
284                               of Neumann boundaries for the global problem.
285 
286    Not collective
287 
288    Input Parameters:
289 +  pc - the preconditioning context
290 -  NeumannBoundaries - sequential index set defining the subdomain part of Neumann boundaries (can be PETSC_NULL)
291 
292    Level: intermediate
293 
294    Notes:
295 
296 .seealso: PCBDDC
297 @*/
298 PetscErrorCode PCBDDCSetNeumannBoundaries(PC pc,IS NeumannBoundaries)
299 {
300   PetscErrorCode ierr;
301 
302   PetscFunctionBegin;
303   PetscValidHeaderSpecific(pc,PC_CLASSID,1);
304   ierr = PetscTryMethod(pc,"PCBDDCSetNeumannBoundaries_C",(PC,IS),(pc,NeumannBoundaries));CHKERRQ(ierr);
305   PetscFunctionReturn(0);
306 }
307 /* -------------------------------------------------------------------------- */
308 EXTERN_C_BEGIN
309 #undef __FUNCT__
310 #define __FUNCT__ "PCBDDCGetDirichletBoundaries_BDDC"
311 static PetscErrorCode PCBDDCGetDirichletBoundaries_BDDC(PC pc,IS *DirichletBoundaries)
312 {
313   PC_BDDC  *pcbddc = (PC_BDDC*)pc->data;
314 
315   PetscFunctionBegin;
316   *DirichletBoundaries = pcbddc->DirichletBoundaries;
317   PetscFunctionReturn(0);
318 }
319 EXTERN_C_END
320 #undef __FUNCT__
321 #define __FUNCT__ "PCBDDCGetDirichletBoundaries"
322 /*@
323  PCBDDCGetDirichletBoundaries - Get index set defining subdomain part (in local ordering)
324                                 of Dirichlet boundaries for the global problem.
325 
326    Not collective
327 
328    Input Parameters:
329 +  pc - the preconditioning context
330 
331    Output Parameters:
332 +  DirichletBoundaries - index set defining the subdomain part of Dirichlet boundaries
333 
334    Level: intermediate
335 
336    Notes:
337 
338 .seealso: PCBDDC
339 @*/
340 PetscErrorCode PCBDDCGetDirichletBoundaries(PC pc,IS *DirichletBoundaries)
341 {
342   PetscErrorCode ierr;
343 
344   PetscFunctionBegin;
345   PetscValidHeaderSpecific(pc,PC_CLASSID,1);
346   ierr = PetscUseMethod(pc,"PCBDDCGetDirichletBoundaries_C",(PC,IS*),(pc,DirichletBoundaries));CHKERRQ(ierr);
347   PetscFunctionReturn(0);
348 }
349 /* -------------------------------------------------------------------------- */
350 EXTERN_C_BEGIN
351 #undef __FUNCT__
352 #define __FUNCT__ "PCBDDCGetNeumannBoundaries_BDDC"
353 static PetscErrorCode PCBDDCGetNeumannBoundaries_BDDC(PC pc,IS *NeumannBoundaries)
354 {
355   PC_BDDC  *pcbddc = (PC_BDDC*)pc->data;
356 
357   PetscFunctionBegin;
358   *NeumannBoundaries = pcbddc->NeumannBoundaries;
359   PetscFunctionReturn(0);
360 }
361 EXTERN_C_END
362 #undef __FUNCT__
363 #define __FUNCT__ "PCBDDCGetNeumannBoundaries"
364 /*@
365  PCBDDCGetNeumannBoundaries - Get index set defining subdomain part (in local ordering)
366                               of Neumann boundaries for the global problem.
367 
368    Not collective
369 
370    Input Parameters:
371 +  pc - the preconditioning context
372 
373    Output Parameters:
374 +  NeumannBoundaries - index set defining the subdomain part of Neumann boundaries
375 
376    Level: intermediate
377 
378    Notes:
379 
380 .seealso: PCBDDC
381 @*/
382 PetscErrorCode PCBDDCGetNeumannBoundaries(PC pc,IS *NeumannBoundaries)
383 {
384   PetscErrorCode ierr;
385 
386   PetscFunctionBegin;
387   PetscValidHeaderSpecific(pc,PC_CLASSID,1);
388   ierr = PetscUseMethod(pc,"PCBDDCGetNeumannBoundaries_C",(PC,IS*),(pc,NeumannBoundaries));CHKERRQ(ierr);
389   PetscFunctionReturn(0);
390 }
391 /* -------------------------------------------------------------------------- */
392 EXTERN_C_BEGIN
393 #undef __FUNCT__
394 #define __FUNCT__ "PCBDDCSetLocalAdjacencyGraph_BDDC"
395 static PetscErrorCode PCBDDCSetLocalAdjacencyGraph_BDDC(PC pc, PetscInt nvtxs, PetscInt xadj[], PetscInt adjncy[], PetscCopyMode copymode)
396 {
397   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
398   PCBDDCGraph    mat_graph=pcbddc->mat_graph;
399   PetscErrorCode ierr;
400 
401   PetscFunctionBegin;
402   mat_graph->nvtxs=nvtxs;
403   ierr = PetscFree(mat_graph->xadj);CHKERRQ(ierr);
404   ierr = PetscFree(mat_graph->adjncy);CHKERRQ(ierr);
405   if (copymode == PETSC_COPY_VALUES) {
406     ierr = PetscMalloc((mat_graph->nvtxs+1)*sizeof(PetscInt),&mat_graph->xadj);CHKERRQ(ierr);
407     ierr = PetscMalloc(xadj[mat_graph->nvtxs]*sizeof(PetscInt),&mat_graph->adjncy);CHKERRQ(ierr);
408     ierr = PetscMemcpy(mat_graph->xadj,xadj,(mat_graph->nvtxs+1)*sizeof(PetscInt));CHKERRQ(ierr);
409     ierr = PetscMemcpy(mat_graph->adjncy,adjncy,xadj[mat_graph->nvtxs]*sizeof(PetscInt));CHKERRQ(ierr);
410   } else if (copymode == PETSC_OWN_POINTER) {
411     mat_graph->xadj=xadj;
412     mat_graph->adjncy=adjncy;
413   } else {
414     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unsupported copy mode %d in %s\n",copymode,__FUNCT__);
415   }
416   PetscFunctionReturn(0);
417 }
418 EXTERN_C_END
419 #undef __FUNCT__
420 #define __FUNCT__ "PCBDDCSetLocalAdjacencyGraph"
421 /*@
422  PCBDDCSetLocalAdjacencyGraph - Set CSR graph of local matrix for use of PCBDDC.
423 
424    Not collective
425 
426    Input Parameters:
427 +  pc - the preconditioning context
428 -  nvtxs - number of local vertices of the graph
429 -  xadj, adjncy - the CSR graph
430 -  copymode - either PETSC_COPY_VALUES or PETSC_OWN_POINTER. In the former case the user must free the array passed in;
431                                                              in the latter case, memory must be obtained with PetscMalloc.
432 
433    Level: intermediate
434 
435    Notes:
436 
437 .seealso: PCBDDC
438 @*/
439 PetscErrorCode PCBDDCSetLocalAdjacencyGraph(PC pc,PetscInt nvtxs,PetscInt xadj[],PetscInt adjncy[], PetscCopyMode copymode)
440 {
441   PetscInt       nrows,ncols;
442   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
443   PetscErrorCode ierr;
444 
445   PetscFunctionBegin;
446   PetscValidHeaderSpecific(pc,PC_CLASSID,1);
447   ierr = MatGetSize(matis->A,&nrows,&ncols);CHKERRQ(ierr);
448   if (nvtxs != nrows) {
449     SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Local adjacency size %d passed in %s differs from local problem size %d!\n",nvtxs,__FUNCT__,nrows);
450   } else {
451     ierr = PetscTryMethod(pc,"PCBDDCSetLocalAdjacencyGraph_C",(PC,PetscInt,PetscInt[],PetscInt[],PetscCopyMode),(pc,nvtxs,xadj,adjncy,copymode));CHKERRQ(ierr);
452   }
453   PetscFunctionReturn(0);
454 }
455 /* -------------------------------------------------------------------------- */
456 EXTERN_C_BEGIN
457 #undef __FUNCT__
458 #define __FUNCT__ "PCBDDCSetDofsSplitting_BDDC"
459 static PetscErrorCode PCBDDCSetDofsSplitting_BDDC(PC pc,PetscInt n_is, IS ISForDofs[])
460 {
461   PC_BDDC  *pcbddc = (PC_BDDC*)pc->data;
462   PetscInt i;
463   PetscErrorCode ierr;
464 
465   PetscFunctionBegin;
466   /* Destroy ISes if they were already set */
467   for (i=0;i<pcbddc->n_ISForDofs;i++) {
468     ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
469   }
470   ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
471   /* allocate space then set */
472   ierr = PetscMalloc(n_is*sizeof(IS),&pcbddc->ISForDofs);CHKERRQ(ierr);
473   for (i=0;i<n_is;i++) {
474     ierr = PetscObjectReference((PetscObject)ISForDofs[i]);CHKERRQ(ierr);
475     pcbddc->ISForDofs[i]=ISForDofs[i];
476   }
477   pcbddc->n_ISForDofs=n_is;
478   PetscFunctionReturn(0);
479 }
480 EXTERN_C_END
481 #undef __FUNCT__
482 #define __FUNCT__ "PCBDDCSetDofsSplitting"
483 /*@
484  PCBDDCSetDofsSplitting - Set index sets defining fields of local mat.
485 
486    Not collective
487 
488    Input Parameters:
489 +  pc - the preconditioning context
490 -  n - number of index sets defining the fields
491 -  IS[] - array of IS describing the fields
492 
493    Level: intermediate
494 
495    Notes:
496 
497 .seealso: PCBDDC
498 @*/
499 PetscErrorCode PCBDDCSetDofsSplitting(PC pc,PetscInt n_is, IS ISForDofs[])
500 {
501   PetscErrorCode ierr;
502 
503   PetscFunctionBegin;
504   PetscValidHeaderSpecific(pc,PC_CLASSID,1);
505   ierr = PetscTryMethod(pc,"PCBDDCSetDofsSplitting_C",(PC,PetscInt,IS[]),(pc,n_is,ISForDofs));CHKERRQ(ierr);
506   PetscFunctionReturn(0);
507 }
508 /* -------------------------------------------------------------------------- */
509 #undef __FUNCT__
510 #define __FUNCT__ "PCPreSolve_BDDC"
511 /* -------------------------------------------------------------------------- */
512 /*
513    PCPreSolve_BDDC - Changes the right hand side and (if necessary) the initial
514                      guess if a transformation of basis approach has been selected.
515 
516    Input Parameter:
517 +  pc - the preconditioner contex
518 
519    Application Interface Routine: PCPreSolve()
520 
521    Notes:
522    The interface routine PCPreSolve() is not usually called directly by
523    the user, but instead is called by KSPSolve().
524 */
525 static PetscErrorCode PCPreSolve_BDDC(PC pc, KSP ksp, Vec rhs, Vec x)
526 {
527   PetscErrorCode ierr;
528   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
529   PC_IS          *pcis = (PC_IS*)(pc->data);
530   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
531   Mat            temp_mat;
532   IS             dirIS;
533   PetscInt       dirsize,i,*is_indices;
534   PetscScalar    *array_x,*array_diagonal;
535   Vec            used_vec;
536   PetscBool      guess_nonzero;
537 
538   PetscFunctionBegin;
539   if (x) {
540     ierr = PetscObjectReference((PetscObject)x);CHKERRQ(ierr);
541     used_vec = x;
542   } else {
543     ierr = PetscObjectReference((PetscObject)pcbddc->temp_solution);CHKERRQ(ierr);
544     used_vec = pcbddc->temp_solution;
545     ierr = VecSet(used_vec,0.0);CHKERRQ(ierr);
546   }
547   /* hack into ksp data structure PCPreSolve comes earlier in src/ksp/ksp/interface/itfunc.c */
548   if (ksp) {
549     ierr = KSPGetInitialGuessNonzero(ksp,&guess_nonzero);CHKERRQ(ierr);
550     if ( !guess_nonzero ) {
551       ierr = VecSet(used_vec,0.0);CHKERRQ(ierr);
552     }
553   }
554   /* store the original rhs */
555   ierr = VecCopy(rhs,pcbddc->original_rhs);CHKERRQ(ierr);
556 
557   /* Take into account zeroed rows -> change rhs and store solution removed */
558   ierr = MatGetDiagonal(pc->pmat,pcis->vec1_global);CHKERRQ(ierr);
559   ierr = VecPointwiseDivide(pcis->vec1_global,rhs,pcis->vec1_global);CHKERRQ(ierr);
560   ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
561   ierr = VecScatterEnd  (matis->ctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
562   ierr = VecScatterBegin(matis->ctx,used_vec,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
563   ierr = VecScatterEnd  (matis->ctx,used_vec,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
564   ierr = PCBDDCGetDirichletBoundaries(pc,&dirIS);CHKERRQ(ierr);
565   if (dirIS) {
566     ierr = ISGetSize(dirIS,&dirsize);CHKERRQ(ierr);
567     ierr = VecGetArray(pcis->vec1_N,&array_x);CHKERRQ(ierr);
568     ierr = VecGetArray(pcis->vec2_N,&array_diagonal);CHKERRQ(ierr);
569     ierr = ISGetIndices(dirIS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
570     for (i=0;i<dirsize;i++) {
571       array_x[is_indices[i]]=array_diagonal[is_indices[i]];
572     }
573     ierr = ISRestoreIndices(dirIS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
574     ierr = VecRestoreArray(pcis->vec2_N,&array_diagonal);CHKERRQ(ierr);
575     ierr = VecRestoreArray(pcis->vec1_N,&array_x);CHKERRQ(ierr);
576   }
577   ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,used_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
578   ierr = VecScatterEnd  (matis->ctx,pcis->vec1_N,used_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
579 
580   /* remove the computed solution from the rhs */
581   ierr = VecScale(used_vec,-1.0);CHKERRQ(ierr);
582   ierr = MatMultAdd(pc->pmat,used_vec,rhs,rhs);CHKERRQ(ierr);
583   ierr = VecScale(used_vec,-1.0);CHKERRQ(ierr);
584 
585   /* store partially computed solution and set initial guess */
586   if (x) {
587     ierr = VecCopy(used_vec,pcbddc->temp_solution);CHKERRQ(ierr);
588     ierr = VecSet(used_vec,0.0);CHKERRQ(ierr);
589     if (pcbddc->use_exact_dirichlet) {
590       ierr = VecScatterBegin(pcis->global_to_D,rhs,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
591       ierr = VecScatterEnd  (pcis->global_to_D,rhs,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
592       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
593       ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,used_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
594       ierr = VecScatterEnd  (pcis->global_to_D,pcis->vec2_D,used_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
595       if (ksp) {
596         ierr = KSPSetInitialGuessNonzero(ksp,PETSC_TRUE);CHKERRQ(ierr);
597       }
598     }
599   }
600 
601   /* rhs change of basis */
602   if (pcbddc->usechangeofbasis) {
603     /* swap pointers for local matrices */
604     temp_mat = matis->A;
605     matis->A = pcbddc->local_mat;
606     pcbddc->local_mat = temp_mat;
607     /* Get local rhs and apply transformation of basis */
608     ierr = VecScatterBegin(pcis->global_to_B,rhs,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
609     ierr = VecScatterEnd  (pcis->global_to_B,rhs,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
610     /* from original basis to modified basis */
611     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
612     /* put back modified values into the global vec using INSERT_VALUES copy mode */
613     ierr = VecScatterBegin(pcis->global_to_B,pcis->vec2_B,rhs,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
614     ierr = VecScatterEnd  (pcis->global_to_B,pcis->vec2_B,rhs,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
615     if (ksp && pcbddc->NullSpace) {
616       ierr = MatNullSpaceRemove(pcbddc->NullSpace,used_vec,PETSC_NULL);CHKERRQ(ierr);
617       ierr = MatNullSpaceRemove(pcbddc->NullSpace,rhs,PETSC_NULL);CHKERRQ(ierr);
618     }
619   }
620   ierr = VecDestroy(&used_vec);CHKERRQ(ierr);
621   PetscFunctionReturn(0);
622 }
623 /* -------------------------------------------------------------------------- */
624 #undef __FUNCT__
625 #define __FUNCT__ "PCPostSolve_BDDC"
626 /* -------------------------------------------------------------------------- */
627 /*
628    PCPostSolve_BDDC - Changes the computed solution if a transformation of basis
629                      approach has been selected. Also, restores rhs to its original state.
630 
631    Input Parameter:
632 +  pc - the preconditioner contex
633 
634    Application Interface Routine: PCPostSolve()
635 
636    Notes:
637    The interface routine PCPostSolve() is not usually called directly by
638    the user, but instead is called by KSPSolve().
639 */
640 static PetscErrorCode PCPostSolve_BDDC(PC pc, KSP ksp, Vec rhs, Vec x)
641 {
642   PetscErrorCode ierr;
643   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
644   PC_IS          *pcis = (PC_IS*)(pc->data);
645   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
646   Mat            temp_mat;
647 
648   PetscFunctionBegin;
649   if (pcbddc->usechangeofbasis) {
650     /* swap pointers for local matrices */
651     temp_mat = matis->A;
652     matis->A = pcbddc->local_mat;
653     pcbddc->local_mat = temp_mat;
654     /* restore rhs to its original state */
655     if (rhs) {
656       ierr = VecCopy(pcbddc->original_rhs,rhs);CHKERRQ(ierr);
657     }
658     /* Get Local boundary and apply transformation of basis to solution vector */
659     ierr = VecScatterBegin(pcis->global_to_B,x,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
660     ierr = VecScatterEnd  (pcis->global_to_B,x,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
661     /* from modified basis to original basis */
662     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
663     /* put back modified values into the global vec using INSERT_VALUES copy mode */
664     ierr = VecScatterBegin(pcis->global_to_B,pcis->vec2_B,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
665     ierr = VecScatterEnd  (pcis->global_to_B,pcis->vec2_B,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
666   }
667   /* add solution removed in presolve */
668   if (x) {
669     ierr = VecAXPY(x,1.0,pcbddc->temp_solution);CHKERRQ(ierr);
670   }
671   PetscFunctionReturn(0);
672 }
673 /* -------------------------------------------------------------------------- */
674 #undef __FUNCT__
675 #define __FUNCT__ "PCSetUp_BDDC"
676 /* -------------------------------------------------------------------------- */
677 /*
678    PCSetUp_BDDC - Prepares for the use of the BDDC preconditioner
679                   by setting data structures and options.
680 
681    Input Parameter:
682 +  pc - the preconditioner context
683 
684    Application Interface Routine: PCSetUp()
685 
686    Notes:
687    The interface routine PCSetUp() is not usually called directly by
688    the user, but instead is called by PCApply() if necessary.
689 */
690 PetscErrorCode PCSetUp_BDDC(PC pc)
691 {
692   PetscErrorCode ierr;
693   PC_BDDC*       pcbddc   = (PC_BDDC*)pc->data;
694 
695   PetscFunctionBegin;
696   if (!pc->setupcalled) {
697     /* For BDDC we need to define a local "Neumann" problem different to that defined in PCISSetup
698        So, we set to pcnone the Neumann problem of pcis in order to avoid unneeded computation
699        Also, we decide to directly build the (same) Dirichlet problem */
700     ierr = PetscOptionsSetValue("-is_localN_pc_type","none");CHKERRQ(ierr);
701     ierr = PetscOptionsSetValue("-is_localD_pc_type","none");CHKERRQ(ierr);
702     /* Set up all the "iterative substructuring" common block */
703 
704     ierr = PCISSetUp(pc);CHKERRQ(ierr);
705     /* Get stdout for dbg */
706     if (pcbddc->dbg_flag) {
707       ierr = PetscViewerASCIIGetStdout(((PetscObject)pc)->comm,&pcbddc->dbg_viewer);CHKERRQ(ierr);
708       ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
709     }
710     /* Analyze local interface */
711     ierr = PCBDDCManageLocalBoundaries(pc);CHKERRQ(ierr);
712     /* Set up local constraint matrix */
713     ierr = PCBDDCCreateConstraintMatrix(pc);CHKERRQ(ierr);
714     /* Create coarse and local stuffs used for evaluating action of preconditioner */
715     ierr = PCBDDCCoarseSetUp(pc);CHKERRQ(ierr);
716   }
717   PetscFunctionReturn(0);
718 }
719 
720 /* -------------------------------------------------------------------------- */
721 /*
722    PCApply_BDDC - Applies the BDDC preconditioner to a vector.
723 
724    Input Parameters:
725 .  pc - the preconditioner context
726 .  r - input vector (global)
727 
728    Output Parameter:
729 .  z - output vector (global)
730 
731    Application Interface Routine: PCApply()
732  */
733 #undef __FUNCT__
734 #define __FUNCT__ "PCApply_BDDC"
735 PetscErrorCode PCApply_BDDC(PC pc,Vec r,Vec z)
736 {
737   PC_IS             *pcis = (PC_IS*)(pc->data);
738   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
739   PetscErrorCode    ierr;
740   const PetscScalar one = 1.0;
741   const PetscScalar m_one = -1.0;
742   const PetscScalar zero = 0.0;
743 
744 /* This code is similar to that provided in nn.c for PCNN
745    NN interface preconditioner changed to BDDC
746    Added support for M_3 preconditioenr in the reference article (code is active if pcbddc->prec_type = PETSC_TRUE) */
747 
748   PetscFunctionBegin;
749   if (!pcbddc->use_exact_dirichlet) {
750     /* First Dirichlet solve */
751     ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
752     ierr = VecScatterEnd  (pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
753     ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
754     /*
755       Assembling right hand side for BDDC operator
756       - vec1_D for the Dirichlet part (if needed, i.e. prec_flag=PETSC_TRUE)
757       - the interface part of the global vector z
758     */
759     ierr = VecScale(pcis->vec2_D,m_one);CHKERRQ(ierr);
760     ierr = MatMult(pcis->A_BI,pcis->vec2_D,pcis->vec1_B);CHKERRQ(ierr);
761     if (pcbddc->prec_type) { ierr = MatMultAdd(pcis->A_II,pcis->vec2_D,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
762     ierr = VecScale(pcis->vec2_D,m_one);CHKERRQ(ierr);
763     ierr = VecCopy(r,z);CHKERRQ(ierr);
764     ierr = VecScatterBegin(pcis->global_to_B,pcis->vec1_B,z,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
765     ierr = VecScatterEnd  (pcis->global_to_B,pcis->vec1_B,z,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
766     ierr = VecScatterBegin(pcis->global_to_B,z,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
767     ierr = VecScatterEnd  (pcis->global_to_B,z,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
768   } else {
769     ierr = VecScatterBegin(pcis->global_to_B,r,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
770     ierr = VecScatterEnd  (pcis->global_to_B,r,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
771     ierr = VecSet(pcis->vec1_D,zero);CHKERRQ(ierr);
772     ierr = VecSet(pcis->vec2_D,zero);CHKERRQ(ierr);
773   }
774 
775   /* Apply partition of unity */
776   ierr = VecPointwiseMult(pcis->vec1_B,pcis->D,pcis->vec1_B);CHKERRQ(ierr);
777 
778   /* Apply interface preconditioner
779      input/output vecs: pcis->vec1_B and pcis->vec1_D */
780   ierr = PCBDDCApplyInterfacePreconditioner(pc);CHKERRQ(ierr);
781 
782   /* Apply partition of unity and sum boundary values */
783   ierr = VecPointwiseMult(pcis->vec1_B,pcis->D,pcis->vec1_B);CHKERRQ(ierr);
784   ierr = VecSet(z,zero);CHKERRQ(ierr);
785   ierr = VecScatterBegin(pcis->global_to_B,pcis->vec1_B,z,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
786   ierr = VecScatterEnd  (pcis->global_to_B,pcis->vec1_B,z,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
787 
788   /* Second Dirichlet solve and assembling of output */
789   ierr = VecScatterBegin(pcis->global_to_B,z,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
790   ierr = VecScatterEnd  (pcis->global_to_B,z,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
791   ierr = MatMult(pcis->A_IB,pcis->vec1_B,pcis->vec3_D);CHKERRQ(ierr);
792   if (pcbddc->prec_type) { ierr = MatMultAdd(pcis->A_II,pcis->vec1_D,pcis->vec3_D,pcis->vec3_D);CHKERRQ(ierr); }
793   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec3_D,pcbddc->vec4_D);CHKERRQ(ierr);
794   ierr = VecScale(pcbddc->vec4_D,m_one);CHKERRQ(ierr);
795   if (pcbddc->prec_type) { ierr = VecAXPY (pcbddc->vec4_D,one,pcis->vec1_D);CHKERRQ(ierr); }
796   ierr = VecAXPY (pcis->vec2_D,one,pcbddc->vec4_D);CHKERRQ(ierr);
797   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
798   ierr = VecScatterEnd  (pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
799   PetscFunctionReturn(0);
800 
801 }
802 /* -------------------------------------------------------------------------- */
803 #undef __FUNCT__
804 #define __FUNCT__ "PCDestroy_BDDC"
805 PetscErrorCode PCDestroy_BDDC(PC pc)
806 {
807   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
808   PetscInt       i;
809   PetscErrorCode ierr;
810 
811   PetscFunctionBegin;
812   /* free data created by PCIS */
813   ierr = PCISDestroy(pc);CHKERRQ(ierr);
814   /* free BDDC data  */
815   ierr = MatNullSpaceDestroy(&pcbddc->CoarseNullSpace);CHKERRQ(ierr);
816   ierr = MatNullSpaceDestroy(&pcbddc->NullSpace);CHKERRQ(ierr);
817   ierr = VecDestroy(&pcbddc->temp_solution);CHKERRQ(ierr);
818   ierr = VecDestroy(&pcbddc->original_rhs);CHKERRQ(ierr);
819   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
820   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
821   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
822   ierr = VecDestroy(&pcbddc->coarse_rhs);CHKERRQ(ierr);
823   ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
824   ierr = MatDestroy(&pcbddc->coarse_mat);CHKERRQ(ierr);
825   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
826   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
827   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
828   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
829   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
830   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
831   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
832   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
833   ierr = VecDestroy(&pcbddc->vec4_D);CHKERRQ(ierr);
834   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
835   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
836   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
837   ierr = KSPDestroy(&pcbddc->ksp_D);CHKERRQ(ierr);
838   ierr = KSPDestroy(&pcbddc->ksp_R);CHKERRQ(ierr);
839   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
840   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
841   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
842   ierr = PetscFree(pcbddc->local_primal_indices);CHKERRQ(ierr);
843   ierr = PetscFree(pcbddc->replicated_local_primal_indices);CHKERRQ(ierr);
844   ierr = PetscFree(pcbddc->replicated_local_primal_values);CHKERRQ(ierr);
845   ierr = PetscFree(pcbddc->local_primal_displacements);CHKERRQ(ierr);
846   ierr = PetscFree(pcbddc->local_primal_sizes);CHKERRQ(ierr);
847   for (i=0;i<pcbddc->n_ISForDofs;i++) { ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr); }
848   ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
849   for (i=0;i<pcbddc->n_ISForFaces;i++) { ierr = ISDestroy(&pcbddc->ISForFaces[i]);CHKERRQ(ierr); }
850   ierr = PetscFree(pcbddc->ISForFaces);CHKERRQ(ierr);
851   for (i=0;i<pcbddc->n_ISForEdges;i++) { ierr = ISDestroy(&pcbddc->ISForEdges[i]);CHKERRQ(ierr); }
852   ierr = PetscFree(pcbddc->ISForEdges);CHKERRQ(ierr);
853   ierr = ISDestroy(&pcbddc->ISForVertices);CHKERRQ(ierr);
854   /* Free graph structure */
855   ierr = PetscFree(pcbddc->mat_graph->xadj);CHKERRQ(ierr);
856   ierr = PetscFree(pcbddc->mat_graph->adjncy);CHKERRQ(ierr);
857   if (pcbddc->mat_graph->nvtxs) {
858     ierr = PetscFree(pcbddc->mat_graph->neighbours_set[0]);CHKERRQ(ierr);
859   }
860   ierr = PetscFree(pcbddc->mat_graph->neighbours_set);CHKERRQ(ierr);
861   ierr = PetscFree4(pcbddc->mat_graph->where,pcbddc->mat_graph->count,pcbddc->mat_graph->cptr,pcbddc->mat_graph->queue);CHKERRQ(ierr);
862   ierr = PetscFree2(pcbddc->mat_graph->which_dof,pcbddc->mat_graph->touched);CHKERRQ(ierr);
863   ierr = PetscFree(pcbddc->mat_graph->where_ncmps);CHKERRQ(ierr);
864   ierr = PetscFree(pcbddc->mat_graph);CHKERRQ(ierr);
865   /* remove functions */
866   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetCoarseningRatio_C","",PETSC_NULL);CHKERRQ(ierr);
867   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetMaxLevels_C","",PETSC_NULL);CHKERRQ(ierr);
868   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetNullSpace_C","",PETSC_NULL);CHKERRQ(ierr);
869   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetDirichletBoundaries_C","",PETSC_NULL);CHKERRQ(ierr);
870   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetNeumannBoundaries_C","",PETSC_NULL);CHKERRQ(ierr);
871   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCGetDirichletBoundaries_C","",PETSC_NULL);CHKERRQ(ierr);
872   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCGetNeumannBoundaries_C","",PETSC_NULL);CHKERRQ(ierr);
873   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetCoarseProblemType_C","",PETSC_NULL);CHKERRQ(ierr);
874   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetDofsSplitting_C","",PETSC_NULL);CHKERRQ(ierr);
875   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetLocalAdjacencyGraph_C","",PETSC_NULL);CHKERRQ(ierr);
876   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCPreSolve_C","",PETSC_NULL);CHKERRQ(ierr);
877   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCPostSolve_C","",PETSC_NULL);CHKERRQ(ierr);
878   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCCreateFETIDPOperators_C","",PETSC_NULL);CHKERRQ(ierr);
879   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCMatFETIDPGetRHS_C","",PETSC_NULL);CHKERRQ(ierr);
880   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCMatFETIDPGetSolution_C","",PETSC_NULL);CHKERRQ(ierr);
881   /* Free the private data structure that was hanging off the PC */
882   ierr = PetscFree(pcbddc);CHKERRQ(ierr);
883   PetscFunctionReturn(0);
884 }
885 /* -------------------------------------------------------------------------- */
886 EXTERN_C_BEGIN
887 #undef __FUNCT__
888 #define __FUNCT__ "PCBDDCMatFETIDPGetRHS_BDDC"
889 static PetscErrorCode PCBDDCMatFETIDPGetRHS_BDDC(Mat fetidp_mat, Vec standard_rhs, Vec fetidp_flux_rhs)
890 {
891   FETIDPMat_ctx  *mat_ctx;
892   PC_IS*         pcis;
893   PC_BDDC*       pcbddc;
894   Mat_IS*        matis;
895   PetscErrorCode ierr;
896 
897   PetscFunctionBegin;
898   ierr = MatShellGetContext(fetidp_mat,&mat_ctx);CHKERRQ(ierr);
899   pcis = (PC_IS*)mat_ctx->pc->data;
900   pcbddc = (PC_BDDC*)mat_ctx->pc->data;
901   matis = (Mat_IS*)mat_ctx->pc->pmat->data;
902 
903   /* change of basis for physical rhs if needed
904      It also changes the rhs in case of dirichlet boundaries */
905   (*mat_ctx->pc->ops->presolve)(mat_ctx->pc,PETSC_NULL,standard_rhs,PETSC_NULL);
906   /* store vectors for computation of fetidp final solution */
907   ierr = VecScatterBegin(pcis->global_to_D,standard_rhs,mat_ctx->temp_solution_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
908   ierr = VecScatterEnd  (pcis->global_to_D,standard_rhs,mat_ctx->temp_solution_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
909   ierr = VecScatterBegin(pcis->global_to_B,standard_rhs,mat_ctx->temp_solution_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
910   ierr = VecScatterEnd  (pcis->global_to_B,standard_rhs,mat_ctx->temp_solution_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
911   /* scale rhs since it should be unassembled */
912   ierr = VecPointwiseMult(mat_ctx->temp_solution_B,pcis->D,mat_ctx->temp_solution_B);CHKERRQ(ierr);
913   if (!pcbddc->prec_type) {
914     /* compute partially subassembled Schur complement right-hand side */
915     ierr = KSPSolve(pcbddc->ksp_D,mat_ctx->temp_solution_D,pcis->vec1_D);CHKERRQ(ierr);
916     ierr = MatMult(pcis->A_BI,pcis->vec1_D,pcis->vec1_B);CHKERRQ(ierr);
917     ierr = VecAXPY(mat_ctx->temp_solution_B,-1.0,pcis->vec1_B);CHKERRQ(ierr);
918     ierr = VecSet(standard_rhs,0.0);CHKERRQ(ierr);
919     ierr = VecScatterBegin(pcis->global_to_B,mat_ctx->temp_solution_B,standard_rhs,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
920     ierr = VecScatterEnd  (pcis->global_to_B,mat_ctx->temp_solution_B,standard_rhs,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
921     ierr = VecScatterBegin(pcis->global_to_B,standard_rhs,mat_ctx->temp_solution_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
922     ierr = VecScatterEnd  (pcis->global_to_B,standard_rhs,mat_ctx->temp_solution_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
923     ierr = VecPointwiseMult(mat_ctx->temp_solution_B,pcis->D,mat_ctx->temp_solution_B);CHKERRQ(ierr);
924   }
925   /* BDDC rhs */
926   ierr = VecCopy(mat_ctx->temp_solution_B,pcis->vec1_B);CHKERRQ(ierr);
927   if (pcbddc->prec_type) {
928     ierr = VecCopy(mat_ctx->temp_solution_D,pcis->vec1_D);CHKERRQ(ierr);
929   }
930   /* apply BDDC */
931   ierr = PCBDDCApplyInterfacePreconditioner(mat_ctx->pc);CHKERRQ(ierr);
932   /* Application of B_delta and assembling of rhs for fetidp fluxes */
933   ierr = VecSet(fetidp_flux_rhs,0.0);CHKERRQ(ierr);
934   ierr = MatMult(mat_ctx->B_delta,pcis->vec1_B,mat_ctx->lambda_local);CHKERRQ(ierr);
935   ierr = VecScatterBegin(mat_ctx->l2g_lambda,mat_ctx->lambda_local,fetidp_flux_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
936   ierr = VecScatterEnd  (mat_ctx->l2g_lambda,mat_ctx->lambda_local,fetidp_flux_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
937   /* restore original rhs */
938   ierr = VecCopy(pcbddc->original_rhs,standard_rhs);CHKERRQ(ierr);
939   PetscFunctionReturn(0);
940 }
941 EXTERN_C_END
942 #undef __FUNCT__
943 #define __FUNCT__ "PCBDDCMatFETIDPGetRHS"
944 /*@
945  PCBDDCMatFETIDPGetRHS - Get rhs for FETIDP linear system.
946 
947    Collective
948 
949    Input Parameters:
950 +  fetidp_mat   - the FETIDP mat obtained by a call to PCBDDCCreateFETIDPOperators
951 +  standard_rhs - the rhs of your linear system
952 
953    Output Parameters:
954 +  fetidp_flux_rhs   - the rhs of the FETIDP linear system
955 
956    Level: developer
957 
958    Notes:
959 
960 .seealso: PCBDDC
961 @*/
962 PetscErrorCode PCBDDCMatFETIDPGetRHS(Mat fetidp_mat, Vec standard_rhs, Vec fetidp_flux_rhs)
963 {
964   FETIDPMat_ctx  *mat_ctx;
965   PetscErrorCode ierr;
966 
967   PetscFunctionBegin;
968   ierr = MatShellGetContext(fetidp_mat,&mat_ctx);CHKERRQ(ierr);
969   ierr = PetscTryMethod(mat_ctx->pc,"PCBDDCMatFETIDPGetRHS_C",(Mat,Vec,Vec),(fetidp_mat,standard_rhs,fetidp_flux_rhs));CHKERRQ(ierr);
970   PetscFunctionReturn(0);
971 }
972 /* -------------------------------------------------------------------------- */
973 EXTERN_C_BEGIN
974 #undef __FUNCT__
975 #define __FUNCT__ "PCBDDCMatFETIDPGetSolution_BDDC"
976 static PetscErrorCode PCBDDCMatFETIDPGetSolution_BDDC(Mat fetidp_mat, Vec fetidp_flux_sol, Vec standard_sol)
977 {
978   FETIDPMat_ctx  *mat_ctx;
979   PC_IS*         pcis;
980   PC_BDDC*       pcbddc;
981   Mat_IS*        matis;
982   PetscErrorCode ierr;
983 
984   PetscFunctionBegin;
985   ierr = MatShellGetContext(fetidp_mat,&mat_ctx);CHKERRQ(ierr);
986   pcis = (PC_IS*)mat_ctx->pc->data;
987   pcbddc = (PC_BDDC*)mat_ctx->pc->data;
988   matis = (Mat_IS*)mat_ctx->pc->pmat->data;
989 
990   /* apply B_delta^T */
991   ierr = VecScatterBegin(mat_ctx->l2g_lambda,fetidp_flux_sol,mat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
992   ierr = VecScatterEnd  (mat_ctx->l2g_lambda,fetidp_flux_sol,mat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
993   ierr = MatMultTranspose(mat_ctx->B_delta,mat_ctx->lambda_local,pcis->vec1_B);CHKERRQ(ierr);
994   /* compute rhs for BDDC application */
995   ierr = VecAYPX(pcis->vec1_B,-1.0,mat_ctx->temp_solution_B);CHKERRQ(ierr);
996   if (pcbddc->prec_type) {
997     ierr = VecCopy(mat_ctx->temp_solution_D,pcis->vec1_D);CHKERRQ(ierr);
998   }
999   /* apply BDDC */
1000   ierr = PCBDDCApplyInterfacePreconditioner(mat_ctx->pc);CHKERRQ(ierr);
1001   /* put values into standard global vector */
1002   ierr = VecScatterBegin(pcis->global_to_B,pcis->vec1_B,standard_sol,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1003   ierr = VecScatterEnd  (pcis->global_to_B,pcis->vec1_B,standard_sol,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1004   if (!pcbddc->prec_type) {
1005     /* compute values into the interior if solved for the partially subassembled Schur complement */
1006     ierr = MatMult(pcis->A_IB,pcis->vec1_B,pcis->vec1_D);CHKERRQ(ierr);
1007     ierr = VecAXPY(mat_ctx->temp_solution_D,-1.0,pcis->vec1_D);CHKERRQ(ierr);
1008     ierr = KSPSolve(pcbddc->ksp_D,mat_ctx->temp_solution_D,pcis->vec1_D);CHKERRQ(ierr);
1009   }
1010   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec1_D,standard_sol,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1011   ierr = VecScatterEnd  (pcis->global_to_D,pcis->vec1_D,standard_sol,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1012   /* final change of basis if needed
1013      Is also sums the dirichlet part removed during RHS assembling */
1014   (*mat_ctx->pc->ops->postsolve)(mat_ctx->pc,PETSC_NULL,PETSC_NULL,standard_sol);
1015   PetscFunctionReturn(0);
1016 
1017 }
1018 EXTERN_C_END
1019 #undef __FUNCT__
1020 #define __FUNCT__ "PCBDDCMatFETIDPGetSolution"
1021 /*@
1022  PCBDDCMatFETIDPGetSolution - Get Solution for FETIDP linear system.
1023 
1024    Collective
1025 
1026    Input Parameters:
1027 +  fetidp_mat        - the FETIDP mat obtained by a call to PCBDDCCreateFETIDPOperators
1028 +  fetidp_flux_sol - the solution of the FETIDP linear system
1029 
1030    Output Parameters:
1031 +  standard_sol      - the solution on the global domain
1032 
1033    Level: developer
1034 
1035    Notes:
1036 
1037 .seealso: PCBDDC
1038 @*/
1039 PetscErrorCode PCBDDCMatFETIDPGetSolution(Mat fetidp_mat, Vec fetidp_flux_sol, Vec standard_sol)
1040 {
1041   FETIDPMat_ctx  *mat_ctx;
1042   PetscErrorCode ierr;
1043 
1044   PetscFunctionBegin;
1045   ierr = MatShellGetContext(fetidp_mat,&mat_ctx);CHKERRQ(ierr);
1046   ierr = PetscTryMethod(mat_ctx->pc,"PCBDDCMatFETIDPGetSolution_C",(Mat,Vec,Vec),(fetidp_mat,fetidp_flux_sol,standard_sol));CHKERRQ(ierr);
1047   PetscFunctionReturn(0);
1048 }
1049 /* -------------------------------------------------------------------------- */
1050 EXTERN_C_BEGIN
1051 #undef __FUNCT__
1052 #define __FUNCT__ "PCBDDCCreateFETIDPOperators_BDDC"
1053 static PetscErrorCode PCBDDCCreateFETIDPOperators_BDDC(PC pc, Mat *fetidp_mat, PC *fetidp_pc)
1054 {
1055   PETSC_EXTERN PetscErrorCode FETIDPMatMult(Mat,Vec,Vec);
1056   PETSC_EXTERN PetscErrorCode PCBDDCDestroyFETIDPMat(Mat);
1057   PETSC_EXTERN PetscErrorCode FETIDPPCApply(PC,Vec,Vec);
1058   PETSC_EXTERN PetscErrorCode PCBDDCDestroyFETIDPPC(PC);
1059 
1060   FETIDPMat_ctx  *fetidpmat_ctx;
1061   Mat            newmat;
1062   FETIDPPC_ctx  *fetidppc_ctx;
1063   PC             newpc;
1064   MPI_Comm       comm = ((PetscObject)pc)->comm;
1065   PetscErrorCode ierr;
1066 
1067   PetscFunctionBegin;
1068   /* FETIDP linear matrix */
1069   ierr = PCBDDCCreateFETIDPMatContext(pc, &fetidpmat_ctx);CHKERRQ(ierr);
1070   ierr = PCBDDCSetupFETIDPMatContext(fetidpmat_ctx);CHKERRQ(ierr);
1071   ierr = MatCreateShell(comm,PETSC_DECIDE,PETSC_DECIDE,fetidpmat_ctx->n_lambda,fetidpmat_ctx->n_lambda,fetidpmat_ctx,&newmat);CHKERRQ(ierr);
1072   ierr = MatShellSetOperation(newmat,MATOP_MULT,(void (*)(void))FETIDPMatMult);CHKERRQ(ierr);
1073   ierr = MatShellSetOperation(newmat,MATOP_DESTROY,(void (*)(void))PCBDDCDestroyFETIDPMat);CHKERRQ(ierr);
1074   ierr = MatSetUp(newmat);CHKERRQ(ierr);
1075   /* FETIDP preconditioner */
1076   ierr = PCBDDCCreateFETIDPPCContext(pc, &fetidppc_ctx);CHKERRQ(ierr);
1077   ierr = PCBDDCSetupFETIDPPCContext(newmat,fetidppc_ctx);CHKERRQ(ierr);
1078   ierr = PCCreate(comm,&newpc);CHKERRQ(ierr);
1079   ierr = PCSetType(newpc,PCSHELL);CHKERRQ(ierr);
1080   ierr = PCShellSetContext(newpc,fetidppc_ctx);CHKERRQ(ierr);
1081   ierr = PCShellSetApply(newpc,FETIDPPCApply);CHKERRQ(ierr);
1082   ierr = PCShellSetDestroy(newpc,PCBDDCDestroyFETIDPPC);CHKERRQ(ierr);
1083   ierr = PCSetOperators(newpc,newmat,newmat,SAME_PRECONDITIONER);CHKERRQ(ierr);
1084   ierr = PCSetUp(newpc);CHKERRQ(ierr);
1085   /* return pointers for objects created */
1086   *fetidp_mat=newmat;
1087   *fetidp_pc=newpc;
1088 
1089   PetscFunctionReturn(0);
1090 }
1091 EXTERN_C_END
1092 #undef __FUNCT__
1093 #define __FUNCT__ "PCBDDCCreateFETIDPOperators"
1094 /*@
1095  PCBDDCCreateFETIDPOperators - Create operators for FETIDP.
1096 
1097    Collective
1098 
1099    Input Parameters:
1100 +  pc - the BDDC preconditioning context (setup must be already called)
1101 
1102    Level: developer
1103 
1104    Notes:
1105 
1106 .seealso: PCBDDC
1107 @*/
1108 PetscErrorCode PCBDDCCreateFETIDPOperators(PC pc, Mat *fetidp_mat, PC *fetidp_pc)
1109 {
1110   PetscErrorCode ierr;
1111 
1112   PetscFunctionBegin;
1113   PetscValidHeaderSpecific(pc,PC_CLASSID,1);
1114   if (pc->setupcalled) {
1115     ierr = PetscTryMethod(pc,"PCBDDCCreateFETIDPOperators_C",(PC,Mat*,PC*),(pc,fetidp_mat,fetidp_pc));CHKERRQ(ierr);
1116   } else {
1117     SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"You must call PCSetup_BDDC before calling %s\n",__FUNCT__);
1118   }
1119   PetscFunctionReturn(0);
1120 }
1121 /* -------------------------------------------------------------------------- */
1122 /*MC
1123    PCBDDC - Balancing Domain Decomposition by Constraints.
1124 
1125    Options Database Keys:
1126 .    -pcbddc ??? -
1127 
1128    Level: intermediate
1129 
1130    Notes: The matrix used with this preconditioner must be of type MATIS
1131 
1132           Unlike more 'conventional' interface preconditioners, this iterates over ALL the
1133           degrees of freedom, NOT just those on the interface (this allows the use of approximate solvers
1134           on the subdomains).
1135 
1136           Options for the coarse grid preconditioner can be set with -
1137           Options for the Dirichlet subproblem can be set with -
1138           Options for the Neumann subproblem can be set with -
1139 
1140    Contributed by Stefano Zampini
1141 
1142 .seealso:  PCCreate(), PCSetType(), PCType (for list of available types), PC,  MATIS
1143 M*/
1144 EXTERN_C_BEGIN
1145 #undef __FUNCT__
1146 #define __FUNCT__ "PCCreate_BDDC"
1147 PetscErrorCode PCCreate_BDDC(PC pc)
1148 {
1149   PetscErrorCode ierr;
1150   PC_BDDC        *pcbddc;
1151   PCBDDCGraph    mat_graph;
1152 
1153   PetscFunctionBegin;
1154   /* Creates the private data structure for this preconditioner and attach it to the PC object. */
1155   ierr      = PetscNewLog(pc,PC_BDDC,&pcbddc);CHKERRQ(ierr);
1156   pc->data  = (void*)pcbddc;
1157 
1158   /* create PCIS data structure */
1159   ierr = PCISCreate(pc);CHKERRQ(ierr);
1160 
1161   /* BDDC specific */
1162   pcbddc->CoarseNullSpace            = 0;
1163   pcbddc->NullSpace                  = 0;
1164   pcbddc->temp_solution              = 0;
1165   pcbddc->original_rhs               = 0;
1166   pcbddc->local_mat                  = 0;
1167   pcbddc->ChangeOfBasisMatrix        = 0;
1168   pcbddc->usechangeofbasis           = PETSC_TRUE;
1169   pcbddc->usechangeonfaces           = PETSC_FALSE;
1170   pcbddc->coarse_vec                 = 0;
1171   pcbddc->coarse_rhs                 = 0;
1172   pcbddc->coarse_ksp                 = 0;
1173   pcbddc->coarse_phi_B               = 0;
1174   pcbddc->coarse_phi_D               = 0;
1175   pcbddc->vec1_P                     = 0;
1176   pcbddc->vec1_R                     = 0;
1177   pcbddc->vec2_R                     = 0;
1178   pcbddc->local_auxmat1              = 0;
1179   pcbddc->local_auxmat2              = 0;
1180   pcbddc->R_to_B                     = 0;
1181   pcbddc->R_to_D                     = 0;
1182   pcbddc->ksp_D                      = 0;
1183   pcbddc->ksp_R                      = 0;
1184   pcbddc->local_primal_indices       = 0;
1185   pcbddc->prec_type                  = PETSC_FALSE;
1186   pcbddc->NeumannBoundaries          = 0;
1187   pcbddc->ISForDofs                  = 0;
1188   pcbddc->ISForVertices              = 0;
1189   pcbddc->n_ISForFaces               = 0;
1190   pcbddc->n_ISForEdges               = 0;
1191   pcbddc->ConstraintMatrix           = 0;
1192   pcbddc->use_nnsp_true              = PETSC_FALSE;
1193   pcbddc->local_primal_sizes         = 0;
1194   pcbddc->local_primal_displacements = 0;
1195   pcbddc->replicated_local_primal_indices = 0;
1196   pcbddc->replicated_local_primal_values  = 0;
1197   pcbddc->coarse_loc_to_glob         = 0;
1198   pcbddc->dbg_flag                   = PETSC_FALSE;
1199   pcbddc->coarsening_ratio           = 8;
1200   pcbddc->use_exact_dirichlet        = PETSC_TRUE;
1201   pcbddc->current_level              = 0;
1202   pcbddc->max_levels                 = 1;
1203 
1204   /* allocate and initialize needed graph structure */
1205   ierr = PetscMalloc(sizeof(*mat_graph),&pcbddc->mat_graph);CHKERRQ(ierr);
1206   pcbddc->mat_graph->xadj            = 0;
1207   pcbddc->mat_graph->adjncy          = 0;
1208 
1209   /* function pointers */
1210   pc->ops->apply               = PCApply_BDDC;
1211   pc->ops->applytranspose      = 0;
1212   pc->ops->setup               = PCSetUp_BDDC;
1213   pc->ops->destroy             = PCDestroy_BDDC;
1214   pc->ops->setfromoptions      = PCSetFromOptions_BDDC;
1215   pc->ops->view                = 0;
1216   pc->ops->applyrichardson     = 0;
1217   pc->ops->applysymmetricleft  = 0;
1218   pc->ops->applysymmetricright = 0;
1219   pc->ops->presolve            = PCPreSolve_BDDC;
1220   pc->ops->postsolve           = PCPostSolve_BDDC;
1221 
1222   /* composing function */
1223   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetCoarseningRatio_C","PCBDDCSetCoarseningRatio_BDDC",
1224                     PCBDDCSetCoarseningRatio_BDDC);CHKERRQ(ierr);
1225   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetMaxLevels_C","PCBDDCSetMaxLevels_BDDC",
1226                     PCBDDCSetMaxLevels_BDDC);CHKERRQ(ierr);
1227   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetNullSpace_C","PCBDDCSetNullSpace_BDDC",
1228                     PCBDDCSetNullSpace_BDDC);CHKERRQ(ierr);
1229   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetDirichletBoundaries_C","PCBDDCSetDirichletBoundaries_BDDC",
1230                     PCBDDCSetDirichletBoundaries_BDDC);CHKERRQ(ierr);
1231   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetNeumannBoundaries_C","PCBDDCSetNeumannBoundaries_BDDC",
1232                     PCBDDCSetNeumannBoundaries_BDDC);CHKERRQ(ierr);
1233   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCGetDirichletBoundaries_C","PCBDDCGetDirichletBoundaries_BDDC",
1234                     PCBDDCGetDirichletBoundaries_BDDC);CHKERRQ(ierr);
1235   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCGetNeumannBoundaries_C","PCBDDCGetNeumannBoundaries_BDDC",
1236                     PCBDDCGetNeumannBoundaries_BDDC);CHKERRQ(ierr);
1237   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetCoarseProblemType_C","PCBDDCSetCoarseProblemType_BDDC",
1238                     PCBDDCSetCoarseProblemType_BDDC);CHKERRQ(ierr);
1239   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetDofsSplitting_C","PCBDDCSetDofsSplitting_BDDC",
1240                     PCBDDCSetDofsSplitting_BDDC);CHKERRQ(ierr);
1241   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetLocalAdjacencyGraph_C","PCBDDCSetLocalAdjacencyGraph_BDDC",
1242                     PCBDDCSetLocalAdjacencyGraph_BDDC);CHKERRQ(ierr);
1243   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCPreSolve_C","PCPreSolve_BDDC",
1244                     PCPreSolve_BDDC);CHKERRQ(ierr);
1245   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCPostSolve_C","PCPostSolve_BDDC",
1246                     PCPostSolve_BDDC);CHKERRQ(ierr);
1247   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCCreateFETIDPOperators_C","PCBDDCCreateFETIDPOperators_BDDC",
1248                     PCBDDCCreateFETIDPOperators_BDDC);CHKERRQ(ierr);
1249   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCMatFETIDPGetRHS_C","PCBDDCMatFETIDPGetRHS_BDDC",
1250                     PCBDDCMatFETIDPGetRHS_BDDC);CHKERRQ(ierr);
1251   ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCMatFETIDPGetSolution_C","PCBDDCMatFETIDPGetSolution_BDDC",
1252                     PCBDDCMatFETIDPGetSolution_BDDC);CHKERRQ(ierr);
1253   PetscFunctionReturn(0);
1254 }
1255 EXTERN_C_END
1256 
1257 /* -------------------------------------------------------------------------- */
1258 /* All static functions from now on                                           */
1259 /* -------------------------------------------------------------------------- */
1260 #undef __FUNCT__
1261 #define __FUNCT__ "PCBDDCSetLevel"
1262 static PetscErrorCode PCBDDCSetLevel(PC pc,PetscInt level)
1263 {
1264   PC_BDDC  *pcbddc = (PC_BDDC*)pc->data;
1265 
1266   PetscFunctionBegin;
1267   pcbddc->current_level=level;
1268   PetscFunctionReturn(0);
1269 }
1270 
1271 #undef __FUNCT__
1272 #define __FUNCT__ "PCBDDCAdaptNullSpace"
1273 static PetscErrorCode PCBDDCAdaptNullSpace(PC pc)
1274 {
1275   PC_IS*         pcis = (PC_IS*)  (pc->data);
1276   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1277   KSP            inv_change;
1278   PC             pc_change;
1279   const Vec      *nsp_vecs;
1280   Vec            *new_nsp_vecs;
1281   PetscInt       i,nsp_size,new_nsp_size,start_new;
1282   PetscBool      nsp_has_cnst;
1283   MatNullSpace   new_nsp;
1284   PetscErrorCode ierr;
1285 
1286   PetscFunctionBegin;
1287   ierr = MatNullSpaceGetVecs(pcbddc->NullSpace,&nsp_has_cnst,&nsp_size,&nsp_vecs);CHKERRQ(ierr);
1288   ierr = KSPCreate(PETSC_COMM_SELF,&inv_change);CHKERRQ(ierr);
1289   ierr = KSPSetOperators(inv_change,pcbddc->ChangeOfBasisMatrix,pcbddc->ChangeOfBasisMatrix,SAME_PRECONDITIONER);CHKERRQ(ierr);
1290   ierr = KSPSetType(inv_change,KSPPREONLY);CHKERRQ(ierr);
1291   ierr = KSPGetPC(inv_change,&pc_change);CHKERRQ(ierr);
1292   ierr = PCSetType(pc_change,PCLU);CHKERRQ(ierr);
1293   ierr = KSPSetUp(inv_change);CHKERRQ(ierr);
1294   new_nsp_size = nsp_size;
1295   if (nsp_has_cnst) { new_nsp_size++; }
1296   ierr = PetscMalloc(new_nsp_size*sizeof(Vec),&new_nsp_vecs);CHKERRQ(ierr);
1297   for (i=0;i<new_nsp_size;i++) { ierr = VecDuplicate(pcis->vec1_global,&new_nsp_vecs[i]);CHKERRQ(ierr); }
1298   start_new = 0;
1299   if (nsp_has_cnst) {
1300     start_new = 1;
1301     ierr = VecSet(new_nsp_vecs[0],1.0);CHKERRQ(ierr);
1302     ierr = VecSet(pcis->vec1_B,1.0);CHKERRQ(ierr);
1303     ierr = KSPSolve(inv_change,pcis->vec1_B,pcis->vec1_B);
1304     ierr = VecScatterBegin(pcis->global_to_B,pcis->vec1_B,new_nsp_vecs[0],INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1305     ierr = VecScatterEnd  (pcis->global_to_B,pcis->vec1_B,new_nsp_vecs[0],INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1306   }
1307   for (i=0;i<nsp_size;i++) {
1308     ierr = VecCopy(nsp_vecs[i],new_nsp_vecs[i+start_new]);CHKERRQ(ierr);
1309     ierr = VecScatterBegin(pcis->global_to_B,nsp_vecs[i],pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1310     ierr = VecScatterEnd  (pcis->global_to_B,nsp_vecs[i],pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1311     ierr = KSPSolve(inv_change,pcis->vec1_B,pcis->vec1_B);
1312     ierr = VecScatterBegin(pcis->global_to_B,pcis->vec1_B,new_nsp_vecs[i+start_new],INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1313     ierr = VecScatterEnd  (pcis->global_to_B,pcis->vec1_B,new_nsp_vecs[i+start_new],INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1314   }
1315   ierr = VecNormalize(new_nsp_vecs[0],PETSC_NULL);CHKERRQ(ierr);
1316   /* TODO : Orthonormalize vecs when new_nsp_size > 0! */
1317 
1318   /*PetscBool nsp_t=PETSC_FALSE;
1319   ierr = MatNullSpaceTest(pcbddc->NullSpace,pc->pmat,&nsp_t);CHKERRQ(ierr);
1320   printf("Original Null Space test: %d\n",nsp_t);
1321   Mat temp_mat;
1322   Mat_IS* matis = (Mat_IS*)pc->pmat->data;
1323     temp_mat = matis->A;
1324     matis->A = pcbddc->local_mat;
1325     pcbddc->local_mat = temp_mat;
1326   ierr = MatNullSpaceTest(pcbddc->NullSpace,pc->pmat,&nsp_t);CHKERRQ(ierr);
1327   printf("Original Null Space, mat changed test: %d\n",nsp_t);
1328   {
1329     PetscReal test_norm;
1330     for (i=0;i<new_nsp_size;i++) {
1331       ierr = MatMult(pc->pmat,new_nsp_vecs[i],pcis->vec1_global);CHKERRQ(ierr);
1332       ierr = VecNorm(pcis->vec1_global,NORM_2,&test_norm);CHKERRQ(ierr);
1333       if (test_norm > 1.e-12) {
1334         printf("------------ERROR VEC %d------------------\n",i);
1335         ierr = VecView(pcis->vec1_global,PETSC_VIEWER_STDOUT_WORLD);
1336         printf("------------------------------------------\n");
1337       }
1338     }
1339   }*/
1340 
1341   ierr = KSPDestroy(&inv_change);CHKERRQ(ierr);
1342   ierr = MatNullSpaceCreate(((PetscObject)pc)->comm,PETSC_FALSE,new_nsp_size,new_nsp_vecs,&new_nsp);CHKERRQ(ierr);
1343   ierr = PCBDDCSetNullSpace(pc,new_nsp);CHKERRQ(ierr);
1344   ierr = MatNullSpaceDestroy(&new_nsp);CHKERRQ(ierr);
1345   /*
1346   ierr = MatNullSpaceTest(pcbddc->NullSpace,pc->pmat,&nsp_t);CHKERRQ(ierr);
1347   printf("New Null Space, mat changed: %d\n",nsp_t);
1348     temp_mat = matis->A;
1349     matis->A = pcbddc->local_mat;
1350     pcbddc->local_mat = temp_mat;
1351   ierr = MatNullSpaceTest(pcbddc->NullSpace,pc->pmat,&nsp_t);CHKERRQ(ierr);
1352   printf("New Null Space, mat original: %d\n",nsp_t);*/
1353 
1354   for (i=0;i<new_nsp_size;i++) { ierr = VecDestroy(&new_nsp_vecs[i]);CHKERRQ(ierr); }
1355   ierr = PetscFree(new_nsp_vecs);CHKERRQ(ierr);
1356   PetscFunctionReturn(0);
1357 }
1358 
1359 #undef __FUNCT__
1360 #define __FUNCT__ "PCBDDCCreateFETIDPMatContext"
1361 static PetscErrorCode PCBDDCCreateFETIDPMatContext(PC pc, FETIDPMat_ctx **fetidpmat_ctx)
1362 {
1363   FETIDPMat_ctx  *newctx;
1364   PetscErrorCode ierr;
1365 
1366   PetscFunctionBegin;
1367   ierr = PetscMalloc(sizeof(*newctx),&newctx);CHKERRQ(ierr);
1368   newctx->lambda_local    = 0;
1369   newctx->temp_solution_B = 0;
1370   newctx->temp_solution_D = 0;
1371   newctx->B_delta         = 0;
1372   newctx->B_Ddelta        = 0; /* theoretically belongs to the FETIDP preconditioner */
1373   newctx->l2g_lambda      = 0;
1374   /* increase the reference count for BDDC preconditioner */
1375   ierr = PetscObjectReference((PetscObject)pc);CHKERRQ(ierr);
1376   newctx->pc              = pc;
1377   *fetidpmat_ctx          = newctx;
1378   PetscFunctionReturn(0);
1379 }
1380 
1381 #undef __FUNCT__
1382 #define __FUNCT__ "PCBDDCCreateFETIDPPCContext"
1383 static PetscErrorCode PCBDDCCreateFETIDPPCContext(PC pc, FETIDPPC_ctx **fetidppc_ctx)
1384 {
1385   FETIDPPC_ctx  *newctx;
1386   PetscErrorCode ierr;
1387 
1388   PetscFunctionBegin;
1389   ierr = PetscMalloc(sizeof(*newctx),&newctx);CHKERRQ(ierr);
1390   newctx->lambda_local    = 0;
1391   newctx->B_Ddelta        = 0;
1392   newctx->l2g_lambda      = 0;
1393   /* increase the reference count for BDDC preconditioner */
1394   ierr = PetscObjectReference((PetscObject)pc);CHKERRQ(ierr);
1395   newctx->pc              = pc;
1396   *fetidppc_ctx           = newctx;
1397   PetscFunctionReturn(0);
1398 }
1399 
1400 #undef __FUNCT__
1401 #define __FUNCT__ "PCBDDCDestroyFETIDPMat"
1402 static PetscErrorCode PCBDDCDestroyFETIDPMat(Mat A)
1403 {
1404   FETIDPMat_ctx  *mat_ctx;
1405   PetscErrorCode ierr;
1406 
1407   PetscFunctionBegin;
1408   ierr = MatShellGetContext(A,(void**)&mat_ctx);CHKERRQ(ierr);
1409   ierr = VecDestroy(&mat_ctx->lambda_local);CHKERRQ(ierr);
1410   ierr = VecDestroy(&mat_ctx->temp_solution_D);CHKERRQ(ierr);
1411   ierr = VecDestroy(&mat_ctx->temp_solution_B);CHKERRQ(ierr);
1412   ierr = MatDestroy(&mat_ctx->B_delta);CHKERRQ(ierr);
1413   ierr = MatDestroy(&mat_ctx->B_Ddelta);CHKERRQ(ierr);
1414   ierr = VecScatterDestroy(&mat_ctx->l2g_lambda);CHKERRQ(ierr);
1415   ierr = PCDestroy(&mat_ctx->pc);CHKERRQ(ierr); /* actually it does not destroy BDDC, only decrease its reference count */
1416   ierr = PetscFree(mat_ctx);CHKERRQ(ierr);
1417   PetscFunctionReturn(0);
1418 }
1419 
1420 #undef __FUNCT__
1421 #define __FUNCT__ "PCBDDCDestroyFETIDPPC"
1422 static PetscErrorCode PCBDDCDestroyFETIDPPC(PC pc)
1423 {
1424   FETIDPPC_ctx  *pc_ctx;
1425   PetscErrorCode ierr;
1426 
1427   PetscFunctionBegin;
1428   ierr = PCShellGetContext(pc,(void**)&pc_ctx);CHKERRQ(ierr);
1429   ierr = VecDestroy(&pc_ctx->lambda_local);CHKERRQ(ierr);
1430   ierr = MatDestroy(&pc_ctx->B_Ddelta);CHKERRQ(ierr);
1431   ierr = VecScatterDestroy(&pc_ctx->l2g_lambda);CHKERRQ(ierr);
1432   ierr = PCDestroy(&pc_ctx->pc);CHKERRQ(ierr); /* actually it does not destroy BDDC, only decrease its reference count */
1433   ierr = PetscFree(pc_ctx);CHKERRQ(ierr);
1434   PetscFunctionReturn(0);
1435 }
1436 
1437 #undef __FUNCT__
1438 #define __FUNCT__ "PCBDDCSetupFETIDPMatContext"
1439 static PetscErrorCode PCBDDCSetupFETIDPMatContext(FETIDPMat_ctx *fetidpmat_ctx )
1440 {
1441   PetscErrorCode ierr;
1442   PC_IS          *pcis=(PC_IS*)fetidpmat_ctx->pc->data;
1443   PC_BDDC        *pcbddc=(PC_BDDC*)fetidpmat_ctx->pc->data;
1444   PCBDDCGraph    mat_graph=pcbddc->mat_graph;
1445   Mat_IS         *matis  = (Mat_IS*)fetidpmat_ctx->pc->pmat->data;
1446   MPI_Comm       comm = ((PetscObject)(fetidpmat_ctx->pc))->comm;
1447 
1448   Mat            ScalingMat;
1449   Vec            lambda_global;
1450   IS             IS_l2g_lambda;
1451 
1452   PetscBool      skip_node,fully_redundant;
1453   PetscInt       i,j,k,s,n_boundary_dofs,sum_dof_sizes,n_global_lambda,n_vertices;
1454   PetscInt       n_local_lambda,n_lambda_for_dof,dual_size,n_neg_values,n_pos_values;
1455   PetscMPIInt    rank,nprocs,partial_sum;
1456   PetscScalar    scalar_value;
1457 
1458   PetscInt       *vertex_indices,*temp_indices;
1459   PetscInt       *dual_dofs_boundary_indices,*aux_local_numbering_1,*aux_global_numbering;
1460   PetscInt       *aux_sums,*cols_B_delta,*l2g_indices;
1461   PetscMPIInt    *aux_local_numbering_2,*aux_global_numbering_mpi,*dof_sizes,*dof_displs;
1462   PetscMPIInt    *all_aux_global_numbering_mpi_1,*all_aux_global_numbering_mpi_2,*global_dofs_numbering;
1463   PetscScalar    *array,*scaling_factors,*vals_B_delta;
1464 
1465   /* For communication of scaling factors */
1466   PetscInt       *ptrs_buffer,neigh_position;
1467   PetscScalar    **all_factors,*send_buffer,*recv_buffer;
1468   MPI_Request    *send_reqs,*recv_reqs;
1469 
1470   /* tests */
1471   Vec            test_vec;
1472   PetscBool      test_fetidp;
1473   PetscViewer    viewer;
1474 
1475   PetscFunctionBegin;
1476   ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
1477   ierr = MPI_Comm_size(comm,&nprocs);CHKERRQ(ierr);
1478 
1479   /* Default type of lagrange multipliers is non-redundant */
1480   fully_redundant = PETSC_FALSE;
1481   ierr = PetscOptionsGetBool(PETSC_NULL,"-fetidp_fullyredundant",&fully_redundant,PETSC_NULL);CHKERRQ(ierr);
1482 
1483   /* Evaluate local and global number of lagrange multipliers */
1484   ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
1485   n_local_lambda = 0;
1486   partial_sum = 0;
1487   n_boundary_dofs = 0;
1488   s = 0;
1489   n_vertices = 0;
1490   /* Get Vertices used to define the BDDC */
1491   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(*vertex_indices),&vertex_indices);CHKERRQ(ierr);
1492   for (i=0;i<pcbddc->local_primal_size;i++) {
1493     ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&j,(const PetscInt**)&temp_indices,PETSC_NULL);CHKERRQ(ierr);
1494     if (j == 1) {
1495       vertex_indices[n_vertices]=temp_indices[0];
1496       n_vertices++;
1497     }
1498     ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&j,(const PetscInt**)&temp_indices,PETSC_NULL);CHKERRQ(ierr);
1499   }
1500   dual_size = pcis->n_B-n_vertices;
1501   ierr = PetscMalloc(dual_size*sizeof(*dual_dofs_boundary_indices),&dual_dofs_boundary_indices);CHKERRQ(ierr);
1502   ierr = PetscMalloc(dual_size*sizeof(*aux_local_numbering_1),&aux_local_numbering_1);CHKERRQ(ierr);
1503   ierr = PetscMalloc(dual_size*sizeof(*aux_local_numbering_2),&aux_local_numbering_2);CHKERRQ(ierr);
1504 
1505   ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
1506   for (i=0;i<pcis->n;i++){
1507     j = mat_graph->count[i]; /* RECALL: mat_graph->count[i] does not count myself */
1508     k = 0;
1509     if (j > 0) {
1510       k = (mat_graph->neighbours_set[i][0] == -1 ?  1 : 0);
1511     }
1512     j = j - k ;
1513     if ( j > 0 ) { n_boundary_dofs++; }
1514 
1515     skip_node = PETSC_FALSE;
1516     if ( s < n_vertices && vertex_indices[s]==i) { /* it works for a sorted set of vertices */
1517       skip_node = PETSC_TRUE;
1518       s++;
1519     }
1520     if (j < 1) {skip_node = PETSC_TRUE;}
1521     if ( !skip_node ) {
1522       if (fully_redundant) {
1523         /* fully redundant set of lagrange multipliers */
1524         n_lambda_for_dof = (j*(j+1))/2;
1525       } else {
1526         n_lambda_for_dof = j;
1527       }
1528       n_local_lambda += j;
1529       /* needed to evaluate global number of lagrange multipliers */
1530       array[i]=(1.0*n_lambda_for_dof)/(j+1.0); /* already scaled for the next global sum */
1531       /* store some data needed */
1532       dual_dofs_boundary_indices[partial_sum] = n_boundary_dofs-1;
1533       aux_local_numbering_1[partial_sum] = i;
1534       aux_local_numbering_2[partial_sum] = (PetscMPIInt)n_lambda_for_dof;
1535       partial_sum++;
1536     }
1537   }
1538   /*printf("I found %d local lambda dofs\n",n_local_lambda);
1539   printf("I found %d boundary dofs (should be %d)\n",n_boundary_dofs,pcis->n_B);
1540   printf("Partial sum %d should be %d\n",partial_sum,dual_size);*/
1541   ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
1542   ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
1543   ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1544   ierr = VecScatterEnd  (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1545   ierr = VecSum(pcis->vec1_global,&scalar_value);CHKERRQ(ierr);
1546   fetidpmat_ctx->n_lambda = (PetscInt) scalar_value;
1547   /* printf("I found %d global multipliers (%f)\n",fetidpmat_ctx->n_lambda,scalar_value); */
1548   ierr = VecCreate(PETSC_COMM_SELF,&fetidpmat_ctx->lambda_local);CHKERRQ(ierr);
1549   ierr = VecSetSizes(fetidpmat_ctx->lambda_local,n_local_lambda,n_local_lambda);CHKERRQ(ierr);
1550   ierr = VecSetType(fetidpmat_ctx->lambda_local,VECSEQ);CHKERRQ(ierr);
1551   ierr = VecCreate(comm,&lambda_global);CHKERRQ(ierr);
1552   ierr = VecSetSizes(lambda_global,PETSC_DECIDE,fetidpmat_ctx->n_lambda);CHKERRQ(ierr);
1553   ierr = VecSetType(lambda_global,VECMPI);CHKERRQ(ierr);
1554 
1555   /* compute global ordering of lagrange multipliers and associate l2g map */
1556 
1557   ierr = PetscMalloc(dual_size*sizeof(*aux_global_numbering),&aux_global_numbering);CHKERRQ(ierr);
1558   ierr = PetscMalloc(dual_size*sizeof(*aux_global_numbering_mpi),&aux_global_numbering_mpi);CHKERRQ(ierr);
1559   j = (rank == 0 ? nprocs : 0);
1560   ierr = PetscMalloc(j*sizeof(*dof_sizes),&dof_sizes);CHKERRQ(ierr);
1561   ierr = PetscMalloc(j*sizeof(*dof_displs),&dof_displs);CHKERRQ(ierr);
1562   ierr = ISLocalToGlobalMappingApply(matis->mapping,dual_size,aux_local_numbering_1,aux_global_numbering);CHKERRQ(ierr);
1563   ierr = MPI_Gather(&dual_size,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
1564   sum_dof_sizes=0;
1565   if ( rank == 0 ) {
1566     dof_displs[0]=0;
1567     sum_dof_sizes=dual_size;
1568     for (i=1;i<nprocs;i++) {
1569       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
1570       sum_dof_sizes += dof_sizes[i];
1571     }
1572   }
1573   for (i=0;i<dual_size;i++) {
1574     aux_global_numbering_mpi[i]=(PetscMPIInt)aux_global_numbering[i];
1575   }
1576   ierr = PetscMalloc(sum_dof_sizes*sizeof(*all_aux_global_numbering_mpi_1),&all_aux_global_numbering_mpi_1);CHKERRQ(ierr);
1577   ierr = PetscMalloc(sum_dof_sizes*sizeof(*all_aux_global_numbering_mpi_2),&all_aux_global_numbering_mpi_2);CHKERRQ(ierr);
1578   ierr = MPI_Gatherv(aux_global_numbering_mpi,dual_size,MPIU_INT,all_aux_global_numbering_mpi_1,dof_sizes,dof_displs,MPIU_INT,0,comm);CHKERRQ(ierr);
1579   ierr = MPI_Gatherv(aux_local_numbering_2,dual_size,MPIU_INT,all_aux_global_numbering_mpi_2,dof_sizes,dof_displs,MPIU_INT,0,comm);CHKERRQ(ierr);
1580 
1581   ierr = PetscMalloc(fetidpmat_ctx->n_lambda*sizeof(*global_dofs_numbering),&global_dofs_numbering);CHKERRQ(ierr);
1582   if ( rank == 0 ) {
1583     ierr = PetscSortMPIIntWithArray(sum_dof_sizes,all_aux_global_numbering_mpi_1,all_aux_global_numbering_mpi_2);CHKERRQ(ierr);
1584     j=-1;
1585     partial_sum = 0;
1586     for (i=0;i<sum_dof_sizes;i++) {
1587       if (j != all_aux_global_numbering_mpi_1[i] ) {
1588         j=all_aux_global_numbering_mpi_1[i];
1589         for (k=0;k<all_aux_global_numbering_mpi_2[i];k++) {
1590           global_dofs_numbering[partial_sum+k]=all_aux_global_numbering_mpi_1[i];
1591         }
1592         partial_sum += all_aux_global_numbering_mpi_2[i];
1593       }
1594     }
1595     /* printf("Partial sum for global dofs %d should be %d\n",partial_sum,fetidpmat_ctx->n_lambda); */
1596   }
1597   ierr = MPI_Bcast(global_dofs_numbering,fetidpmat_ctx->n_lambda,MPIU_INT,0,comm);CHKERRQ(ierr);
1598 
1599   /* init data for scaling factors exchange */
1600   partial_sum = 0;
1601   j = 0;
1602   ierr = PetscMalloc( pcis->n_neigh*sizeof(PetscInt),&ptrs_buffer);CHKERRQ(ierr);
1603   ierr = PetscMalloc( (pcis->n_neigh-1)*sizeof(MPI_Request),&send_reqs);CHKERRQ(ierr);
1604   ierr = PetscMalloc( (pcis->n_neigh-1)*sizeof(MPI_Request),&recv_reqs);CHKERRQ(ierr);
1605   ierr = PetscMalloc( pcis->n*sizeof(PetscScalar*),&all_factors);CHKERRQ(ierr);
1606   ptrs_buffer[0]=0;
1607   for (i=1;i<pcis->n_neigh;i++) {
1608     partial_sum += pcis->n_shared[i];
1609     ptrs_buffer[i] = ptrs_buffer[i-1]+pcis->n_shared[i];
1610   }
1611   ierr = PetscMalloc( partial_sum*sizeof(PetscScalar),&send_buffer);CHKERRQ(ierr);
1612   ierr = PetscMalloc( partial_sum*sizeof(PetscScalar),&recv_buffer);CHKERRQ(ierr);
1613   ierr = PetscMalloc( partial_sum*sizeof(PetscScalar),&all_factors[0]);CHKERRQ(ierr);
1614   for (i=0;i<pcis->n-1;i++) {
1615     j = mat_graph->count[i];
1616     if (j>0) {
1617       k = (mat_graph->neighbours_set[i][0] == -1 ?  1 : 0);
1618       j = j - k;
1619     }
1620     all_factors[i+1]=all_factors[i]+j;
1621   }
1622   /* scatter B scaling to N vec */
1623   ierr = VecScatterBegin(pcis->N_to_B,pcis->D,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1624   ierr = VecScatterEnd  (pcis->N_to_B,pcis->D,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1625   /* communications */
1626   ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
1627   for (i=1;i<pcis->n_neigh;i++) {
1628     for (j=0;j<pcis->n_shared[i];j++) {
1629       send_buffer[ptrs_buffer[i-1]+j]=array[pcis->shared[i][j]];
1630     }
1631     j = ptrs_buffer[i]-ptrs_buffer[i-1];
1632     ierr = MPI_Isend(&send_buffer[ptrs_buffer[i-1]],j,MPIU_SCALAR,pcis->neigh[i],0,comm,&send_reqs[i-1]);CHKERRQ(ierr);
1633     ierr = MPI_Irecv(&recv_buffer[ptrs_buffer[i-1]],j,MPIU_SCALAR,pcis->neigh[i],0,comm,&recv_reqs[i-1]);CHKERRQ(ierr);
1634   }
1635   ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
1636   ierr = MPI_Waitall((pcis->n_neigh-1),recv_reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
1637   /* put values in correct places */
1638   for (i=1;i<pcis->n_neigh;i++) {
1639     for (j=0;j<pcis->n_shared[i];j++) {
1640       k = pcis->shared[i][j];
1641       neigh_position = 0;
1642       while(mat_graph->neighbours_set[k][neigh_position] != pcis->neigh[i]) {neigh_position++;}
1643       s = (mat_graph->neighbours_set[k][0] == -1 ?  1 : 0);
1644       neigh_position = neigh_position - s;
1645       all_factors[k][neigh_position]=recv_buffer[ptrs_buffer[i-1]+j];
1646     }
1647   }
1648   ierr = MPI_Waitall((pcis->n_neigh-1),send_reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
1649   ierr = PetscFree(send_reqs);CHKERRQ(ierr);
1650   ierr = PetscFree(recv_reqs);CHKERRQ(ierr);
1651   ierr = PetscFree(send_buffer);CHKERRQ(ierr);
1652   ierr = PetscFree(recv_buffer);CHKERRQ(ierr);
1653   ierr = PetscFree(ptrs_buffer);CHKERRQ(ierr);
1654 
1655   /* Compute B and B_delta (local actions) */
1656   ierr = PetscMalloc(pcis->n_neigh*sizeof(*aux_sums),&aux_sums);CHKERRQ(ierr);
1657   ierr = PetscMalloc(n_local_lambda*sizeof(*l2g_indices),&l2g_indices);CHKERRQ(ierr);
1658   ierr = PetscMalloc(n_local_lambda*sizeof(*vals_B_delta),&vals_B_delta);CHKERRQ(ierr);
1659   ierr = PetscMalloc(n_local_lambda*sizeof(*cols_B_delta),&cols_B_delta);CHKERRQ(ierr);
1660   ierr = PetscMalloc(n_local_lambda*sizeof(*scaling_factors),&scaling_factors);CHKERRQ(ierr);
1661   n_global_lambda=0;
1662   partial_sum=0;
1663   for (i=0;i<dual_size;i++) {
1664     while( global_dofs_numbering[n_global_lambda] != aux_global_numbering_mpi[i] ) { n_global_lambda++; }
1665     j = mat_graph->count[aux_local_numbering_1[i]];
1666     k = (mat_graph->neighbours_set[aux_local_numbering_1[i]][0] == -1 ?  1 : 0);
1667     j = j - k;
1668     aux_sums[0]=0;
1669     for (s=1;s<j;s++) {
1670       aux_sums[s]=aux_sums[s-1]+j-s+1;
1671     }
1672     array = all_factors[aux_local_numbering_1[i]];
1673     n_neg_values = 0;
1674     while(n_neg_values < j && mat_graph->neighbours_set[aux_local_numbering_1[i]][n_neg_values+k] < rank) {n_neg_values++;}
1675     n_pos_values = j - n_neg_values;
1676     if (fully_redundant) {
1677       for (s=0;s<n_neg_values;s++) {
1678         l2g_indices    [partial_sum+s]=aux_sums[s]+n_neg_values-s-1+n_global_lambda;
1679         cols_B_delta   [partial_sum+s]=dual_dofs_boundary_indices[i];
1680         vals_B_delta   [partial_sum+s]=-1.0;
1681         scaling_factors[partial_sum+s]=array[s];
1682       }
1683       for (s=0;s<n_pos_values;s++) {
1684         l2g_indices    [partial_sum+s+n_neg_values]=aux_sums[n_neg_values]+s+n_global_lambda;
1685         cols_B_delta   [partial_sum+s+n_neg_values]=dual_dofs_boundary_indices[i];
1686         vals_B_delta   [partial_sum+s+n_neg_values]=1.0;
1687         scaling_factors[partial_sum+s+n_neg_values]=array[s+n_neg_values];
1688       }
1689       partial_sum += j;
1690     } else {
1691       /* l2g_indices and default cols and vals of B_delta */
1692       for (s=0;s<j;s++) {
1693         l2g_indices    [partial_sum+s]=n_global_lambda+s;
1694         cols_B_delta   [partial_sum+s]=dual_dofs_boundary_indices[i];
1695         vals_B_delta   [partial_sum+s]=0.0;
1696       }
1697       /* B_delta */
1698       if ( n_neg_values > 0 ) { /* there's a rank next to me to the left */
1699         vals_B_delta   [partial_sum+n_neg_values-1]=-1.0;
1700       }
1701       if ( n_neg_values < j ) { /* there's a rank next to me to the right */
1702         vals_B_delta   [partial_sum+n_neg_values]=1.0;
1703       }
1704       /* scaling as in Klawonn-Widlund 1999*/
1705       for (s=0;s<n_neg_values;s++) {
1706         scalar_value = 0.0;
1707         for (k=0;k<s+1;k++) {
1708           scalar_value += array[k];
1709         }
1710         scalar_value = -scalar_value;
1711         scaling_factors[partial_sum+s] = scalar_value;
1712       }
1713       for (s=0;s<n_pos_values;s++) {
1714         scalar_value = 0.0;
1715         for (k=s+n_neg_values;k<j;k++) {
1716           scalar_value += array[k];
1717         }
1718         scaling_factors[partial_sum+s+n_neg_values] = scalar_value;
1719       }
1720       partial_sum += j;
1721     }
1722   }
1723   ierr = PetscFree(all_factors[0]);CHKERRQ(ierr);
1724   ierr = PetscFree(all_factors);CHKERRQ(ierr);
1725   /* printf("I found %d local lambda dofs when numbering them (should be %d)\n",partial_sum,n_local_lambda); */
1726   ierr = ISCreateGeneral(comm,n_local_lambda,l2g_indices,PETSC_OWN_POINTER,&IS_l2g_lambda);CHKERRQ(ierr);
1727   ierr = VecScatterCreate(fetidpmat_ctx->lambda_local,(IS)0,lambda_global,IS_l2g_lambda,&fetidpmat_ctx->l2g_lambda);CHKERRQ(ierr);
1728 
1729   /* Create local part of B_delta */
1730   ierr = MatCreate(PETSC_COMM_SELF,&fetidpmat_ctx->B_delta);
1731   ierr = MatSetSizes(fetidpmat_ctx->B_delta,n_local_lambda,pcis->n_B,n_local_lambda,pcis->n_B);CHKERRQ(ierr);
1732   ierr = MatSetType(fetidpmat_ctx->B_delta,MATSEQAIJ);CHKERRQ(ierr);
1733   ierr = MatSeqAIJSetPreallocation(fetidpmat_ctx->B_delta,1,PETSC_NULL);CHKERRQ(ierr);
1734   ierr = MatSetOption(fetidpmat_ctx->B_delta,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr);
1735   for (i=0;i<n_local_lambda;i++) {
1736     ierr = MatSetValue(fetidpmat_ctx->B_delta,i,cols_B_delta[i],vals_B_delta[i],INSERT_VALUES);CHKERRQ(ierr);
1737   }
1738   ierr = MatAssemblyBegin(fetidpmat_ctx->B_delta,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1739   ierr = MatAssemblyEnd  (fetidpmat_ctx->B_delta,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1740 
1741   if (fully_redundant) {
1742     ierr = MatCreate(PETSC_COMM_SELF,&ScalingMat);
1743     ierr = MatSetSizes(ScalingMat,n_local_lambda,n_local_lambda,n_local_lambda,n_local_lambda);CHKERRQ(ierr);
1744     ierr = MatSetType(ScalingMat,MATSEQAIJ);CHKERRQ(ierr);
1745     ierr = MatSeqAIJSetPreallocation(ScalingMat,1,PETSC_NULL);CHKERRQ(ierr);
1746     for (i=0;i<n_local_lambda;i++) {
1747       ierr = MatSetValue(ScalingMat,i,i,scaling_factors[i],INSERT_VALUES);CHKERRQ(ierr);
1748     }
1749     ierr = MatAssemblyBegin(ScalingMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1750     ierr = MatAssemblyEnd  (ScalingMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1751     ierr = MatMatMult(ScalingMat,fetidpmat_ctx->B_delta,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&fetidpmat_ctx->B_Ddelta);CHKERRQ(ierr);
1752     ierr = MatDestroy(&ScalingMat);CHKERRQ(ierr);
1753   } else {
1754     ierr = MatCreate(PETSC_COMM_SELF,&fetidpmat_ctx->B_Ddelta);
1755     ierr = MatSetSizes(fetidpmat_ctx->B_Ddelta,n_local_lambda,pcis->n_B,n_local_lambda,pcis->n_B);CHKERRQ(ierr);
1756     ierr = MatSetType(fetidpmat_ctx->B_Ddelta,MATSEQAIJ);CHKERRQ(ierr);
1757     ierr = MatSeqAIJSetPreallocation(fetidpmat_ctx->B_Ddelta,1,PETSC_NULL);CHKERRQ(ierr);
1758     for (i=0;i<n_local_lambda;i++) {
1759       ierr = MatSetValue(fetidpmat_ctx->B_Ddelta,i,cols_B_delta[i],scaling_factors[i],INSERT_VALUES);CHKERRQ(ierr);
1760     }
1761     ierr = MatAssemblyBegin(fetidpmat_ctx->B_Ddelta,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1762     ierr = MatAssemblyEnd  (fetidpmat_ctx->B_Ddelta,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1763   }
1764 
1765   /* Create some vectors needed by fetidp */
1766   ierr = VecDuplicate(pcis->vec1_B,&fetidpmat_ctx->temp_solution_B);CHKERRQ(ierr);
1767   ierr = VecDuplicate(pcis->vec1_D,&fetidpmat_ctx->temp_solution_D);CHKERRQ(ierr);
1768 
1769   test_fetidp = PETSC_FALSE;
1770   ierr = PetscOptionsGetBool(PETSC_NULL,"-fetidp_check",&test_fetidp,PETSC_NULL);CHKERRQ(ierr);
1771 
1772   if (test_fetidp) {
1773 
1774     ierr = PetscViewerASCIIGetStdout(((PetscObject)(fetidpmat_ctx->pc))->comm,&viewer);CHKERRQ(ierr);
1775     ierr = PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);CHKERRQ(ierr);
1776     ierr = PetscViewerASCIIPrintf(viewer,"----------FETI_DP TESTS--------------\n");CHKERRQ(ierr);
1777     ierr = PetscViewerASCIIPrintf(viewer,"All tests should return zero!\n");CHKERRQ(ierr);
1778     ierr = PetscViewerASCIIPrintf(viewer,"FETIDP MAT context in the ");CHKERRQ(ierr);
1779     if (fully_redundant) {
1780       ierr = PetscViewerASCIIPrintf(viewer,"fully redundant case for lagrange multipliers.\n");CHKERRQ(ierr);
1781     } else {
1782       ierr = PetscViewerASCIIPrintf(viewer,"Non-fully redundant case for lagrange multiplier.\n");CHKERRQ(ierr);
1783     }
1784     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
1785 
1786     /******************************************************************/
1787     /* TEST A/B: Test numbering of global lambda dofs             */
1788     /******************************************************************/
1789 
1790     ierr = VecDuplicate(fetidpmat_ctx->lambda_local,&test_vec);CHKERRQ(ierr);
1791     ierr = VecSet(lambda_global,1.0);CHKERRQ(ierr);
1792     ierr = VecSet(test_vec,1.0);CHKERRQ(ierr);
1793     ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1794     ierr = VecScatterEnd  (fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1795     scalar_value = -1.0;
1796     ierr = VecAXPY(test_vec,scalar_value,fetidpmat_ctx->lambda_local);CHKERRQ(ierr);
1797     ierr = VecNorm(test_vec,NORM_INFINITY,&scalar_value);CHKERRQ(ierr);
1798     ierr = VecDestroy(&test_vec);CHKERRQ(ierr);
1799     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"A[%04d]: CHECK glob to loc: % 1.14e\n",rank,scalar_value);CHKERRQ(ierr);
1800     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
1801     if (fully_redundant) {
1802       ierr = VecSet(lambda_global,0.0);CHKERRQ(ierr);
1803       ierr = VecSet(fetidpmat_ctx->lambda_local,0.5);CHKERRQ(ierr);
1804       ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1805       ierr = VecScatterEnd  (fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1806       ierr = VecSum(lambda_global,&scalar_value);CHKERRQ(ierr);
1807       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"B[%04d]: CHECK loc to glob: % 1.14e\n",rank,scalar_value-fetidpmat_ctx->n_lambda);CHKERRQ(ierr);
1808       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
1809     }
1810 
1811     /******************************************************************/
1812     /* TEST C: It should holds B_delta*w=0, w\in\widehat{W}           */
1813     /* This is the meaning of the B matrix                            */
1814     /******************************************************************/
1815 
1816     ierr = VecSetRandom(pcis->vec1_N,PETSC_NULL);CHKERRQ(ierr);
1817     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
1818     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1819     ierr = VecScatterEnd  (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1820     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1821     ierr = VecScatterEnd  (matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1822     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1823     ierr = VecScatterEnd  (pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1824     /* Action of B_delta */
1825     ierr = MatMult(fetidpmat_ctx->B_delta,pcis->vec1_B,fetidpmat_ctx->lambda_local);CHKERRQ(ierr);
1826     ierr = VecSet(lambda_global,0.0);CHKERRQ(ierr);
1827     ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1828     ierr = VecScatterEnd  (fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1829     ierr = VecNorm(lambda_global,NORM_INFINITY,&scalar_value);CHKERRQ(ierr);
1830     ierr = PetscViewerASCIIPrintf(viewer,"C[coll]: CHECK infty norm of B_delta*w (w continuous): % 1.14e\n",scalar_value);CHKERRQ(ierr);
1831     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
1832 
1833     /******************************************************************/
1834     /* TEST D: It should holds E_Dw = w - P_Dw w\in\widetilde{W}     */
1835     /* E_D = R_D^TR                                                   */
1836     /* P_D = B_{D,delta}^T B_{delta}                                  */
1837     /* eq.44 Mandel Tezaur and Dohrmann 2005                          */
1838     /******************************************************************/
1839 
1840     /* compute a random vector in \widetilde{W} */
1841     ierr = VecSetRandom(pcis->vec1_N,PETSC_NULL);CHKERRQ(ierr);
1842     scalar_value = 0.0;  /* set zero at vertices */
1843     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
1844     for (i=0;i<n_vertices;i++) { array[vertex_indices[i]]=scalar_value; }
1845     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
1846     /* store w for final comparison */
1847     ierr = VecDuplicate(pcis->vec1_B,&test_vec);CHKERRQ(ierr);
1848     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,test_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1849     ierr = VecScatterEnd  (pcis->N_to_B,pcis->vec1_N,test_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1850 
1851     /* Jump operator P_D : results stored in pcis->vec1_B */
1852 
1853     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1854     ierr = VecScatterEnd  (pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1855     /* Action of B_delta */
1856     ierr = MatMult(fetidpmat_ctx->B_delta,pcis->vec1_B,fetidpmat_ctx->lambda_local);CHKERRQ(ierr);
1857     ierr = VecSet(lambda_global,0.0);CHKERRQ(ierr);
1858     ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1859     ierr = VecScatterEnd  (fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1860     /* Action of B_Ddelta^T */
1861     ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1862     ierr = VecScatterEnd  (fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1863     ierr = MatMultTranspose(fetidpmat_ctx->B_Ddelta,fetidpmat_ctx->lambda_local,pcis->vec1_B);CHKERRQ(ierr);
1864 
1865     /* Average operator E_D : results stored in pcis->vec2_B */
1866 
1867     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1868     ierr = VecScatterEnd  (pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1869     ierr = VecPointwiseMult(pcis->vec2_B,pcis->D,pcis->vec2_B);CHKERRQ(ierr);
1870     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec2_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1871     ierr = VecScatterEnd  (pcis->N_to_B,pcis->vec2_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1872     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
1873     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1874     ierr = VecScatterEnd  (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1875     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1876     ierr = VecScatterEnd  (matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1877     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1878     ierr = VecScatterEnd  (pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1879 
1880     /* test E_D=I-P_D */
1881     scalar_value = 1.0;
1882     ierr = VecAXPY(pcis->vec1_B,scalar_value,pcis->vec2_B);CHKERRQ(ierr);
1883     scalar_value = -1.0;
1884     ierr = VecAXPY(pcis->vec1_B,scalar_value,test_vec);CHKERRQ(ierr);
1885     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&scalar_value);CHKERRQ(ierr);
1886     ierr = VecDestroy(&test_vec);CHKERRQ(ierr);
1887     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"D[%04d] CHECK infty norm of E_D + P_D - I: % 1.14e\n",rank,scalar_value);CHKERRQ(ierr);
1888     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
1889 
1890     /******************************************************************/
1891     /* TEST E: It should holds R_D^TP_Dw=0 w\in\widetilde{W}          */
1892     /* eq.48 Mandel Tezaur and Dohrmann 2005                          */
1893     /******************************************************************/
1894 
1895     ierr = VecSetRandom(pcis->vec1_N,PETSC_NULL);CHKERRQ(ierr);
1896     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
1897     scalar_value = 0.0;  /* set zero at vertices */
1898     for (i=0;i<n_vertices;i++) { array[vertex_indices[i]]=scalar_value; }
1899     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
1900 
1901     /* Jump operator P_D : results stored in pcis->vec1_B */
1902 
1903     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1904     ierr = VecScatterEnd  (pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1905     /* Action of B_delta */
1906     ierr = MatMult(fetidpmat_ctx->B_delta,pcis->vec1_B,fetidpmat_ctx->lambda_local);CHKERRQ(ierr);
1907     ierr = VecSet(lambda_global,0.0);CHKERRQ(ierr);
1908     ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1909     ierr = VecScatterEnd  (fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1910     /* Action of B_Ddelta^T */
1911     ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1912     ierr = VecScatterEnd  (fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1913     ierr = MatMultTranspose(fetidpmat_ctx->B_Ddelta,fetidpmat_ctx->lambda_local,pcis->vec1_B);CHKERRQ(ierr);
1914     /* diagonal scaling */
1915     ierr = VecPointwiseMult(pcis->vec1_B,pcis->D,pcis->vec1_B);CHKERRQ(ierr);
1916     /* sum on the interface */
1917     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
1918     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1919     ierr = VecScatterEnd  (pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1920     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
1921     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1922     ierr = VecScatterEnd  (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1923     ierr = VecNorm(pcis->vec1_global,NORM_INFINITY,&scalar_value);CHKERRQ(ierr);
1924     ierr = PetscViewerASCIIPrintf(viewer,"E[coll]: CHECK infty norm of R^T_D P_D: % 1.14e\n",scalar_value);CHKERRQ(ierr);
1925     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
1926 
1927     if (!fully_redundant) {
1928       /******************************************************************/
1929       /* TEST F: It should holds B_{delta}B^T_{D,delta}=I               */
1930       /* Corollary thm 14 Mandel Tezaur and Dohrmann 2005               */
1931       /******************************************************************/
1932       ierr = VecDuplicate(lambda_global,&test_vec);CHKERRQ(ierr);
1933       ierr = VecSetRandom(lambda_global,PETSC_NULL);CHKERRQ(ierr);
1934       /* Action of B_Ddelta^T */
1935       ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1936       ierr = VecScatterEnd  (fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1937       ierr = MatMultTranspose(fetidpmat_ctx->B_Ddelta,fetidpmat_ctx->lambda_local,pcis->vec1_B);CHKERRQ(ierr);
1938       /* Action of B_delta */
1939       ierr = MatMult(fetidpmat_ctx->B_delta,pcis->vec1_B,fetidpmat_ctx->lambda_local);CHKERRQ(ierr);
1940       ierr = VecSet(test_vec,0.0);CHKERRQ(ierr);
1941       ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,test_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1942       ierr = VecScatterEnd  (fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,test_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1943       scalar_value = -1.0;
1944       ierr = VecAXPY(lambda_global,scalar_value,test_vec);CHKERRQ(ierr);
1945       ierr = VecNorm(lambda_global,NORM_INFINITY,&scalar_value);CHKERRQ(ierr);
1946       ierr = PetscViewerASCIIPrintf(viewer,"E[coll]: CHECK infty norm of P^T_D - I: % 1.14e\n",scalar_value);CHKERRQ(ierr);
1947       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
1948       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
1949       ierr = VecDestroy(&test_vec);CHKERRQ(ierr);
1950     }
1951   }
1952   /* final cleanup */
1953   ierr = PetscFree(dual_dofs_boundary_indices);CHKERRQ(ierr);
1954   ierr = PetscFree(vertex_indices);CHKERRQ(ierr);
1955   ierr = PetscFree(aux_local_numbering_1);CHKERRQ(ierr);
1956   ierr = PetscFree(aux_local_numbering_2);CHKERRQ(ierr);
1957   ierr = PetscFree(aux_global_numbering);CHKERRQ(ierr);
1958   ierr = PetscFree(aux_global_numbering_mpi);CHKERRQ(ierr);
1959   ierr = PetscFree(dof_sizes);CHKERRQ(ierr);
1960   ierr = PetscFree(dof_displs);CHKERRQ(ierr);
1961   ierr = PetscFree(all_aux_global_numbering_mpi_1);CHKERRQ(ierr);
1962   ierr = PetscFree(all_aux_global_numbering_mpi_2);CHKERRQ(ierr);
1963   ierr = PetscFree(global_dofs_numbering);CHKERRQ(ierr);
1964   ierr = PetscFree(aux_sums);CHKERRQ(ierr);
1965   ierr = PetscFree(cols_B_delta);CHKERRQ(ierr);
1966   ierr = PetscFree(vals_B_delta);CHKERRQ(ierr);
1967   ierr = PetscFree(scaling_factors);CHKERRQ(ierr);
1968   ierr = VecDestroy(&lambda_global);CHKERRQ(ierr);
1969   ierr = ISDestroy(&IS_l2g_lambda);CHKERRQ(ierr);
1970 
1971   PetscFunctionReturn(0);
1972 }
1973 
1974 #undef __FUNCT__
1975 #define __FUNCT__ "PCBDDCSetupFETIDPPCContext"
1976 static PetscErrorCode PCBDDCSetupFETIDPPCContext(Mat fetimat, FETIDPPC_ctx *fetidppc_ctx)
1977 {
1978   FETIDPMat_ctx  *mat_ctx;
1979   PetscErrorCode ierr;
1980 
1981   PetscFunctionBegin;
1982   ierr = MatShellGetContext(fetimat,&mat_ctx);CHKERRQ(ierr);
1983   /* get references from objects created when setting up feti mat context */
1984   ierr = PetscObjectReference((PetscObject)mat_ctx->lambda_local);CHKERRQ(ierr);
1985   fetidppc_ctx->lambda_local = mat_ctx->lambda_local;
1986   ierr = PetscObjectReference((PetscObject)mat_ctx->B_Ddelta);CHKERRQ(ierr);
1987   fetidppc_ctx->B_Ddelta = mat_ctx->B_Ddelta;
1988   ierr = PetscObjectReference((PetscObject)mat_ctx->l2g_lambda);CHKERRQ(ierr);
1989   fetidppc_ctx->l2g_lambda = mat_ctx->l2g_lambda;
1990   PetscFunctionReturn(0);
1991 }
1992 
1993 #undef __FUNCT__
1994 #define __FUNCT__ "FETIDPMatMult"
1995 static PetscErrorCode FETIDPMatMult(Mat fetimat, Vec x, Vec y)
1996 {
1997   FETIDPMat_ctx  *mat_ctx;
1998   PC_IS          *pcis;
1999   PetscErrorCode ierr;
2000 
2001   PetscFunctionBegin;
2002   ierr = MatShellGetContext(fetimat,&mat_ctx);CHKERRQ(ierr);
2003   pcis = (PC_IS*)mat_ctx->pc->data;
2004   /* Application of B_delta^T */
2005   ierr = VecScatterBegin(mat_ctx->l2g_lambda,x,mat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2006   ierr = VecScatterEnd(mat_ctx->l2g_lambda,x,mat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2007   ierr = MatMultTranspose(mat_ctx->B_delta,mat_ctx->lambda_local,pcis->vec1_B);CHKERRQ(ierr);
2008   /* Application of \widetilde{S}^-1 */
2009   ierr = VecSet(pcis->vec1_D,0.0);CHKERRQ(ierr);
2010   ierr = PCBDDCApplyInterfacePreconditioner(mat_ctx->pc);CHKERRQ(ierr);
2011   /* Application of B_delta */
2012   ierr = MatMult(mat_ctx->B_delta,pcis->vec1_B,mat_ctx->lambda_local);CHKERRQ(ierr);
2013   ierr = VecSet(y,0.0);CHKERRQ(ierr);
2014   ierr = VecScatterBegin(mat_ctx->l2g_lambda,mat_ctx->lambda_local,y,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2015   ierr = VecScatterEnd(mat_ctx->l2g_lambda,mat_ctx->lambda_local,y,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2016   PetscFunctionReturn(0);
2017 }
2018 
2019 #undef __FUNCT__
2020 #define __FUNCT__ "FETIDPPCApply"
2021 static PetscErrorCode FETIDPPCApply(PC fetipc, Vec x, Vec y)
2022 {
2023   FETIDPPC_ctx   *pc_ctx;
2024   PC_IS          *pcis;
2025   PetscErrorCode ierr;
2026 
2027   PetscFunctionBegin;
2028   ierr = PCShellGetContext(fetipc,(void**)&pc_ctx);
2029   pcis = (PC_IS*)pc_ctx->pc->data;
2030   /* Application of B_Ddelta^T */
2031   ierr = VecScatterBegin(pc_ctx->l2g_lambda,x,pc_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2032   ierr = VecScatterEnd(pc_ctx->l2g_lambda,x,pc_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2033   ierr = VecSet(pcis->vec2_B,0.0);CHKERRQ(ierr);
2034   ierr = MatMultTranspose(pc_ctx->B_Ddelta,pc_ctx->lambda_local,pcis->vec2_B);CHKERRQ(ierr);
2035   /* Application of S */
2036   ierr = PCISApplySchur(pc_ctx->pc,pcis->vec2_B,pcis->vec1_B,(Vec)0,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
2037   /* Application of B_Ddelta */
2038   ierr = MatMult(pc_ctx->B_Ddelta,pcis->vec1_B,pc_ctx->lambda_local);CHKERRQ(ierr);
2039   ierr = VecSet(y,0.0);CHKERRQ(ierr);
2040   ierr = VecScatterBegin(pc_ctx->l2g_lambda,pc_ctx->lambda_local,y,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2041   ierr = VecScatterEnd(pc_ctx->l2g_lambda,pc_ctx->lambda_local,y,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2042   PetscFunctionReturn(0);
2043 }
2044 
2045 #undef __FUNCT__
2046 #define __FUNCT__ "PCBDDCSetupLocalAdjacencyGraph"
2047 static PetscErrorCode PCBDDCSetupLocalAdjacencyGraph(PC pc)
2048 {
2049   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
2050   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
2051   PetscInt       nvtxs,*xadj,*adjncy;
2052   Mat            mat_adj;
2053   PetscBool      symmetrize_rowij=PETSC_TRUE,compressed_rowij=PETSC_FALSE,flg_row=PETSC_TRUE;
2054   PCBDDCGraph    mat_graph=pcbddc->mat_graph;
2055   PetscErrorCode ierr;
2056 
2057   PetscFunctionBegin;
2058   /* get CSR adjacency from local matrix if user has not yet provided local graph using PCBDDCSetLocalAdjacencyGraph function */
2059   if (!mat_graph->xadj) {
2060     ierr = MatConvert(matis->A,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr);
2061     ierr = MatGetRowIJ(mat_adj,0,symmetrize_rowij,compressed_rowij,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2062     if (!flg_row) {
2063       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ called in %s\n",__FUNCT__);
2064     }
2065     /* Get adjacency into BDDC workspace */
2066     ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
2067     ierr = MatRestoreRowIJ(mat_adj,0,symmetrize_rowij,compressed_rowij,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2068     if (!flg_row) {
2069       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__);
2070     }
2071     ierr = MatDestroy(&mat_adj);CHKERRQ(ierr);
2072   }
2073   PetscFunctionReturn(0);
2074 }
2075 /* -------------------------------------------------------------------------- */
2076 #undef __FUNCT__
2077 #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
2078 static PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc)
2079 {
2080   PetscErrorCode ierr;
2081   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
2082   PC_IS*            pcis = (PC_IS*)  (pc->data);
2083   const PetscScalar zero = 0.0;
2084 
2085   PetscFunctionBegin;
2086   /* Application of PHI^T  */
2087   ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
2088   if (pcbddc->prec_type) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
2089 
2090   /* Scatter data of coarse_rhs */
2091   if (pcbddc->coarse_rhs) { ierr = VecSet(pcbddc->coarse_rhs,zero);CHKERRQ(ierr); }
2092   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2093 
2094   /* Local solution on R nodes */
2095   ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
2096   ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2097   ierr = VecScatterEnd  (pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2098   if (pcbddc->prec_type) {
2099     ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2100     ierr = VecScatterEnd  (pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2101   }
2102   ierr = PCBDDCSolveSaddlePoint(pc);CHKERRQ(ierr);
2103   ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
2104   ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2105   ierr = VecScatterEnd  (pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2106   if (pcbddc->prec_type) {
2107     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2108     ierr = VecScatterEnd  (pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2109   }
2110 
2111   /* Coarse solution */
2112   ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2113   if (pcbddc->coarse_rhs) {
2114     if (pcbddc->CoarseNullSpace) {
2115       ierr = MatNullSpaceRemove(pcbddc->CoarseNullSpace,pcbddc->coarse_rhs,PETSC_NULL);CHKERRQ(ierr);
2116     }
2117     ierr = KSPSolve(pcbddc->coarse_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
2118     if (pcbddc->CoarseNullSpace) {
2119       ierr = MatNullSpaceRemove(pcbddc->CoarseNullSpace,pcbddc->coarse_vec,PETSC_NULL);CHKERRQ(ierr);
2120     }
2121   }
2122   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2123   ierr = PCBDDCScatterCoarseDataEnd  (pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2124 
2125   /* Sum contributions from two levels */
2126   ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
2127   if (pcbddc->prec_type) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
2128   PetscFunctionReturn(0);
2129 }
2130 /* -------------------------------------------------------------------------- */
2131 #undef __FUNCT__
2132 #define __FUNCT__ "PCBDDCSolveSaddlePoint"
2133 static PetscErrorCode  PCBDDCSolveSaddlePoint(PC pc)
2134 {
2135   PetscErrorCode ierr;
2136   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
2137 
2138   PetscFunctionBegin;
2139   ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
2140   if (pcbddc->local_auxmat1) {
2141     ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec2_R,pcbddc->vec1_C);CHKERRQ(ierr);
2142     ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
2143   }
2144   PetscFunctionReturn(0);
2145 }
2146 /* -------------------------------------------------------------------------- */
2147 #undef __FUNCT__
2148 #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
2149 static PetscErrorCode  PCBDDCScatterCoarseDataBegin(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
2150 {
2151   PetscErrorCode ierr;
2152   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
2153 
2154   PetscFunctionBegin;
2155   switch(pcbddc->coarse_communications_type){
2156     case SCATTERS_BDDC:
2157       ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
2158       break;
2159     case GATHERS_BDDC:
2160       break;
2161   }
2162   PetscFunctionReturn(0);
2163 }
2164 /* -------------------------------------------------------------------------- */
2165 #undef __FUNCT__
2166 #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
2167 static PetscErrorCode  PCBDDCScatterCoarseDataEnd(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
2168 {
2169   PetscErrorCode ierr;
2170   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
2171   PetscScalar*   array_to;
2172   PetscScalar*   array_from;
2173   MPI_Comm       comm=((PetscObject)pc)->comm;
2174   PetscInt i;
2175 
2176   PetscFunctionBegin;
2177 
2178   switch(pcbddc->coarse_communications_type){
2179     case SCATTERS_BDDC:
2180       ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
2181       break;
2182     case GATHERS_BDDC:
2183       if (vec_from) VecGetArray(vec_from,&array_from);
2184       if (vec_to)   VecGetArray(vec_to,&array_to);
2185       switch(pcbddc->coarse_problem_type){
2186         case SEQUENTIAL_BDDC:
2187           if (smode == SCATTER_FORWARD) {
2188             ierr = MPI_Gatherv(&array_from[0],pcbddc->local_primal_size,MPIU_SCALAR,&pcbddc->replicated_local_primal_values[0],pcbddc->local_primal_sizes,pcbddc->local_primal_displacements,MPIU_SCALAR,0,comm);CHKERRQ(ierr);
2189             if (vec_to) {
2190               if (imode == ADD_VALUES) {
2191                 for (i=0;i<pcbddc->replicated_primal_size;i++) {
2192                   array_to[pcbddc->replicated_local_primal_indices[i]]+=pcbddc->replicated_local_primal_values[i];
2193                 }
2194               } else {
2195                 for (i=0;i<pcbddc->replicated_primal_size;i++) {
2196                   array_to[pcbddc->replicated_local_primal_indices[i]]=pcbddc->replicated_local_primal_values[i];
2197                 }
2198               }
2199             }
2200           } else {
2201             if (vec_from) {
2202               if (imode == ADD_VALUES) {
2203                 printf("Scatter mode %d, insert mode %d for case %d not implemented!\n",smode,imode,pcbddc->coarse_problem_type);
2204               }
2205               for (i=0;i<pcbddc->replicated_primal_size;i++) {
2206                 pcbddc->replicated_local_primal_values[i]=array_from[pcbddc->replicated_local_primal_indices[i]];
2207               }
2208             }
2209             ierr = MPI_Scatterv(&pcbddc->replicated_local_primal_values[0],pcbddc->local_primal_sizes,pcbddc->local_primal_displacements,MPIU_SCALAR,&array_to[0],pcbddc->local_primal_size,MPIU_SCALAR,0,comm);CHKERRQ(ierr);
2210           }
2211           break;
2212         case REPLICATED_BDDC:
2213           if (smode == SCATTER_FORWARD) {
2214             ierr = MPI_Allgatherv(&array_from[0],pcbddc->local_primal_size,MPIU_SCALAR,&pcbddc->replicated_local_primal_values[0],pcbddc->local_primal_sizes,pcbddc->local_primal_displacements,MPIU_SCALAR,comm);CHKERRQ(ierr);
2215             if (imode == ADD_VALUES) {
2216               for (i=0;i<pcbddc->replicated_primal_size;i++) {
2217                 array_to[pcbddc->replicated_local_primal_indices[i]]+=pcbddc->replicated_local_primal_values[i];
2218               }
2219             } else {
2220               for (i=0;i<pcbddc->replicated_primal_size;i++) {
2221                 array_to[pcbddc->replicated_local_primal_indices[i]]=pcbddc->replicated_local_primal_values[i];
2222               }
2223             }
2224           } else { /* no communications needed for SCATTER_REVERSE since needed data is already present */
2225             if (imode == ADD_VALUES) {
2226               for (i=0;i<pcbddc->local_primal_size;i++) {
2227                 array_to[i]+=array_from[pcbddc->local_primal_indices[i]];
2228               }
2229             } else {
2230               for (i=0;i<pcbddc->local_primal_size;i++) {
2231                 array_to[i]=array_from[pcbddc->local_primal_indices[i]];
2232               }
2233             }
2234           }
2235           break;
2236         case MULTILEVEL_BDDC:
2237           break;
2238         case PARALLEL_BDDC:
2239           break;
2240       }
2241       if (vec_from) VecRestoreArray(vec_from,&array_from);
2242       if (vec_to)   VecRestoreArray(vec_to,&array_to);
2243       break;
2244   }
2245   PetscFunctionReturn(0);
2246 }
2247 /* -------------------------------------------------------------------------- */
2248 #undef __FUNCT__
2249 #define __FUNCT__ "PCBDDCCreateConstraintMatrix"
2250 static PetscErrorCode PCBDDCCreateConstraintMatrix(PC pc)
2251 {
2252   PetscErrorCode ierr;
2253   PC_IS*         pcis = (PC_IS*)(pc->data);
2254   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2255   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
2256   PetscInt       *nnz,*is_indices;
2257   PetscScalar    *temp_quadrature_constraint;
2258   PetscInt       *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B,*local_to_B;
2259   PetscInt       local_primal_size,i,j,k,total_counts,max_size_of_constraint;
2260   PetscInt       n_constraints,n_vertices,size_of_constraint;
2261   PetscScalar    quad_value;
2262   PetscBool      nnsp_has_cnst=PETSC_FALSE,use_nnsp_true=pcbddc->use_nnsp_true;
2263   PetscInt       nnsp_size=0,nnsp_addone=0,temp_constraints,temp_start_ptr;
2264   IS             *used_IS;
2265   const MatType  impMatType=MATSEQAIJ;
2266   PetscBLASInt   Bs,Bt,lwork,lierr;
2267   PetscReal      tol=1.0e-8;
2268   MatNullSpace   nearnullsp;
2269   const Vec      *nearnullvecs;
2270   Vec            *localnearnullsp;
2271   PetscScalar    *work,*temp_basis,*array_vector,*correlation_mat;
2272   PetscReal      *rwork,*singular_vals;
2273   PetscBLASInt   Bone=1,*ipiv;
2274   Vec            temp_vec;
2275   Mat            temp_mat;
2276   KSP            temp_ksp;
2277   PC             temp_pc;
2278   PetscInt       s,start_constraint,dual_dofs;
2279   PetscBool      compute_submatrix,useksp=PETSC_FALSE;
2280   PetscInt       *aux_primal_permutation,*aux_primal_numbering;
2281   PetscBool      boolforface,*change_basis;
2282 /* some ugly conditional declarations */
2283 #if defined(PETSC_MISSING_LAPACK_GESVD)
2284   PetscScalar    dot_result;
2285   PetscScalar    one=1.0,zero=0.0;
2286   PetscInt       ii;
2287   PetscScalar    *singular_vectors;
2288   PetscBLASInt   *iwork,*ifail;
2289   PetscReal      dummy_real,abs_tol;
2290   PetscBLASInt   eigs_found;
2291 #if defined(PETSC_USE_COMPLEX)
2292   PetscScalar    val1,val2;
2293 #endif
2294 #endif
2295   PetscBLASInt   dummy_int;
2296   PetscScalar    dummy_scalar;
2297 
2298   PetscFunctionBegin;
2299   /* check if near null space is attached to global mat */
2300   ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
2301   if (nearnullsp) {
2302     ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
2303   } else { /* if near null space is not provided it uses constants */
2304     nnsp_has_cnst = PETSC_TRUE;
2305     use_nnsp_true = PETSC_TRUE;
2306   }
2307   if (nnsp_has_cnst) {
2308     nnsp_addone = 1;
2309   }
2310   /*
2311        Evaluate maximum storage size needed by the procedure
2312        - temp_indices will contain start index of each constraint stored as follows
2313        - temp_indices_to_constraint  [temp_indices[i],...,temp[indices[i+1]-1] will contain the indices (in local numbering) on which the constraint acts
2314        - temp_indices_to_constraint_B[temp_indices[i],...,temp[indices[i+1]-1] will contain the indices (in boundary numbering) on which the constraint acts
2315        - temp_quadrature_constraint  [temp_indices[i],...,temp[indices[i+1]-1] will contain the scalars representing the constraint itself
2316                                                                                                                                                          */
2317 
2318   total_counts = pcbddc->n_ISForFaces+pcbddc->n_ISForEdges;
2319   total_counts *= (nnsp_addone+nnsp_size);
2320   ierr = ISGetSize(pcbddc->ISForVertices,&n_vertices);CHKERRQ(ierr);
2321   total_counts += n_vertices;
2322   ierr = PetscMalloc((total_counts+1)*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
2323   ierr = PetscMalloc((total_counts+1)*sizeof(PetscBool),&change_basis);CHKERRQ(ierr);
2324   total_counts = 0;
2325   max_size_of_constraint = 0;
2326   for (i=0;i<pcbddc->n_ISForEdges+pcbddc->n_ISForFaces;i++){
2327     if (i<pcbddc->n_ISForEdges){
2328       used_IS = &pcbddc->ISForEdges[i];
2329     } else {
2330       used_IS = &pcbddc->ISForFaces[i-pcbddc->n_ISForEdges];
2331     }
2332     ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
2333     total_counts += j;
2334     if (j>max_size_of_constraint) max_size_of_constraint=j;
2335   }
2336   total_counts *= (nnsp_addone+nnsp_size);
2337   total_counts += n_vertices;
2338   ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&temp_quadrature_constraint);CHKERRQ(ierr);
2339   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint);CHKERRQ(ierr);
2340   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint_B);CHKERRQ(ierr);
2341   ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&local_to_B);CHKERRQ(ierr);
2342   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2343   for (i=0;i<pcis->n;i++) {
2344     local_to_B[i]=-1;
2345   }
2346   for (i=0;i<pcis->n_B;i++) {
2347     local_to_B[is_indices[i]]=i;
2348   }
2349   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2350 
2351   /* First we issue queries to allocate optimal workspace for LAPACKgesvd or LAPACKsyev/LAPACKheev */
2352   rwork = 0;
2353   work = 0;
2354   singular_vals = 0;
2355   temp_basis = 0;
2356   correlation_mat = 0;
2357   if (!pcbddc->use_nnsp_true) {
2358     PetscScalar temp_work;
2359 #if defined(PETSC_MISSING_LAPACK_GESVD)
2360     /* POD */
2361     PetscInt max_n;
2362     max_n = nnsp_addone+nnsp_size;
2363     /* using some techniques borrowed from Proper Orthogonal Decomposition */
2364     ierr = PetscMalloc(max_n*max_n*sizeof(PetscScalar),&correlation_mat);CHKERRQ(ierr);
2365     ierr = PetscMalloc(max_n*max_n*sizeof(PetscScalar),&singular_vectors);CHKERRQ(ierr);
2366     ierr = PetscMalloc(max_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
2367     ierr = PetscMalloc(max_size_of_constraint*(nnsp_addone+nnsp_size)*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr);
2368 #if defined(PETSC_USE_COMPLEX)
2369     ierr = PetscMalloc(3*max_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
2370 #endif
2371     ierr = PetscMalloc(5*max_n*sizeof(PetscBLASInt),&iwork);CHKERRQ(ierr);
2372     ierr = PetscMalloc(max_n*sizeof(PetscBLASInt),&ifail);CHKERRQ(ierr);
2373     /* now we evaluate the optimal workspace using query with lwork=-1 */
2374     Bt = PetscBLASIntCast(max_n);
2375     lwork=-1;
2376     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2377 #if !defined(PETSC_USE_COMPLEX)
2378     abs_tol=1.e-8;
2379 /*    LAPACKsyev_("V","U",&Bt,correlation_mat,&Bt,singular_vals,&temp_work,&lwork,&lierr); */
2380     LAPACKsyevx_("V","A","U",&Bt,correlation_mat,&Bt,&dummy_real,&dummy_real,&dummy_int,&dummy_int,
2381                  &abs_tol,&eigs_found,singular_vals,singular_vectors,&Bt,&temp_work,&lwork,iwork,ifail,&lierr);
2382 #else
2383 /*    LAPACKsyev_("V","U",&Bt,correlation_mat,&Bt,singular_vals,&temp_work,&lwork,rwork,&lierr); */
2384 /*  LAPACK call is missing here! TODO */
2385     SETERRQ(((PetscObject) pc)->comm, PETSC_ERR_SUP, "Not yet implemented for complexes when PETSC_MISSING_GESVD = 1");
2386 #endif
2387     if ( lierr ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEVX Lapack routine %d",(int)lierr);
2388     ierr = PetscFPTrapPop();CHKERRQ(ierr);
2389 #else /* on missing GESVD */
2390     /* SVD */
2391     PetscInt max_n,min_n;
2392     max_n = max_size_of_constraint;
2393     min_n = nnsp_addone+nnsp_size;
2394     if (max_size_of_constraint < ( nnsp_addone+nnsp_size ) ) {
2395       min_n = max_size_of_constraint;
2396       max_n = nnsp_addone+nnsp_size;
2397     }
2398     ierr = PetscMalloc(min_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
2399 #if defined(PETSC_USE_COMPLEX)
2400     ierr = PetscMalloc(5*min_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
2401 #endif
2402     /* now we evaluate the optimal workspace using query with lwork=-1 */
2403     lwork=-1;
2404     Bs = PetscBLASIntCast(max_n);
2405     Bt = PetscBLASIntCast(min_n);
2406     dummy_int = Bs;
2407     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2408 #if !defined(PETSC_USE_COMPLEX)
2409     LAPACKgesvd_("O","N",&Bs,&Bt,&temp_quadrature_constraint[0],&Bs,singular_vals,
2410                  &dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,&temp_work,&lwork,&lierr);
2411 #else
2412     LAPACKgesvd_("O","N",&Bs,&Bt,&temp_quadrature_constraint[0],&Bs,singular_vals,
2413                  &dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,&temp_work,&lwork,rwork,&lierr);
2414 #endif
2415     if ( lierr ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SVD Lapack routine %d",(int)lierr);
2416     ierr = PetscFPTrapPop();CHKERRQ(ierr);
2417 #endif
2418     /* Allocate optimal workspace */
2419     lwork = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work));
2420     total_counts = (PetscInt)lwork;
2421     ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&work);CHKERRQ(ierr);
2422   }
2423   /* get local part of global near null space vectors */
2424   ierr = PetscMalloc(nnsp_size*sizeof(Vec),&localnearnullsp);CHKERRQ(ierr);
2425   for (k=0;k<nnsp_size;k++) {
2426     ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
2427     ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2428     ierr = VecScatterEnd  (matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2429   }
2430   /* Now we can loop on constraining sets */
2431   total_counts=0;
2432   temp_indices[0]=0;
2433   /* vertices */
2434   PetscBool used_vertex;
2435   ierr = ISGetIndices(pcbddc->ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2436   if (nnsp_has_cnst) { /* consider all vertices */
2437     for (i=0;i<n_vertices;i++) {
2438       temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
2439       temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
2440       temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
2441       temp_indices[total_counts+1]=temp_indices[total_counts]+1;
2442       change_basis[total_counts]=PETSC_FALSE;
2443       total_counts++;
2444     }
2445   } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
2446     for (i=0;i<n_vertices;i++) {
2447       used_vertex=PETSC_FALSE;
2448       k=0;
2449       while(!used_vertex && k<nnsp_size) {
2450         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array_vector);CHKERRQ(ierr);
2451         if (PetscAbsScalar(array_vector[is_indices[i]])>0.0) {
2452           temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
2453           temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
2454           temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
2455           temp_indices[total_counts+1]=temp_indices[total_counts]+1;
2456           change_basis[total_counts]=PETSC_FALSE;
2457           total_counts++;
2458           used_vertex=PETSC_TRUE;
2459         }
2460         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array_vector);CHKERRQ(ierr);
2461         k++;
2462       }
2463     }
2464   }
2465   ierr = ISRestoreIndices(pcbddc->ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2466   n_vertices=total_counts;
2467   /* edges and faces */
2468   for (i=0;i<pcbddc->n_ISForEdges+pcbddc->n_ISForFaces;i++){
2469     if (i<pcbddc->n_ISForEdges){
2470       used_IS = &pcbddc->ISForEdges[i];
2471       boolforface = pcbddc->usechangeofbasis;
2472     } else {
2473       used_IS = &pcbddc->ISForFaces[i-pcbddc->n_ISForEdges];
2474       boolforface = pcbddc->usechangeonfaces;
2475     }
2476     temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
2477     temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
2478     ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
2479     ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2480     if (nnsp_has_cnst) {
2481       temp_constraints++;
2482       quad_value = (PetscScalar) (1.0/PetscSqrtReal((PetscReal)size_of_constraint));
2483       for (j=0;j<size_of_constraint;j++) {
2484         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
2485         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
2486         temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
2487       }
2488       temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
2489       change_basis[total_counts]=boolforface;
2490       total_counts++;
2491     }
2492     for (k=0;k<nnsp_size;k++) {
2493       ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array_vector);CHKERRQ(ierr);
2494       for (j=0;j<size_of_constraint;j++) {
2495         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
2496         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
2497         temp_quadrature_constraint[temp_indices[total_counts]+j]=array_vector[is_indices[j]];
2498       }
2499       ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array_vector);CHKERRQ(ierr);
2500       quad_value = 1.0;
2501       if ( use_nnsp_true ) { /* check if array is null on the connected component in case use_nnsp_true has been requested */
2502         Bs = PetscBLASIntCast(size_of_constraint);
2503         quad_value = BLASasum_(&Bs,&temp_quadrature_constraint[temp_indices[total_counts]],&Bone);
2504       }
2505       if ( quad_value > 0.0 ) { /* keep indices and values */
2506         temp_constraints++;
2507         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
2508         change_basis[total_counts]=boolforface;
2509         total_counts++;
2510       }
2511     }
2512     ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2513     /* perform SVD on the constraint if use_nnsp_true has not be requested by the user */
2514     if (!use_nnsp_true) {
2515 
2516       Bs = PetscBLASIntCast(size_of_constraint);
2517       Bt = PetscBLASIntCast(temp_constraints);
2518 
2519 #if defined(PETSC_MISSING_LAPACK_GESVD)
2520       ierr = PetscMemzero(correlation_mat,Bt*Bt*sizeof(PetscScalar));CHKERRQ(ierr);
2521       /* Store upper triangular part of correlation matrix */
2522       for (j=0;j<temp_constraints;j++) {
2523         for (k=0;k<j+1;k++) {
2524 #if defined(PETSC_USE_COMPLEX)
2525           /* hand made complex dot product -> replace */
2526           dot_result = 0.0;
2527           for (ii=0; ii<size_of_constraint; ii++) {
2528             val1 = temp_quadrature_constraint[temp_indices[temp_start_ptr+j]+ii];
2529             val2 = temp_quadrature_constraint[temp_indices[temp_start_ptr+k]+ii];
2530             dot_result += val1*PetscConj(val2);
2531           }
2532 #else
2533           dot_result = BLASdot_(&Bs,&temp_quadrature_constraint[temp_indices[temp_start_ptr+j]],&Bone,
2534                                     &temp_quadrature_constraint[temp_indices[temp_start_ptr+k]],&Bone);
2535 #endif
2536           correlation_mat[j*temp_constraints+k]=dot_result;
2537         }
2538       }
2539       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2540 #if !defined(PETSC_USE_COMPLEX)
2541 /*      LAPACKsyev_("V","U",&Bt,correlation_mat,&Bt,singular_vals,work,&lwork,&lierr); */
2542       LAPACKsyevx_("V","A","U",&Bt,correlation_mat,&Bt,&dummy_real,&dummy_real,&dummy_int,&dummy_int,
2543                  &abs_tol,&eigs_found,singular_vals,singular_vectors,&Bt,work,&lwork,iwork,ifail,&lierr);
2544 #else
2545 /*  LAPACK call is missing here! TODO */
2546       SETERRQ(((PetscObject) pc)->comm, PETSC_ERR_SUP, "Not yet implemented for complexes when PETSC_MISSING_GESVD = 1");
2547 #endif
2548       if ( lierr ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEVX Lapack routine %d",(int)lierr);
2549       ierr = PetscFPTrapPop();CHKERRQ(ierr);
2550       /* retain eigenvalues greater than tol: note that lapack SYEV gives eigs in ascending order */
2551       j=0;
2552       while( j < Bt && singular_vals[j] < tol) j++;
2553       total_counts=total_counts-j;
2554       if (j<temp_constraints) {
2555         for (k=j;k<Bt;k++) { singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]); }
2556         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2557         BLASgemm_("N","N",&Bs,&Bt,&Bt,&one,&temp_quadrature_constraint[temp_indices[temp_start_ptr]],&Bs,correlation_mat,&Bt,&zero,temp_basis,&Bs);
2558         ierr = PetscFPTrapPop();CHKERRQ(ierr);
2559         /* copy POD basis into used quadrature memory */
2560         for (k=0;k<Bt-j;k++) {
2561           for (ii=0;ii<size_of_constraint;ii++) {
2562             temp_quadrature_constraint[temp_indices[temp_start_ptr+k]+ii]=singular_vals[Bt-1-k]*temp_basis[(Bt-1-k)*size_of_constraint+ii];
2563           }
2564         }
2565       }
2566 
2567 #else  /* on missing GESVD */
2568       PetscInt min_n = temp_constraints;
2569       if (min_n > size_of_constraint) min_n = size_of_constraint;
2570       dummy_int = Bs;
2571       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2572 #if !defined(PETSC_USE_COMPLEX)
2573       LAPACKgesvd_("O","N",&Bs,&Bt,&temp_quadrature_constraint[temp_indices[temp_start_ptr]],&Bs,singular_vals,
2574                    &dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,work,&lwork,&lierr);
2575 #else
2576       LAPACKgesvd_("O","N",&Bs,&Bt,&temp_quadrature_constraint[temp_indices[temp_start_ptr]],&Bs,singular_vals,
2577                    &dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,work,&lwork,rwork,&lierr);
2578 #endif
2579       if ( lierr ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SVD Lapack routine %d",(int)lierr);
2580       ierr = PetscFPTrapPop();CHKERRQ(ierr);
2581       /* retain eigenvalues greater than tol: note that lapack SVD gives eigs in descending order */
2582       j=0;
2583       while( j < min_n && singular_vals[min_n-j-1] < tol) j++;
2584       total_counts = total_counts-(PetscInt)Bt+(min_n-j);
2585 #endif
2586     }
2587   }
2588 
2589   n_constraints=total_counts-n_vertices;
2590   local_primal_size = total_counts;
2591   /* set quantities in pcbddc data structure */
2592   pcbddc->n_vertices = n_vertices;
2593   pcbddc->n_constraints = n_constraints;
2594   pcbddc->local_primal_size = local_primal_size;
2595 
2596   /* Create constraint matrix */
2597   /* The constraint matrix is used to compute the l2g map of primal dofs */
2598   /* so we need to set it up properly either with or without change of basis */
2599   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
2600   ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr);
2601   ierr = MatSetSizes(pcbddc->ConstraintMatrix,local_primal_size,pcis->n,local_primal_size,pcis->n);CHKERRQ(ierr);
2602   /* compute a local numbering of constraints : vertices first then constraints */
2603   ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
2604   ierr = VecGetArray(pcis->vec1_N,&array_vector);CHKERRQ(ierr);
2605   ierr = PetscMalloc(local_primal_size*sizeof(PetscInt),&aux_primal_numbering);CHKERRQ(ierr);
2606   ierr = PetscMalloc(local_primal_size*sizeof(PetscInt),&aux_primal_permutation);CHKERRQ(ierr);
2607   total_counts=0;
2608   /* find vertices: subdomain corners plus dofs with basis changed */
2609   for (i=0;i<local_primal_size;i++) {
2610     size_of_constraint=temp_indices[i+1]-temp_indices[i];
2611     if (change_basis[i] || size_of_constraint == 1) {
2612       k=0;
2613       while(k < size_of_constraint && array_vector[temp_indices_to_constraint[temp_indices[i]+size_of_constraint-k-1]] != 0.0) {
2614         k=k+1;
2615       }
2616       j=temp_indices_to_constraint[temp_indices[i]+size_of_constraint-k-1];
2617       array_vector[j] = 1.0;
2618       aux_primal_numbering[total_counts]=j;
2619       aux_primal_permutation[total_counts]=total_counts;
2620       total_counts++;
2621     }
2622   }
2623   ierr = VecRestoreArray(pcis->vec1_N,&array_vector);CHKERRQ(ierr);
2624   /* permute indices in order to have a sorted set of vertices */
2625   ierr = PetscSortIntWithPermutation(total_counts,aux_primal_numbering,aux_primal_permutation);
2626   /* nonzero structure */
2627   ierr = PetscMalloc(local_primal_size*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
2628   for (i=0;i<total_counts;i++) {
2629     nnz[i]=1;
2630   }
2631   j=total_counts;
2632   for (i=n_vertices;i<local_primal_size;i++) {
2633     if (!change_basis[i]) {
2634       nnz[j]=temp_indices[i+1]-temp_indices[i];
2635       j++;
2636     }
2637   }
2638   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
2639   ierr = PetscFree(nnz);CHKERRQ(ierr);
2640   /* set values in constraint matrix */
2641   for (i=0;i<total_counts;i++) {
2642     j = aux_primal_permutation[i];
2643     k = aux_primal_numbering[j];
2644     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,k,1.0,INSERT_VALUES);CHKERRQ(ierr);
2645   }
2646   for (i=n_vertices;i<local_primal_size;i++) {
2647     if (!change_basis[i]) {
2648       size_of_constraint=temp_indices[i+1]-temp_indices[i];
2649       ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&total_counts,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],&temp_quadrature_constraint[temp_indices[i]],INSERT_VALUES);CHKERRQ(ierr);
2650       total_counts++;
2651     }
2652   }
2653   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2654   ierr = PetscFree(aux_primal_permutation);CHKERRQ(ierr);
2655   /* assembling */
2656   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2657   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2658 
2659   /* Create matrix for change of basis. We don't need it in case pcbddc->usechangeofbasis is FALSE */
2660   if (pcbddc->usechangeofbasis) {
2661     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
2662     ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr);
2663     ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr);
2664     /* work arrays */
2665     /* we need to reuse these arrays, so we free them */
2666     ierr = PetscFree(temp_basis);CHKERRQ(ierr);
2667     ierr = PetscFree(work);CHKERRQ(ierr);
2668     ierr = PetscMalloc(pcis->n_B*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
2669     ierr = PetscMalloc((nnsp_addone+nnsp_size)*(nnsp_addone+nnsp_size)*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr);
2670     ierr = PetscMalloc((nnsp_addone+nnsp_size)*sizeof(PetscScalar),&work);CHKERRQ(ierr);
2671     ierr = PetscMalloc((nnsp_addone+nnsp_size)*sizeof(PetscBLASInt),&ipiv);CHKERRQ(ierr);
2672     for (i=0;i<pcis->n_B;i++) {
2673       nnz[i]=1;
2674     }
2675     /* Overestimated nonzeros per row */
2676     k=1;
2677     for (i=pcbddc->n_vertices;i<local_primal_size;i++) {
2678       if (change_basis[i]) {
2679         size_of_constraint = temp_indices[i+1]-temp_indices[i];
2680         if (k < size_of_constraint) {
2681           k = size_of_constraint;
2682         }
2683         for (j=0;j<size_of_constraint;j++) {
2684           nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
2685         }
2686       }
2687     }
2688     ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
2689     ierr = PetscFree(nnz);CHKERRQ(ierr);
2690     /* Temporary array to store indices */
2691     ierr = PetscMalloc(k*sizeof(PetscInt),&is_indices);CHKERRQ(ierr);
2692     /* Set initial identity in the matrix */
2693     for (i=0;i<pcis->n_B;i++) {
2694       ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
2695     }
2696     /* Now we loop on the constraints which need a change of basis */
2697     /* Change of basis matrix is evaluated as the FIRST APPROACH in */
2698     /* Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (6.2.1) */
2699     temp_constraints = 0;
2700     if (pcbddc->n_vertices < local_primal_size) {
2701       temp_start_ptr = temp_indices_to_constraint_B[temp_indices[pcbddc->n_vertices]];
2702     }
2703     for (i=pcbddc->n_vertices;i<local_primal_size;i++) {
2704       if (change_basis[i]) {
2705         compute_submatrix = PETSC_FALSE;
2706         useksp = PETSC_FALSE;
2707         if (temp_start_ptr == temp_indices_to_constraint_B[temp_indices[i]]) {
2708           temp_constraints++;
2709           if (i == local_primal_size -1 ||  temp_start_ptr != temp_indices_to_constraint_B[temp_indices[i+1]]) {
2710             compute_submatrix = PETSC_TRUE;
2711           }
2712         }
2713         if (compute_submatrix) {
2714           if (temp_constraints > 1 || pcbddc->use_nnsp_true) {
2715             useksp = PETSC_TRUE;
2716           }
2717           size_of_constraint = temp_indices[i+1]-temp_indices[i];
2718           if (useksp) { /* experimental */
2719             ierr = MatCreate(PETSC_COMM_SELF,&temp_mat);CHKERRQ(ierr);
2720             ierr = MatSetType(temp_mat,impMatType);CHKERRQ(ierr);
2721             ierr = MatSetSizes(temp_mat,size_of_constraint,size_of_constraint,size_of_constraint,size_of_constraint);CHKERRQ(ierr);
2722             ierr = MatSeqAIJSetPreallocation(temp_mat,size_of_constraint,PETSC_NULL);CHKERRQ(ierr);
2723           }
2724           /* First _size_of_constraint-temp_constraints_ columns */
2725           dual_dofs = size_of_constraint-temp_constraints;
2726           start_constraint = i+1-temp_constraints;
2727           for (s=0;s<dual_dofs;s++) {
2728             is_indices[0] = s;
2729             for (j=0;j<temp_constraints;j++) {
2730               for (k=0;k<temp_constraints;k++) {
2731                 temp_basis[j*temp_constraints+k]=temp_quadrature_constraint[temp_indices[start_constraint+k]+s+j+1];
2732               }
2733               work[j]=-temp_quadrature_constraint[temp_indices[start_constraint+j]+s];
2734               is_indices[j+1]=s+j+1;
2735             }
2736             Bt = temp_constraints;
2737             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2738             LAPACKgesv_(&Bt,&Bone,temp_basis,&Bt,ipiv,work,&Bt,&lierr);
2739             if ( lierr ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESV Lapack routine %d",(int)lierr);
2740             ierr = PetscFPTrapPop();CHKERRQ(ierr);
2741             j = temp_indices_to_constraint_B[temp_indices[start_constraint]+s];
2742             ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,temp_constraints,&temp_indices_to_constraint_B[temp_indices[start_constraint]+s+1],1,&j,work,INSERT_VALUES);CHKERRQ(ierr);
2743             if (useksp) {
2744               /* temp mat with transposed rows and columns */
2745               ierr = MatSetValues(temp_mat,1,&s,temp_constraints,&is_indices[1],work,INSERT_VALUES);CHKERRQ(ierr);
2746               ierr = MatSetValue(temp_mat,is_indices[0],is_indices[0],1.0,INSERT_VALUES);CHKERRQ(ierr);
2747             }
2748           }
2749           if (useksp) {
2750             /* last rows of temp_mat */
2751             for (j=0;j<size_of_constraint;j++) {
2752               is_indices[j] = j;
2753             }
2754             for (s=0;s<temp_constraints;s++) {
2755               k = s + dual_dofs;
2756               ierr = MatSetValues(temp_mat,1,&k,size_of_constraint,is_indices,&temp_quadrature_constraint[temp_indices[start_constraint+s]],INSERT_VALUES);CHKERRQ(ierr);
2757             }
2758             ierr = MatAssemblyBegin(temp_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2759             ierr = MatAssemblyEnd(temp_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2760             ierr = MatGetVecs(temp_mat,&temp_vec,PETSC_NULL);CHKERRQ(ierr);
2761             ierr = KSPCreate(PETSC_COMM_SELF,&temp_ksp);CHKERRQ(ierr);
2762             ierr = KSPSetOperators(temp_ksp,temp_mat,temp_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
2763             ierr = KSPSetType(temp_ksp,KSPPREONLY);CHKERRQ(ierr);
2764             ierr = KSPGetPC(temp_ksp,&temp_pc);CHKERRQ(ierr);
2765             ierr = PCSetType(temp_pc,PCLU);CHKERRQ(ierr);
2766             ierr = KSPSetUp(temp_ksp);CHKERRQ(ierr);
2767             for (s=0;s<temp_constraints;s++) {
2768               ierr = VecSet(temp_vec,0.0);CHKERRQ(ierr);
2769               ierr = VecSetValue(temp_vec,s+dual_dofs,1.0,INSERT_VALUES);CHKERRQ(ierr);
2770               ierr = VecAssemblyBegin(temp_vec);CHKERRQ(ierr);
2771               ierr = VecAssemblyEnd(temp_vec);CHKERRQ(ierr);
2772               ierr = KSPSolve(temp_ksp,temp_vec,temp_vec);CHKERRQ(ierr);
2773               ierr = VecGetArray(temp_vec,&array_vector);CHKERRQ(ierr);
2774               j = temp_indices_to_constraint_B[temp_indices[start_constraint+s]+size_of_constraint-s-1];
2775               /* last columns of change of basis matrix associated to new primal dofs */
2776               ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,&temp_indices_to_constraint_B[temp_indices[start_constraint+s]],1,&j,array_vector,INSERT_VALUES);CHKERRQ(ierr);
2777               ierr = VecRestoreArray(temp_vec,&array_vector);CHKERRQ(ierr);
2778             }
2779             ierr = MatDestroy(&temp_mat);CHKERRQ(ierr);
2780             ierr = KSPDestroy(&temp_ksp);CHKERRQ(ierr);
2781             ierr = VecDestroy(&temp_vec);CHKERRQ(ierr);
2782           } else {
2783             /* last columns of change of basis matrix associated to new primal dofs */
2784             for (s=0;s<temp_constraints;s++) {
2785               j = temp_indices_to_constraint_B[temp_indices[start_constraint+s]+size_of_constraint-s-1];
2786               ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,&temp_indices_to_constraint_B[temp_indices[start_constraint+s]],1,&j,&temp_quadrature_constraint[temp_indices[start_constraint+s]],INSERT_VALUES);CHKERRQ(ierr);
2787             }
2788           }
2789           /* prepare for the next cycle */
2790           temp_constraints = 0;
2791           if (i != local_primal_size -1 ) {
2792             temp_start_ptr = temp_indices_to_constraint_B[temp_indices[i+1]];
2793           }
2794         }
2795       }
2796     }
2797     /* assembling */
2798     ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2799     ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2800     ierr = PetscFree(ipiv);CHKERRQ(ierr);
2801     ierr = PetscFree(is_indices);CHKERRQ(ierr);
2802   }
2803   /* free workspace no longer needed */
2804   ierr = PetscFree(rwork);CHKERRQ(ierr);
2805   ierr = PetscFree(work);CHKERRQ(ierr);
2806   ierr = PetscFree(temp_basis);CHKERRQ(ierr);
2807   ierr = PetscFree(singular_vals);CHKERRQ(ierr);
2808   ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
2809   ierr = PetscFree(temp_indices);CHKERRQ(ierr);
2810   ierr = PetscFree(change_basis);CHKERRQ(ierr);
2811   ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr);
2812   ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
2813   ierr = PetscFree(local_to_B);CHKERRQ(ierr);
2814   ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr);
2815 #if defined(PETSC_MISSING_LAPACK_GESVD)
2816   ierr = PetscFree(iwork);CHKERRQ(ierr);
2817   ierr = PetscFree(ifail);CHKERRQ(ierr);
2818   ierr = PetscFree(singular_vectors);CHKERRQ(ierr);
2819 #endif
2820   for (k=0;k<nnsp_size;k++) {
2821     ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
2822   }
2823   ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
2824   PetscFunctionReturn(0);
2825 }
2826 /* -------------------------------------------------------------------------- */
2827 #undef __FUNCT__
2828 #define __FUNCT__ "PCBDDCCoarseSetUp"
2829 static PetscErrorCode PCBDDCCoarseSetUp(PC pc)
2830 {
2831   PetscErrorCode  ierr;
2832 
2833   PC_IS*            pcis = (PC_IS*)(pc->data);
2834   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
2835   Mat_IS            *matis = (Mat_IS*)pc->pmat->data;
2836   Mat               change_mat_all;
2837   IS                is_R_local;
2838   IS                is_V_local;
2839   IS                is_C_local;
2840   IS                is_aux1;
2841   IS                is_aux2;
2842   const VecType     impVecType;
2843   const MatType     impMatType;
2844   PetscInt          n_R=0;
2845   PetscInt          n_D=0;
2846   PetscInt          n_B=0;
2847   PetscScalar       zero=0.0;
2848   PetscScalar       one=1.0;
2849   PetscScalar       m_one=-1.0;
2850   PetscScalar*      array;
2851   PetscScalar       *coarse_submat_vals;
2852   PetscInt          *idx_R_local;
2853   PetscInt          *idx_V_B;
2854   PetscScalar       *coarsefunctions_errors;
2855   PetscScalar       *constraints_errors;
2856   /* auxiliary indices */
2857   PetscInt i,j,k;
2858   /* for verbose output of bddc */
2859   PetscViewer       viewer=pcbddc->dbg_viewer;
2860   PetscBool         dbg_flag=pcbddc->dbg_flag;
2861   /* for counting coarse dofs */
2862   PetscInt          n_vertices,n_constraints;
2863   PetscInt          size_of_constraint;
2864   PetscInt          *row_cmat_indices;
2865   PetscScalar       *row_cmat_values;
2866   PetscInt          *vertices,*nnz,*is_indices,*temp_indices;
2867 
2868   PetscFunctionBegin;
2869   /* Set Non-overlapping dimensions */
2870   n_B = pcis->n_B; n_D = pcis->n - n_B;
2871   /* Set types for local objects needed by BDDC precondtioner */
2872   impMatType = MATSEQDENSE;
2873   impVecType = VECSEQ;
2874   /* get vertex indices from constraint matrix */
2875   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&vertices);CHKERRQ(ierr);
2876   n_vertices=0;
2877   for (i=0;i<pcbddc->local_primal_size;i++) {
2878     ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,PETSC_NULL);CHKERRQ(ierr);
2879     if (size_of_constraint == 1) {
2880       vertices[n_vertices]=row_cmat_indices[0];
2881       n_vertices++;
2882     }
2883     ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,PETSC_NULL);CHKERRQ(ierr);
2884   }
2885   /* Set number of constraints */
2886   n_constraints = pcbddc->local_primal_size-n_vertices;
2887 
2888   /* vertices in boundary numbering */
2889   if (n_vertices) {
2890     ierr = VecSet(pcis->vec1_N,m_one);CHKERRQ(ierr);
2891     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
2892     for (i=0; i<n_vertices; i++) { array[ vertices[i] ] = i; }
2893     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
2894     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2895     ierr = VecScatterEnd  (pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2896     ierr = PetscMalloc(n_vertices*sizeof(PetscInt),&idx_V_B);CHKERRQ(ierr);
2897     ierr = VecGetArray(pcis->vec1_B,&array);CHKERRQ(ierr);
2898     for (i=0; i<n_vertices; i++) {
2899       j=0;
2900       while (array[j] != i ) {j++;}
2901       idx_V_B[i]=j;
2902     }
2903     ierr = VecRestoreArray(pcis->vec1_B,&array);CHKERRQ(ierr);
2904   }
2905 
2906   /* transform local matrices if needed */
2907   if (pcbddc->usechangeofbasis) {
2908     ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
2909     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2910     for (i=0;i<n_D;i++) {
2911       nnz[is_indices[i]]=1;
2912     }
2913     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2914     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2915     k=1;
2916     for (i=0;i<n_B;i++) {
2917       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
2918       nnz[is_indices[i]]=j;
2919       if ( k < j) {
2920         k = j;
2921       }
2922       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
2923     }
2924     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2925     /* assemble change of basis matrix on the whole set of local dofs */
2926     ierr = PetscMalloc(k*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
2927     ierr = MatCreate(PETSC_COMM_SELF,&change_mat_all);CHKERRQ(ierr);
2928     ierr = MatSetSizes(change_mat_all,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
2929     ierr = MatSetType(change_mat_all,MATSEQAIJ);CHKERRQ(ierr);
2930     ierr = MatSeqAIJSetPreallocation(change_mat_all,0,nnz);CHKERRQ(ierr);
2931     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2932     for (i=0;i<n_D;i++) {
2933       ierr = MatSetValue(change_mat_all,is_indices[i],is_indices[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
2934     }
2935     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2936     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2937     for (i=0;i<n_B;i++) {
2938       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
2939       for (k=0;k<j;k++) {
2940         temp_indices[k]=is_indices[row_cmat_indices[k]];
2941       }
2942       ierr = MatSetValues(change_mat_all,1,&is_indices[i],j,temp_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
2943       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
2944     }
2945     ierr = MatAssemblyBegin(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2946     ierr = MatAssemblyEnd(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2947     ierr = MatPtAP(matis->A,change_mat_all,MAT_INITIAL_MATRIX,1.0,&pcbddc->local_mat);CHKERRQ(ierr);
2948     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
2949     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
2950     ierr = MatDestroy(&pcis->A_BB);CHKERRQ(ierr);
2951     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&pcis->A_IB);CHKERRQ(ierr);
2952     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&pcis->A_BI);CHKERRQ(ierr);
2953     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&pcis->A_BB);CHKERRQ(ierr);
2954     ierr = MatDestroy(&change_mat_all);CHKERRQ(ierr);
2955     ierr = PetscFree(nnz);CHKERRQ(ierr);
2956     ierr = PetscFree(temp_indices);CHKERRQ(ierr);
2957   } else {
2958     /* without change of basis, the local matrix is unchanged */
2959     ierr = PetscObjectReference((PetscObject)matis->A);CHKERRQ(ierr);
2960     pcbddc->local_mat = matis->A;
2961   }
2962   /* Change global null space passed in by the user if change of basis has been performed */
2963   if (pcbddc->NullSpace && pcbddc->usechangeofbasis) {
2964     ierr = PCBDDCAdaptNullSpace(pc);CHKERRQ(ierr);
2965   }
2966 
2967   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
2968   ierr = VecSet(pcis->vec1_N,one);CHKERRQ(ierr);
2969   ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
2970   for (i=0;i<n_vertices;i++) { array[ vertices[i] ] = zero; }
2971   ierr = PetscMalloc(( pcis->n - n_vertices )*sizeof(PetscInt),&idx_R_local);CHKERRQ(ierr);
2972   for (i=0, n_R=0; i<pcis->n; i++) { if (array[i] == one) { idx_R_local[n_R] = i; n_R++; } }
2973   ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
2974   if (dbg_flag) {
2975     ierr = PetscViewerASCIIPrintf(viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
2976     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2977     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
2978     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
2979     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"r_size = %d, v_size = %d, constraints = %d, local_primal_size = %d\n",n_R,n_vertices,n_constraints,pcbddc->local_primal_size);CHKERRQ(ierr);
2980     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr);
2981     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2982   }
2983 
2984   /* Allocate needed vectors */
2985   ierr = VecDuplicate(pcis->vec1_global,&pcbddc->original_rhs);CHKERRQ(ierr);
2986   ierr = VecDuplicate(pcis->vec1_global,&pcbddc->temp_solution);CHKERRQ(ierr);
2987   ierr = VecDuplicate(pcis->vec1_D,&pcbddc->vec4_D);CHKERRQ(ierr);
2988   ierr = VecCreate(PETSC_COMM_SELF,&pcbddc->vec1_R);CHKERRQ(ierr);
2989   ierr = VecSetSizes(pcbddc->vec1_R,n_R,n_R);CHKERRQ(ierr);
2990   ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
2991   ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
2992   ierr = VecCreate(PETSC_COMM_SELF,&pcbddc->vec1_P);CHKERRQ(ierr);
2993   ierr = VecSetSizes(pcbddc->vec1_P,pcbddc->local_primal_size,pcbddc->local_primal_size);CHKERRQ(ierr);
2994   ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
2995 
2996   /* Creating some index sets needed  */
2997   /* For submatrices */
2998   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_R,idx_R_local,PETSC_OWN_POINTER,&is_R_local);CHKERRQ(ierr);
2999   if (n_vertices)    {
3000     ierr = ISCreateGeneral(PETSC_COMM_SELF,n_vertices,vertices,PETSC_OWN_POINTER,&is_V_local);CHKERRQ(ierr);
3001   }
3002   if (n_constraints) {
3003     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_C_local);CHKERRQ(ierr);
3004   }
3005 
3006   /* For VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
3007   {
3008     PetscInt   *aux_array1;
3009     PetscInt   *aux_array2;
3010 
3011     ierr = PetscMalloc( (pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
3012     ierr = PetscMalloc( (pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array2);CHKERRQ(ierr);
3013 
3014     ierr = VecSet(pcis->vec1_global,zero);CHKERRQ(ierr);
3015     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3016     ierr = VecScatterEnd  (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3017     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3018     ierr = VecScatterEnd  (matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3019     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3020     ierr = VecScatterEnd  (pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3021     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3022     for (i=0, j=0; i<n_R; i++) { if ( array[idx_R_local[i]] > one ) { aux_array1[j] = i; j++; } }
3023     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3024     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_COPY_VALUES,&is_aux1);CHKERRQ(ierr);
3025     ierr = VecGetArray(pcis->vec1_B,&array);CHKERRQ(ierr);
3026     for (i=0, j=0; i<n_B; i++) { if ( array[i] > one ) { aux_array2[j] = i; j++; } }
3027     ierr = VecRestoreArray(pcis->vec1_B,&array);CHKERRQ(ierr);
3028     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_COPY_VALUES,&is_aux2);CHKERRQ(ierr);
3029     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
3030     ierr = PetscFree(aux_array1);CHKERRQ(ierr);
3031     ierr = PetscFree(aux_array2);CHKERRQ(ierr);
3032     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
3033     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
3034 
3035     if (pcbddc->prec_type || dbg_flag ) {
3036       ierr = PetscMalloc(n_D*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
3037       ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3038       for (i=0, j=0; i<n_R; i++) { if (array[idx_R_local[i]] == one) { aux_array1[j] = i; j++; } }
3039       ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3040       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_COPY_VALUES,&is_aux1);CHKERRQ(ierr);
3041       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
3042       ierr = PetscFree(aux_array1);CHKERRQ(ierr);
3043       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
3044     }
3045   }
3046 
3047   /* Creating PC contexts for local Dirichlet and Neumann problems */
3048   {
3049     Mat  A_RR;
3050     PC   pc_temp;
3051     /* Matrix for Dirichlet problem is A_II -> we already have it from pcis.c code */
3052     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
3053     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
3054     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II,SAME_PRECONDITIONER);CHKERRQ(ierr);
3055     ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
3056     ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,"dirichlet_");CHKERRQ(ierr);
3057     /* default */
3058     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
3059     ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
3060     /* Allow user's customization */
3061     ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
3062     /* Set Up KSP for Dirichlet problem of BDDC */
3063     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
3064     /* set ksp_D into pcis data */
3065     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
3066     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
3067     pcis->ksp_D = pcbddc->ksp_D;
3068     /* Matrix for Neumann problem is A_RR -> we need to create it */
3069     ierr = MatGetSubMatrix(pcbddc->local_mat,is_R_local,is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
3070     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
3071     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
3072     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR,SAME_PRECONDITIONER);CHKERRQ(ierr);
3073     ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
3074     ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,"neumann_");CHKERRQ(ierr);
3075     /* default */
3076     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
3077     ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
3078     /* Allow user's customization */
3079     ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
3080     /* Set Up KSP for Neumann problem of BDDC */
3081     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
3082     /* check Dirichlet and Neumann solvers */
3083     {
3084       Vec         temp_vec;
3085       PetscReal   value;
3086       PetscMPIInt use_exact,use_exact_reduced;
3087 
3088       ierr = VecDuplicate(pcis->vec1_D,&temp_vec);CHKERRQ(ierr);
3089       ierr = VecSetRandom(pcis->vec1_D,PETSC_NULL);CHKERRQ(ierr);
3090       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
3091       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,temp_vec);CHKERRQ(ierr);
3092       ierr = VecAXPY(temp_vec,m_one,pcis->vec1_D);CHKERRQ(ierr);
3093       ierr = VecNorm(temp_vec,NORM_INFINITY,&value);CHKERRQ(ierr);
3094       use_exact = 1;
3095       if (PetscAbsReal(value) > 1.e-4) {
3096         use_exact = 0;
3097       }
3098       ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_INT,MPI_LAND,((PetscObject)pc)->comm);CHKERRQ(ierr);
3099       pcbddc->use_exact_dirichlet = (PetscBool) use_exact_reduced;
3100       ierr = VecDestroy(&temp_vec);CHKERRQ(ierr);
3101       if (dbg_flag) {
3102         ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
3103         ierr = PetscViewerASCIIPrintf(viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3104         ierr = PetscViewerASCIIPrintf(viewer,"Checking solution of Dirichlet and Neumann problems\n");CHKERRQ(ierr);
3105         ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d infinity error for Dirichlet solve = % 1.14e \n",PetscGlobalRank,value);CHKERRQ(ierr);
3106         ierr = VecDuplicate(pcbddc->vec1_R,&temp_vec);CHKERRQ(ierr);
3107         ierr = VecSetRandom(pcbddc->vec1_R,PETSC_NULL);CHKERRQ(ierr);
3108         ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3109         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,temp_vec);CHKERRQ(ierr);
3110         ierr = VecAXPY(temp_vec,m_one,pcbddc->vec1_R);CHKERRQ(ierr);
3111         ierr = VecNorm(temp_vec,NORM_INFINITY,&value);CHKERRQ(ierr);
3112         ierr = VecDestroy(&temp_vec);CHKERRQ(ierr);
3113         ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d infinity error for  Neumann  solve = % 1.14e \n",PetscGlobalRank,value);CHKERRQ(ierr);
3114         ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
3115       }
3116     }
3117     /* free Neumann problem's matrix */
3118     ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
3119   }
3120 
3121   /* Assemble all remaining stuff needed to apply BDDC  */
3122   {
3123     Mat          A_RV,A_VR,A_VV;
3124     Mat          M1;
3125     Mat          C_CR;
3126     Mat          AUXMAT;
3127     Vec          vec1_C;
3128     Vec          vec2_C;
3129     Vec          vec1_V;
3130     Vec          vec2_V;
3131     PetscInt     *nnz;
3132     PetscInt     *auxindices;
3133     PetscInt     index;
3134     PetscScalar* array2;
3135     MatFactorInfo matinfo;
3136 
3137     /* Allocating some extra storage just to be safe */
3138     ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
3139     ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&auxindices);CHKERRQ(ierr);
3140     for (i=0;i<pcis->n;i++) {auxindices[i]=i;}
3141 
3142     /* some work vectors on vertices and/or constraints */
3143     if (n_vertices) {
3144       ierr = VecCreate(PETSC_COMM_SELF,&vec1_V);CHKERRQ(ierr);
3145       ierr = VecSetSizes(vec1_V,n_vertices,n_vertices);CHKERRQ(ierr);
3146       ierr = VecSetType(vec1_V,impVecType);CHKERRQ(ierr);
3147       ierr = VecDuplicate(vec1_V,&vec2_V);CHKERRQ(ierr);
3148     }
3149     if (n_constraints) {
3150       ierr = VecCreate(PETSC_COMM_SELF,&vec1_C);CHKERRQ(ierr);
3151       ierr = VecSetSizes(vec1_C,n_constraints,n_constraints);CHKERRQ(ierr);
3152       ierr = VecSetType(vec1_C,impVecType);CHKERRQ(ierr);
3153       ierr = VecDuplicate(vec1_C,&vec2_C);CHKERRQ(ierr);
3154       ierr = VecDuplicate(vec1_C,&pcbddc->vec1_C);CHKERRQ(ierr);
3155     }
3156     /* Precompute stuffs needed for preprocessing and application of BDDC*/
3157     if (n_constraints) {
3158       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3159       ierr = MatSetSizes(pcbddc->local_auxmat2,n_R,n_constraints,n_R,n_constraints);CHKERRQ(ierr);
3160       ierr = MatSetType(pcbddc->local_auxmat2,impMatType);CHKERRQ(ierr);
3161       ierr = MatSeqDenseSetPreallocation(pcbddc->local_auxmat2,PETSC_NULL);CHKERRQ(ierr);
3162 
3163       /* Create Constraint matrix on R nodes: C_{CR}  */
3164       ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_C_local,is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
3165       ierr = ISDestroy(&is_C_local);CHKERRQ(ierr);
3166 
3167       /* Assemble local_auxmat2 = - A_{RR}^{-1} C^T_{CR} needed by BDDC application */
3168       for (i=0;i<n_constraints;i++) {
3169         ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
3170         /* Get row of constraint matrix in R numbering */
3171         ierr = VecGetArray(pcbddc->vec1_R,&array);CHKERRQ(ierr);
3172         ierr = MatGetRow(C_CR,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
3173         for (j=0;j<size_of_constraint;j++) { array[ row_cmat_indices[j] ] = - row_cmat_values[j]; }
3174         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
3175         ierr = VecRestoreArray(pcbddc->vec1_R,&array);CHKERRQ(ierr);
3176         /* Solve for row of constraint matrix in R numbering */
3177         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3178         /* Set values */
3179         ierr = VecGetArray(pcbddc->vec2_R,&array);CHKERRQ(ierr);
3180         ierr = MatSetValues(pcbddc->local_auxmat2,n_R,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
3181         ierr = VecRestoreArray(pcbddc->vec2_R,&array);CHKERRQ(ierr);
3182       }
3183       ierr = MatAssemblyBegin(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3184       ierr = MatAssemblyEnd(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3185 
3186       /* Assemble AUXMAT = ( LUFactor )( -C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1} */
3187       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&AUXMAT);CHKERRQ(ierr);
3188       ierr = MatFactorInfoInitialize(&matinfo);CHKERRQ(ierr);
3189       ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,0,1,&is_aux1);CHKERRQ(ierr);
3190       ierr = MatLUFactor(AUXMAT,is_aux1,is_aux1,&matinfo);CHKERRQ(ierr);
3191       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
3192 
3193       /* Assemble explicitly M1 = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1} needed in preproc  */
3194       ierr = MatCreate(PETSC_COMM_SELF,&M1);CHKERRQ(ierr);
3195       ierr = MatSetSizes(M1,n_constraints,n_constraints,n_constraints,n_constraints);CHKERRQ(ierr);
3196       ierr = MatSetType(M1,impMatType);CHKERRQ(ierr);
3197       ierr = MatSeqDenseSetPreallocation(M1,PETSC_NULL);CHKERRQ(ierr);
3198       for (i=0;i<n_constraints;i++) {
3199         ierr = VecSet(vec1_C,zero);CHKERRQ(ierr);
3200         ierr = VecSetValue(vec1_C,i,one,INSERT_VALUES);CHKERRQ(ierr);
3201         ierr = VecAssemblyBegin(vec1_C);CHKERRQ(ierr);
3202         ierr = VecAssemblyEnd(vec1_C);CHKERRQ(ierr);
3203         ierr = MatSolve(AUXMAT,vec1_C,vec2_C);CHKERRQ(ierr);
3204         ierr = VecScale(vec2_C,m_one);CHKERRQ(ierr);
3205         ierr = VecGetArray(vec2_C,&array);CHKERRQ(ierr);
3206         ierr = MatSetValues(M1,n_constraints,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
3207         ierr = VecRestoreArray(vec2_C,&array);CHKERRQ(ierr);
3208       }
3209       ierr = MatAssemblyBegin(M1,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3210       ierr = MatAssemblyEnd(M1,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3211       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
3212       /* Assemble local_auxmat1 = M1*C_{CR} needed by BDDC application in KSP and in preproc */
3213       ierr = MatMatMult(M1,C_CR,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
3214 
3215     }
3216 
3217     /* Get submatrices from subdomain matrix */
3218     if (n_vertices){
3219       ierr = MatGetSubMatrix(pcbddc->local_mat,is_R_local,is_V_local,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3220       ierr = MatGetSubMatrix(pcbddc->local_mat,is_V_local,is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3221       ierr = MatGetSubMatrix(pcbddc->local_mat,is_V_local,is_V_local,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3222     }
3223 
3224     /* Matrix of coarse basis functions (local) */
3225     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3226     ierr = MatSetSizes(pcbddc->coarse_phi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
3227     ierr = MatSetType(pcbddc->coarse_phi_B,impMatType);CHKERRQ(ierr);
3228     ierr = MatSeqDenseSetPreallocation(pcbddc->coarse_phi_B,PETSC_NULL);CHKERRQ(ierr);
3229     if (pcbddc->prec_type || dbg_flag ) {
3230       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3231       ierr = MatSetSizes(pcbddc->coarse_phi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
3232       ierr = MatSetType(pcbddc->coarse_phi_D,impMatType);CHKERRQ(ierr);
3233       ierr = MatSeqDenseSetPreallocation(pcbddc->coarse_phi_D,PETSC_NULL);CHKERRQ(ierr);
3234     }
3235 
3236     if (dbg_flag) {
3237       ierr = PetscMalloc( pcbddc->local_primal_size*sizeof(PetscScalar),&coarsefunctions_errors);CHKERRQ(ierr);
3238       ierr = PetscMalloc( pcbddc->local_primal_size*sizeof(PetscScalar),&constraints_errors);CHKERRQ(ierr);
3239     }
3240     /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3241     ierr = PetscMalloc ((pcbddc->local_primal_size)*(pcbddc->local_primal_size)*sizeof(PetscScalar),&coarse_submat_vals);CHKERRQ(ierr);
3242 
3243     /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
3244     for (i=0;i<n_vertices;i++){
3245       ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
3246       ierr = VecSetValue(vec1_V,i,one,INSERT_VALUES);CHKERRQ(ierr);
3247       ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
3248       ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
3249       /* solution of saddle point problem */
3250       ierr = MatMult(A_RV,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
3251       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
3252       ierr = VecScale(pcbddc->vec1_R,m_one);CHKERRQ(ierr);
3253       if (n_constraints) {
3254         ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec1_R,vec1_C);CHKERRQ(ierr);
3255         ierr = MatMultAdd(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
3256         ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
3257       }
3258       ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
3259       ierr = MatMultAdd(A_VV,vec1_V,vec2_V,vec2_V);CHKERRQ(ierr);
3260 
3261       /* Set values in coarse basis function and subdomain part of coarse_mat */
3262       /* coarse basis functions */
3263       ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
3264       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3265       ierr = VecScatterEnd  (pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3266       ierr = VecGetArray(pcis->vec1_B,&array);CHKERRQ(ierr);
3267       ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
3268       ierr = VecRestoreArray(pcis->vec1_B,&array);CHKERRQ(ierr);
3269       ierr = MatSetValue(pcbddc->coarse_phi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
3270       if ( pcbddc->prec_type || dbg_flag  ) {
3271         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3272         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3273         ierr = VecGetArray(pcis->vec1_D,&array);CHKERRQ(ierr);
3274         ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
3275         ierr = VecRestoreArray(pcis->vec1_D,&array);CHKERRQ(ierr);
3276       }
3277       /* subdomain contribution to coarse matrix */
3278       ierr = VecGetArray(vec2_V,&array);CHKERRQ(ierr);
3279       for (j=0;j<n_vertices;j++) { coarse_submat_vals[i*pcbddc->local_primal_size+j] = array[j]; } /* WARNING -> column major ordering */
3280       ierr = VecRestoreArray(vec2_V,&array);CHKERRQ(ierr);
3281       if (n_constraints) {
3282         ierr = VecGetArray(vec1_C,&array);CHKERRQ(ierr);
3283         for (j=0;j<n_constraints;j++) { coarse_submat_vals[i*pcbddc->local_primal_size+j+n_vertices] = array[j]; } /* WARNING -> column major ordering */
3284         ierr = VecRestoreArray(vec1_C,&array);CHKERRQ(ierr);
3285       }
3286 
3287       if ( dbg_flag ) {
3288         /* assemble subdomain vector on nodes */
3289         ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
3290         ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3291         ierr = VecGetArray(pcbddc->vec1_R,&array2);CHKERRQ(ierr);
3292         for (j=0;j<n_R;j++) { array[idx_R_local[j]] = array2[j]; }
3293         array[ vertices[i] ] = one;
3294         ierr = VecRestoreArray(pcbddc->vec1_R,&array2);CHKERRQ(ierr);
3295         ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3296         /* assemble subdomain vector of lagrange multipliers (i.e. primal nodes) */
3297         ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
3298         ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
3299         ierr = VecGetArray(vec2_V,&array);CHKERRQ(ierr);
3300         for (j=0;j<n_vertices;j++) { array2[j]=array[j]; }
3301         ierr = VecRestoreArray(vec2_V,&array);CHKERRQ(ierr);
3302         if (n_constraints) {
3303           ierr = VecGetArray(vec1_C,&array);CHKERRQ(ierr);
3304           for (j=0;j<n_constraints;j++) { array2[j+n_vertices]=array[j]; }
3305           ierr = VecRestoreArray(vec1_C,&array);CHKERRQ(ierr);
3306         }
3307         ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
3308         ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
3309         /* check saddle point solution */
3310         ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
3311         ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
3312         ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i]);CHKERRQ(ierr);
3313         ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
3314         ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
3315         array[i]=array[i]+m_one;  /* shift by the identity matrix */
3316         ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
3317         ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i]);CHKERRQ(ierr);
3318       }
3319     }
3320 
3321     for (i=0;i<n_constraints;i++){
3322       ierr = VecSet(vec2_C,zero);CHKERRQ(ierr);
3323       ierr = VecSetValue(vec2_C,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
3324       ierr = VecAssemblyBegin(vec2_C);CHKERRQ(ierr);
3325       ierr = VecAssemblyEnd(vec2_C);CHKERRQ(ierr);
3326       /* solution of saddle point problem */
3327       ierr = MatMult(M1,vec2_C,vec1_C);CHKERRQ(ierr);
3328       ierr = MatMult(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
3329       ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
3330       if (n_vertices) { ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr); }
3331       /* Set values in coarse basis function and subdomain part of coarse_mat */
3332       /* coarse basis functions */
3333       index=i+n_vertices;
3334       ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
3335       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3336       ierr = VecScatterEnd  (pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3337       ierr = VecGetArray(pcis->vec1_B,&array);CHKERRQ(ierr);
3338       ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&index,array,INSERT_VALUES);CHKERRQ(ierr);
3339       ierr = VecRestoreArray(pcis->vec1_B,&array);CHKERRQ(ierr);
3340       if ( pcbddc->prec_type || dbg_flag ) {
3341         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3342         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3343         ierr = VecGetArray(pcis->vec1_D,&array);CHKERRQ(ierr);
3344         ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&index,array,INSERT_VALUES);CHKERRQ(ierr);
3345         ierr = VecRestoreArray(pcis->vec1_D,&array);CHKERRQ(ierr);
3346       }
3347       /* subdomain contribution to coarse matrix */
3348       if (n_vertices) {
3349         ierr = VecGetArray(vec2_V,&array);CHKERRQ(ierr);
3350         for (j=0;j<n_vertices;j++) {coarse_submat_vals[index*pcbddc->local_primal_size+j]=array[j];} /* WARNING -> column major ordering */
3351         ierr = VecRestoreArray(vec2_V,&array);CHKERRQ(ierr);
3352       }
3353       ierr = VecGetArray(vec1_C,&array);CHKERRQ(ierr);
3354       for (j=0;j<n_constraints;j++) {coarse_submat_vals[index*pcbddc->local_primal_size+j+n_vertices]=array[j];} /* WARNING -> column major ordering */
3355       ierr = VecRestoreArray(vec1_C,&array);CHKERRQ(ierr);
3356 
3357       if ( dbg_flag ) {
3358         /* assemble subdomain vector on nodes */
3359         ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
3360         ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3361         ierr = VecGetArray(pcbddc->vec1_R,&array2);CHKERRQ(ierr);
3362         for (j=0;j<n_R;j++){ array[ idx_R_local[j] ] = array2[j]; }
3363         ierr = VecRestoreArray(pcbddc->vec1_R,&array2);CHKERRQ(ierr);
3364         ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3365         /* assemble subdomain vector of lagrange multipliers */
3366         ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
3367         ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
3368         if ( n_vertices) {
3369           ierr = VecGetArray(vec2_V,&array);CHKERRQ(ierr);
3370           for (j=0;j<n_vertices;j++) {array2[j]=-array[j];}
3371           ierr = VecRestoreArray(vec2_V,&array);CHKERRQ(ierr);
3372         }
3373         ierr = VecGetArray(vec1_C,&array);CHKERRQ(ierr);
3374         for (j=0;j<n_constraints;j++) {array2[j+n_vertices]=-array[j];}
3375         ierr = VecRestoreArray(vec1_C,&array);CHKERRQ(ierr);
3376         ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
3377         /* check saddle point solution */
3378         ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
3379         ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
3380         ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[index]);CHKERRQ(ierr);
3381         ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
3382         ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
3383         array[index]=array[index]+m_one; /* shift by the identity matrix */
3384         ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
3385         ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[index]);CHKERRQ(ierr);
3386       }
3387     }
3388     ierr = MatAssemblyBegin(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3389     ierr = MatAssemblyEnd  (pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3390     if ( pcbddc->prec_type || dbg_flag ) {
3391       ierr = MatAssemblyBegin(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3392       ierr = MatAssemblyEnd  (pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3393     }
3394     /* Checking coarse_sub_mat and coarse basis functios */
3395     /* It shuld be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
3396     if (dbg_flag) {
3397 
3398       Mat coarse_sub_mat;
3399       Mat TM1,TM2,TM3,TM4;
3400       Mat coarse_phi_D,coarse_phi_B,A_II,A_BB,A_IB,A_BI;
3401       const MatType checkmattype=MATSEQAIJ;
3402       PetscScalar      value;
3403 
3404       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
3405       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
3406       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
3407       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
3408       ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
3409       ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
3410       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
3411       ierr = MatConvert(coarse_sub_mat,checkmattype,MAT_REUSE_MATRIX,&coarse_sub_mat);CHKERRQ(ierr);
3412 
3413       /*PetscViewer view_out;
3414       PetscMPIInt myrank;
3415       char filename[256];
3416       MPI_Comm_rank(((PetscObject)pc)->comm,&myrank);
3417       sprintf(filename,"coarsesubmat_%04d.m",myrank);
3418       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&view_out);CHKERRQ(ierr);
3419       ierr = PetscViewerSetFormat(view_out,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
3420       ierr = MatView(coarse_sub_mat,view_out);CHKERRQ(ierr);
3421       ierr = PetscViewerDestroy(&view_out);CHKERRQ(ierr);*/
3422 
3423       ierr = PetscViewerASCIIPrintf(viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3424       ierr = PetscViewerASCIIPrintf(viewer,"Check coarse sub mat and local basis functions\n");CHKERRQ(ierr);
3425       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
3426       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
3427       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
3428       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
3429       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
3430       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
3431       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
3432       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
3433       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
3434       ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
3435       ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
3436       ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
3437       ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
3438       ierr = MatNorm(TM1,NORM_INFINITY,&value);CHKERRQ(ierr);
3439       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"----------------------------------\n");CHKERRQ(ierr);
3440       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d \n",PetscGlobalRank);CHKERRQ(ierr);
3441       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"matrix error = % 1.14e\n",value);CHKERRQ(ierr);
3442       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"coarse functions errors\n");CHKERRQ(ierr);
3443       for (i=0;i<pcbddc->local_primal_size;i++) { ierr = PetscViewerASCIISynchronizedPrintf(viewer,"local %02d-th function error = % 1.14e\n",i,coarsefunctions_errors[i]);CHKERRQ(ierr); }
3444       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"constraints errors\n");CHKERRQ(ierr);
3445       for (i=0;i<pcbddc->local_primal_size;i++) { ierr = PetscViewerASCIISynchronizedPrintf(viewer,"local %02d-th function error = % 1.14e\n",i,constraints_errors[i]);CHKERRQ(ierr); }
3446       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
3447       ierr = MatDestroy(&A_II);CHKERRQ(ierr);
3448       ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
3449       ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
3450       ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
3451       ierr = MatDestroy(&TM1);CHKERRQ(ierr);
3452       ierr = MatDestroy(&TM2);CHKERRQ(ierr);
3453       ierr = MatDestroy(&TM3);CHKERRQ(ierr);
3454       ierr = MatDestroy(&TM4);CHKERRQ(ierr);
3455       ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
3456       ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
3457       ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
3458       ierr = PetscFree(coarsefunctions_errors);CHKERRQ(ierr);
3459       ierr = PetscFree(constraints_errors);CHKERRQ(ierr);
3460     }
3461 
3462     /* create coarse matrix and data structures for message passing associated actual choice of coarse problem type */
3463     ierr = PCBDDCSetupCoarseEnvironment(pc,coarse_submat_vals);CHKERRQ(ierr);
3464     /* free memory */
3465     ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3466     ierr = PetscFree(auxindices);CHKERRQ(ierr);
3467     ierr = PetscFree(nnz);CHKERRQ(ierr);
3468     if (n_vertices) {
3469       ierr = VecDestroy(&vec1_V);CHKERRQ(ierr);
3470       ierr = VecDestroy(&vec2_V);CHKERRQ(ierr);
3471       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3472       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
3473       ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
3474     }
3475     if (n_constraints) {
3476       ierr = VecDestroy(&vec1_C);CHKERRQ(ierr);
3477       ierr = VecDestroy(&vec2_C);CHKERRQ(ierr);
3478       ierr = MatDestroy(&M1);CHKERRQ(ierr);
3479       ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
3480     }
3481   }
3482   /* free memory */
3483   if (n_vertices) {
3484     ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
3485     ierr = ISDestroy(&is_V_local);CHKERRQ(ierr);
3486   }
3487   ierr = ISDestroy(&is_R_local);CHKERRQ(ierr);
3488 
3489   PetscFunctionReturn(0);
3490 }
3491 
3492 /* -------------------------------------------------------------------------- */
3493 
3494 #undef __FUNCT__
3495 #define __FUNCT__ "PCBDDCSetupCoarseEnvironment"
3496 static PetscErrorCode PCBDDCSetupCoarseEnvironment(PC pc,PetscScalar* coarse_submat_vals)
3497 {
3498 
3499 
3500   Mat_IS    *matis    = (Mat_IS*)pc->pmat->data;
3501   PC_BDDC   *pcbddc   = (PC_BDDC*)pc->data;
3502   PC_IS     *pcis     = (PC_IS*)pc->data;
3503   MPI_Comm  prec_comm = ((PetscObject)pc)->comm;
3504   MPI_Comm  coarse_comm;
3505 
3506   /* common to all choiches */
3507   PetscScalar *temp_coarse_mat_vals;
3508   PetscScalar *ins_coarse_mat_vals;
3509   PetscInt    *ins_local_primal_indices;
3510   PetscMPIInt *localsizes2,*localdispl2;
3511   PetscMPIInt size_prec_comm;
3512   PetscMPIInt rank_prec_comm;
3513   PetscMPIInt active_rank=MPI_PROC_NULL;
3514   PetscMPIInt master_proc=0;
3515   PetscInt    ins_local_primal_size;
3516   /* specific to MULTILEVEL_BDDC */
3517   PetscMPIInt *ranks_recv;
3518   PetscMPIInt count_recv=0;
3519   PetscMPIInt rank_coarse_proc_send_to;
3520   PetscMPIInt coarse_color = MPI_UNDEFINED;
3521   ISLocalToGlobalMapping coarse_ISLG;
3522   /* some other variables */
3523   PetscErrorCode ierr;
3524   const MatType coarse_mat_type;
3525   const PCType  coarse_pc_type;
3526   const KSPType coarse_ksp_type;
3527   PC pc_temp;
3528   PetscInt i,j,k;
3529   PetscInt max_it_coarse_ksp=1;  /* don't increase this value */
3530   /* verbose output viewer */
3531   PetscViewer viewer=pcbddc->dbg_viewer;
3532   PetscBool   dbg_flag=pcbddc->dbg_flag;
3533 
3534   PetscInt      offset,offset2;
3535   PetscMPIInt   im_active=0;
3536   PetscMPIInt   *auxglobal_primal;
3537 
3538   PetscBool     setsym,issym=PETSC_FALSE;
3539 
3540   PetscFunctionBegin;
3541   ins_local_primal_indices = 0;
3542   ins_coarse_mat_vals      = 0;
3543   localsizes2              = 0;
3544   localdispl2              = 0;
3545   temp_coarse_mat_vals     = 0;
3546   coarse_ISLG              = 0;
3547 
3548   ierr = MPI_Comm_size(prec_comm,&size_prec_comm);CHKERRQ(ierr);
3549   ierr = MPI_Comm_rank(prec_comm,&rank_prec_comm);CHKERRQ(ierr);
3550   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
3551 
3552   /* Assign global numbering to coarse dofs */
3553   {
3554     PetscScalar    one=1.,zero=0.;
3555     PetscScalar    *array;
3556     PetscMPIInt    *auxlocal_primal;
3557     PetscMPIInt    *all_auxglobal_primal;
3558     PetscMPIInt    mpi_local_primal_size = (PetscMPIInt)pcbddc->local_primal_size;
3559     PetscInt       *row_cmat_indices;
3560     PetscInt       size_of_constraint;
3561     PetscScalar    coarsesum;
3562 
3563     /* Construct needed data structures for message passing */
3564     ierr = PetscMalloc(mpi_local_primal_size*sizeof(PetscMPIInt),&pcbddc->local_primal_indices);CHKERRQ(ierr);
3565     j = 0;
3566     if (rank_prec_comm == 0 || pcbddc->coarse_problem_type == REPLICATED_BDDC || pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
3567       j = size_prec_comm;
3568     }
3569     ierr = PetscMalloc(j*sizeof(PetscMPIInt),&pcbddc->local_primal_sizes);CHKERRQ(ierr);
3570     ierr = PetscMalloc(j*sizeof(PetscMPIInt),&pcbddc->local_primal_displacements);CHKERRQ(ierr);
3571     /* Gather local_primal_size information for all processes  */
3572     if (pcbddc->coarse_problem_type == REPLICATED_BDDC || pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
3573       ierr = MPI_Allgather(&mpi_local_primal_size,1,MPIU_INT,&pcbddc->local_primal_sizes[0],1,MPIU_INT,prec_comm);CHKERRQ(ierr);
3574     } else {
3575       ierr = MPI_Gather(&mpi_local_primal_size,1,MPIU_INT,&pcbddc->local_primal_sizes[0],1,MPIU_INT,0,prec_comm);CHKERRQ(ierr);
3576     }
3577     pcbddc->replicated_primal_size = 0;
3578     for (i=0; i<j; i++) {
3579       pcbddc->local_primal_displacements[i] = pcbddc->replicated_primal_size ;
3580       pcbddc->replicated_primal_size += pcbddc->local_primal_sizes[i];
3581     }
3582     if (rank_prec_comm == 0) {
3583       /* allocate some auxiliary space */
3584       ierr = PetscMalloc(pcbddc->replicated_primal_size*sizeof(*all_auxglobal_primal),&all_auxglobal_primal);CHKERRQ(ierr);
3585     }
3586     ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscMPIInt),&auxlocal_primal);CHKERRQ(ierr);
3587     ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscMPIInt),&auxglobal_primal);CHKERRQ(ierr);
3588 
3589     /* First let's count coarse dofs.
3590        This code fragment assumes that the number of local constraints per connected component
3591        is not greater than the number of nodes defined for the connected component
3592        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
3593     /* auxlocal_primal      : primal indices in local nodes numbering (internal and interface) with complete queue sorted by global ordering */
3594     ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
3595     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3596     for (i=0;i<pcbddc->local_primal_size;i++) {
3597       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,PETSC_NULL);CHKERRQ(ierr);
3598       for (j=0; j<size_of_constraint; j++) {
3599         k = row_cmat_indices[j];
3600         if ( array[k] == zero ) {
3601           array[k] = one;
3602           auxlocal_primal[i] = k;
3603           break;
3604         }
3605       }
3606       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,PETSC_NULL);CHKERRQ(ierr);
3607     }
3608     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3609     ierr = VecSet(pcis->vec1_global,zero);CHKERRQ(ierr);
3610     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3611     ierr = VecScatterEnd  (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3612     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3613     ierr = VecScatterEnd  (matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3614     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3615     for (i=0;i<pcis->n;i++) { if ( PetscAbsScalar(array[i]) > zero) array[i] = one/array[i]; }
3616     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3617     ierr = VecSet(pcis->vec1_global,zero);CHKERRQ(ierr);
3618     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3619     ierr = VecScatterEnd  (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3620     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
3621     pcbddc->coarse_size = (PetscInt) coarsesum;
3622 
3623     /* Now assign them a global numbering */
3624     /* auxglobal_primal contains indices in global nodes numbering (internal and interface) */
3625     ierr = ISLocalToGlobalMappingApply(matis->mapping,pcbddc->local_primal_size,auxlocal_primal,auxglobal_primal);CHKERRQ(ierr);
3626     ierr = PetscFree(auxlocal_primal);CHKERRQ(ierr);
3627     /* all_auxglobal_primal contains all primal nodes indices in global nodes numbering (internal and interface) */
3628     ierr = MPI_Gatherv(&auxglobal_primal[0],pcbddc->local_primal_size,MPIU_INT,&all_auxglobal_primal[0],pcbddc->local_primal_sizes,pcbddc->local_primal_displacements,MPIU_INT,0,prec_comm);CHKERRQ(ierr);
3629 
3630     /* After this block all_auxglobal_primal should contains one copy of each primal node's indices in global nodes numbering */
3631     if (rank_prec_comm==0) {
3632       j=pcbddc->replicated_primal_size;
3633       ierr = PetscSortRemoveDupsMPIInt(&j,all_auxglobal_primal);CHKERRQ(ierr);
3634     } else {
3635       ierr = PetscMalloc(pcbddc->coarse_size*sizeof(PetscMPIInt),&all_auxglobal_primal);CHKERRQ(ierr);
3636     }
3637     /* We only need to broadcast the indices from 0 to pcbddc->coarse_size. Remaning elements of array all_aux_global_primal are garbage. */
3638     ierr = MPI_Bcast(all_auxglobal_primal,pcbddc->coarse_size,MPIU_INT,0,prec_comm);CHKERRQ(ierr);
3639 
3640     /* Now get global coarse numbering of local primal nodes */
3641     for (i=0;i<pcbddc->local_primal_size;i++) {
3642       k=0;
3643       while( all_auxglobal_primal[k] != auxglobal_primal[i] ) { k++;}
3644       pcbddc->local_primal_indices[i]=k;
3645     }
3646     ierr = PetscFree(auxglobal_primal);CHKERRQ(ierr);
3647     ierr = PetscFree(all_auxglobal_primal);CHKERRQ(ierr);
3648     if (rank_prec_comm==0) {
3649       j=pcbddc->replicated_primal_size;
3650       ierr = PetscMalloc(j*sizeof(PetscMPIInt),&auxglobal_primal);CHKERRQ(ierr);
3651     }
3652     ierr = MPI_Gatherv(pcbddc->local_primal_indices,pcbddc->local_primal_size,MPIU_INT,auxglobal_primal,pcbddc->local_primal_sizes,pcbddc->local_primal_displacements,MPIU_INT,0,prec_comm);CHKERRQ(ierr);
3653   }
3654 
3655   if (pcis->n) { im_active = 1; }
3656   ierr = MPI_Allreduce(&im_active,&pcbddc->active_procs,1,MPIU_INT,MPI_SUM,prec_comm);CHKERRQ(ierr);
3657 
3658   /* adapt coarse problem type */
3659   if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
3660     if (pcbddc->current_level < pcbddc->max_levels) {
3661       if ( (pcbddc->active_procs/pcbddc->coarsening_ratio) < 2 ) {
3662         if (dbg_flag) {
3663           ierr = PetscViewerASCIIPrintf(viewer,"Not enough active processes on level %d (active %d,ratio %d). Parallel direct solve for coarse problem\n",pcbddc->current_level,pcbddc->active_procs,pcbddc->coarsening_ratio);CHKERRQ(ierr);
3664          ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
3665         }
3666         pcbddc->coarse_problem_type = PARALLEL_BDDC;
3667       }
3668     } else {
3669       if (dbg_flag) {
3670         ierr = PetscViewerASCIIPrintf(viewer,"Max number of levels reached. Using parallel direct solve for coarse problem\n",pcbddc->max_levels,pcbddc->active_procs,pcbddc->coarsening_ratio);CHKERRQ(ierr);
3671         ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
3672       }
3673       pcbddc->coarse_problem_type = PARALLEL_BDDC;
3674     }
3675   }
3676 
3677   switch(pcbddc->coarse_problem_type){
3678 
3679     case(MULTILEVEL_BDDC):   /* we define a coarse mesh where subdomains are elements */
3680     {
3681       /* we need additional variables */
3682       MetisInt    n_subdomains,n_parts,objval,ncon,faces_nvtxs;
3683       MetisInt    *metis_coarse_subdivision;
3684       MetisInt    options[METIS_NOPTIONS];
3685       PetscMPIInt size_coarse_comm,rank_coarse_comm;
3686       PetscMPIInt procs_jumps_coarse_comm;
3687       PetscMPIInt *coarse_subdivision;
3688       PetscMPIInt *total_count_recv;
3689       PetscMPIInt *total_ranks_recv;
3690       PetscMPIInt *displacements_recv;
3691       PetscMPIInt *my_faces_connectivity;
3692       PetscMPIInt *petsc_faces_adjncy;
3693       MetisInt    *faces_adjncy;
3694       MetisInt    *faces_xadj;
3695       PetscMPIInt *number_of_faces;
3696       PetscMPIInt *faces_displacements;
3697       PetscInt    *array_int;
3698       PetscMPIInt my_faces=0;
3699       PetscMPIInt total_faces=0;
3700       PetscInt    ranks_stretching_ratio;
3701 
3702       /* define some quantities */
3703       pcbddc->coarse_communications_type = SCATTERS_BDDC;
3704       coarse_mat_type = MATIS;
3705       coarse_pc_type  = PCBDDC;
3706       coarse_ksp_type = KSPRICHARDSON;
3707 
3708       /* details of coarse decomposition */
3709       n_subdomains = pcbddc->active_procs;
3710       n_parts      = n_subdomains/pcbddc->coarsening_ratio;
3711       ranks_stretching_ratio = size_prec_comm/pcbddc->active_procs;
3712       procs_jumps_coarse_comm = pcbddc->coarsening_ratio*ranks_stretching_ratio;
3713 
3714       /* build CSR graph of subdomains' connectivity */
3715       ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&array_int);CHKERRQ(ierr);
3716       ierr = PetscMemzero(array_int,pcis->n*sizeof(PetscInt));CHKERRQ(ierr);
3717       for (i=1;i<pcis->n_neigh;i++){/* i=1 so I don't count myself -> faces nodes counts to 1 */
3718         for (j=0;j<pcis->n_shared[i];j++){
3719           array_int[ pcis->shared[i][j] ]+=1;
3720         }
3721       }
3722       for (i=1;i<pcis->n_neigh;i++){
3723         for (j=0;j<pcis->n_shared[i];j++){
3724           if (array_int[ pcis->shared[i][j] ] > 0 ){
3725             my_faces++;
3726             break;
3727           }
3728         }
3729       }
3730 
3731       ierr = MPI_Reduce(&my_faces,&total_faces,1,MPIU_INT,MPI_SUM,master_proc,prec_comm);CHKERRQ(ierr);
3732       ierr = PetscMalloc (my_faces*sizeof(PetscInt),&my_faces_connectivity);CHKERRQ(ierr);
3733       my_faces=0;
3734       for (i=1;i<pcis->n_neigh;i++){
3735         for (j=0;j<pcis->n_shared[i];j++){
3736           if (array_int[ pcis->shared[i][j] ] > 0 ){
3737             my_faces_connectivity[my_faces]=pcis->neigh[i];
3738             my_faces++;
3739             break;
3740           }
3741         }
3742       }
3743       if (rank_prec_comm == master_proc) {
3744         ierr = PetscMalloc (total_faces*sizeof(PetscMPIInt),&petsc_faces_adjncy);CHKERRQ(ierr);
3745         ierr = PetscMalloc (size_prec_comm*sizeof(PetscMPIInt),&number_of_faces);CHKERRQ(ierr);
3746         ierr = PetscMalloc (total_faces*sizeof(MetisInt),&faces_adjncy);CHKERRQ(ierr);
3747         ierr = PetscMalloc ((n_subdomains+1)*sizeof(MetisInt),&faces_xadj);CHKERRQ(ierr);
3748         ierr = PetscMalloc ((size_prec_comm+1)*sizeof(PetscMPIInt),&faces_displacements);CHKERRQ(ierr);
3749       }
3750       ierr = MPI_Gather(&my_faces,1,MPIU_INT,&number_of_faces[0],1,MPIU_INT,master_proc,prec_comm);CHKERRQ(ierr);
3751       if (rank_prec_comm == master_proc) {
3752         faces_xadj[0]=0;
3753         faces_displacements[0]=0;
3754         j=0;
3755         for (i=1;i<size_prec_comm+1;i++) {
3756           faces_displacements[i]=faces_displacements[i-1]+number_of_faces[i-1];
3757           if (number_of_faces[i-1]) {
3758             j++;
3759             faces_xadj[j]=faces_xadj[j-1]+number_of_faces[i-1];
3760           }
3761         }
3762       }
3763       ierr = MPI_Gatherv(&my_faces_connectivity[0],my_faces,MPIU_INT,&petsc_faces_adjncy[0],number_of_faces,faces_displacements,MPIU_INT,master_proc,prec_comm);CHKERRQ(ierr);
3764       ierr = PetscFree(my_faces_connectivity);CHKERRQ(ierr);
3765       ierr = PetscFree(array_int);CHKERRQ(ierr);
3766       if (rank_prec_comm == master_proc) {
3767         for (i=0;i<total_faces;i++) faces_adjncy[i]=(MetisInt)(petsc_faces_adjncy[i]/ranks_stretching_ratio); /* cast to MetisInt */
3768         /*printf("This is the face connectivity (actual ranks)\n");
3769         for (i=0;i<n_subdomains;i++){
3770           printf("proc %d is connected with \n",i);
3771           for (j=faces_xadj[i];j<faces_xadj[i+1];j++)
3772             printf("%d ",faces_adjncy[j]);
3773           printf("\n");
3774         }*/
3775         ierr = PetscFree(faces_displacements);CHKERRQ(ierr);
3776         ierr = PetscFree(number_of_faces);CHKERRQ(ierr);
3777         ierr = PetscFree(petsc_faces_adjncy);CHKERRQ(ierr);
3778       }
3779 
3780       if ( rank_prec_comm == master_proc ) {
3781 
3782         PetscInt heuristic_for_metis=3;
3783 
3784         ncon=1;
3785         faces_nvtxs=n_subdomains;
3786         /* partition graoh induced by face connectivity */
3787         ierr = PetscMalloc (n_subdomains*sizeof(MetisInt),&metis_coarse_subdivision);CHKERRQ(ierr);
3788         ierr = METIS_SetDefaultOptions(options);
3789         /* we need a contiguous partition of the coarse mesh */
3790         options[METIS_OPTION_CONTIG]=1;
3791         options[METIS_OPTION_NITER]=30;
3792         if (pcbddc->coarsening_ratio > 1) {
3793           if (n_subdomains>n_parts*heuristic_for_metis) {
3794             options[METIS_OPTION_IPTYPE]=METIS_IPTYPE_EDGE;
3795             options[METIS_OPTION_OBJTYPE]=METIS_OBJTYPE_CUT;
3796             ierr = METIS_PartGraphKway(&faces_nvtxs,&ncon,faces_xadj,faces_adjncy,NULL,NULL,NULL,&n_parts,NULL,NULL,options,&objval,metis_coarse_subdivision);
3797             if (ierr != METIS_OK) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in METIS_PartGraphKway (metis error code %D) called from PCBDDCSetupCoarseEnvironment\n",ierr);
3798           } else {
3799             ierr = METIS_PartGraphRecursive(&faces_nvtxs,&ncon,faces_xadj,faces_adjncy,NULL,NULL,NULL,&n_parts,NULL,NULL,options,&objval,metis_coarse_subdivision);
3800             if (ierr != METIS_OK) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in METIS_PartGraphRecursive (metis error code %D) called from PCBDDCSetupCoarseEnvironment\n",ierr);
3801           }
3802         } else {
3803           for (i=0;i<n_subdomains;i++) {
3804             metis_coarse_subdivision[i]=i;
3805           }
3806         }
3807         ierr = PetscFree(faces_xadj);CHKERRQ(ierr);
3808         ierr = PetscFree(faces_adjncy);CHKERRQ(ierr);
3809         ierr = PetscMalloc(size_prec_comm*sizeof(PetscMPIInt),&coarse_subdivision);CHKERRQ(ierr);
3810         /* copy/cast values avoiding possible type conflicts between PETSc, MPI and METIS */
3811         for (i=0;i<size_prec_comm;i++) { coarse_subdivision[i]=MPI_PROC_NULL; }
3812         for (i=0;i<n_subdomains;i++)   { coarse_subdivision[ranks_stretching_ratio*i]=(PetscInt)(metis_coarse_subdivision[i]); }
3813         ierr = PetscFree(metis_coarse_subdivision);CHKERRQ(ierr);
3814       }
3815 
3816       /* Create new communicator for coarse problem splitting the old one */
3817       if ( !(rank_prec_comm%procs_jumps_coarse_comm) && rank_prec_comm < procs_jumps_coarse_comm*n_parts ){
3818         coarse_color=0;              /* for communicator splitting */
3819         active_rank=rank_prec_comm;  /* for insertion of matrix values */
3820       }
3821       /* procs with coarse_color = MPI_UNDEFINED will have coarse_comm = MPI_COMM_NULL (from mpi standards)
3822          key = rank_prec_comm -> keep same ordering of ranks from the old to the new communicator */
3823       ierr = MPI_Comm_split(prec_comm,coarse_color,rank_prec_comm,&coarse_comm);CHKERRQ(ierr);
3824 
3825       if ( coarse_color == 0 ) {
3826         ierr = MPI_Comm_size(coarse_comm,&size_coarse_comm);CHKERRQ(ierr);
3827         ierr = MPI_Comm_rank(coarse_comm,&rank_coarse_comm);CHKERRQ(ierr);
3828       } else {
3829         rank_coarse_comm = MPI_PROC_NULL;
3830       }
3831 
3832       /* master proc take care of arranging and distributing coarse informations */
3833       if (rank_coarse_comm == master_proc) {
3834         ierr = PetscMalloc (size_coarse_comm*sizeof(PetscMPIInt),&displacements_recv);CHKERRQ(ierr);
3835         ierr = PetscMalloc (size_coarse_comm*sizeof(PetscMPIInt),&total_count_recv);CHKERRQ(ierr);
3836         ierr = PetscMalloc (n_subdomains*sizeof(PetscMPIInt),&total_ranks_recv);CHKERRQ(ierr);
3837         /* some initializations */
3838         displacements_recv[0]=0;
3839         ierr = PetscMemzero(total_count_recv,size_coarse_comm*sizeof(PetscMPIInt));CHKERRQ(ierr);
3840         /* count from how many processes the j-th process of the coarse decomposition will receive data */
3841         for (j=0;j<size_coarse_comm;j++) {
3842           for (i=0;i<size_prec_comm;i++) {
3843             if (coarse_subdivision[i]==j) {
3844               total_count_recv[j]++;
3845             }
3846           }
3847         }
3848         /* displacements needed for scatterv of total_ranks_recv */
3849         for (i=1;i<size_coarse_comm;i++) { displacements_recv[i]=displacements_recv[i-1]+total_count_recv[i-1]; }
3850         /* Now fill properly total_ranks_recv -> each coarse process will receive the ranks (in prec_comm communicator) of its friend (sending) processes */
3851         ierr = PetscMemzero(total_count_recv,size_coarse_comm*sizeof(PetscMPIInt));CHKERRQ(ierr);
3852         for (j=0;j<size_coarse_comm;j++) {
3853           for (i=0;i<size_prec_comm;i++) {
3854             if (coarse_subdivision[i]==j) {
3855               total_ranks_recv[displacements_recv[j]+total_count_recv[j]]=i;
3856               total_count_recv[j]+=1;
3857             }
3858           }
3859         }
3860         /*for (j=0;j<size_coarse_comm;j++) {
3861           printf("process %d in new rank will receive from %d processes (original ranks follows)\n",j,total_count_recv[j]);
3862           for (i=0;i<total_count_recv[j];i++) {
3863             printf("%d ",total_ranks_recv[displacements_recv[j]+i]);
3864           }
3865           printf("\n");
3866         }*/
3867 
3868         /* identify new decomposition in terms of ranks in the old communicator */
3869         for (i=0;i<n_subdomains;i++) {
3870           coarse_subdivision[ranks_stretching_ratio*i]=coarse_subdivision[ranks_stretching_ratio*i]*procs_jumps_coarse_comm;
3871         }
3872         /*printf("coarse_subdivision in old end new ranks\n");
3873         for (i=0;i<size_prec_comm;i++)
3874           if (coarse_subdivision[i]!=MPI_PROC_NULL) {
3875             printf("%d=(%d %d), ",i,coarse_subdivision[i],coarse_subdivision[i]/procs_jumps_coarse_comm);
3876           } else {
3877             printf("%d=(%d %d), ",i,coarse_subdivision[i],coarse_subdivision[i]);
3878           }
3879         printf("\n");*/
3880       }
3881 
3882       /* Scatter new decomposition for send details */
3883       ierr = MPI_Scatter(&coarse_subdivision[0],1,MPIU_INT,&rank_coarse_proc_send_to,1,MPIU_INT,master_proc,prec_comm);CHKERRQ(ierr);
3884       /* Scatter receiving details to members of coarse decomposition */
3885       if ( coarse_color == 0) {
3886         ierr = MPI_Scatter(&total_count_recv[0],1,MPIU_INT,&count_recv,1,MPIU_INT,master_proc,coarse_comm);CHKERRQ(ierr);
3887         ierr = PetscMalloc (count_recv*sizeof(PetscMPIInt),&ranks_recv);CHKERRQ(ierr);
3888         ierr = MPI_Scatterv(&total_ranks_recv[0],total_count_recv,displacements_recv,MPIU_INT,&ranks_recv[0],count_recv,MPIU_INT,master_proc,coarse_comm);CHKERRQ(ierr);
3889       }
3890 
3891       /*printf("I will send my matrix data to proc  %d\n",rank_coarse_proc_send_to);
3892       if (coarse_color == 0) {
3893         printf("I will receive some matrix data from %d processes (ranks follows)\n",count_recv);
3894         for (i=0;i<count_recv;i++)
3895           printf("%d ",ranks_recv[i]);
3896         printf("\n");
3897       }*/
3898 
3899       if (rank_prec_comm == master_proc) {
3900         ierr = PetscFree(coarse_subdivision);CHKERRQ(ierr);
3901         ierr = PetscFree(total_count_recv);CHKERRQ(ierr);
3902         ierr = PetscFree(total_ranks_recv);CHKERRQ(ierr);
3903         ierr = PetscFree(displacements_recv);CHKERRQ(ierr);
3904       }
3905       break;
3906     }
3907 
3908     case(REPLICATED_BDDC):
3909 
3910       pcbddc->coarse_communications_type = GATHERS_BDDC;
3911       coarse_mat_type = MATSEQAIJ;
3912       coarse_pc_type  = PCLU;
3913       coarse_ksp_type  = KSPPREONLY;
3914       coarse_comm = PETSC_COMM_SELF;
3915       active_rank = rank_prec_comm;
3916       break;
3917 
3918     case(PARALLEL_BDDC):
3919 
3920       pcbddc->coarse_communications_type = SCATTERS_BDDC;
3921       coarse_mat_type = MATMPIAIJ;
3922       coarse_pc_type  = PCREDUNDANT;
3923       coarse_ksp_type  = KSPPREONLY;
3924       coarse_comm = prec_comm;
3925       active_rank = rank_prec_comm;
3926       break;
3927 
3928     case(SEQUENTIAL_BDDC):
3929       pcbddc->coarse_communications_type = GATHERS_BDDC;
3930       coarse_mat_type = MATSEQAIJ;
3931       coarse_pc_type = PCLU;
3932       coarse_ksp_type  = KSPPREONLY;
3933       coarse_comm = PETSC_COMM_SELF;
3934       active_rank = master_proc;
3935       break;
3936   }
3937 
3938   switch(pcbddc->coarse_communications_type){
3939 
3940     case(SCATTERS_BDDC):
3941       {
3942         if (pcbddc->coarse_problem_type==MULTILEVEL_BDDC) {
3943 
3944           PetscMPIInt send_size;
3945           PetscInt    *aux_ins_indices;
3946           PetscInt    ii,jj;
3947           MPI_Request *requests;
3948 
3949           if(pcbddc->coarsening_ratio == 1) {
3950             ins_local_primal_size = pcbddc->local_primal_size;
3951             ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr);
3952             ierr = PetscMemcpy(ins_local_primal_indices,pcbddc->local_primal_indices,ins_local_primal_size*sizeof(PetscInt));CHKERRQ(ierr);
3953             ierr = PetscMalloc(ins_local_primal_size*ins_local_primal_size*sizeof(PetscScalar),&ins_coarse_mat_vals);CHKERRQ(ierr);
3954             ierr = PetscMemcpy(ins_coarse_mat_vals,coarse_submat_vals,ins_local_primal_size*ins_local_primal_size*sizeof(PetscScalar));CHKERRQ(ierr);
3955           } else {
3956             /* allocate auxiliary space */
3957             ierr = PetscMalloc (pcbddc->replicated_primal_size*sizeof(PetscMPIInt),&pcbddc->replicated_local_primal_indices);CHKERRQ(ierr);
3958             ierr = MPI_Allgatherv(&pcbddc->local_primal_indices[0],pcbddc->local_primal_size,MPIU_INT,&pcbddc->replicated_local_primal_indices[0],pcbddc->local_primal_sizes,pcbddc->local_primal_displacements,MPIU_INT,prec_comm);CHKERRQ(ierr);
3959             ierr = PetscMalloc ( pcbddc->coarse_size*sizeof(PetscInt),&aux_ins_indices);CHKERRQ(ierr);
3960             ierr = PetscMemzero(aux_ins_indices,pcbddc->coarse_size*sizeof(PetscInt));CHKERRQ(ierr);
3961             /* allocate stuffs for message massing */
3962             ierr = PetscMalloc ( (count_recv+1)*sizeof(MPI_Request),&requests);CHKERRQ(ierr);
3963             for (i=0;i<count_recv+1;i++) requests[i]=MPI_REQUEST_NULL;
3964             ierr = PetscMalloc ( count_recv*sizeof(PetscMPIInt),&localsizes2);CHKERRQ(ierr);
3965             ierr = PetscMalloc ( count_recv*sizeof(PetscMPIInt),&localdispl2);CHKERRQ(ierr);
3966             /* fill up quantities */
3967             j=0;
3968             for (i=0;i<count_recv;i++){
3969               ii = ranks_recv[i];
3970               localsizes2[i]=pcbddc->local_primal_sizes[ii]*pcbddc->local_primal_sizes[ii];
3971               localdispl2[i]=j;
3972               j+=localsizes2[i];
3973               jj = pcbddc->local_primal_displacements[ii];
3974               /* it counts the coarse subdomains sharing the coarse node */
3975               for (k=0;k<pcbddc->local_primal_sizes[ii];k++) {
3976                 aux_ins_indices[pcbddc->replicated_local_primal_indices[jj+k]]+=1;
3977               }
3978             }
3979             /* temp_coarse_mat_vals used to store temporarly received matrix values */
3980             ierr = PetscMalloc ( j*sizeof(PetscScalar),&temp_coarse_mat_vals);CHKERRQ(ierr);
3981             /* evaluate how many values I will insert in coarse mat */
3982             ins_local_primal_size=0;
3983             for (i=0;i<pcbddc->coarse_size;i++){
3984               if (aux_ins_indices[i]){
3985                 ins_local_primal_size++;
3986               }
3987             }
3988             /* evaluate indices I will insert in coarse mat */
3989             ierr = PetscMalloc ( ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr);
3990             j=0;
3991             for (i=0;i<pcbddc->coarse_size;i++){
3992               if (aux_ins_indices[i]){
3993                 ins_local_primal_indices[j++]=i;
3994               }
3995             }
3996             /* use aux_ins_indices to realize a global to local mapping */
3997             j=0;
3998             for (i=0;i<pcbddc->coarse_size;i++){
3999               if (aux_ins_indices[i]==0){
4000                 aux_ins_indices[i]=-1;
4001               } else {
4002                 aux_ins_indices[i]=j;
4003                 j++;
4004               }
4005             }
4006 
4007             /* processes partecipating in coarse problem receive matrix data from their friends */
4008             for (i=0;i<count_recv;i++) {
4009               ierr = MPI_Irecv(&temp_coarse_mat_vals[localdispl2[i]],localsizes2[i],MPIU_SCALAR,ranks_recv[i],666,prec_comm,&requests[i]);CHKERRQ(ierr); }
4010             if (rank_coarse_proc_send_to != MPI_PROC_NULL ) {
4011               send_size=pcbddc->local_primal_size*pcbddc->local_primal_size;
4012               ierr = MPI_Isend(&coarse_submat_vals[0],send_size,MPIU_SCALAR,rank_coarse_proc_send_to,666,prec_comm,&requests[count_recv]);CHKERRQ(ierr);
4013             }
4014             ierr = MPI_Waitall(count_recv+1,requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
4015 
4016             /* calculate data to insert in coarse mat */
4017             ierr = PetscMalloc ( ins_local_primal_size*ins_local_primal_size*sizeof(PetscScalar),&ins_coarse_mat_vals);CHKERRQ(ierr);
4018             PetscMemzero(ins_coarse_mat_vals,ins_local_primal_size*ins_local_primal_size*sizeof(PetscScalar));
4019 
4020             PetscMPIInt rr,kk,lps,lpd;
4021             PetscInt row_ind,col_ind;
4022             for (k=0;k<count_recv;k++){
4023               rr = ranks_recv[k];
4024               kk = localdispl2[k];
4025               lps = pcbddc->local_primal_sizes[rr];
4026               lpd = pcbddc->local_primal_displacements[rr];
4027               for (j=0;j<lps;j++){
4028                 col_ind=aux_ins_indices[pcbddc->replicated_local_primal_indices[lpd+j]];
4029                 for (i=0;i<lps;i++){
4030                   row_ind=aux_ins_indices[pcbddc->replicated_local_primal_indices[lpd+i]];
4031                   ins_coarse_mat_vals[col_ind*ins_local_primal_size+row_ind]+=temp_coarse_mat_vals[kk+j*lps+i];
4032                 }
4033               }
4034             }
4035             ierr = PetscFree(requests);CHKERRQ(ierr);
4036             ierr = PetscFree(aux_ins_indices);CHKERRQ(ierr);
4037             ierr = PetscFree(temp_coarse_mat_vals);CHKERRQ(ierr);
4038             if (coarse_color == 0) { ierr = PetscFree(ranks_recv);CHKERRQ(ierr); }
4039           }
4040 
4041           /* create local to global mapping needed by coarse MATIS */
4042           {
4043             IS coarse_IS;
4044             if (coarse_comm != MPI_COMM_NULL ) {ierr = MPI_Comm_free(&coarse_comm);CHKERRQ(ierr);}
4045             coarse_comm = prec_comm;
4046             active_rank=rank_prec_comm;
4047             ierr = ISCreateGeneral(coarse_comm,ins_local_primal_size,ins_local_primal_indices,PETSC_COPY_VALUES,&coarse_IS);CHKERRQ(ierr);
4048             ierr = ISLocalToGlobalMappingCreateIS(coarse_IS,&coarse_ISLG);CHKERRQ(ierr);
4049             ierr = ISDestroy(&coarse_IS);CHKERRQ(ierr);
4050           }
4051         }
4052         if (pcbddc->coarse_problem_type==PARALLEL_BDDC) {
4053           /* arrays for values insertion */
4054           ins_local_primal_size = pcbddc->local_primal_size;
4055           ierr = PetscMalloc ( ins_local_primal_size*sizeof(PetscMPIInt),&ins_local_primal_indices);CHKERRQ(ierr);
4056           ierr = PetscMalloc ( ins_local_primal_size*ins_local_primal_size*sizeof(PetscScalar),&ins_coarse_mat_vals);CHKERRQ(ierr);
4057           for (j=0;j<ins_local_primal_size;j++){
4058             ins_local_primal_indices[j]=pcbddc->local_primal_indices[j];
4059             for (i=0;i<ins_local_primal_size;i++) {
4060               ins_coarse_mat_vals[j*ins_local_primal_size+i]=coarse_submat_vals[j*ins_local_primal_size+i];
4061             }
4062           }
4063         }
4064         break;
4065 
4066     }
4067 
4068     case(GATHERS_BDDC):
4069       {
4070 
4071         PetscMPIInt mysize,mysize2;
4072 
4073         if (rank_prec_comm==active_rank) {
4074           ierr = PetscMalloc ( pcbddc->replicated_primal_size*sizeof(PetscMPIInt),&pcbddc->replicated_local_primal_indices);CHKERRQ(ierr);
4075           ierr = PetscMalloc ( pcbddc->replicated_primal_size*sizeof(PetscScalar),&pcbddc->replicated_local_primal_values);CHKERRQ(ierr);
4076           ierr = PetscMalloc ( size_prec_comm*sizeof(PetscMPIInt),&localsizes2);CHKERRQ(ierr);
4077           ierr = PetscMalloc ( size_prec_comm*sizeof(PetscMPIInt),&localdispl2);CHKERRQ(ierr);
4078           /* arrays for values insertion */
4079           for (i=0;i<size_prec_comm;i++) { localsizes2[i]=pcbddc->local_primal_sizes[i]*pcbddc->local_primal_sizes[i]; }
4080           localdispl2[0]=0;
4081           for (i=1;i<size_prec_comm;i++) { localdispl2[i]=localsizes2[i-1]+localdispl2[i-1]; }
4082           j=0;
4083           for (i=0;i<size_prec_comm;i++) { j+=localsizes2[i]; }
4084           ierr = PetscMalloc ( j*sizeof(PetscScalar),&temp_coarse_mat_vals);CHKERRQ(ierr);
4085         }
4086 
4087         mysize=pcbddc->local_primal_size;
4088         mysize2=pcbddc->local_primal_size*pcbddc->local_primal_size;
4089         if (pcbddc->coarse_problem_type == SEQUENTIAL_BDDC){
4090           ierr = MPI_Gatherv(&pcbddc->local_primal_indices[0],mysize,MPIU_INT,&pcbddc->replicated_local_primal_indices[0],pcbddc->local_primal_sizes,pcbddc->local_primal_displacements,MPIU_INT,master_proc,prec_comm);CHKERRQ(ierr);
4091           ierr = MPI_Gatherv(&coarse_submat_vals[0],mysize2,MPIU_SCALAR,&temp_coarse_mat_vals[0],localsizes2,localdispl2,MPIU_SCALAR,master_proc,prec_comm);CHKERRQ(ierr);
4092         } else {
4093           ierr = MPI_Allgatherv(&pcbddc->local_primal_indices[0],mysize,MPIU_INT,&pcbddc->replicated_local_primal_indices[0],pcbddc->local_primal_sizes,pcbddc->local_primal_displacements,MPIU_INT,prec_comm);CHKERRQ(ierr);
4094           ierr = MPI_Allgatherv(&coarse_submat_vals[0],mysize2,MPIU_SCALAR,&temp_coarse_mat_vals[0],localsizes2,localdispl2,MPIU_SCALAR,prec_comm);CHKERRQ(ierr);
4095         }
4096         break;
4097       }/* switch on coarse problem and communications associated with finished */
4098   }
4099 
4100   /* Now create and fill up coarse matrix */
4101   if ( rank_prec_comm == active_rank ) {
4102 
4103     Mat matis_coarse_local_mat;
4104 
4105     if (pcbddc->coarse_problem_type != MULTILEVEL_BDDC) {
4106       ierr = MatCreate(coarse_comm,&pcbddc->coarse_mat);CHKERRQ(ierr);
4107       ierr = MatSetSizes(pcbddc->coarse_mat,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size);CHKERRQ(ierr);
4108       ierr = MatSetType(pcbddc->coarse_mat,coarse_mat_type);CHKERRQ(ierr);
4109       ierr = MatSetUp(pcbddc->coarse_mat);CHKERRQ(ierr);
4110       ierr = MatSetOption(pcbddc->coarse_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr); /* local values stored in column major */
4111       ierr = MatSetOption(pcbddc->coarse_mat,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr);
4112     } else {
4113       ierr = MatCreateIS(coarse_comm,1,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size,coarse_ISLG,&pcbddc->coarse_mat);CHKERRQ(ierr);
4114       ierr = MatSetUp(pcbddc->coarse_mat);CHKERRQ(ierr);
4115       ierr = MatISGetLocalMat(pcbddc->coarse_mat,&matis_coarse_local_mat);CHKERRQ(ierr);
4116       ierr = MatSetUp(matis_coarse_local_mat);CHKERRQ(ierr);
4117       ierr = MatSetOption(matis_coarse_local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr); /* local values stored in column major */
4118       ierr = MatSetOption(matis_coarse_local_mat,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr);
4119     }
4120     /* preallocation */
4121     if (pcbddc->coarse_problem_type != MULTILEVEL_BDDC) {
4122       PetscInt *dnz,*onz;
4123       PetscInt lrows,lcols;
4124       ierr = MatGetLocalSize(pcbddc->coarse_mat,&lrows,&lcols);CHKERRQ(ierr);
4125       ierr = MatPreallocateInitialize(coarse_comm,lrows,lcols,dnz,onz);CHKERRQ(ierr);
4126       if (pcbddc->coarse_problem_type == PARALLEL_BDDC) {
4127         PetscInt coarse_index_row,coarse_index_col,start_row,owner;
4128         PetscMPIInt *auxpreall_displs;
4129         PetscMPIInt *auxpreall_sizes;
4130         PetscMPIInt *auxpreall_dnz;
4131         PetscMPIInt *auxpreall_onz;
4132         PetscInt    *auxpreall_ownership;
4133         if (rank_prec_comm == 0) {
4134           ierr = PetscMalloc((size_prec_comm+1)*sizeof(PetscMPIInt),&auxpreall_displs);CHKERRQ(ierr);
4135           auxpreall_displs[size_prec_comm]=pcbddc->coarse_size;
4136           ierr = PetscMalloc(size_prec_comm*sizeof(PetscMPIInt),&auxpreall_sizes);CHKERRQ(ierr);
4137           ierr = PetscMalloc(pcbddc->coarse_size*sizeof(PetscMPIInt),&auxpreall_dnz);CHKERRQ(ierr);
4138           ierr = PetscMemzero(auxpreall_dnz,pcbddc->coarse_size*sizeof(PetscMPIInt));CHKERRQ(ierr);
4139           ierr = PetscMalloc(pcbddc->coarse_size*sizeof(PetscMPIInt),&auxpreall_onz);CHKERRQ(ierr);
4140           ierr = PetscMemzero(auxpreall_onz,pcbddc->coarse_size*sizeof(PetscMPIInt));CHKERRQ(ierr);
4141           ierr = PetscMalloc(pcbddc->coarse_size*sizeof(PetscInt),&auxpreall_ownership);CHKERRQ(ierr);
4142         }
4143         ierr = MatGetOwnershipRange(pcbddc->coarse_mat,&start_row,PETSC_NULL);CHKERRQ(ierr);
4144         ierr = MPI_Gather(&start_row,1,MPIU_INT,auxpreall_displs,1,MPIU_INT,0,prec_comm);CHKERRQ(ierr);
4145         if (rank_prec_comm == 0) {
4146           k=0;
4147           for (i=0;i<size_prec_comm;i++) {
4148             auxpreall_sizes[i]=auxpreall_displs[i+1]-auxpreall_displs[i];
4149             for (j=0;j<auxpreall_sizes[i];j++) {
4150               auxpreall_ownership[auxpreall_displs[i]+j]=i;
4151             }
4152           }
4153           for (i=0;i<size_prec_comm;i++) {
4154             for (j=0;j<pcbddc->local_primal_sizes[i];j++) {
4155               coarse_index_row=auxglobal_primal[j+pcbddc->local_primal_displacements[i]];
4156               for (k=j;k<pcbddc->local_primal_sizes[i];k++) {
4157                 coarse_index_col=auxglobal_primal[k+pcbddc->local_primal_displacements[i]];
4158                 owner = auxpreall_ownership[coarse_index_row];
4159                 if (coarse_index_col>auxpreall_displs[owner]-1 && coarse_index_col < auxpreall_displs[owner]+auxpreall_sizes[owner]) {
4160                   auxpreall_dnz[coarse_index_row]++;
4161                 } else {
4162                   auxpreall_onz[coarse_index_row]++;
4163                 }
4164                 if (k != j) {
4165                   owner = auxpreall_ownership[coarse_index_col];
4166                   if (coarse_index_row>auxpreall_displs[owner]-1 && coarse_index_row < auxpreall_displs[owner]+auxpreall_sizes[owner]) {
4167                     auxpreall_dnz[coarse_index_col]++;
4168                   } else {
4169                     auxpreall_onz[coarse_index_col]++;
4170                   }
4171                 }
4172               }
4173             }
4174           }
4175         }
4176         ierr = MPI_Scatterv(auxpreall_dnz,auxpreall_sizes,auxpreall_displs,MPIU_INT,
4177                             dnz,lrows,MPIU_INT,0,prec_comm);
4178         ierr = MPI_Scatterv(auxpreall_onz,auxpreall_sizes,auxpreall_displs,MPIU_INT,
4179                             onz,lrows,MPIU_INT,0,prec_comm);
4180         if (rank_prec_comm == 0) {
4181           ierr = PetscFree(auxpreall_displs);CHKERRQ(ierr);
4182           ierr = PetscFree(auxpreall_sizes);CHKERRQ(ierr);
4183           ierr = PetscFree(auxpreall_dnz);CHKERRQ(ierr);
4184           ierr = PetscFree(auxpreall_onz);CHKERRQ(ierr);
4185           ierr = PetscFree(auxpreall_ownership);CHKERRQ(ierr);
4186         }
4187       } else {
4188         for (k=0;k<size_prec_comm;k++){
4189           offset=pcbddc->local_primal_displacements[k];
4190           offset2=localdispl2[k];
4191           ins_local_primal_size = pcbddc->local_primal_sizes[k];
4192           ins_local_primal_indices = &pcbddc->replicated_local_primal_indices[offset];
4193           for (j=0;j<ins_local_primal_size;j++) {
4194             ierr = MatPreallocateSet(ins_local_primal_indices[j],ins_local_primal_size,ins_local_primal_indices,dnz,onz);CHKERRQ(ierr);
4195           }
4196         }
4197       }
4198       /* check */
4199       for (i=0;i<lrows;i++) {
4200         if (dnz[i]>lcols) {
4201           dnz[i]=lcols;
4202         }
4203         if (onz[i]>pcbddc->coarse_size-lcols) {
4204           onz[i]=pcbddc->coarse_size-lcols;
4205         }
4206       }
4207       ierr = MatSeqAIJSetPreallocation(pcbddc->coarse_mat,PETSC_NULL,dnz);CHKERRQ(ierr);
4208       ierr = MatMPIAIJSetPreallocation(pcbddc->coarse_mat,PETSC_NULL,dnz,PETSC_NULL,onz);CHKERRQ(ierr);
4209       ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
4210     } else {
4211       ierr = MatSeqAIJSetPreallocation(matis_coarse_local_mat,ins_local_primal_size,PETSC_NULL);CHKERRQ(ierr);
4212     }
4213     if (rank_prec_comm == 0) { ierr = PetscFree(auxglobal_primal);CHKERRQ(ierr); }
4214     /* insert values */
4215     if (pcbddc->coarse_communications_type != GATHERS_BDDC) {
4216       ierr = MatSetValues(pcbddc->coarse_mat,ins_local_primal_size,ins_local_primal_indices,ins_local_primal_size,ins_local_primal_indices,ins_coarse_mat_vals,ADD_VALUES);CHKERRQ(ierr);
4217     } else {
4218       for (k=0;k<size_prec_comm;k++){
4219         offset=pcbddc->local_primal_displacements[k];
4220         offset2=localdispl2[k];
4221         ins_local_primal_size = pcbddc->local_primal_sizes[k];
4222         ins_local_primal_indices = &pcbddc->replicated_local_primal_indices[offset];
4223         ins_coarse_mat_vals = &temp_coarse_mat_vals[offset2];
4224         ierr = MatSetValues(pcbddc->coarse_mat,ins_local_primal_size,ins_local_primal_indices,ins_local_primal_size,ins_local_primal_indices,ins_coarse_mat_vals,ADD_VALUES);CHKERRQ(ierr);
4225       }
4226       ins_local_primal_indices = 0;
4227       ins_coarse_mat_vals = 0;
4228     }
4229     ierr = MatAssemblyBegin(pcbddc->coarse_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4230     ierr = MatAssemblyEnd(pcbddc->coarse_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4231     /* symmetry of coarse matrix */
4232     if (issym) {
4233       ierr = MatSetOption(pcbddc->coarse_mat,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
4234     }
4235     ierr = MatGetVecs(pcbddc->coarse_mat,&pcbddc->coarse_vec,&pcbddc->coarse_rhs);CHKERRQ(ierr);
4236   }
4237 
4238   /* create loc to glob scatters if needed */
4239   if (pcbddc->coarse_communications_type == SCATTERS_BDDC) {
4240      IS local_IS,global_IS;
4241      ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size,0,1,&local_IS);CHKERRQ(ierr);
4242      ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_indices,PETSC_COPY_VALUES,&global_IS);CHKERRQ(ierr);
4243      ierr = VecScatterCreate(pcbddc->vec1_P,local_IS,pcbddc->coarse_vec,global_IS,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
4244      ierr = ISDestroy(&local_IS);CHKERRQ(ierr);
4245      ierr = ISDestroy(&global_IS);CHKERRQ(ierr);
4246   }
4247 
4248   /* Eval coarse null space */
4249   if (pcbddc->NullSpace) {
4250     const Vec      *nsp_vecs;
4251     PetscInt       nsp_size,coarse_nsp_size;
4252     PetscBool      nsp_has_cnst;
4253     PetscReal      test_null;
4254     Vec            *coarse_nsp_vecs;
4255 
4256     coarse_nsp_size = 0;
4257     coarse_nsp_vecs = 0;
4258     ierr = MatNullSpaceGetVecs(pcbddc->NullSpace,&nsp_has_cnst,&nsp_size,&nsp_vecs);CHKERRQ(ierr);
4259     if (rank_prec_comm == active_rank) {
4260       ierr = PetscMalloc((nsp_size+1)*sizeof(Vec),&coarse_nsp_vecs);CHKERRQ(ierr);
4261       for (i=0;i<nsp_size+1;i++) {
4262         ierr = VecDuplicate(pcbddc->coarse_vec,&coarse_nsp_vecs[i]);CHKERRQ(ierr);
4263       }
4264     }
4265     if (nsp_has_cnst) {
4266       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
4267       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
4268       ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4269       ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4270       if (rank_prec_comm == active_rank) {
4271         ierr = MatMult(pcbddc->coarse_mat,pcbddc->coarse_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
4272         ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&test_null);CHKERRQ(ierr);
4273         if (test_null > 1.0e-12 && pcbddc->dbg_flag ) {
4274           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Constant coarse null space error % 1.14e\n",test_null);CHKERRQ(ierr);
4275         }
4276         ierr = VecCopy(pcbddc->coarse_vec,coarse_nsp_vecs[coarse_nsp_size]);CHKERRQ(ierr);
4277         coarse_nsp_size++;
4278       }
4279     }
4280     for (i=0;i<nsp_size;i++)  {
4281       ierr = VecScatterBegin(matis->ctx,nsp_vecs[i],pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4282       ierr = VecScatterEnd  (matis->ctx,nsp_vecs[i],pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4283       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
4284       ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4285       ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4286       if (rank_prec_comm == active_rank) {
4287         ierr = MatMult(pcbddc->coarse_mat,pcbddc->coarse_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
4288         ierr = VecNorm(pcbddc->coarse_rhs,NORM_2,&test_null);CHKERRQ(ierr);
4289         if (test_null > 1.0e-12 && pcbddc->dbg_flag ) {
4290           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Vec %d coarse null space error % 1.14e\n",i,test_null);CHKERRQ(ierr);
4291         }
4292         ierr = VecCopy(pcbddc->coarse_vec,coarse_nsp_vecs[coarse_nsp_size]);CHKERRQ(ierr);
4293         coarse_nsp_size++;
4294       }
4295     }
4296     if (coarse_nsp_size > 0) {
4297       /* TODO orthonormalize vecs */
4298       ierr = VecNormalize(coarse_nsp_vecs[0],PETSC_NULL);CHKERRQ(ierr);
4299       ierr = MatNullSpaceCreate(coarse_comm,PETSC_FALSE,coarse_nsp_size,coarse_nsp_vecs,&pcbddc->CoarseNullSpace);CHKERRQ(ierr);
4300       for (i=0;i<nsp_size+1;i++) {
4301         ierr = VecDestroy(&coarse_nsp_vecs[i]);CHKERRQ(ierr);
4302       }
4303     }
4304     ierr = PetscFree(coarse_nsp_vecs);CHKERRQ(ierr);
4305   }
4306 
4307   /* KSP for coarse problem */
4308   if (rank_prec_comm == active_rank) {
4309 
4310     ierr = KSPCreate(coarse_comm,&pcbddc->coarse_ksp);CHKERRQ(ierr);
4311     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
4312     ierr = KSPSetOperators(pcbddc->coarse_ksp,pcbddc->coarse_mat,pcbddc->coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
4313     ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,max_it_coarse_ksp);CHKERRQ(ierr);
4314     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
4315     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
4316     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
4317     /* Allow user's customization */
4318     ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,"coarse_");CHKERRQ(ierr);
4319     /* Set Up PC for coarse problem BDDC */
4320     if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
4321       i = pcbddc->current_level+1;
4322       ierr = PCBDDCSetLevel(pc_temp,i);CHKERRQ(ierr);
4323       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
4324       ierr = PCBDDCSetMaxLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
4325       ierr = PCBDDCSetCoarseProblemType(pc_temp,MULTILEVEL_BDDC);CHKERRQ(ierr);
4326       if (pcbddc->CoarseNullSpace) { ierr = PCBDDCSetNullSpace(pc_temp,pcbddc->CoarseNullSpace);CHKERRQ(ierr); }
4327       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
4328       if (dbg_flag) {
4329         ierr = PetscViewerASCIIPrintf(viewer,"----------------Level %d: Setting up level %d---------------\n",pcbddc->current_level,i);CHKERRQ(ierr);
4330         ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
4331       }
4332     }
4333     ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
4334     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
4335 
4336     if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
4337       /* TODO: this is a hack! need to be solved! */
4338       PC_BDDC*     coarse_pcbddc = (PC_BDDC*)pc_temp->data;
4339       coarse_pcbddc->use_exact_dirichlet = PETSC_FALSE;
4340       if (dbg_flag) {
4341         ierr = PetscViewerASCIIPrintf(viewer,"----------------Level %d set----------------------\n",i);CHKERRQ(ierr);
4342         ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
4343       }
4344     }
4345   }
4346   /* Evaluate condition number of coarse problem for cheby (and verbose output if requested) */
4347   if ( dbg_flag && rank_prec_comm == active_rank ) {
4348     KSP check_ksp;
4349     PC  check_pc;
4350     Vec check_vec;
4351     PetscReal   abs_infty_error,infty_error,lambda_min,lambda_max;
4352     const KSPType check_ksp_type;
4353 
4354     /* Create ksp object suitable for extreme eigenvalues' estimation */
4355     ierr = KSPCreate(coarse_comm,&check_ksp);CHKERRQ(ierr);
4356     ierr = KSPSetOperators(check_ksp,pcbddc->coarse_mat,pcbddc->coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
4357     ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
4358     if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
4359       if (issym) {
4360         check_ksp_type = KSPCG;
4361       } else {
4362         check_ksp_type = KSPGMRES;
4363       }
4364       ierr = KSPSetComputeSingularValues(check_ksp,PETSC_TRUE);CHKERRQ(ierr);
4365     } else {
4366       check_ksp_type = KSPPREONLY;
4367     }
4368     ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
4369     ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
4370     ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
4371     ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
4372     /* create random vec */
4373     ierr = VecDuplicate(pcbddc->coarse_vec,&check_vec);CHKERRQ(ierr);
4374     ierr = VecSetRandom(check_vec,PETSC_NULL);CHKERRQ(ierr);
4375     if (pcbddc->CoarseNullSpace) { ierr = MatNullSpaceRemove(pcbddc->CoarseNullSpace,check_vec,PETSC_NULL);CHKERRQ(ierr); }
4376     ierr = MatMult(pcbddc->coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
4377     /* solve coarse problem */
4378     ierr = KSPSolve(check_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
4379     if (pcbddc->CoarseNullSpace) { ierr = MatNullSpaceRemove(pcbddc->CoarseNullSpace,pcbddc->coarse_vec,PETSC_NULL);CHKERRQ(ierr); }
4380     /* check coarse problem residual error */
4381     ierr = VecAXPY(check_vec,-1.0,pcbddc->coarse_vec);CHKERRQ(ierr);
4382     ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
4383     ierr = MatMult(pcbddc->coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
4384     ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
4385     ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
4386     ierr = PetscViewerASCIIPrintf(viewer,"Size of coarse problem %d\n",pcbddc->coarse_size);CHKERRQ(ierr);
4387     /* get eigenvalue estimation if inexact */
4388     if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
4389       ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
4390       ierr = KSPGetIterationNumber(check_ksp,&k);CHKERRQ(ierr);
4391       ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem eigenvalues estimated with %d iterations of %s.\n",k,check_ksp_type);CHKERRQ(ierr);
4392       ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem eigenvalues: % 1.14e %1.14e\n",lambda_min,lambda_max);CHKERRQ(ierr);
4393     }
4394     ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem exact infty_error   : %1.14e\n",infty_error);CHKERRQ(ierr);
4395     ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem residual infty_error: %1.14e\n",abs_infty_error);CHKERRQ(ierr);
4396     ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
4397   }
4398   if (dbg_flag) { ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); }
4399   /* free data structures no longer needed */
4400   if (coarse_ISLG)                { ierr = ISLocalToGlobalMappingDestroy(&coarse_ISLG);CHKERRQ(ierr); }
4401   if (ins_local_primal_indices)   { ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr);  }
4402   if (ins_coarse_mat_vals)        { ierr = PetscFree(ins_coarse_mat_vals);CHKERRQ(ierr);}
4403   if (localsizes2)                { ierr = PetscFree(localsizes2);CHKERRQ(ierr);}
4404   if (localdispl2)                { ierr = PetscFree(localdispl2);CHKERRQ(ierr);}
4405   if (temp_coarse_mat_vals)       { ierr = PetscFree(temp_coarse_mat_vals);CHKERRQ(ierr);}
4406 
4407   PetscFunctionReturn(0);
4408 }
4409 
4410 #undef __FUNCT__
4411 #define __FUNCT__ "PCBDDCManageLocalBoundaries"
4412 static PetscErrorCode PCBDDCManageLocalBoundaries(PC pc)
4413 {
4414 
4415   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
4416   PC_IS         *pcis = (PC_IS*)pc->data;
4417   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
4418   PCBDDCGraph mat_graph=pcbddc->mat_graph;
4419   PetscInt    *queue_in_global_numbering,*is_indices,*auxis;
4420   PetscInt    bs,ierr,i,j,s,k,iindex,neumann_bsize,dirichlet_bsize;
4421   PetscInt    total_counts,nodes_touched,where_values=1,vertex_size;
4422   PetscMPIInt adapt_interface=0,adapt_interface_reduced=0,NEUMANNCNT=0;
4423   PetscBool   same_set;
4424   MPI_Comm    interface_comm=((PetscObject)pc)->comm;
4425   PetscBool   use_faces=PETSC_FALSE,use_edges=PETSC_FALSE;
4426   const PetscInt *neumann_nodes;
4427   const PetscInt *dirichlet_nodes;
4428   IS          used_IS,*custom_ISForDofs;
4429   PetscScalar *array;
4430   PetscScalar *array2;
4431   PetscViewer viewer=pcbddc->dbg_viewer;
4432 
4433   PetscFunctionBegin;
4434   /* Setup local adjacency graph */
4435   mat_graph->nvtxs=pcis->n;
4436   if (!mat_graph->xadj) { NEUMANNCNT = 1; }
4437   ierr = PCBDDCSetupLocalAdjacencyGraph(pc);CHKERRQ(ierr);
4438   i = mat_graph->nvtxs;
4439   ierr = PetscMalloc4(i,PetscInt,&mat_graph->where,i,PetscInt,&mat_graph->count,i+1,PetscInt,&mat_graph->cptr,i,PetscInt,&mat_graph->queue);CHKERRQ(ierr);
4440   ierr = PetscMalloc2(i,PetscInt,&mat_graph->which_dof,i,PetscBool,&mat_graph->touched);CHKERRQ(ierr);
4441   ierr = PetscMalloc(i*sizeof(PetscInt),&queue_in_global_numbering);CHKERRQ(ierr);
4442   ierr = PetscMemzero(mat_graph->where,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr);
4443   ierr = PetscMemzero(mat_graph->count,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr);
4444   ierr = PetscMemzero(mat_graph->which_dof,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr);
4445   ierr = PetscMemzero(mat_graph->queue,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr);
4446   ierr = PetscMemzero(mat_graph->cptr,(mat_graph->nvtxs+1)*sizeof(PetscInt));CHKERRQ(ierr);
4447 
4448   /* Setting dofs splitting in mat_graph->which_dof
4449      Get information about dofs' splitting if provided by the user
4450      Otherwise it assumes a constant block size */
4451   vertex_size=0;
4452   if (!pcbddc->n_ISForDofs) {
4453     ierr = MatGetBlockSize(matis->A,&bs);CHKERRQ(ierr);
4454     ierr = PetscMalloc(bs*sizeof(IS),&custom_ISForDofs);CHKERRQ(ierr);
4455     for (i=0;i<bs;i++) {
4456       ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n/bs,i,bs,&custom_ISForDofs[i]);CHKERRQ(ierr);
4457     }
4458     ierr = PCBDDCSetDofsSplitting(pc,bs,custom_ISForDofs);CHKERRQ(ierr);
4459     vertex_size=1;
4460     /* remove my references to IS objects */
4461     for (i=0;i<bs;i++) {
4462       ierr = ISDestroy(&custom_ISForDofs[i]);CHKERRQ(ierr);
4463     }
4464     ierr = PetscFree(custom_ISForDofs);CHKERRQ(ierr);
4465   }
4466   for (i=0;i<pcbddc->n_ISForDofs;i++) {
4467     ierr = ISGetSize(pcbddc->ISForDofs[i],&k);CHKERRQ(ierr);
4468     ierr = ISGetIndices(pcbddc->ISForDofs[i],(const PetscInt**)&is_indices);CHKERRQ(ierr);
4469     for (j=0;j<k;j++) {
4470       mat_graph->which_dof[is_indices[j]]=i;
4471     }
4472     ierr = ISRestoreIndices(pcbddc->ISForDofs[i],(const PetscInt**)&is_indices);CHKERRQ(ierr);
4473   }
4474   /* use mat block size as vertex size if it has not yet set */
4475   if (!vertex_size) {
4476     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
4477   }
4478 
4479   /* count number of neigh per node */
4480   total_counts=0;
4481   for (i=1;i<pcis->n_neigh;i++){
4482     s=pcis->n_shared[i];
4483     total_counts+=s;
4484     for (j=0;j<s;j++){
4485       mat_graph->count[pcis->shared[i][j]] += 1;
4486     }
4487   }
4488   /* Take into account Neumann data -> it increments number of sharing subdomains for nodes lying on the interface */
4489   ierr = PCBDDCGetNeumannBoundaries(pc,&used_IS);CHKERRQ(ierr);
4490   ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
4491   ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4492   if (used_IS) {
4493     ierr = ISGetSize(used_IS,&neumann_bsize);CHKERRQ(ierr);
4494     ierr = ISGetIndices(used_IS,&neumann_nodes);CHKERRQ(ierr);
4495     for (i=0;i<neumann_bsize;i++){
4496       iindex = neumann_nodes[i];
4497       if (mat_graph->count[iindex] > NEUMANNCNT && array[iindex]==0.0){
4498         mat_graph->count[iindex]+=1;
4499         total_counts++;
4500         array[iindex]=array[iindex]+1.0;
4501       } else if (array[iindex]>0.0) {
4502         SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_USER,"Error for neumann nodes provided to BDDC! They must be uniquely listed! Found duplicate node %d\n",iindex);
4503       }
4504     }
4505   }
4506   ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4507   /* allocate space for storing the set of neighbours for each node */
4508   ierr = PetscMalloc(mat_graph->nvtxs*sizeof(PetscInt*),&mat_graph->neighbours_set);CHKERRQ(ierr);
4509   if (mat_graph->nvtxs) { ierr = PetscMalloc(total_counts*sizeof(PetscInt),&mat_graph->neighbours_set[0]);CHKERRQ(ierr); }
4510   for (i=1;i<mat_graph->nvtxs;i++) mat_graph->neighbours_set[i]=mat_graph->neighbours_set[i-1]+mat_graph->count[i-1];
4511   ierr = PetscMemzero(mat_graph->count,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr);
4512   for (i=1;i<pcis->n_neigh;i++){
4513     s=pcis->n_shared[i];
4514     for (j=0;j<s;j++) {
4515       k=pcis->shared[i][j];
4516       mat_graph->neighbours_set[k][mat_graph->count[k]] = pcis->neigh[i];
4517       mat_graph->count[k]+=1;
4518     }
4519   }
4520   /* Check consistency of Neumann nodes */
4521   ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
4522   ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4523   ierr = VecScatterEnd  (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4524   ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4525   ierr = VecScatterEnd  (matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4526   ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4527   /* set -1 fake neighbour to mimic Neumann boundary */
4528   if (used_IS) {
4529     for (i=0;i<neumann_bsize;i++){
4530       iindex = neumann_nodes[i];
4531       if (mat_graph->count[iindex] > NEUMANNCNT){
4532         if (mat_graph->count[iindex]+1 != (PetscInt)array[iindex]) {
4533           SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_USER,"Neumann nodes provided to BDDC must be consistent among neighbours!\nNode %d: number of sharing subdomains %d != number of subdomains for which it is a neumann node %d\n",iindex,mat_graph->count[iindex]+1,(PetscInt)array[iindex]);
4534         }
4535         mat_graph->neighbours_set[iindex][mat_graph->count[iindex]] = -1;
4536         mat_graph->count[iindex]+=1;
4537       }
4538     }
4539     ierr = ISRestoreIndices(used_IS,&neumann_nodes);CHKERRQ(ierr);
4540   }
4541   ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4542   /* sort set of sharing subdomains */
4543   for (i=0;i<mat_graph->nvtxs;i++) { ierr = PetscSortInt(mat_graph->count[i],mat_graph->neighbours_set[i]);CHKERRQ(ierr); }
4544   /* remove interior nodes and dirichlet boundary nodes from the next search into the graph */
4545   for (i=0;i<mat_graph->nvtxs;i++){mat_graph->touched[i]=PETSC_FALSE;}
4546   nodes_touched=0;
4547   ierr = PCBDDCGetDirichletBoundaries(pc,&used_IS);CHKERRQ(ierr);
4548   ierr = VecSet(pcis->vec2_N,0.0);CHKERRQ(ierr);
4549   ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4550   ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
4551   if (used_IS) {
4552     ierr = ISGetSize(used_IS,&dirichlet_bsize);CHKERRQ(ierr);
4553     if (dirichlet_bsize && matis->pure_neumann) {
4554       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"Dirichlet boundaries are intended to be used with matrices with zeroed rows!\n");
4555     }
4556     ierr = ISGetIndices(used_IS,&dirichlet_nodes);CHKERRQ(ierr);
4557     for (i=0;i<dirichlet_bsize;i++){
4558       iindex=dirichlet_nodes[i];
4559       if (mat_graph->count[iindex] && !mat_graph->touched[iindex]) {
4560         if (array[iindex]>0.0) {
4561           SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_USER,"BDDC cannot have nodes which are marked as Neumann and Dirichlet at the same time! Wrong node %d\n",iindex);
4562         }
4563         mat_graph->touched[iindex]=PETSC_TRUE;
4564         mat_graph->where[iindex]=0;
4565         nodes_touched++;
4566         array2[iindex]=array2[iindex]+1.0;
4567       }
4568     }
4569     ierr = ISRestoreIndices(used_IS,&dirichlet_nodes);CHKERRQ(ierr);
4570   }
4571   ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4572   ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
4573   /* Check consistency of Dirichlet nodes */
4574   ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
4575   ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
4576   ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4577   ierr = VecScatterEnd  (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4578   ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4579   ierr = VecScatterEnd  (matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4580   ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
4581   ierr = VecScatterBegin(matis->ctx,pcis->vec2_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4582   ierr = VecScatterEnd  (matis->ctx,pcis->vec2_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4583   ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4584   ierr = VecScatterEnd  (matis->ctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4585   ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4586   ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
4587   if (used_IS) {
4588     ierr = ISGetSize(used_IS,&dirichlet_bsize);CHKERRQ(ierr);
4589     ierr = ISGetIndices(used_IS,&dirichlet_nodes);CHKERRQ(ierr);
4590     for (i=0;i<dirichlet_bsize;i++){
4591       iindex=dirichlet_nodes[i];
4592       if (array[iindex]>1.0 && array[iindex]!=array2[iindex] ) {
4593          SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_USER,"Dirichlet nodes provided to BDDC must be consistent among neighbours!\nNode %d: number of sharing subdomains %d != number of subdomains for which it is a neumann node %d\n",iindex,(PetscInt)array[iindex],(PetscInt)array2[iindex]);
4594       }
4595     }
4596     ierr = ISRestoreIndices(used_IS,&dirichlet_nodes);CHKERRQ(ierr);
4597   }
4598   ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4599   ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
4600 
4601   for (i=0;i<mat_graph->nvtxs;i++){
4602     if (!mat_graph->count[i]){  /* interior nodes */
4603       mat_graph->touched[i]=PETSC_TRUE;
4604       mat_graph->where[i]=0;
4605       nodes_touched++;
4606     }
4607   }
4608   mat_graph->ncmps = 0;
4609   i=0;
4610   while(nodes_touched<mat_graph->nvtxs) {
4611     /*  find first untouched node in local ordering */
4612     while(mat_graph->touched[i]) i++;
4613     mat_graph->touched[i]=PETSC_TRUE;
4614     mat_graph->where[i]=where_values;
4615     nodes_touched++;
4616     /* now find all other nodes having the same set of sharing subdomains */
4617     for (j=i+1;j<mat_graph->nvtxs;j++){
4618       /* check for same number of sharing subdomains and dof number */
4619       if (!mat_graph->touched[j] && mat_graph->count[i]==mat_graph->count[j] && mat_graph->which_dof[i] == mat_graph->which_dof[j] ){
4620         /* check for same set of sharing subdomains */
4621         same_set=PETSC_TRUE;
4622         for (k=0;k<mat_graph->count[j];k++){
4623           if (mat_graph->neighbours_set[i][k]!=mat_graph->neighbours_set[j][k]) {
4624             same_set=PETSC_FALSE;
4625           }
4626         }
4627         /* I found a friend of mine */
4628         if (same_set) {
4629           mat_graph->where[j]=where_values;
4630           mat_graph->touched[j]=PETSC_TRUE;
4631           nodes_touched++;
4632         }
4633       }
4634     }
4635     where_values++;
4636   }
4637   where_values--; if (where_values<0) where_values=0;
4638   ierr = PetscMalloc(where_values*sizeof(PetscMPIInt),&mat_graph->where_ncmps);CHKERRQ(ierr);
4639   /* Find connected components defined on the shared interface */
4640   if (where_values) {
4641     ierr = PCBDDCFindConnectedComponents(mat_graph, where_values);
4642     /* For consistency among neughbouring procs, I need to sort (by global ordering) each connected component */
4643     for (i=0;i<mat_graph->ncmps;i++) {
4644       ierr = ISLocalToGlobalMappingApply(matis->mapping,mat_graph->cptr[i+1]-mat_graph->cptr[i],&mat_graph->queue[mat_graph->cptr[i]],&queue_in_global_numbering[mat_graph->cptr[i]]);CHKERRQ(ierr);
4645       ierr = PetscSortIntWithArray(mat_graph->cptr[i+1]-mat_graph->cptr[i],&queue_in_global_numbering[mat_graph->cptr[i]],&mat_graph->queue[mat_graph->cptr[i]]);CHKERRQ(ierr);
4646     }
4647   }
4648   /* check consistency of connected components among neighbouring subdomains -> it adapt them in case it is needed */
4649   for (i=0;i<where_values;i++) {
4650     /* We are not sure that two connected components will be the same among subdomains sharing a subset of local interface */
4651     if (mat_graph->where_ncmps[i]>1) {
4652       adapt_interface=1;
4653       break;
4654     }
4655   }
4656   ierr = MPI_Allreduce(&adapt_interface,&adapt_interface_reduced,1,MPIU_INT,MPI_LOR,interface_comm);CHKERRQ(ierr);
4657   if (pcbddc->dbg_flag && adapt_interface_reduced) {
4658     ierr = PetscViewerASCIIPrintf(viewer,"Adapting interface\n");CHKERRQ(ierr);
4659     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
4660   }
4661   if (where_values && adapt_interface_reduced) {
4662 
4663     PetscInt sum_requests=0,my_rank;
4664     PetscInt buffer_size,start_of_recv,size_of_recv,start_of_send;
4665     PetscInt temp_buffer_size,ins_val,global_where_counter;
4666     PetscInt *cum_recv_counts;
4667     PetscInt *where_to_nodes_indices;
4668     PetscInt *petsc_buffer;
4669     PetscMPIInt *recv_buffer;
4670     PetscMPIInt *recv_buffer_where;
4671     PetscMPIInt *send_buffer;
4672     PetscMPIInt size_of_send;
4673     PetscInt *sizes_of_sends;
4674     MPI_Request *send_requests;
4675     MPI_Request *recv_requests;
4676     PetscInt *where_cc_adapt;
4677     PetscInt **temp_buffer;
4678     PetscInt *nodes_to_temp_buffer_indices;
4679     PetscInt *add_to_where;
4680 
4681     ierr = MPI_Comm_rank(interface_comm,&my_rank);CHKERRQ(ierr);
4682     ierr = PetscMalloc((where_values+1)*sizeof(PetscInt),&cum_recv_counts);CHKERRQ(ierr);
4683     ierr = PetscMemzero(cum_recv_counts,(where_values+1)*sizeof(PetscInt));CHKERRQ(ierr);
4684     ierr = PetscMalloc(where_values*sizeof(PetscInt),&where_to_nodes_indices);CHKERRQ(ierr);
4685     /* first count how many neighbours per connected component I will receive from */
4686     cum_recv_counts[0]=0;
4687     for (i=1;i<where_values+1;i++){
4688       j=0;
4689       while(mat_graph->where[j] != i) { j++; }
4690       where_to_nodes_indices[i-1]=j;
4691       if (mat_graph->neighbours_set[j][0]!=-1) { cum_recv_counts[i]=cum_recv_counts[i-1]+mat_graph->count[j]; } /* We don't want sends/recvs_to/from_self -> here I don't count myself  */
4692       else { cum_recv_counts[i]=cum_recv_counts[i-1]+mat_graph->count[j]-1; }
4693     }
4694     ierr = PetscMalloc(2*cum_recv_counts[where_values]*sizeof(PetscMPIInt),&recv_buffer_where);CHKERRQ(ierr);
4695     ierr = PetscMalloc(cum_recv_counts[where_values]*sizeof(MPI_Request),&send_requests);CHKERRQ(ierr);
4696     ierr = PetscMalloc(cum_recv_counts[where_values]*sizeof(MPI_Request),&recv_requests);CHKERRQ(ierr);
4697     for (i=0;i<cum_recv_counts[where_values];i++) {
4698       send_requests[i]=MPI_REQUEST_NULL;
4699       recv_requests[i]=MPI_REQUEST_NULL;
4700     }
4701     /* exchange with my neighbours the number of my connected components on the shared interface */
4702     for (i=0;i<where_values;i++){
4703       j=where_to_nodes_indices[i];
4704       k = (mat_graph->neighbours_set[j][0] == -1 ?  1 : 0);
4705       for (;k<mat_graph->count[j];k++){
4706         ierr = MPI_Isend(&mat_graph->where_ncmps[i],1,MPIU_INT,mat_graph->neighbours_set[j][k],(my_rank+1)*mat_graph->count[j],interface_comm,&send_requests[sum_requests]);CHKERRQ(ierr);
4707         ierr = MPI_Irecv(&recv_buffer_where[sum_requests],1,MPIU_INT,mat_graph->neighbours_set[j][k],(mat_graph->neighbours_set[j][k]+1)*mat_graph->count[j],interface_comm,&recv_requests[sum_requests]);CHKERRQ(ierr);
4708         sum_requests++;
4709       }
4710     }
4711     ierr = MPI_Waitall(sum_requests,recv_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
4712     ierr = MPI_Waitall(sum_requests,send_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
4713     /* determine the connected component I need to adapt */
4714     ierr = PetscMalloc(where_values*sizeof(PetscInt),&where_cc_adapt);CHKERRQ(ierr);
4715     ierr = PetscMemzero(where_cc_adapt,where_values*sizeof(PetscInt));CHKERRQ(ierr);
4716     for (i=0;i<where_values;i++){
4717       for (j=cum_recv_counts[i];j<cum_recv_counts[i+1];j++){
4718         /* The first condition is natural (i.e someone has a different number of cc than me), the second one is just to be safe */
4719         if ( mat_graph->where_ncmps[i]!=recv_buffer_where[j] || mat_graph->where_ncmps[i] > 1 ) {
4720           where_cc_adapt[i]=PETSC_TRUE;
4721           break;
4722         }
4723       }
4724     }
4725     buffer_size = 0;
4726     for (i=0;i<where_values;i++) {
4727       if (where_cc_adapt[i]) {
4728         for (j=i;j<mat_graph->ncmps;j++) {
4729           if (mat_graph->where[mat_graph->queue[mat_graph->cptr[j]]] == i+1) { /* WARNING -> where values goes from 1 to where_values included */
4730             buffer_size += 1 + mat_graph->cptr[j+1]-mat_graph->cptr[j];
4731           }
4732         }
4733       }
4734     }
4735     ierr = PetscMalloc(buffer_size*sizeof(PetscMPIInt),&send_buffer);CHKERRQ(ierr);
4736     /* now get from neighbours their ccs (in global numbering) and adapt them (in case it is needed) */
4737     /* first determine how much data to send (size of each queue plus the global indices) and communicate it to neighbours */
4738     ierr = PetscMalloc(where_values*sizeof(PetscInt),&sizes_of_sends);CHKERRQ(ierr);
4739     ierr = PetscMemzero(sizes_of_sends,where_values*sizeof(PetscInt));CHKERRQ(ierr);
4740     sum_requests=0;
4741     start_of_send=0;
4742     start_of_recv=cum_recv_counts[where_values];
4743     for (i=0;i<where_values;i++) {
4744       if (where_cc_adapt[i]) {
4745         size_of_send=0;
4746         for (j=i;j<mat_graph->ncmps;j++) {
4747           if (mat_graph->where[mat_graph->queue[mat_graph->cptr[j]]] == i+1) { /* WARNING -> where values goes from 1 to where_values included */
4748             send_buffer[start_of_send+size_of_send]=mat_graph->cptr[j+1]-mat_graph->cptr[j];
4749             size_of_send+=1;
4750             for (k=0;k<mat_graph->cptr[j+1]-mat_graph->cptr[j];k++) {
4751               send_buffer[start_of_send+size_of_send+k]=queue_in_global_numbering[mat_graph->cptr[j]+k];
4752             }
4753             size_of_send=size_of_send+mat_graph->cptr[j+1]-mat_graph->cptr[j];
4754           }
4755         }
4756         j = where_to_nodes_indices[i];
4757         k = (mat_graph->neighbours_set[j][0] == -1 ?  1 : 0);
4758         sizes_of_sends[i]=size_of_send;
4759         for (;k<mat_graph->count[j];k++){
4760           ierr = MPI_Isend(&sizes_of_sends[i],1,MPIU_INT,mat_graph->neighbours_set[j][k],(my_rank+1)*mat_graph->count[j],interface_comm,&send_requests[sum_requests]);CHKERRQ(ierr);
4761           ierr = MPI_Irecv(&recv_buffer_where[sum_requests+start_of_recv],1,MPIU_INT,mat_graph->neighbours_set[j][k],(mat_graph->neighbours_set[j][k]+1)*mat_graph->count[j],interface_comm,&recv_requests[sum_requests]);CHKERRQ(ierr);
4762           sum_requests++;
4763         }
4764         start_of_send+=size_of_send;
4765       }
4766     }
4767     ierr = MPI_Waitall(sum_requests,send_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
4768     ierr = MPI_Waitall(sum_requests,recv_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
4769     buffer_size=0;
4770     for (k=0;k<sum_requests;k++) { buffer_size+=recv_buffer_where[start_of_recv+k]; }
4771     ierr = PetscMalloc(buffer_size*sizeof(PetscMPIInt),&recv_buffer);CHKERRQ(ierr);
4772     /* now exchange the data */
4773     start_of_recv=0;
4774     start_of_send=0;
4775     sum_requests=0;
4776     for (i=0;i<where_values;i++) {
4777       if (where_cc_adapt[i]) {
4778         size_of_send = sizes_of_sends[i];
4779         j = where_to_nodes_indices[i];
4780         k = (mat_graph->neighbours_set[j][0] == -1 ?  1 : 0);
4781         for (;k<mat_graph->count[j];k++){
4782           ierr = MPI_Isend(&send_buffer[start_of_send],size_of_send,MPIU_INT,mat_graph->neighbours_set[j][k],(my_rank+1)*mat_graph->count[j],interface_comm,&send_requests[sum_requests]);CHKERRQ(ierr);
4783           size_of_recv=recv_buffer_where[cum_recv_counts[where_values]+sum_requests];
4784           ierr = MPI_Irecv(&recv_buffer[start_of_recv],size_of_recv,MPIU_INT,mat_graph->neighbours_set[j][k],(mat_graph->neighbours_set[j][k]+1)*mat_graph->count[j],interface_comm,&recv_requests[sum_requests]);CHKERRQ(ierr);
4785           start_of_recv+=size_of_recv;
4786           sum_requests++;
4787         }
4788         start_of_send+=size_of_send;
4789       }
4790     }
4791     ierr = MPI_Waitall(sum_requests,recv_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
4792     ierr = MPI_Waitall(sum_requests,send_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
4793     ierr = PetscMalloc(buffer_size*sizeof(PetscInt),&petsc_buffer);CHKERRQ(ierr);
4794     for (k=0;k<start_of_recv;k++) { petsc_buffer[k]=(PetscInt)recv_buffer[k]; }
4795     for (j=0;j<buffer_size;) {
4796        ierr = ISGlobalToLocalMappingApply(matis->mapping,IS_GTOLM_MASK,petsc_buffer[j],&petsc_buffer[j+1],&petsc_buffer[j],&petsc_buffer[j+1]);CHKERRQ(ierr);
4797        k=petsc_buffer[j]+1;
4798        j+=k;
4799     }
4800     sum_requests=cum_recv_counts[where_values];
4801     start_of_recv=0;
4802     ierr = PetscMalloc(mat_graph->nvtxs*sizeof(PetscInt),&nodes_to_temp_buffer_indices);CHKERRQ(ierr);
4803     global_where_counter=0;
4804     for (i=0;i<where_values;i++){
4805       if (where_cc_adapt[i]){
4806         temp_buffer_size=0;
4807         /* find nodes on the shared interface we need to adapt */
4808         for (j=0;j<mat_graph->nvtxs;j++){
4809           if (mat_graph->where[j]==i+1) {
4810             nodes_to_temp_buffer_indices[j]=temp_buffer_size;
4811             temp_buffer_size++;
4812           } else {
4813             nodes_to_temp_buffer_indices[j]=-1;
4814           }
4815         }
4816         /* allocate some temporary space */
4817         ierr = PetscMalloc(temp_buffer_size*sizeof(PetscInt*),&temp_buffer);CHKERRQ(ierr);
4818         ierr = PetscMalloc(temp_buffer_size*(cum_recv_counts[i+1]-cum_recv_counts[i])*sizeof(PetscInt),&temp_buffer[0]);CHKERRQ(ierr);
4819         ierr = PetscMemzero(temp_buffer[0],temp_buffer_size*(cum_recv_counts[i+1]-cum_recv_counts[i])*sizeof(PetscInt));CHKERRQ(ierr);
4820         for (j=1;j<temp_buffer_size;j++){
4821           temp_buffer[j]=temp_buffer[j-1]+cum_recv_counts[i+1]-cum_recv_counts[i];
4822         }
4823         /* analyze contributions from neighbouring subdomains for i-th conn comp
4824            temp buffer structure:
4825            supposing part of the interface has dimension 5 (global nodes 0,1,2,3,4)
4826            3 neighs procs with structured connected components:
4827              neigh 0: [0 1 4], [2 3];  (2 connected components)
4828              neigh 1: [0 1], [2 3 4];  (2 connected components)
4829              neigh 2: [0 4], [1], [2 3]; (3 connected components)
4830            tempbuffer (row-oriented) should be filled as:
4831              [ 0, 0, 0;
4832                0, 0, 1;
4833                1, 1, 2;
4834                1, 1, 2;
4835                0, 1, 0; ];
4836            This way we can simply recover the resulting structure account for possible intersections of ccs among neighs.
4837            The mat_graph->where array will be modified to reproduce the following 4 connected components [0], [1], [2 3], [4];
4838                                                                                                                                    */
4839         for (j=0;j<cum_recv_counts[i+1]-cum_recv_counts[i];j++) {
4840           ins_val=0;
4841           size_of_recv=recv_buffer_where[sum_requests];  /* total size of recv from neighs */
4842           for (buffer_size=0;buffer_size<size_of_recv;) {  /* loop until all data from neighs has been taken into account */
4843             for (k=1;k<petsc_buffer[buffer_size+start_of_recv]+1;k++) { /* filling properly temp_buffer using data from a single recv */
4844               temp_buffer[ nodes_to_temp_buffer_indices[ petsc_buffer[ start_of_recv+buffer_size+k ] ] ][j]=ins_val;
4845             }
4846             buffer_size+=k;
4847             ins_val++;
4848           }
4849           start_of_recv+=size_of_recv;
4850           sum_requests++;
4851         }
4852         ierr = PetscMalloc(temp_buffer_size*sizeof(PetscInt),&add_to_where);CHKERRQ(ierr);
4853         ierr = PetscMemzero(add_to_where,temp_buffer_size*sizeof(PetscInt));CHKERRQ(ierr);
4854         for (j=0;j<temp_buffer_size;j++){
4855           if (!add_to_where[j]){ /* found a new cc  */
4856             global_where_counter++;
4857             add_to_where[j]=global_where_counter;
4858             for (k=j+1;k<temp_buffer_size;k++){ /* check for other nodes in new cc */
4859               same_set=PETSC_TRUE;
4860               for (s=0;s<cum_recv_counts[i+1]-cum_recv_counts[i];s++){
4861                 if (temp_buffer[j][s]!=temp_buffer[k][s]) {
4862                   same_set=PETSC_FALSE;
4863                   break;
4864                 }
4865               }
4866               if (same_set) add_to_where[k]=global_where_counter;
4867             }
4868           }
4869         }
4870         /* insert new data in where array */
4871         temp_buffer_size=0;
4872         for (j=0;j<mat_graph->nvtxs;j++){
4873           if (mat_graph->where[j]==i+1) {
4874             mat_graph->where[j]=where_values+add_to_where[temp_buffer_size];
4875             temp_buffer_size++;
4876           }
4877         }
4878         ierr = PetscFree(temp_buffer[0]);CHKERRQ(ierr);
4879         ierr = PetscFree(temp_buffer);CHKERRQ(ierr);
4880         ierr = PetscFree(add_to_where);CHKERRQ(ierr);
4881       }
4882     }
4883     ierr = PetscFree(nodes_to_temp_buffer_indices);CHKERRQ(ierr);
4884     ierr = PetscFree(sizes_of_sends);CHKERRQ(ierr);
4885     ierr = PetscFree(send_requests);CHKERRQ(ierr);
4886     ierr = PetscFree(recv_requests);CHKERRQ(ierr);
4887     ierr = PetscFree(petsc_buffer);CHKERRQ(ierr);
4888     ierr = PetscFree(recv_buffer);CHKERRQ(ierr);
4889     ierr = PetscFree(recv_buffer_where);CHKERRQ(ierr);
4890     ierr = PetscFree(send_buffer);CHKERRQ(ierr);
4891     ierr = PetscFree(cum_recv_counts);CHKERRQ(ierr);
4892     ierr = PetscFree(where_to_nodes_indices);CHKERRQ(ierr);
4893     ierr = PetscFree(where_cc_adapt);CHKERRQ(ierr);
4894     /* We are ready to evaluate consistent connected components on each part of the shared interface */
4895     if (global_where_counter) {
4896       for (i=0;i<mat_graph->nvtxs;i++){ mat_graph->touched[i]=PETSC_FALSE; }
4897       global_where_counter=0;
4898       for (i=0;i<mat_graph->nvtxs;i++){
4899         if (mat_graph->where[i] && !mat_graph->touched[i]) {
4900           global_where_counter++;
4901           for (j=i+1;j<mat_graph->nvtxs;j++){
4902             if (!mat_graph->touched[j] && mat_graph->where[j]==mat_graph->where[i]) {
4903               mat_graph->where[j]=global_where_counter;
4904               mat_graph->touched[j]=PETSC_TRUE;
4905             }
4906           }
4907           mat_graph->where[i]=global_where_counter;
4908           mat_graph->touched[i]=PETSC_TRUE;
4909         }
4910       }
4911       where_values=global_where_counter;
4912     }
4913     if (global_where_counter) {
4914       ierr = PetscMemzero(mat_graph->cptr,(mat_graph->nvtxs+1)*sizeof(PetscInt));CHKERRQ(ierr);
4915       ierr = PetscMemzero(mat_graph->queue,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr);
4916       ierr = PetscFree(mat_graph->where_ncmps);CHKERRQ(ierr);
4917       ierr = PetscMalloc(where_values*sizeof(PetscMPIInt),&mat_graph->where_ncmps);CHKERRQ(ierr);
4918       ierr = PCBDDCFindConnectedComponents(mat_graph, where_values);
4919       for (i=0;i<mat_graph->ncmps;i++) {
4920         ierr = ISLocalToGlobalMappingApply(matis->mapping,mat_graph->cptr[i+1]-mat_graph->cptr[i],&mat_graph->queue[mat_graph->cptr[i]],&queue_in_global_numbering[mat_graph->cptr[i]]);CHKERRQ(ierr);
4921         ierr = PetscSortIntWithArray(mat_graph->cptr[i+1]-mat_graph->cptr[i],&queue_in_global_numbering[mat_graph->cptr[i]],&mat_graph->queue[mat_graph->cptr[i]]);CHKERRQ(ierr);
4922       }
4923     }
4924   } /* Finished adapting interface */
4925   PetscInt nfc=0;
4926   PetscInt nec=0;
4927   PetscInt nvc=0;
4928   PetscBool twodim_flag=PETSC_FALSE;
4929   for (i=0; i<mat_graph->ncmps; i++) {
4930     if ( mat_graph->cptr[i+1]-mat_graph->cptr[i] > vertex_size ){
4931       if (mat_graph->count[mat_graph->queue[mat_graph->cptr[i]]]==1){ /* 1 neigh Neumann fake included */
4932         nfc++;
4933       } else { /* note that nec will be zero in 2d */
4934         nec++;
4935       }
4936     } else {
4937       nvc+=mat_graph->cptr[i+1]-mat_graph->cptr[i];
4938     }
4939   }
4940 
4941   if (!nec) { /* we are in a 2d case -> no faces, only edges */
4942     nec = nfc;
4943     nfc = 0;
4944     twodim_flag = PETSC_TRUE;
4945   }
4946   /* allocate IS arrays for faces, edges. Vertices need a single index set. */
4947   k=0;
4948   for (i=0; i<mat_graph->ncmps; i++) {
4949     j=mat_graph->cptr[i+1]-mat_graph->cptr[i];
4950     if ( j > k) {
4951       k=j;
4952     }
4953     if (j<=vertex_size) {
4954       k+=vertex_size;
4955     }
4956   }
4957   ierr = PetscMalloc(k*sizeof(PetscInt),&auxis);CHKERRQ(ierr);
4958 
4959   if (!pcbddc->vertices_flag && !pcbddc->edges_flag) {
4960     ierr = PetscMalloc(nfc*sizeof(IS),&pcbddc->ISForFaces);CHKERRQ(ierr);
4961     use_faces=PETSC_TRUE;
4962   }
4963   if (!pcbddc->vertices_flag && !pcbddc->faces_flag) {
4964     ierr = PetscMalloc(nec*sizeof(IS),&pcbddc->ISForEdges);CHKERRQ(ierr);
4965     use_edges=PETSC_TRUE;
4966   }
4967   nfc=0;
4968   nec=0;
4969   for (i=0; i<mat_graph->ncmps; i++) {
4970     if ( mat_graph->cptr[i+1]-mat_graph->cptr[i] > vertex_size ){
4971       for (j=0;j<mat_graph->cptr[i+1]-mat_graph->cptr[i];j++) {
4972         auxis[j]=mat_graph->queue[mat_graph->cptr[i]+j];
4973       }
4974       if (mat_graph->count[mat_graph->queue[mat_graph->cptr[i]]]==1){
4975         if (twodim_flag) {
4976           if (use_edges) {
4977             ierr = ISCreateGeneral(PETSC_COMM_SELF,j,auxis,PETSC_COPY_VALUES,&pcbddc->ISForEdges[nec]);CHKERRQ(ierr);
4978             nec++;
4979           }
4980         } else {
4981           if (use_faces) {
4982             ierr = ISCreateGeneral(PETSC_COMM_SELF,j,auxis,PETSC_COPY_VALUES,&pcbddc->ISForFaces[nfc]);CHKERRQ(ierr);
4983             nfc++;
4984           }
4985         }
4986       } else {
4987         if (use_edges) {
4988           ierr = ISCreateGeneral(PETSC_COMM_SELF,j,auxis,PETSC_COPY_VALUES,&pcbddc->ISForEdges[nec]);CHKERRQ(ierr);
4989           nec++;
4990         }
4991       }
4992     }
4993   }
4994   pcbddc->n_ISForFaces=nfc;
4995   pcbddc->n_ISForEdges=nec;
4996   nvc=0;
4997   if ( !pcbddc->constraints_flag ) {
4998     for (i=0; i<mat_graph->ncmps; i++) {
4999       if ( mat_graph->cptr[i+1]-mat_graph->cptr[i] <= vertex_size ){
5000         for ( j=mat_graph->cptr[i];j<mat_graph->cptr[i+1];j++) {
5001           auxis[nvc]=mat_graph->queue[j];
5002           nvc++;
5003         }
5004       }
5005     }
5006   }
5007   /* sort vertex set (by local ordering) */
5008   ierr = PetscSortInt(nvc,auxis);CHKERRQ(ierr);
5009   ierr = ISCreateGeneral(PETSC_COMM_SELF,nvc,auxis,PETSC_COPY_VALUES,&pcbddc->ISForVertices);CHKERRQ(ierr);
5010 
5011   if (pcbddc->dbg_flag) {
5012 
5013     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5014     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Details from PCBDDCManageLocalBoundaries for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
5015     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5016 /*    ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Graph (adjacency structure) of local Neumann mat\n");CHKERRQ(ierr);
5017     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5018     for (i=0;i<mat_graph->nvtxs;i++) {
5019       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Nodes connected to node number %d are %d\n",i,mat_graph->xadj[i+1]-mat_graph->xadj[i]);CHKERRQ(ierr);
5020       for (j=mat_graph->xadj[i];j<mat_graph->xadj[i+1];j++){
5021         ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%d ",mat_graph->adjncy[j]);CHKERRQ(ierr);
5022       }
5023       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n--------------------------------------------------------------\n");CHKERRQ(ierr);
5024     }*/
5025     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Matrix graph has %d connected components", mat_graph->ncmps);CHKERRQ(ierr);
5026     for (i=0;i<mat_graph->ncmps;i++) {
5027       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\nDetails for connected component number %02d: size %04d, count %01d. Nodes follow.\n",
5028              i,mat_graph->cptr[i+1]-mat_graph->cptr[i],mat_graph->count[mat_graph->queue[mat_graph->cptr[i]]]);CHKERRQ(ierr);
5029       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"subdomains: ");
5030       for (j=0;j<mat_graph->count[mat_graph->queue[mat_graph->cptr[i]]]; j++) {
5031         ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%d ",mat_graph->neighbours_set[mat_graph->queue[mat_graph->cptr[i]]][j]);
5032       }
5033       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");
5034       for (j=mat_graph->cptr[i]; j<mat_graph->cptr[i+1]; j++){
5035         /* ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%d (%d), ",queue_in_global_numbering[j],mat_graph->queue[j]);CHKERRQ(ierr); */
5036         ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%d, ",mat_graph->queue[j]);CHKERRQ(ierr);
5037       }
5038     }
5039     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n--------------------------------------------------------------\n");CHKERRQ(ierr);
5040     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d detected %02d local vertices\n",PetscGlobalRank,nvc);CHKERRQ(ierr);
5041     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d detected %02d local faces\n",PetscGlobalRank,nfc);CHKERRQ(ierr);
5042     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d detected %02d local edges\n",PetscGlobalRank,nec);CHKERRQ(ierr);
5043     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
5044   }
5045 
5046   ierr = PetscFree(queue_in_global_numbering);CHKERRQ(ierr);
5047   ierr = PetscFree(auxis);CHKERRQ(ierr);
5048   PetscFunctionReturn(0);
5049 
5050 }
5051 
5052 /* -------------------------------------------------------------------------- */
5053 
5054 /* The following code has been adapted from function IsConnectedSubdomain contained
5055    in source file contig.c of METIS library (version 5.0.1)
5056    It finds connected components of each partition labeled from 1 to n_dist  */
5057 
5058 #undef __FUNCT__
5059 #define __FUNCT__ "PCBDDCFindConnectedComponents"
5060 static PetscErrorCode PCBDDCFindConnectedComponents(PCBDDCGraph graph, PetscInt n_dist )
5061 {
5062   PetscInt i, j, k, nvtxs, first, last, nleft, ncmps,pid,cum_queue,n,ncmps_pid;
5063   PetscInt *xadj, *adjncy, *where, *queue;
5064   PetscInt *cptr;
5065   PetscBool *touched;
5066 
5067   PetscFunctionBegin;
5068 
5069   nvtxs   = graph->nvtxs;
5070   xadj    = graph->xadj;
5071   adjncy  = graph->adjncy;
5072   where   = graph->where;
5073   touched = graph->touched;
5074   queue   = graph->queue;
5075   cptr    = graph->cptr;
5076 
5077   for (i=0; i<nvtxs; i++)
5078     touched[i] = PETSC_FALSE;
5079 
5080   cum_queue=0;
5081   ncmps=0;
5082 
5083   for (n=0; n<n_dist; n++) {
5084     pid = n+1;  /* partition labeled by 0 is discarded */
5085     nleft = 0;
5086     for (i=0; i<nvtxs; i++) {
5087       if (where[i] == pid)
5088         nleft++;
5089     }
5090     for (i=0; i<nvtxs; i++) {
5091       if (where[i] == pid)
5092         break;
5093     }
5094     touched[i] = PETSC_TRUE;
5095     queue[cum_queue] = i;
5096     first = 0; last = 1;
5097     cptr[ncmps] = cum_queue;  /* This actually points to queue */
5098     ncmps_pid = 0;
5099     while (first != nleft) {
5100       if (first == last) { /* Find another starting vertex */
5101         cptr[++ncmps] = first+cum_queue;
5102         ncmps_pid++;
5103         for (i=0; i<nvtxs; i++) {
5104           if (where[i] == pid && !touched[i])
5105             break;
5106         }
5107         queue[cum_queue+last] = i;
5108         last++;
5109         touched[i] = PETSC_TRUE;
5110       }
5111       i = queue[cum_queue+first];
5112       first++;
5113       for (j=xadj[i]; j<xadj[i+1]; j++) {
5114         k = adjncy[j];
5115         if (where[k] == pid && !touched[k]) {
5116           queue[cum_queue+last] = k;
5117           last++;
5118           touched[k] = PETSC_TRUE;
5119         }
5120       }
5121     }
5122     cptr[++ncmps] = first+cum_queue;
5123     ncmps_pid++;
5124     cum_queue=cptr[ncmps];
5125     graph->where_ncmps[n] = ncmps_pid;
5126   }
5127   graph->ncmps = ncmps;
5128 
5129   PetscFunctionReturn(0);
5130 }
5131