xref: /petsc/src/ksp/pc/impls/bddc/bddc.c (revision 21d449790124db1729bdb4bf1ac56934002f3a15)
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   PetscInt      *dnz,*onz;
3538 
3539   PetscBool     setsym,issym=PETSC_FALSE;
3540 
3541   PetscFunctionBegin;
3542   ins_local_primal_indices = 0;
3543   ins_coarse_mat_vals      = 0;
3544   localsizes2              = 0;
3545   localdispl2              = 0;
3546   temp_coarse_mat_vals     = 0;
3547   coarse_ISLG              = 0;
3548 
3549   ierr = MPI_Comm_size(prec_comm,&size_prec_comm);CHKERRQ(ierr);
3550   ierr = MPI_Comm_rank(prec_comm,&rank_prec_comm);CHKERRQ(ierr);
3551   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
3552 
3553   /* Assign global numbering to coarse dofs */
3554   {
3555     PetscScalar    one=1.,zero=0.;
3556     PetscScalar    *array;
3557     PetscMPIInt    *auxlocal_primal;
3558     PetscMPIInt    *all_auxglobal_primal;
3559     PetscMPIInt    mpi_local_primal_size = (PetscMPIInt)pcbddc->local_primal_size;
3560     PetscInt       *row_cmat_indices;
3561     PetscInt       size_of_constraint;
3562     PetscScalar    coarsesum;
3563 
3564     /* Construct needed data structures for message passing */
3565     ierr = PetscMalloc(mpi_local_primal_size*sizeof(PetscMPIInt),&pcbddc->local_primal_indices);CHKERRQ(ierr);
3566     j = 0;
3567     if (rank_prec_comm == 0 || pcbddc->coarse_problem_type == REPLICATED_BDDC || pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
3568       j = size_prec_comm;
3569     }
3570     ierr = PetscMalloc(j*sizeof(PetscMPIInt),&pcbddc->local_primal_sizes);CHKERRQ(ierr);
3571     ierr = PetscMalloc(j*sizeof(PetscMPIInt),&pcbddc->local_primal_displacements);CHKERRQ(ierr);
3572     /* Gather local_primal_size information for all processes  */
3573     if (pcbddc->coarse_problem_type == REPLICATED_BDDC || pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
3574       ierr = MPI_Allgather(&mpi_local_primal_size,1,MPIU_INT,&pcbddc->local_primal_sizes[0],1,MPIU_INT,prec_comm);CHKERRQ(ierr);
3575     } else {
3576       ierr = MPI_Gather(&mpi_local_primal_size,1,MPIU_INT,&pcbddc->local_primal_sizes[0],1,MPIU_INT,0,prec_comm);CHKERRQ(ierr);
3577     }
3578     pcbddc->replicated_primal_size = 0;
3579     for (i=0; i<j; i++) {
3580       pcbddc->local_primal_displacements[i] = pcbddc->replicated_primal_size ;
3581       pcbddc->replicated_primal_size += pcbddc->local_primal_sizes[i];
3582     }
3583     if (rank_prec_comm == 0) {
3584       /* allocate some auxiliary space */
3585       ierr = PetscMalloc(pcbddc->replicated_primal_size*sizeof(*all_auxglobal_primal),&all_auxglobal_primal);CHKERRQ(ierr);
3586     }
3587     ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscMPIInt),&auxlocal_primal);CHKERRQ(ierr);
3588     ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscMPIInt),&auxglobal_primal);CHKERRQ(ierr);
3589 
3590     /* First let's count coarse dofs.
3591        This code fragment assumes that the number of local constraints per connected component
3592        is not greater than the number of nodes defined for the connected component
3593        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
3594     /* auxlocal_primal      : primal indices in local nodes numbering (internal and interface) with complete queue sorted by global ordering */
3595     ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
3596     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3597     for (i=0;i<pcbddc->local_primal_size;i++) {
3598       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,PETSC_NULL);CHKERRQ(ierr);
3599       for (j=0; j<size_of_constraint; j++) {
3600         k = row_cmat_indices[j];
3601         if ( array[k] == zero ) {
3602           array[k] = one;
3603           auxlocal_primal[i] = k;
3604           break;
3605         }
3606       }
3607       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,PETSC_NULL);CHKERRQ(ierr);
3608     }
3609     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3610     ierr = VecSet(pcis->vec1_global,zero);CHKERRQ(ierr);
3611     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3612     ierr = VecScatterEnd  (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3613     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3614     ierr = VecScatterEnd  (matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3615     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3616     for (i=0;i<pcis->n;i++) { if ( PetscAbsScalar(array[i]) > zero) array[i] = one/array[i]; }
3617     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3618     ierr = VecSet(pcis->vec1_global,zero);CHKERRQ(ierr);
3619     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3620     ierr = VecScatterEnd  (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3621     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
3622     pcbddc->coarse_size = (PetscInt) coarsesum;
3623 
3624     /* Now assign them a global numbering */
3625     /* auxglobal_primal contains indices in global nodes numbering (internal and interface) */
3626     ierr = ISLocalToGlobalMappingApply(matis->mapping,pcbddc->local_primal_size,auxlocal_primal,auxglobal_primal);CHKERRQ(ierr);
3627     ierr = PetscFree(auxlocal_primal);CHKERRQ(ierr);
3628     /* all_auxglobal_primal contains all primal nodes indices in global nodes numbering (internal and interface) */
3629     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);
3630 
3631     /* After this block all_auxglobal_primal should contains one copy of each primal node's indices in global nodes numbering */
3632     if (rank_prec_comm==0) {
3633       j=pcbddc->replicated_primal_size;
3634       ierr = PetscSortRemoveDupsMPIInt(&j,all_auxglobal_primal);CHKERRQ(ierr);
3635     } else {
3636       ierr = PetscMalloc(pcbddc->coarse_size*sizeof(PetscMPIInt),&all_auxglobal_primal);CHKERRQ(ierr);
3637     }
3638     /* We only need to broadcast the indices from 0 to pcbddc->coarse_size. Remaning elements of array all_aux_global_primal are garbage. */
3639     ierr = MPI_Bcast(all_auxglobal_primal,pcbddc->coarse_size,MPIU_INT,0,prec_comm);CHKERRQ(ierr);
3640 
3641     /* Now get global coarse numbering of local primal nodes */
3642     for (i=0;i<pcbddc->local_primal_size;i++) {
3643       k=0;
3644       while( all_auxglobal_primal[k] != auxglobal_primal[i] ) { k++;}
3645       pcbddc->local_primal_indices[i]=k;
3646     }
3647     ierr = PetscFree(auxglobal_primal);CHKERRQ(ierr);
3648     ierr = PetscFree(all_auxglobal_primal);CHKERRQ(ierr);
3649     if (rank_prec_comm==0) {
3650       j=pcbddc->replicated_primal_size;
3651       ierr = PetscMalloc(j*sizeof(PetscMPIInt),&auxglobal_primal);CHKERRQ(ierr);
3652     }
3653     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);
3654   }
3655 
3656   if (pcis->n) { im_active = 1; }
3657   ierr = MPI_Allreduce(&im_active,&pcbddc->active_procs,1,MPIU_INT,MPI_SUM,prec_comm);CHKERRQ(ierr);
3658 
3659   /* adapt coarse problem type */
3660   if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
3661     if (pcbddc->current_level < pcbddc->max_levels) {
3662       if ( (pcbddc->active_procs/pcbddc->coarsening_ratio) < 2 ) {
3663         if (dbg_flag) {
3664           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);
3665          ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
3666         }
3667         pcbddc->coarse_problem_type = PARALLEL_BDDC;
3668       }
3669     } else {
3670       if (dbg_flag) {
3671         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);
3672         ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
3673       }
3674       pcbddc->coarse_problem_type = PARALLEL_BDDC;
3675     }
3676   }
3677 
3678   switch(pcbddc->coarse_problem_type){
3679 
3680     case(MULTILEVEL_BDDC):   /* we define a coarse mesh where subdomains are elements */
3681     {
3682       /* we need additional variables */
3683       MetisInt    n_subdomains,n_parts,objval,ncon,faces_nvtxs;
3684       MetisInt    *metis_coarse_subdivision;
3685       MetisInt    options[METIS_NOPTIONS];
3686       PetscMPIInt size_coarse_comm,rank_coarse_comm;
3687       PetscMPIInt procs_jumps_coarse_comm;
3688       PetscMPIInt *coarse_subdivision;
3689       PetscMPIInt *total_count_recv;
3690       PetscMPIInt *total_ranks_recv;
3691       PetscMPIInt *displacements_recv;
3692       PetscMPIInt *my_faces_connectivity;
3693       PetscMPIInt *petsc_faces_adjncy;
3694       MetisInt    *faces_adjncy;
3695       MetisInt    *faces_xadj;
3696       PetscMPIInt *number_of_faces;
3697       PetscMPIInt *faces_displacements;
3698       PetscInt    *array_int;
3699       PetscMPIInt my_faces=0;
3700       PetscMPIInt total_faces=0;
3701       PetscInt    ranks_stretching_ratio;
3702 
3703       /* define some quantities */
3704       pcbddc->coarse_communications_type = SCATTERS_BDDC;
3705       coarse_mat_type = MATIS;
3706       coarse_pc_type  = PCBDDC;
3707       coarse_ksp_type = KSPRICHARDSON;
3708 
3709       /* details of coarse decomposition */
3710       n_subdomains = pcbddc->active_procs;
3711       n_parts      = n_subdomains/pcbddc->coarsening_ratio;
3712       ranks_stretching_ratio = size_prec_comm/pcbddc->active_procs;
3713       procs_jumps_coarse_comm = pcbddc->coarsening_ratio*ranks_stretching_ratio;
3714 
3715       /* build CSR graph of subdomains' connectivity */
3716       ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&array_int);CHKERRQ(ierr);
3717       ierr = PetscMemzero(array_int,pcis->n*sizeof(PetscInt));CHKERRQ(ierr);
3718       for (i=1;i<pcis->n_neigh;i++){/* i=1 so I don't count myself -> faces nodes counts to 1 */
3719         for (j=0;j<pcis->n_shared[i];j++){
3720           array_int[ pcis->shared[i][j] ]+=1;
3721         }
3722       }
3723       for (i=1;i<pcis->n_neigh;i++){
3724         for (j=0;j<pcis->n_shared[i];j++){
3725           if (array_int[ pcis->shared[i][j] ] > 0 ){
3726             my_faces++;
3727             break;
3728           }
3729         }
3730       }
3731 
3732       ierr = MPI_Reduce(&my_faces,&total_faces,1,MPIU_INT,MPI_SUM,master_proc,prec_comm);CHKERRQ(ierr);
3733       ierr = PetscMalloc (my_faces*sizeof(PetscInt),&my_faces_connectivity);CHKERRQ(ierr);
3734       my_faces=0;
3735       for (i=1;i<pcis->n_neigh;i++){
3736         for (j=0;j<pcis->n_shared[i];j++){
3737           if (array_int[ pcis->shared[i][j] ] > 0 ){
3738             my_faces_connectivity[my_faces]=pcis->neigh[i];
3739             my_faces++;
3740             break;
3741           }
3742         }
3743       }
3744       if (rank_prec_comm == master_proc) {
3745         ierr = PetscMalloc (total_faces*sizeof(PetscMPIInt),&petsc_faces_adjncy);CHKERRQ(ierr);
3746         ierr = PetscMalloc (size_prec_comm*sizeof(PetscMPIInt),&number_of_faces);CHKERRQ(ierr);
3747         ierr = PetscMalloc (total_faces*sizeof(MetisInt),&faces_adjncy);CHKERRQ(ierr);
3748         ierr = PetscMalloc ((n_subdomains+1)*sizeof(MetisInt),&faces_xadj);CHKERRQ(ierr);
3749         ierr = PetscMalloc ((size_prec_comm+1)*sizeof(PetscMPIInt),&faces_displacements);CHKERRQ(ierr);
3750       }
3751       ierr = MPI_Gather(&my_faces,1,MPIU_INT,&number_of_faces[0],1,MPIU_INT,master_proc,prec_comm);CHKERRQ(ierr);
3752       if (rank_prec_comm == master_proc) {
3753         faces_xadj[0]=0;
3754         faces_displacements[0]=0;
3755         j=0;
3756         for (i=1;i<size_prec_comm+1;i++) {
3757           faces_displacements[i]=faces_displacements[i-1]+number_of_faces[i-1];
3758           if (number_of_faces[i-1]) {
3759             j++;
3760             faces_xadj[j]=faces_xadj[j-1]+number_of_faces[i-1];
3761           }
3762         }
3763       }
3764       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);
3765       ierr = PetscFree(my_faces_connectivity);CHKERRQ(ierr);
3766       ierr = PetscFree(array_int);CHKERRQ(ierr);
3767       if (rank_prec_comm == master_proc) {
3768         for (i=0;i<total_faces;i++) faces_adjncy[i]=(MetisInt)(petsc_faces_adjncy[i]/ranks_stretching_ratio); /* cast to MetisInt */
3769         /*printf("This is the face connectivity (actual ranks)\n");
3770         for (i=0;i<n_subdomains;i++){
3771           printf("proc %d is connected with \n",i);
3772           for (j=faces_xadj[i];j<faces_xadj[i+1];j++)
3773             printf("%d ",faces_adjncy[j]);
3774           printf("\n");
3775         }*/
3776         ierr = PetscFree(faces_displacements);CHKERRQ(ierr);
3777         ierr = PetscFree(number_of_faces);CHKERRQ(ierr);
3778         ierr = PetscFree(petsc_faces_adjncy);CHKERRQ(ierr);
3779       }
3780 
3781       if ( rank_prec_comm == master_proc ) {
3782 
3783         PetscInt heuristic_for_metis=3;
3784 
3785         ncon=1;
3786         faces_nvtxs=n_subdomains;
3787         /* partition graoh induced by face connectivity */
3788         ierr = PetscMalloc (n_subdomains*sizeof(MetisInt),&metis_coarse_subdivision);CHKERRQ(ierr);
3789         ierr = METIS_SetDefaultOptions(options);
3790         /* we need a contiguous partition of the coarse mesh */
3791         options[METIS_OPTION_CONTIG]=1;
3792         options[METIS_OPTION_NITER]=30;
3793         if (pcbddc->coarsening_ratio > 1) {
3794           if (n_subdomains>n_parts*heuristic_for_metis) {
3795             options[METIS_OPTION_IPTYPE]=METIS_IPTYPE_EDGE;
3796             options[METIS_OPTION_OBJTYPE]=METIS_OBJTYPE_CUT;
3797             ierr = METIS_PartGraphKway(&faces_nvtxs,&ncon,faces_xadj,faces_adjncy,NULL,NULL,NULL,&n_parts,NULL,NULL,options,&objval,metis_coarse_subdivision);
3798             if (ierr != METIS_OK) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in METIS_PartGraphKway (metis error code %D) called from PCBDDCSetupCoarseEnvironment\n",ierr);
3799           } else {
3800             ierr = METIS_PartGraphRecursive(&faces_nvtxs,&ncon,faces_xadj,faces_adjncy,NULL,NULL,NULL,&n_parts,NULL,NULL,options,&objval,metis_coarse_subdivision);
3801             if (ierr != METIS_OK) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in METIS_PartGraphRecursive (metis error code %D) called from PCBDDCSetupCoarseEnvironment\n",ierr);
3802           }
3803         } else {
3804           for (i=0;i<n_subdomains;i++) {
3805             metis_coarse_subdivision[i]=i;
3806           }
3807         }
3808         ierr = PetscFree(faces_xadj);CHKERRQ(ierr);
3809         ierr = PetscFree(faces_adjncy);CHKERRQ(ierr);
3810         ierr = PetscMalloc(size_prec_comm*sizeof(PetscMPIInt),&coarse_subdivision);CHKERRQ(ierr);
3811         /* copy/cast values avoiding possible type conflicts between PETSc, MPI and METIS */
3812         for (i=0;i<size_prec_comm;i++) { coarse_subdivision[i]=MPI_PROC_NULL; }
3813         for (i=0;i<n_subdomains;i++)   { coarse_subdivision[ranks_stretching_ratio*i]=(PetscInt)(metis_coarse_subdivision[i]); }
3814         ierr = PetscFree(metis_coarse_subdivision);CHKERRQ(ierr);
3815       }
3816 
3817       /* Create new communicator for coarse problem splitting the old one */
3818       if ( !(rank_prec_comm%procs_jumps_coarse_comm) && rank_prec_comm < procs_jumps_coarse_comm*n_parts ){
3819         coarse_color=0;              /* for communicator splitting */
3820         active_rank=rank_prec_comm;  /* for insertion of matrix values */
3821       }
3822       /* procs with coarse_color = MPI_UNDEFINED will have coarse_comm = MPI_COMM_NULL (from mpi standards)
3823          key = rank_prec_comm -> keep same ordering of ranks from the old to the new communicator */
3824       ierr = MPI_Comm_split(prec_comm,coarse_color,rank_prec_comm,&coarse_comm);CHKERRQ(ierr);
3825 
3826       if ( coarse_color == 0 ) {
3827         ierr = MPI_Comm_size(coarse_comm,&size_coarse_comm);CHKERRQ(ierr);
3828         ierr = MPI_Comm_rank(coarse_comm,&rank_coarse_comm);CHKERRQ(ierr);
3829       } else {
3830         rank_coarse_comm = MPI_PROC_NULL;
3831       }
3832 
3833       /* master proc take care of arranging and distributing coarse informations */
3834       if (rank_coarse_comm == master_proc) {
3835         ierr = PetscMalloc (size_coarse_comm*sizeof(PetscMPIInt),&displacements_recv);CHKERRQ(ierr);
3836         ierr = PetscMalloc (size_coarse_comm*sizeof(PetscMPIInt),&total_count_recv);CHKERRQ(ierr);
3837         ierr = PetscMalloc (n_subdomains*sizeof(PetscMPIInt),&total_ranks_recv);CHKERRQ(ierr);
3838         /* some initializations */
3839         displacements_recv[0]=0;
3840         ierr = PetscMemzero(total_count_recv,size_coarse_comm*sizeof(PetscMPIInt));CHKERRQ(ierr);
3841         /* count from how many processes the j-th process of the coarse decomposition will receive data */
3842         for (j=0;j<size_coarse_comm;j++) {
3843           for (i=0;i<size_prec_comm;i++) {
3844             if (coarse_subdivision[i]==j) {
3845               total_count_recv[j]++;
3846             }
3847           }
3848         }
3849         /* displacements needed for scatterv of total_ranks_recv */
3850         for (i=1;i<size_coarse_comm;i++) { displacements_recv[i]=displacements_recv[i-1]+total_count_recv[i-1]; }
3851         /* Now fill properly total_ranks_recv -> each coarse process will receive the ranks (in prec_comm communicator) of its friend (sending) processes */
3852         ierr = PetscMemzero(total_count_recv,size_coarse_comm*sizeof(PetscMPIInt));CHKERRQ(ierr);
3853         for (j=0;j<size_coarse_comm;j++) {
3854           for (i=0;i<size_prec_comm;i++) {
3855             if (coarse_subdivision[i]==j) {
3856               total_ranks_recv[displacements_recv[j]+total_count_recv[j]]=i;
3857               total_count_recv[j]+=1;
3858             }
3859           }
3860         }
3861         /*for (j=0;j<size_coarse_comm;j++) {
3862           printf("process %d in new rank will receive from %d processes (original ranks follows)\n",j,total_count_recv[j]);
3863           for (i=0;i<total_count_recv[j];i++) {
3864             printf("%d ",total_ranks_recv[displacements_recv[j]+i]);
3865           }
3866           printf("\n");
3867         }*/
3868 
3869         /* identify new decomposition in terms of ranks in the old communicator */
3870         for (i=0;i<n_subdomains;i++) {
3871           coarse_subdivision[ranks_stretching_ratio*i]=coarse_subdivision[ranks_stretching_ratio*i]*procs_jumps_coarse_comm;
3872         }
3873         /*printf("coarse_subdivision in old end new ranks\n");
3874         for (i=0;i<size_prec_comm;i++)
3875           if (coarse_subdivision[i]!=MPI_PROC_NULL) {
3876             printf("%d=(%d %d), ",i,coarse_subdivision[i],coarse_subdivision[i]/procs_jumps_coarse_comm);
3877           } else {
3878             printf("%d=(%d %d), ",i,coarse_subdivision[i],coarse_subdivision[i]);
3879           }
3880         printf("\n");*/
3881       }
3882 
3883       /* Scatter new decomposition for send details */
3884       ierr = MPI_Scatter(&coarse_subdivision[0],1,MPIU_INT,&rank_coarse_proc_send_to,1,MPIU_INT,master_proc,prec_comm);CHKERRQ(ierr);
3885       /* Scatter receiving details to members of coarse decomposition */
3886       if ( coarse_color == 0) {
3887         ierr = MPI_Scatter(&total_count_recv[0],1,MPIU_INT,&count_recv,1,MPIU_INT,master_proc,coarse_comm);CHKERRQ(ierr);
3888         ierr = PetscMalloc (count_recv*sizeof(PetscMPIInt),&ranks_recv);CHKERRQ(ierr);
3889         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);
3890       }
3891 
3892       /*printf("I will send my matrix data to proc  %d\n",rank_coarse_proc_send_to);
3893       if (coarse_color == 0) {
3894         printf("I will receive some matrix data from %d processes (ranks follows)\n",count_recv);
3895         for (i=0;i<count_recv;i++)
3896           printf("%d ",ranks_recv[i]);
3897         printf("\n");
3898       }*/
3899 
3900       if (rank_prec_comm == master_proc) {
3901         ierr = PetscFree(coarse_subdivision);CHKERRQ(ierr);
3902         ierr = PetscFree(total_count_recv);CHKERRQ(ierr);
3903         ierr = PetscFree(total_ranks_recv);CHKERRQ(ierr);
3904         ierr = PetscFree(displacements_recv);CHKERRQ(ierr);
3905       }
3906       break;
3907     }
3908 
3909     case(REPLICATED_BDDC):
3910 
3911       pcbddc->coarse_communications_type = GATHERS_BDDC;
3912       coarse_mat_type = MATSEQAIJ;
3913       coarse_pc_type  = PCLU;
3914       coarse_ksp_type  = KSPPREONLY;
3915       coarse_comm = PETSC_COMM_SELF;
3916       active_rank = rank_prec_comm;
3917       break;
3918 
3919     case(PARALLEL_BDDC):
3920 
3921       pcbddc->coarse_communications_type = SCATTERS_BDDC;
3922       coarse_mat_type = MATMPIAIJ;
3923       coarse_pc_type  = PCREDUNDANT;
3924       coarse_ksp_type  = KSPPREONLY;
3925       coarse_comm = prec_comm;
3926       active_rank = rank_prec_comm;
3927       break;
3928 
3929     case(SEQUENTIAL_BDDC):
3930       pcbddc->coarse_communications_type = GATHERS_BDDC;
3931       coarse_mat_type = MATSEQAIJ;
3932       coarse_pc_type = PCLU;
3933       coarse_ksp_type  = KSPPREONLY;
3934       coarse_comm = PETSC_COMM_SELF;
3935       active_rank = master_proc;
3936       break;
3937   }
3938 
3939   switch(pcbddc->coarse_communications_type){
3940 
3941     case(SCATTERS_BDDC):
3942       {
3943         if (pcbddc->coarse_problem_type==MULTILEVEL_BDDC) {
3944 
3945           if(pcbddc->coarsening_ratio == 1) {
3946             ins_local_primal_size = pcbddc->local_primal_size;
3947             ins_local_primal_indices = pcbddc->local_primal_indices;
3948             if (coarse_color == 0) { ierr = PetscFree(ranks_recv);CHKERRQ(ierr); }
3949             /* nonzeros */
3950             ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&dnz);CHKERRQ(ierr);
3951             ierr = PetscMemzero(dnz,ins_local_primal_size*sizeof(PetscInt));CHKERRQ(ierr);
3952             for (i=0;i<ins_local_primal_size;i++) {
3953               dnz[i] = ins_local_primal_size;
3954             }
3955           } else {
3956             PetscMPIInt send_size;
3957             PetscInt    *aux_ins_indices;
3958             PetscInt    ii,jj;
3959             MPI_Request *requests;
3960             ierr = PetscMalloc(count_recv*sizeof(PetscMPIInt),&localdispl2);CHKERRQ(ierr);
3961             /* reusing pcbddc->local_primal_displacements and pcbddc->replicated_primal_size */
3962             ierr = PetscFree(pcbddc->local_primal_displacements);CHKERRQ(ierr);
3963             ierr = PetscMalloc((count_recv+1)*sizeof(PetscMPIInt),&pcbddc->local_primal_displacements);CHKERRQ(ierr);
3964             pcbddc->replicated_primal_size = count_recv;
3965             j = 0;
3966             for (i=0;i<count_recv;i++) {
3967               pcbddc->local_primal_displacements[i] = j;
3968               j += pcbddc->local_primal_sizes[ranks_recv[i]];
3969             }
3970             pcbddc->local_primal_displacements[count_recv] = j;
3971             ierr = PetscMalloc(j*sizeof(PetscMPIInt),&pcbddc->replicated_local_primal_indices);CHKERRQ(ierr);
3972             /* allocate auxiliary space */
3973             ierr = PetscMalloc(count_recv*sizeof(PetscMPIInt),&localsizes2);CHKERRQ(ierr);
3974             ierr = PetscMalloc(pcbddc->coarse_size*sizeof(PetscInt),&aux_ins_indices);CHKERRQ(ierr);
3975             ierr = PetscMemzero(aux_ins_indices,pcbddc->coarse_size*sizeof(PetscInt));CHKERRQ(ierr);
3976             /* allocate stuffs for message massing */
3977             ierr = PetscMalloc((count_recv+1)*sizeof(MPI_Request),&requests);CHKERRQ(ierr);
3978             for (i=0;i<count_recv+1;i++) { requests[i]=MPI_REQUEST_NULL; }
3979             /* send indices to be inserted */
3980             for (i=0;i<count_recv;i++) {
3981               send_size = pcbddc->local_primal_sizes[ranks_recv[i]];
3982               ierr = MPI_Irecv(&pcbddc->replicated_local_primal_indices[pcbddc->local_primal_displacements[i]],send_size,MPIU_INT,ranks_recv[i],999,prec_comm,&requests[i]);CHKERRQ(ierr);
3983             }
3984             if (rank_coarse_proc_send_to != MPI_PROC_NULL ) {
3985               send_size = pcbddc->local_primal_size;
3986               ierr = MPI_Isend(pcbddc->local_primal_indices,send_size,MPIU_INT,rank_coarse_proc_send_to,999,prec_comm,&requests[count_recv]);CHKERRQ(ierr);
3987             }
3988             ierr = MPI_Waitall(count_recv+1,requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3989             j = 0;
3990             for (i=0;i<count_recv;i++) {
3991               ii = ranks_recv[i];
3992               localsizes2[i] = pcbddc->local_primal_sizes[ii]*pcbddc->local_primal_sizes[ii];
3993               localdispl2[i] = j;
3994               j += localsizes2[i];
3995               jj = pcbddc->local_primal_displacements[i];
3996               /* it counts the coarse subdomains sharing the coarse node */
3997               for (k=0;k<pcbddc->local_primal_sizes[ii];k++) {
3998                 aux_ins_indices[pcbddc->replicated_local_primal_indices[jj+k]] += 1;
3999               }
4000             }
4001             /* temp_coarse_mat_vals used to store matrix values to be received */
4002             ierr = PetscMalloc(j*sizeof(PetscScalar),&temp_coarse_mat_vals);CHKERRQ(ierr);
4003             /* evaluate how many values I will insert in coarse mat */
4004             ins_local_primal_size = 0;
4005             for (i=0;i<pcbddc->coarse_size;i++) {
4006               if (aux_ins_indices[i]) {
4007                 ins_local_primal_size++;
4008               }
4009             }
4010             /* evaluate indices I will insert in coarse mat */
4011             ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr);
4012             j = 0;
4013             for(i=0;i<pcbddc->coarse_size;i++) {
4014               if(aux_ins_indices[i]) {
4015                 ins_local_primal_indices[j++] = i;
4016               }
4017             }
4018             /* processes partecipating in coarse problem receive matrix data from their friends */
4019             for (i=0;i<count_recv;i++) {
4020               ierr = MPI_Irecv(&temp_coarse_mat_vals[localdispl2[i]],localsizes2[i],MPIU_SCALAR,ranks_recv[i],666,prec_comm,&requests[i]);CHKERRQ(ierr);
4021             }
4022             if (rank_coarse_proc_send_to != MPI_PROC_NULL ) {
4023               send_size = pcbddc->local_primal_size*pcbddc->local_primal_size;
4024               ierr = MPI_Isend(&coarse_submat_vals[0],send_size,MPIU_SCALAR,rank_coarse_proc_send_to,666,prec_comm,&requests[count_recv]);CHKERRQ(ierr);
4025             }
4026             ierr = MPI_Waitall(count_recv+1,requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
4027             /* nonzeros */
4028             ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&dnz);CHKERRQ(ierr);
4029             ierr = PetscMemzero(dnz,ins_local_primal_size*sizeof(PetscInt));CHKERRQ(ierr);
4030             /* use aux_ins_indices to realize a global to local mapping */
4031             j=0;
4032             for(i=0;i<pcbddc->coarse_size;i++){
4033               if(aux_ins_indices[i]==0){
4034                 aux_ins_indices[i]=-1;
4035               } else {
4036                 aux_ins_indices[i]=j;
4037                 j++;
4038               }
4039             }
4040             for (i=0;i<count_recv;i++) {
4041               j = pcbddc->local_primal_sizes[ranks_recv[i]];
4042               for (k=0;k<j;k++) {
4043                 dnz[aux_ins_indices[pcbddc->replicated_local_primal_indices[pcbddc->local_primal_displacements[i]+k]]] += j;
4044               }
4045             }
4046             /* check */
4047             for (i=0;i<ins_local_primal_size;i++) {
4048               if (dnz[i] > ins_local_primal_size) {
4049                 dnz[i] = ins_local_primal_size;
4050               }
4051             }
4052             ierr = PetscFree(requests);CHKERRQ(ierr);
4053             ierr = PetscFree(aux_ins_indices);CHKERRQ(ierr);
4054             if (coarse_color == 0) { ierr = PetscFree(ranks_recv);CHKERRQ(ierr); }
4055           }
4056           /* create local to global mapping needed by coarse MATIS */
4057           {
4058             IS coarse_IS;
4059             if (coarse_comm != MPI_COMM_NULL ) {ierr = MPI_Comm_free(&coarse_comm);CHKERRQ(ierr);}
4060             coarse_comm = prec_comm;
4061             active_rank=rank_prec_comm;
4062             ierr = ISCreateGeneral(coarse_comm,ins_local_primal_size,ins_local_primal_indices,PETSC_COPY_VALUES,&coarse_IS);CHKERRQ(ierr);
4063             ierr = ISLocalToGlobalMappingCreateIS(coarse_IS,&coarse_ISLG);CHKERRQ(ierr);
4064             ierr = ISDestroy(&coarse_IS);CHKERRQ(ierr);
4065           }
4066         }
4067         if (pcbddc->coarse_problem_type==PARALLEL_BDDC) {
4068           /* arrays for values insertion */
4069           ins_local_primal_size = pcbddc->local_primal_size;
4070           ierr = PetscMalloc ( ins_local_primal_size*sizeof(PetscMPIInt),&ins_local_primal_indices);CHKERRQ(ierr);
4071           ierr = PetscMalloc ( ins_local_primal_size*ins_local_primal_size*sizeof(PetscScalar),&ins_coarse_mat_vals);CHKERRQ(ierr);
4072           for (j=0;j<ins_local_primal_size;j++){
4073             ins_local_primal_indices[j]=pcbddc->local_primal_indices[j];
4074             for (i=0;i<ins_local_primal_size;i++) {
4075               ins_coarse_mat_vals[j*ins_local_primal_size+i]=coarse_submat_vals[j*ins_local_primal_size+i];
4076             }
4077           }
4078         }
4079         break;
4080 
4081     }
4082 
4083     case(GATHERS_BDDC):
4084       {
4085 
4086         PetscMPIInt mysize,mysize2;
4087 
4088         if (rank_prec_comm==active_rank) {
4089           ierr = PetscMalloc ( pcbddc->replicated_primal_size*sizeof(PetscMPIInt),&pcbddc->replicated_local_primal_indices);CHKERRQ(ierr);
4090           ierr = PetscMalloc ( pcbddc->replicated_primal_size*sizeof(PetscScalar),&pcbddc->replicated_local_primal_values);CHKERRQ(ierr);
4091           ierr = PetscMalloc ( size_prec_comm*sizeof(PetscMPIInt),&localsizes2);CHKERRQ(ierr);
4092           ierr = PetscMalloc ( size_prec_comm*sizeof(PetscMPIInt),&localdispl2);CHKERRQ(ierr);
4093           /* arrays for values insertion */
4094           for (i=0;i<size_prec_comm;i++) { localsizes2[i]=pcbddc->local_primal_sizes[i]*pcbddc->local_primal_sizes[i]; }
4095           localdispl2[0]=0;
4096           for (i=1;i<size_prec_comm;i++) { localdispl2[i]=localsizes2[i-1]+localdispl2[i-1]; }
4097           j=0;
4098           for (i=0;i<size_prec_comm;i++) { j+=localsizes2[i]; }
4099           ierr = PetscMalloc ( j*sizeof(PetscScalar),&temp_coarse_mat_vals);CHKERRQ(ierr);
4100         }
4101 
4102         mysize=pcbddc->local_primal_size;
4103         mysize2=pcbddc->local_primal_size*pcbddc->local_primal_size;
4104         if (pcbddc->coarse_problem_type == SEQUENTIAL_BDDC){
4105           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);
4106           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);
4107         } else {
4108           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);
4109           ierr = MPI_Allgatherv(&coarse_submat_vals[0],mysize2,MPIU_SCALAR,&temp_coarse_mat_vals[0],localsizes2,localdispl2,MPIU_SCALAR,prec_comm);CHKERRQ(ierr);
4110         }
4111         break;
4112       }/* switch on coarse problem and communications associated with finished */
4113   }
4114 
4115   /* Now create and fill up coarse matrix */
4116   if ( rank_prec_comm == active_rank ) {
4117 
4118     Mat matis_coarse_local_mat;
4119 
4120     if (pcbddc->coarse_problem_type != MULTILEVEL_BDDC) {
4121       ierr = MatCreate(coarse_comm,&pcbddc->coarse_mat);CHKERRQ(ierr);
4122       ierr = MatSetSizes(pcbddc->coarse_mat,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size);CHKERRQ(ierr);
4123       ierr = MatSetType(pcbddc->coarse_mat,coarse_mat_type);CHKERRQ(ierr);
4124       ierr = MatSetUp(pcbddc->coarse_mat);CHKERRQ(ierr);
4125       ierr = MatSetOption(pcbddc->coarse_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr); /* local values stored in column major */
4126       ierr = MatSetOption(pcbddc->coarse_mat,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr);
4127     } else {
4128       ierr = MatCreateIS(coarse_comm,1,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size,coarse_ISLG,&pcbddc->coarse_mat);CHKERRQ(ierr);
4129       ierr = MatSetUp(pcbddc->coarse_mat);CHKERRQ(ierr);
4130       ierr = MatISGetLocalMat(pcbddc->coarse_mat,&matis_coarse_local_mat);CHKERRQ(ierr);
4131       ierr = MatSetUp(matis_coarse_local_mat);CHKERRQ(ierr);
4132       ierr = MatSetOption(matis_coarse_local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr); /* local values stored in column major */
4133       ierr = MatSetOption(matis_coarse_local_mat,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr);
4134     }
4135     /* preallocation */
4136     if (pcbddc->coarse_problem_type != MULTILEVEL_BDDC) {
4137       PetscInt lrows,lcols;
4138       ierr = MatGetLocalSize(pcbddc->coarse_mat,&lrows,&lcols);CHKERRQ(ierr);
4139       ierr = MatPreallocateInitialize(coarse_comm,lrows,lcols,dnz,onz);CHKERRQ(ierr);
4140       if (pcbddc->coarse_problem_type == PARALLEL_BDDC) {
4141         PetscInt coarse_index_row,coarse_index_col,start_row,owner;
4142         PetscMPIInt *auxpreall_displs;
4143         PetscMPIInt *auxpreall_sizes;
4144         PetscMPIInt *auxpreall_dnz;
4145         PetscMPIInt *auxpreall_onz;
4146         PetscInt    *auxpreall_ownership;
4147         if (rank_prec_comm == 0) {
4148           ierr = PetscMalloc((size_prec_comm+1)*sizeof(PetscMPIInt),&auxpreall_displs);CHKERRQ(ierr);
4149           auxpreall_displs[size_prec_comm]=pcbddc->coarse_size;
4150           ierr = PetscMalloc(size_prec_comm*sizeof(PetscMPIInt),&auxpreall_sizes);CHKERRQ(ierr);
4151           ierr = PetscMalloc(pcbddc->coarse_size*sizeof(PetscMPIInt),&auxpreall_dnz);CHKERRQ(ierr);
4152           ierr = PetscMemzero(auxpreall_dnz,pcbddc->coarse_size*sizeof(PetscMPIInt));CHKERRQ(ierr);
4153           ierr = PetscMalloc(pcbddc->coarse_size*sizeof(PetscMPIInt),&auxpreall_onz);CHKERRQ(ierr);
4154           ierr = PetscMemzero(auxpreall_onz,pcbddc->coarse_size*sizeof(PetscMPIInt));CHKERRQ(ierr);
4155           ierr = PetscMalloc(pcbddc->coarse_size*sizeof(PetscInt),&auxpreall_ownership);CHKERRQ(ierr);
4156         }
4157         ierr = MatGetOwnershipRange(pcbddc->coarse_mat,&start_row,PETSC_NULL);CHKERRQ(ierr);
4158         ierr = MPI_Gather(&start_row,1,MPIU_INT,auxpreall_displs,1,MPIU_INT,0,prec_comm);CHKERRQ(ierr);
4159         if (rank_prec_comm == 0) {
4160           k=0;
4161           for (i=0;i<size_prec_comm;i++) {
4162             auxpreall_sizes[i]=auxpreall_displs[i+1]-auxpreall_displs[i];
4163             for (j=0;j<auxpreall_sizes[i];j++) {
4164               auxpreall_ownership[auxpreall_displs[i]+j]=i;
4165             }
4166           }
4167           for (i=0;i<size_prec_comm;i++) {
4168             for (j=0;j<pcbddc->local_primal_sizes[i];j++) {
4169               coarse_index_row=auxglobal_primal[j+pcbddc->local_primal_displacements[i]];
4170               for (k=j;k<pcbddc->local_primal_sizes[i];k++) {
4171                 coarse_index_col=auxglobal_primal[k+pcbddc->local_primal_displacements[i]];
4172                 owner = auxpreall_ownership[coarse_index_row];
4173                 if (coarse_index_col>auxpreall_displs[owner]-1 && coarse_index_col < auxpreall_displs[owner]+auxpreall_sizes[owner]) {
4174                   auxpreall_dnz[coarse_index_row]++;
4175                 } else {
4176                   auxpreall_onz[coarse_index_row]++;
4177                 }
4178                 if (k != j) {
4179                   owner = auxpreall_ownership[coarse_index_col];
4180                   if (coarse_index_row>auxpreall_displs[owner]-1 && coarse_index_row < auxpreall_displs[owner]+auxpreall_sizes[owner]) {
4181                     auxpreall_dnz[coarse_index_col]++;
4182                   } else {
4183                     auxpreall_onz[coarse_index_col]++;
4184                   }
4185                 }
4186               }
4187             }
4188           }
4189         }
4190         ierr = MPI_Scatterv(auxpreall_dnz,auxpreall_sizes,auxpreall_displs,MPIU_INT,
4191                             dnz,lrows,MPIU_INT,0,prec_comm);
4192         ierr = MPI_Scatterv(auxpreall_onz,auxpreall_sizes,auxpreall_displs,MPIU_INT,
4193                             onz,lrows,MPIU_INT,0,prec_comm);
4194         if (rank_prec_comm == 0) {
4195           ierr = PetscFree(auxpreall_displs);CHKERRQ(ierr);
4196           ierr = PetscFree(auxpreall_sizes);CHKERRQ(ierr);
4197           ierr = PetscFree(auxpreall_dnz);CHKERRQ(ierr);
4198           ierr = PetscFree(auxpreall_onz);CHKERRQ(ierr);
4199           ierr = PetscFree(auxpreall_ownership);CHKERRQ(ierr);
4200         }
4201       } else {
4202         for (k=0;k<size_prec_comm;k++){
4203           offset=pcbddc->local_primal_displacements[k];
4204           offset2=localdispl2[k];
4205           ins_local_primal_size = pcbddc->local_primal_sizes[k];
4206           ins_local_primal_indices = &pcbddc->replicated_local_primal_indices[offset];
4207           for (j=0;j<ins_local_primal_size;j++) {
4208             ierr = MatPreallocateSet(ins_local_primal_indices[j],ins_local_primal_size,ins_local_primal_indices,dnz,onz);CHKERRQ(ierr);
4209           }
4210         }
4211       }
4212       /* check */
4213       for (i=0;i<lrows;i++) {
4214         if (dnz[i]>lcols) {
4215           dnz[i]=lcols;
4216         }
4217         if (onz[i]>pcbddc->coarse_size-lcols) {
4218           onz[i]=pcbddc->coarse_size-lcols;
4219         }
4220       }
4221       ierr = MatSeqAIJSetPreallocation(pcbddc->coarse_mat,PETSC_NULL,dnz);CHKERRQ(ierr);
4222       ierr = MatMPIAIJSetPreallocation(pcbddc->coarse_mat,PETSC_NULL,dnz,PETSC_NULL,onz);CHKERRQ(ierr);
4223       ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
4224     } else {
4225       ierr = MatSeqAIJSetPreallocation(matis_coarse_local_mat,0,dnz);CHKERRQ(ierr);
4226       ierr = PetscFree(dnz);CHKERRQ(ierr);
4227     }
4228     if (rank_prec_comm == 0) { ierr = PetscFree(auxglobal_primal);CHKERRQ(ierr); }
4229     /* insert values */
4230     if (pcbddc->coarse_problem_type == PARALLEL_BDDC) {
4231       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);
4232     } else if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
4233       if (pcbddc->coarsening_ratio == 1) {
4234         ins_coarse_mat_vals = coarse_submat_vals;
4235         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,INSERT_VALUES);CHKERRQ(ierr);
4236       } else {
4237         ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr);
4238         for (k=0;k<pcbddc->replicated_primal_size;k++) {
4239           offset = pcbddc->local_primal_displacements[k];
4240           offset2 = localdispl2[k];
4241           ins_local_primal_size = pcbddc->local_primal_displacements[k+1]-pcbddc->local_primal_displacements[k];
4242           ins_local_primal_indices = &pcbddc->replicated_local_primal_indices[offset];
4243           ins_coarse_mat_vals = &temp_coarse_mat_vals[offset2];
4244           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);
4245         }
4246       }
4247       ins_local_primal_indices = 0;
4248       ins_coarse_mat_vals = 0;
4249     } else {
4250       for (k=0;k<size_prec_comm;k++){
4251         offset=pcbddc->local_primal_displacements[k];
4252         offset2=localdispl2[k];
4253         ins_local_primal_size = pcbddc->local_primal_sizes[k];
4254         ins_local_primal_indices = &pcbddc->replicated_local_primal_indices[offset];
4255         ins_coarse_mat_vals = &temp_coarse_mat_vals[offset2];
4256         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);
4257       }
4258       ins_local_primal_indices = 0;
4259       ins_coarse_mat_vals = 0;
4260     }
4261     ierr = MatAssemblyBegin(pcbddc->coarse_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4262     ierr = MatAssemblyEnd(pcbddc->coarse_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4263     /* symmetry of coarse matrix */
4264     if (issym) {
4265       ierr = MatSetOption(pcbddc->coarse_mat,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
4266     }
4267     ierr = MatGetVecs(pcbddc->coarse_mat,&pcbddc->coarse_vec,&pcbddc->coarse_rhs);CHKERRQ(ierr);
4268   }
4269 
4270   /* create loc to glob scatters if needed */
4271   if (pcbddc->coarse_communications_type == SCATTERS_BDDC) {
4272      IS local_IS,global_IS;
4273      ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size,0,1,&local_IS);CHKERRQ(ierr);
4274      ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_indices,PETSC_COPY_VALUES,&global_IS);CHKERRQ(ierr);
4275      ierr = VecScatterCreate(pcbddc->vec1_P,local_IS,pcbddc->coarse_vec,global_IS,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
4276      ierr = ISDestroy(&local_IS);CHKERRQ(ierr);
4277      ierr = ISDestroy(&global_IS);CHKERRQ(ierr);
4278   }
4279 
4280   /* Eval coarse null space */
4281   if (pcbddc->NullSpace) {
4282     const Vec      *nsp_vecs;
4283     PetscInt       nsp_size,coarse_nsp_size;
4284     PetscBool      nsp_has_cnst;
4285     PetscReal      test_null;
4286     Vec            *coarse_nsp_vecs;
4287 
4288     coarse_nsp_size = 0;
4289     coarse_nsp_vecs = 0;
4290     ierr = MatNullSpaceGetVecs(pcbddc->NullSpace,&nsp_has_cnst,&nsp_size,&nsp_vecs);CHKERRQ(ierr);
4291     if (rank_prec_comm == active_rank) {
4292       ierr = PetscMalloc((nsp_size+1)*sizeof(Vec),&coarse_nsp_vecs);CHKERRQ(ierr);
4293       for (i=0;i<nsp_size+1;i++) {
4294         ierr = VecDuplicate(pcbddc->coarse_vec,&coarse_nsp_vecs[i]);CHKERRQ(ierr);
4295       }
4296     }
4297     if (nsp_has_cnst) {
4298       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
4299       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
4300       ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4301       ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4302       if (rank_prec_comm == active_rank) {
4303         ierr = MatMult(pcbddc->coarse_mat,pcbddc->coarse_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
4304         ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&test_null);CHKERRQ(ierr);
4305         if (test_null > 1.0e-12 && pcbddc->dbg_flag ) {
4306           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Constant coarse null space error % 1.14e\n",test_null);CHKERRQ(ierr);
4307         }
4308         ierr = VecCopy(pcbddc->coarse_vec,coarse_nsp_vecs[coarse_nsp_size]);CHKERRQ(ierr);
4309         coarse_nsp_size++;
4310       }
4311     }
4312     for (i=0;i<nsp_size;i++)  {
4313       ierr = VecScatterBegin(matis->ctx,nsp_vecs[i],pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4314       ierr = VecScatterEnd  (matis->ctx,nsp_vecs[i],pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4315       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
4316       ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4317       ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4318       if (rank_prec_comm == active_rank) {
4319         ierr = MatMult(pcbddc->coarse_mat,pcbddc->coarse_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
4320         ierr = VecNorm(pcbddc->coarse_rhs,NORM_2,&test_null);CHKERRQ(ierr);
4321         if (test_null > 1.0e-12 && pcbddc->dbg_flag ) {
4322           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Vec %d coarse null space error % 1.14e\n",i,test_null);CHKERRQ(ierr);
4323         }
4324         ierr = VecCopy(pcbddc->coarse_vec,coarse_nsp_vecs[coarse_nsp_size]);CHKERRQ(ierr);
4325         coarse_nsp_size++;
4326       }
4327     }
4328     if (coarse_nsp_size > 0) {
4329       /* TODO orthonormalize vecs */
4330       ierr = VecNormalize(coarse_nsp_vecs[0],PETSC_NULL);CHKERRQ(ierr);
4331       ierr = MatNullSpaceCreate(coarse_comm,PETSC_FALSE,coarse_nsp_size,coarse_nsp_vecs,&pcbddc->CoarseNullSpace);CHKERRQ(ierr);
4332       for (i=0;i<nsp_size+1;i++) {
4333         ierr = VecDestroy(&coarse_nsp_vecs[i]);CHKERRQ(ierr);
4334       }
4335     }
4336     ierr = PetscFree(coarse_nsp_vecs);CHKERRQ(ierr);
4337   }
4338 
4339   /* KSP for coarse problem */
4340   if (rank_prec_comm == active_rank) {
4341 
4342     ierr = KSPCreate(coarse_comm,&pcbddc->coarse_ksp);CHKERRQ(ierr);
4343     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
4344     ierr = KSPSetOperators(pcbddc->coarse_ksp,pcbddc->coarse_mat,pcbddc->coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
4345     ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,max_it_coarse_ksp);CHKERRQ(ierr);
4346     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
4347     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
4348     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
4349     /* Allow user's customization */
4350     ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,"coarse_");CHKERRQ(ierr);
4351     /* Set Up PC for coarse problem BDDC */
4352     if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
4353       i = pcbddc->current_level+1;
4354       ierr = PCBDDCSetLevel(pc_temp,i);CHKERRQ(ierr);
4355       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
4356       ierr = PCBDDCSetMaxLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
4357       ierr = PCBDDCSetCoarseProblemType(pc_temp,MULTILEVEL_BDDC);CHKERRQ(ierr);
4358       if (pcbddc->CoarseNullSpace) { ierr = PCBDDCSetNullSpace(pc_temp,pcbddc->CoarseNullSpace);CHKERRQ(ierr); }
4359       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
4360       if (dbg_flag) {
4361         ierr = PetscViewerASCIIPrintf(viewer,"----------------Level %d: Setting up level %d---------------\n",pcbddc->current_level,i);CHKERRQ(ierr);
4362         ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
4363       }
4364     }
4365     ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
4366     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
4367 
4368     if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
4369       /* TODO: this is a hack! need to be solved! */
4370       PC_BDDC*     coarse_pcbddc = (PC_BDDC*)pc_temp->data;
4371       coarse_pcbddc->use_exact_dirichlet = PETSC_FALSE;
4372       if (dbg_flag) {
4373         ierr = PetscViewerASCIIPrintf(viewer,"----------------Level %d set----------------------\n",i);CHKERRQ(ierr);
4374         ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
4375       }
4376     }
4377   }
4378   /* Evaluate condition number of coarse problem for cheby (and verbose output if requested) */
4379   if ( dbg_flag && rank_prec_comm == active_rank ) {
4380     KSP check_ksp;
4381     PC  check_pc;
4382     Vec check_vec;
4383     PetscReal   abs_infty_error,infty_error,lambda_min,lambda_max;
4384     const KSPType check_ksp_type;
4385 
4386     /* Create ksp object suitable for extreme eigenvalues' estimation */
4387     ierr = KSPCreate(coarse_comm,&check_ksp);CHKERRQ(ierr);
4388     ierr = KSPSetOperators(check_ksp,pcbddc->coarse_mat,pcbddc->coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
4389     ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
4390     if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
4391       if (issym) {
4392         check_ksp_type = KSPCG;
4393       } else {
4394         check_ksp_type = KSPGMRES;
4395       }
4396       ierr = KSPSetComputeSingularValues(check_ksp,PETSC_TRUE);CHKERRQ(ierr);
4397     } else {
4398       check_ksp_type = KSPPREONLY;
4399     }
4400     ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
4401     ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
4402     ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
4403     ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
4404     /* create random vec */
4405     ierr = VecDuplicate(pcbddc->coarse_vec,&check_vec);CHKERRQ(ierr);
4406     ierr = VecSetRandom(check_vec,PETSC_NULL);CHKERRQ(ierr);
4407     if (pcbddc->CoarseNullSpace) { ierr = MatNullSpaceRemove(pcbddc->CoarseNullSpace,check_vec,PETSC_NULL);CHKERRQ(ierr); }
4408     ierr = MatMult(pcbddc->coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
4409     /* solve coarse problem */
4410     ierr = KSPSolve(check_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
4411     if (pcbddc->CoarseNullSpace) { ierr = MatNullSpaceRemove(pcbddc->CoarseNullSpace,pcbddc->coarse_vec,PETSC_NULL);CHKERRQ(ierr); }
4412     /* check coarse problem residual error */
4413     ierr = VecAXPY(check_vec,-1.0,pcbddc->coarse_vec);CHKERRQ(ierr);
4414     ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
4415     ierr = MatMult(pcbddc->coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
4416     ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
4417     ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
4418     ierr = PetscViewerASCIIPrintf(viewer,"Size of coarse problem %d\n",pcbddc->coarse_size);CHKERRQ(ierr);
4419     /* get eigenvalue estimation if inexact */
4420     if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
4421       ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
4422       ierr = KSPGetIterationNumber(check_ksp,&k);CHKERRQ(ierr);
4423       ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem eigenvalues estimated with %d iterations of %s.\n",k,check_ksp_type);CHKERRQ(ierr);
4424       ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem eigenvalues: % 1.14e %1.14e\n",lambda_min,lambda_max);CHKERRQ(ierr);
4425     }
4426     ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem exact infty_error   : %1.14e\n",infty_error);CHKERRQ(ierr);
4427     ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem residual infty_error: %1.14e\n",abs_infty_error);CHKERRQ(ierr);
4428     ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
4429   }
4430   if (dbg_flag) { ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); }
4431   /* free data structures no longer needed */
4432   if (coarse_ISLG)                { ierr = ISLocalToGlobalMappingDestroy(&coarse_ISLG);CHKERRQ(ierr); }
4433   if (ins_local_primal_indices)   { ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr);  }
4434   if (ins_coarse_mat_vals)        { ierr = PetscFree(ins_coarse_mat_vals);CHKERRQ(ierr);}
4435   if (localsizes2)                { ierr = PetscFree(localsizes2);CHKERRQ(ierr);}
4436   if (localdispl2)                { ierr = PetscFree(localdispl2);CHKERRQ(ierr);}
4437   if (temp_coarse_mat_vals)       { ierr = PetscFree(temp_coarse_mat_vals);CHKERRQ(ierr);}
4438 
4439   PetscFunctionReturn(0);
4440 }
4441 
4442 #undef __FUNCT__
4443 #define __FUNCT__ "PCBDDCManageLocalBoundaries"
4444 static PetscErrorCode PCBDDCManageLocalBoundaries(PC pc)
4445 {
4446 
4447   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
4448   PC_IS         *pcis = (PC_IS*)pc->data;
4449   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
4450   PCBDDCGraph mat_graph=pcbddc->mat_graph;
4451   PetscInt    *queue_in_global_numbering,*is_indices,*auxis;
4452   PetscInt    bs,ierr,i,j,s,k,iindex,neumann_bsize,dirichlet_bsize;
4453   PetscInt    total_counts,nodes_touched,where_values=1,vertex_size;
4454   PetscMPIInt adapt_interface=0,adapt_interface_reduced=0,NEUMANNCNT=0;
4455   PetscBool   same_set;
4456   MPI_Comm    interface_comm=((PetscObject)pc)->comm;
4457   PetscBool   use_faces=PETSC_FALSE,use_edges=PETSC_FALSE;
4458   const PetscInt *neumann_nodes;
4459   const PetscInt *dirichlet_nodes;
4460   IS          used_IS,*custom_ISForDofs;
4461   PetscScalar *array;
4462   PetscScalar *array2;
4463   PetscViewer viewer=pcbddc->dbg_viewer;
4464 
4465   PetscFunctionBegin;
4466   /* Setup local adjacency graph */
4467   mat_graph->nvtxs=pcis->n;
4468   if (!mat_graph->xadj) { NEUMANNCNT = 1; }
4469   ierr = PCBDDCSetupLocalAdjacencyGraph(pc);CHKERRQ(ierr);
4470   i = mat_graph->nvtxs;
4471   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);
4472   ierr = PetscMalloc2(i,PetscInt,&mat_graph->which_dof,i,PetscBool,&mat_graph->touched);CHKERRQ(ierr);
4473   ierr = PetscMalloc(i*sizeof(PetscInt),&queue_in_global_numbering);CHKERRQ(ierr);
4474   ierr = PetscMemzero(mat_graph->where,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr);
4475   ierr = PetscMemzero(mat_graph->count,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr);
4476   ierr = PetscMemzero(mat_graph->which_dof,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr);
4477   ierr = PetscMemzero(mat_graph->queue,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr);
4478   ierr = PetscMemzero(mat_graph->cptr,(mat_graph->nvtxs+1)*sizeof(PetscInt));CHKERRQ(ierr);
4479 
4480   /* Setting dofs splitting in mat_graph->which_dof
4481      Get information about dofs' splitting if provided by the user
4482      Otherwise it assumes a constant block size */
4483   vertex_size=0;
4484   if (!pcbddc->n_ISForDofs) {
4485     ierr = MatGetBlockSize(matis->A,&bs);CHKERRQ(ierr);
4486     ierr = PetscMalloc(bs*sizeof(IS),&custom_ISForDofs);CHKERRQ(ierr);
4487     for (i=0;i<bs;i++) {
4488       ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n/bs,i,bs,&custom_ISForDofs[i]);CHKERRQ(ierr);
4489     }
4490     ierr = PCBDDCSetDofsSplitting(pc,bs,custom_ISForDofs);CHKERRQ(ierr);
4491     vertex_size=1;
4492     /* remove my references to IS objects */
4493     for (i=0;i<bs;i++) {
4494       ierr = ISDestroy(&custom_ISForDofs[i]);CHKERRQ(ierr);
4495     }
4496     ierr = PetscFree(custom_ISForDofs);CHKERRQ(ierr);
4497   }
4498   for (i=0;i<pcbddc->n_ISForDofs;i++) {
4499     ierr = ISGetSize(pcbddc->ISForDofs[i],&k);CHKERRQ(ierr);
4500     ierr = ISGetIndices(pcbddc->ISForDofs[i],(const PetscInt**)&is_indices);CHKERRQ(ierr);
4501     for (j=0;j<k;j++) {
4502       mat_graph->which_dof[is_indices[j]]=i;
4503     }
4504     ierr = ISRestoreIndices(pcbddc->ISForDofs[i],(const PetscInt**)&is_indices);CHKERRQ(ierr);
4505   }
4506   /* use mat block size as vertex size if it has not yet set */
4507   if (!vertex_size) {
4508     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
4509   }
4510 
4511   /* count number of neigh per node */
4512   total_counts=0;
4513   for (i=1;i<pcis->n_neigh;i++){
4514     s=pcis->n_shared[i];
4515     total_counts+=s;
4516     for (j=0;j<s;j++){
4517       mat_graph->count[pcis->shared[i][j]] += 1;
4518     }
4519   }
4520   /* Take into account Neumann data -> it increments number of sharing subdomains for nodes lying on the interface */
4521   ierr = PCBDDCGetNeumannBoundaries(pc,&used_IS);CHKERRQ(ierr);
4522   ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
4523   ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4524   if (used_IS) {
4525     ierr = ISGetSize(used_IS,&neumann_bsize);CHKERRQ(ierr);
4526     ierr = ISGetIndices(used_IS,&neumann_nodes);CHKERRQ(ierr);
4527     for (i=0;i<neumann_bsize;i++){
4528       iindex = neumann_nodes[i];
4529       if (mat_graph->count[iindex] > NEUMANNCNT && array[iindex]==0.0){
4530         mat_graph->count[iindex]+=1;
4531         total_counts++;
4532         array[iindex]=array[iindex]+1.0;
4533       } else if (array[iindex]>0.0) {
4534         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);
4535       }
4536     }
4537   }
4538   ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4539   /* allocate space for storing the set of neighbours for each node */
4540   ierr = PetscMalloc(mat_graph->nvtxs*sizeof(PetscInt*),&mat_graph->neighbours_set);CHKERRQ(ierr);
4541   if (mat_graph->nvtxs) { ierr = PetscMalloc(total_counts*sizeof(PetscInt),&mat_graph->neighbours_set[0]);CHKERRQ(ierr); }
4542   for (i=1;i<mat_graph->nvtxs;i++) mat_graph->neighbours_set[i]=mat_graph->neighbours_set[i-1]+mat_graph->count[i-1];
4543   ierr = PetscMemzero(mat_graph->count,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr);
4544   for (i=1;i<pcis->n_neigh;i++){
4545     s=pcis->n_shared[i];
4546     for (j=0;j<s;j++) {
4547       k=pcis->shared[i][j];
4548       mat_graph->neighbours_set[k][mat_graph->count[k]] = pcis->neigh[i];
4549       mat_graph->count[k]+=1;
4550     }
4551   }
4552   /* Check consistency of Neumann nodes */
4553   ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
4554   ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4555   ierr = VecScatterEnd  (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4556   ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4557   ierr = VecScatterEnd  (matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4558   ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4559   /* set -1 fake neighbour to mimic Neumann boundary */
4560   if (used_IS) {
4561     for (i=0;i<neumann_bsize;i++){
4562       iindex = neumann_nodes[i];
4563       if (mat_graph->count[iindex] > NEUMANNCNT){
4564         if (mat_graph->count[iindex]+1 != (PetscInt)array[iindex]) {
4565           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]);
4566         }
4567         mat_graph->neighbours_set[iindex][mat_graph->count[iindex]] = -1;
4568         mat_graph->count[iindex]+=1;
4569       }
4570     }
4571     ierr = ISRestoreIndices(used_IS,&neumann_nodes);CHKERRQ(ierr);
4572   }
4573   ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4574   /* sort set of sharing subdomains */
4575   for (i=0;i<mat_graph->nvtxs;i++) { ierr = PetscSortInt(mat_graph->count[i],mat_graph->neighbours_set[i]);CHKERRQ(ierr); }
4576   /* remove interior nodes and dirichlet boundary nodes from the next search into the graph */
4577   for (i=0;i<mat_graph->nvtxs;i++){mat_graph->touched[i]=PETSC_FALSE;}
4578   nodes_touched=0;
4579   ierr = PCBDDCGetDirichletBoundaries(pc,&used_IS);CHKERRQ(ierr);
4580   ierr = VecSet(pcis->vec2_N,0.0);CHKERRQ(ierr);
4581   ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4582   ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
4583   if (used_IS) {
4584     ierr = ISGetSize(used_IS,&dirichlet_bsize);CHKERRQ(ierr);
4585     if (dirichlet_bsize && matis->pure_neumann) {
4586       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"Dirichlet boundaries are intended to be used with matrices with zeroed rows!\n");
4587     }
4588     ierr = ISGetIndices(used_IS,&dirichlet_nodes);CHKERRQ(ierr);
4589     for (i=0;i<dirichlet_bsize;i++){
4590       iindex=dirichlet_nodes[i];
4591       if (mat_graph->count[iindex] && !mat_graph->touched[iindex]) {
4592         if (array[iindex]>0.0) {
4593           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);
4594         }
4595         mat_graph->touched[iindex]=PETSC_TRUE;
4596         mat_graph->where[iindex]=0;
4597         nodes_touched++;
4598         array2[iindex]=array2[iindex]+1.0;
4599       }
4600     }
4601     ierr = ISRestoreIndices(used_IS,&dirichlet_nodes);CHKERRQ(ierr);
4602   }
4603   ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4604   ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
4605   /* Check consistency of Dirichlet nodes */
4606   ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
4607   ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
4608   ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4609   ierr = VecScatterEnd  (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4610   ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4611   ierr = VecScatterEnd  (matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4612   ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
4613   ierr = VecScatterBegin(matis->ctx,pcis->vec2_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4614   ierr = VecScatterEnd  (matis->ctx,pcis->vec2_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4615   ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4616   ierr = VecScatterEnd  (matis->ctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4617   ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4618   ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
4619   if (used_IS) {
4620     ierr = ISGetSize(used_IS,&dirichlet_bsize);CHKERRQ(ierr);
4621     ierr = ISGetIndices(used_IS,&dirichlet_nodes);CHKERRQ(ierr);
4622     for (i=0;i<dirichlet_bsize;i++){
4623       iindex=dirichlet_nodes[i];
4624       if (array[iindex]>1.0 && array[iindex]!=array2[iindex] ) {
4625          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]);
4626       }
4627     }
4628     ierr = ISRestoreIndices(used_IS,&dirichlet_nodes);CHKERRQ(ierr);
4629   }
4630   ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4631   ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
4632 
4633   for (i=0;i<mat_graph->nvtxs;i++){
4634     if (!mat_graph->count[i]){  /* interior nodes */
4635       mat_graph->touched[i]=PETSC_TRUE;
4636       mat_graph->where[i]=0;
4637       nodes_touched++;
4638     }
4639   }
4640   mat_graph->ncmps = 0;
4641   i=0;
4642   while(nodes_touched<mat_graph->nvtxs) {
4643     /*  find first untouched node in local ordering */
4644     while(mat_graph->touched[i]) i++;
4645     mat_graph->touched[i]=PETSC_TRUE;
4646     mat_graph->where[i]=where_values;
4647     nodes_touched++;
4648     /* now find all other nodes having the same set of sharing subdomains */
4649     for (j=i+1;j<mat_graph->nvtxs;j++){
4650       /* check for same number of sharing subdomains and dof number */
4651       if (!mat_graph->touched[j] && mat_graph->count[i]==mat_graph->count[j] && mat_graph->which_dof[i] == mat_graph->which_dof[j] ){
4652         /* check for same set of sharing subdomains */
4653         same_set=PETSC_TRUE;
4654         for (k=0;k<mat_graph->count[j];k++){
4655           if (mat_graph->neighbours_set[i][k]!=mat_graph->neighbours_set[j][k]) {
4656             same_set=PETSC_FALSE;
4657           }
4658         }
4659         /* I found a friend of mine */
4660         if (same_set) {
4661           mat_graph->where[j]=where_values;
4662           mat_graph->touched[j]=PETSC_TRUE;
4663           nodes_touched++;
4664         }
4665       }
4666     }
4667     where_values++;
4668   }
4669   where_values--; if (where_values<0) where_values=0;
4670   ierr = PetscMalloc(where_values*sizeof(PetscMPIInt),&mat_graph->where_ncmps);CHKERRQ(ierr);
4671   /* Find connected components defined on the shared interface */
4672   if (where_values) {
4673     ierr = PCBDDCFindConnectedComponents(mat_graph, where_values);
4674     /* For consistency among neughbouring procs, I need to sort (by global ordering) each connected component */
4675     for (i=0;i<mat_graph->ncmps;i++) {
4676       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);
4677       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);
4678     }
4679   }
4680   /* check consistency of connected components among neighbouring subdomains -> it adapt them in case it is needed */
4681   for (i=0;i<where_values;i++) {
4682     /* We are not sure that two connected components will be the same among subdomains sharing a subset of local interface */
4683     if (mat_graph->where_ncmps[i]>1) {
4684       adapt_interface=1;
4685       break;
4686     }
4687   }
4688   ierr = MPI_Allreduce(&adapt_interface,&adapt_interface_reduced,1,MPIU_INT,MPI_LOR,interface_comm);CHKERRQ(ierr);
4689   if (pcbddc->dbg_flag && adapt_interface_reduced) {
4690     ierr = PetscViewerASCIIPrintf(viewer,"Adapting interface\n");CHKERRQ(ierr);
4691     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
4692   }
4693   if (where_values && adapt_interface_reduced) {
4694 
4695     PetscInt sum_requests=0,my_rank;
4696     PetscInt buffer_size,start_of_recv,size_of_recv,start_of_send;
4697     PetscInt temp_buffer_size,ins_val,global_where_counter;
4698     PetscInt *cum_recv_counts;
4699     PetscInt *where_to_nodes_indices;
4700     PetscInt *petsc_buffer;
4701     PetscMPIInt *recv_buffer;
4702     PetscMPIInt *recv_buffer_where;
4703     PetscMPIInt *send_buffer;
4704     PetscMPIInt size_of_send;
4705     PetscInt *sizes_of_sends;
4706     MPI_Request *send_requests;
4707     MPI_Request *recv_requests;
4708     PetscInt *where_cc_adapt;
4709     PetscInt **temp_buffer;
4710     PetscInt *nodes_to_temp_buffer_indices;
4711     PetscInt *add_to_where;
4712 
4713     ierr = MPI_Comm_rank(interface_comm,&my_rank);CHKERRQ(ierr);
4714     ierr = PetscMalloc((where_values+1)*sizeof(PetscInt),&cum_recv_counts);CHKERRQ(ierr);
4715     ierr = PetscMemzero(cum_recv_counts,(where_values+1)*sizeof(PetscInt));CHKERRQ(ierr);
4716     ierr = PetscMalloc(where_values*sizeof(PetscInt),&where_to_nodes_indices);CHKERRQ(ierr);
4717     /* first count how many neighbours per connected component I will receive from */
4718     cum_recv_counts[0]=0;
4719     for (i=1;i<where_values+1;i++){
4720       j=0;
4721       while(mat_graph->where[j] != i) { j++; }
4722       where_to_nodes_indices[i-1]=j;
4723       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  */
4724       else { cum_recv_counts[i]=cum_recv_counts[i-1]+mat_graph->count[j]-1; }
4725     }
4726     ierr = PetscMalloc(2*cum_recv_counts[where_values]*sizeof(PetscMPIInt),&recv_buffer_where);CHKERRQ(ierr);
4727     ierr = PetscMalloc(cum_recv_counts[where_values]*sizeof(MPI_Request),&send_requests);CHKERRQ(ierr);
4728     ierr = PetscMalloc(cum_recv_counts[where_values]*sizeof(MPI_Request),&recv_requests);CHKERRQ(ierr);
4729     for (i=0;i<cum_recv_counts[where_values];i++) {
4730       send_requests[i]=MPI_REQUEST_NULL;
4731       recv_requests[i]=MPI_REQUEST_NULL;
4732     }
4733     /* exchange with my neighbours the number of my connected components on the shared interface */
4734     for (i=0;i<where_values;i++){
4735       j=where_to_nodes_indices[i];
4736       k = (mat_graph->neighbours_set[j][0] == -1 ?  1 : 0);
4737       for (;k<mat_graph->count[j];k++){
4738         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);
4739         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);
4740         sum_requests++;
4741       }
4742     }
4743     ierr = MPI_Waitall(sum_requests,recv_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
4744     ierr = MPI_Waitall(sum_requests,send_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
4745     /* determine the connected component I need to adapt */
4746     ierr = PetscMalloc(where_values*sizeof(PetscInt),&where_cc_adapt);CHKERRQ(ierr);
4747     ierr = PetscMemzero(where_cc_adapt,where_values*sizeof(PetscInt));CHKERRQ(ierr);
4748     for (i=0;i<where_values;i++){
4749       for (j=cum_recv_counts[i];j<cum_recv_counts[i+1];j++){
4750         /* The first condition is natural (i.e someone has a different number of cc than me), the second one is just to be safe */
4751         if ( mat_graph->where_ncmps[i]!=recv_buffer_where[j] || mat_graph->where_ncmps[i] > 1 ) {
4752           where_cc_adapt[i]=PETSC_TRUE;
4753           break;
4754         }
4755       }
4756     }
4757     buffer_size = 0;
4758     for (i=0;i<where_values;i++) {
4759       if (where_cc_adapt[i]) {
4760         for (j=i;j<mat_graph->ncmps;j++) {
4761           if (mat_graph->where[mat_graph->queue[mat_graph->cptr[j]]] == i+1) { /* WARNING -> where values goes from 1 to where_values included */
4762             buffer_size += 1 + mat_graph->cptr[j+1]-mat_graph->cptr[j];
4763           }
4764         }
4765       }
4766     }
4767     ierr = PetscMalloc(buffer_size*sizeof(PetscMPIInt),&send_buffer);CHKERRQ(ierr);
4768     /* now get from neighbours their ccs (in global numbering) and adapt them (in case it is needed) */
4769     /* first determine how much data to send (size of each queue plus the global indices) and communicate it to neighbours */
4770     ierr = PetscMalloc(where_values*sizeof(PetscInt),&sizes_of_sends);CHKERRQ(ierr);
4771     ierr = PetscMemzero(sizes_of_sends,where_values*sizeof(PetscInt));CHKERRQ(ierr);
4772     sum_requests=0;
4773     start_of_send=0;
4774     start_of_recv=cum_recv_counts[where_values];
4775     for (i=0;i<where_values;i++) {
4776       if (where_cc_adapt[i]) {
4777         size_of_send=0;
4778         for (j=i;j<mat_graph->ncmps;j++) {
4779           if (mat_graph->where[mat_graph->queue[mat_graph->cptr[j]]] == i+1) { /* WARNING -> where values goes from 1 to where_values included */
4780             send_buffer[start_of_send+size_of_send]=mat_graph->cptr[j+1]-mat_graph->cptr[j];
4781             size_of_send+=1;
4782             for (k=0;k<mat_graph->cptr[j+1]-mat_graph->cptr[j];k++) {
4783               send_buffer[start_of_send+size_of_send+k]=queue_in_global_numbering[mat_graph->cptr[j]+k];
4784             }
4785             size_of_send=size_of_send+mat_graph->cptr[j+1]-mat_graph->cptr[j];
4786           }
4787         }
4788         j = where_to_nodes_indices[i];
4789         k = (mat_graph->neighbours_set[j][0] == -1 ?  1 : 0);
4790         sizes_of_sends[i]=size_of_send;
4791         for (;k<mat_graph->count[j];k++){
4792           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);
4793           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);
4794           sum_requests++;
4795         }
4796         start_of_send+=size_of_send;
4797       }
4798     }
4799     ierr = MPI_Waitall(sum_requests,send_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
4800     ierr = MPI_Waitall(sum_requests,recv_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
4801     buffer_size=0;
4802     for (k=0;k<sum_requests;k++) { buffer_size+=recv_buffer_where[start_of_recv+k]; }
4803     ierr = PetscMalloc(buffer_size*sizeof(PetscMPIInt),&recv_buffer);CHKERRQ(ierr);
4804     /* now exchange the data */
4805     start_of_recv=0;
4806     start_of_send=0;
4807     sum_requests=0;
4808     for (i=0;i<where_values;i++) {
4809       if (where_cc_adapt[i]) {
4810         size_of_send = sizes_of_sends[i];
4811         j = where_to_nodes_indices[i];
4812         k = (mat_graph->neighbours_set[j][0] == -1 ?  1 : 0);
4813         for (;k<mat_graph->count[j];k++){
4814           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);
4815           size_of_recv=recv_buffer_where[cum_recv_counts[where_values]+sum_requests];
4816           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);
4817           start_of_recv+=size_of_recv;
4818           sum_requests++;
4819         }
4820         start_of_send+=size_of_send;
4821       }
4822     }
4823     ierr = MPI_Waitall(sum_requests,recv_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
4824     ierr = MPI_Waitall(sum_requests,send_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
4825     ierr = PetscMalloc(buffer_size*sizeof(PetscInt),&petsc_buffer);CHKERRQ(ierr);
4826     for (k=0;k<start_of_recv;k++) { petsc_buffer[k]=(PetscInt)recv_buffer[k]; }
4827     for (j=0;j<buffer_size;) {
4828        ierr = ISGlobalToLocalMappingApply(matis->mapping,IS_GTOLM_MASK,petsc_buffer[j],&petsc_buffer[j+1],&petsc_buffer[j],&petsc_buffer[j+1]);CHKERRQ(ierr);
4829        k=petsc_buffer[j]+1;
4830        j+=k;
4831     }
4832     sum_requests=cum_recv_counts[where_values];
4833     start_of_recv=0;
4834     ierr = PetscMalloc(mat_graph->nvtxs*sizeof(PetscInt),&nodes_to_temp_buffer_indices);CHKERRQ(ierr);
4835     global_where_counter=0;
4836     for (i=0;i<where_values;i++){
4837       if (where_cc_adapt[i]){
4838         temp_buffer_size=0;
4839         /* find nodes on the shared interface we need to adapt */
4840         for (j=0;j<mat_graph->nvtxs;j++){
4841           if (mat_graph->where[j]==i+1) {
4842             nodes_to_temp_buffer_indices[j]=temp_buffer_size;
4843             temp_buffer_size++;
4844           } else {
4845             nodes_to_temp_buffer_indices[j]=-1;
4846           }
4847         }
4848         /* allocate some temporary space */
4849         ierr = PetscMalloc(temp_buffer_size*sizeof(PetscInt*),&temp_buffer);CHKERRQ(ierr);
4850         ierr = PetscMalloc(temp_buffer_size*(cum_recv_counts[i+1]-cum_recv_counts[i])*sizeof(PetscInt),&temp_buffer[0]);CHKERRQ(ierr);
4851         ierr = PetscMemzero(temp_buffer[0],temp_buffer_size*(cum_recv_counts[i+1]-cum_recv_counts[i])*sizeof(PetscInt));CHKERRQ(ierr);
4852         for (j=1;j<temp_buffer_size;j++){
4853           temp_buffer[j]=temp_buffer[j-1]+cum_recv_counts[i+1]-cum_recv_counts[i];
4854         }
4855         /* analyze contributions from neighbouring subdomains for i-th conn comp
4856            temp buffer structure:
4857            supposing part of the interface has dimension 5 (global nodes 0,1,2,3,4)
4858            3 neighs procs with structured connected components:
4859              neigh 0: [0 1 4], [2 3];  (2 connected components)
4860              neigh 1: [0 1], [2 3 4];  (2 connected components)
4861              neigh 2: [0 4], [1], [2 3]; (3 connected components)
4862            tempbuffer (row-oriented) should be filled as:
4863              [ 0, 0, 0;
4864                0, 0, 1;
4865                1, 1, 2;
4866                1, 1, 2;
4867                0, 1, 0; ];
4868            This way we can simply recover the resulting structure account for possible intersections of ccs among neighs.
4869            The mat_graph->where array will be modified to reproduce the following 4 connected components [0], [1], [2 3], [4];
4870                                                                                                                                    */
4871         for (j=0;j<cum_recv_counts[i+1]-cum_recv_counts[i];j++) {
4872           ins_val=0;
4873           size_of_recv=recv_buffer_where[sum_requests];  /* total size of recv from neighs */
4874           for (buffer_size=0;buffer_size<size_of_recv;) {  /* loop until all data from neighs has been taken into account */
4875             for (k=1;k<petsc_buffer[buffer_size+start_of_recv]+1;k++) { /* filling properly temp_buffer using data from a single recv */
4876               temp_buffer[ nodes_to_temp_buffer_indices[ petsc_buffer[ start_of_recv+buffer_size+k ] ] ][j]=ins_val;
4877             }
4878             buffer_size+=k;
4879             ins_val++;
4880           }
4881           start_of_recv+=size_of_recv;
4882           sum_requests++;
4883         }
4884         ierr = PetscMalloc(temp_buffer_size*sizeof(PetscInt),&add_to_where);CHKERRQ(ierr);
4885         ierr = PetscMemzero(add_to_where,temp_buffer_size*sizeof(PetscInt));CHKERRQ(ierr);
4886         for (j=0;j<temp_buffer_size;j++){
4887           if (!add_to_where[j]){ /* found a new cc  */
4888             global_where_counter++;
4889             add_to_where[j]=global_where_counter;
4890             for (k=j+1;k<temp_buffer_size;k++){ /* check for other nodes in new cc */
4891               same_set=PETSC_TRUE;
4892               for (s=0;s<cum_recv_counts[i+1]-cum_recv_counts[i];s++){
4893                 if (temp_buffer[j][s]!=temp_buffer[k][s]) {
4894                   same_set=PETSC_FALSE;
4895                   break;
4896                 }
4897               }
4898               if (same_set) add_to_where[k]=global_where_counter;
4899             }
4900           }
4901         }
4902         /* insert new data in where array */
4903         temp_buffer_size=0;
4904         for (j=0;j<mat_graph->nvtxs;j++){
4905           if (mat_graph->where[j]==i+1) {
4906             mat_graph->where[j]=where_values+add_to_where[temp_buffer_size];
4907             temp_buffer_size++;
4908           }
4909         }
4910         ierr = PetscFree(temp_buffer[0]);CHKERRQ(ierr);
4911         ierr = PetscFree(temp_buffer);CHKERRQ(ierr);
4912         ierr = PetscFree(add_to_where);CHKERRQ(ierr);
4913       }
4914     }
4915     ierr = PetscFree(nodes_to_temp_buffer_indices);CHKERRQ(ierr);
4916     ierr = PetscFree(sizes_of_sends);CHKERRQ(ierr);
4917     ierr = PetscFree(send_requests);CHKERRQ(ierr);
4918     ierr = PetscFree(recv_requests);CHKERRQ(ierr);
4919     ierr = PetscFree(petsc_buffer);CHKERRQ(ierr);
4920     ierr = PetscFree(recv_buffer);CHKERRQ(ierr);
4921     ierr = PetscFree(recv_buffer_where);CHKERRQ(ierr);
4922     ierr = PetscFree(send_buffer);CHKERRQ(ierr);
4923     ierr = PetscFree(cum_recv_counts);CHKERRQ(ierr);
4924     ierr = PetscFree(where_to_nodes_indices);CHKERRQ(ierr);
4925     ierr = PetscFree(where_cc_adapt);CHKERRQ(ierr);
4926     /* We are ready to evaluate consistent connected components on each part of the shared interface */
4927     if (global_where_counter) {
4928       for (i=0;i<mat_graph->nvtxs;i++){ mat_graph->touched[i]=PETSC_FALSE; }
4929       global_where_counter=0;
4930       for (i=0;i<mat_graph->nvtxs;i++){
4931         if (mat_graph->where[i] && !mat_graph->touched[i]) {
4932           global_where_counter++;
4933           for (j=i+1;j<mat_graph->nvtxs;j++){
4934             if (!mat_graph->touched[j] && mat_graph->where[j]==mat_graph->where[i]) {
4935               mat_graph->where[j]=global_where_counter;
4936               mat_graph->touched[j]=PETSC_TRUE;
4937             }
4938           }
4939           mat_graph->where[i]=global_where_counter;
4940           mat_graph->touched[i]=PETSC_TRUE;
4941         }
4942       }
4943       where_values=global_where_counter;
4944     }
4945     if (global_where_counter) {
4946       ierr = PetscMemzero(mat_graph->cptr,(mat_graph->nvtxs+1)*sizeof(PetscInt));CHKERRQ(ierr);
4947       ierr = PetscMemzero(mat_graph->queue,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr);
4948       ierr = PetscFree(mat_graph->where_ncmps);CHKERRQ(ierr);
4949       ierr = PetscMalloc(where_values*sizeof(PetscMPIInt),&mat_graph->where_ncmps);CHKERRQ(ierr);
4950       ierr = PCBDDCFindConnectedComponents(mat_graph, where_values);
4951       for (i=0;i<mat_graph->ncmps;i++) {
4952         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);
4953         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);
4954       }
4955     }
4956   } /* Finished adapting interface */
4957   PetscInt nfc=0;
4958   PetscInt nec=0;
4959   PetscInt nvc=0;
4960   PetscBool twodim_flag=PETSC_FALSE;
4961   for (i=0; i<mat_graph->ncmps; i++) {
4962     if ( mat_graph->cptr[i+1]-mat_graph->cptr[i] > vertex_size ){
4963       if (mat_graph->count[mat_graph->queue[mat_graph->cptr[i]]]==1){ /* 1 neigh Neumann fake included */
4964         nfc++;
4965       } else { /* note that nec will be zero in 2d */
4966         nec++;
4967       }
4968     } else {
4969       nvc+=mat_graph->cptr[i+1]-mat_graph->cptr[i];
4970     }
4971   }
4972 
4973   if (!nec) { /* we are in a 2d case -> no faces, only edges */
4974     nec = nfc;
4975     nfc = 0;
4976     twodim_flag = PETSC_TRUE;
4977   }
4978   /* allocate IS arrays for faces, edges. Vertices need a single index set. */
4979   k=0;
4980   for (i=0; i<mat_graph->ncmps; i++) {
4981     j=mat_graph->cptr[i+1]-mat_graph->cptr[i];
4982     if ( j > k) {
4983       k=j;
4984     }
4985     if (j<=vertex_size) {
4986       k+=vertex_size;
4987     }
4988   }
4989   ierr = PetscMalloc(k*sizeof(PetscInt),&auxis);CHKERRQ(ierr);
4990 
4991   if (!pcbddc->vertices_flag && !pcbddc->edges_flag) {
4992     ierr = PetscMalloc(nfc*sizeof(IS),&pcbddc->ISForFaces);CHKERRQ(ierr);
4993     use_faces=PETSC_TRUE;
4994   }
4995   if (!pcbddc->vertices_flag && !pcbddc->faces_flag) {
4996     ierr = PetscMalloc(nec*sizeof(IS),&pcbddc->ISForEdges);CHKERRQ(ierr);
4997     use_edges=PETSC_TRUE;
4998   }
4999   nfc=0;
5000   nec=0;
5001   for (i=0; i<mat_graph->ncmps; i++) {
5002     if ( mat_graph->cptr[i+1]-mat_graph->cptr[i] > vertex_size ){
5003       for (j=0;j<mat_graph->cptr[i+1]-mat_graph->cptr[i];j++) {
5004         auxis[j]=mat_graph->queue[mat_graph->cptr[i]+j];
5005       }
5006       if (mat_graph->count[mat_graph->queue[mat_graph->cptr[i]]]==1){
5007         if (twodim_flag) {
5008           if (use_edges) {
5009             ierr = ISCreateGeneral(PETSC_COMM_SELF,j,auxis,PETSC_COPY_VALUES,&pcbddc->ISForEdges[nec]);CHKERRQ(ierr);
5010             nec++;
5011           }
5012         } else {
5013           if (use_faces) {
5014             ierr = ISCreateGeneral(PETSC_COMM_SELF,j,auxis,PETSC_COPY_VALUES,&pcbddc->ISForFaces[nfc]);CHKERRQ(ierr);
5015             nfc++;
5016           }
5017         }
5018       } else {
5019         if (use_edges) {
5020           ierr = ISCreateGeneral(PETSC_COMM_SELF,j,auxis,PETSC_COPY_VALUES,&pcbddc->ISForEdges[nec]);CHKERRQ(ierr);
5021           nec++;
5022         }
5023       }
5024     }
5025   }
5026   pcbddc->n_ISForFaces=nfc;
5027   pcbddc->n_ISForEdges=nec;
5028   nvc=0;
5029   if ( !pcbddc->constraints_flag ) {
5030     for (i=0; i<mat_graph->ncmps; i++) {
5031       if ( mat_graph->cptr[i+1]-mat_graph->cptr[i] <= vertex_size ){
5032         for ( j=mat_graph->cptr[i];j<mat_graph->cptr[i+1];j++) {
5033           auxis[nvc]=mat_graph->queue[j];
5034           nvc++;
5035         }
5036       }
5037     }
5038   }
5039   /* sort vertex set (by local ordering) */
5040   ierr = PetscSortInt(nvc,auxis);CHKERRQ(ierr);
5041   ierr = ISCreateGeneral(PETSC_COMM_SELF,nvc,auxis,PETSC_COPY_VALUES,&pcbddc->ISForVertices);CHKERRQ(ierr);
5042 
5043   if (pcbddc->dbg_flag) {
5044 
5045     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5046     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Details from PCBDDCManageLocalBoundaries for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
5047     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5048 /*    ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Graph (adjacency structure) of local Neumann mat\n");CHKERRQ(ierr);
5049     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5050     for (i=0;i<mat_graph->nvtxs;i++) {
5051       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Nodes connected to node number %d are %d\n",i,mat_graph->xadj[i+1]-mat_graph->xadj[i]);CHKERRQ(ierr);
5052       for (j=mat_graph->xadj[i];j<mat_graph->xadj[i+1];j++){
5053         ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%d ",mat_graph->adjncy[j]);CHKERRQ(ierr);
5054       }
5055       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n--------------------------------------------------------------\n");CHKERRQ(ierr);
5056     }*/
5057     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Matrix graph has %d connected components", mat_graph->ncmps);CHKERRQ(ierr);
5058     for (i=0;i<mat_graph->ncmps;i++) {
5059       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\nDetails for connected component number %02d: size %04d, count %01d. Nodes follow.\n",
5060              i,mat_graph->cptr[i+1]-mat_graph->cptr[i],mat_graph->count[mat_graph->queue[mat_graph->cptr[i]]]);CHKERRQ(ierr);
5061       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"subdomains: ");
5062       for (j=0;j<mat_graph->count[mat_graph->queue[mat_graph->cptr[i]]]; j++) {
5063         ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%d ",mat_graph->neighbours_set[mat_graph->queue[mat_graph->cptr[i]]][j]);
5064       }
5065       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");
5066       for (j=mat_graph->cptr[i]; j<mat_graph->cptr[i+1]; j++){
5067         /* ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%d (%d), ",queue_in_global_numbering[j],mat_graph->queue[j]);CHKERRQ(ierr); */
5068         ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%d, ",mat_graph->queue[j]);CHKERRQ(ierr);
5069       }
5070     }
5071     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n--------------------------------------------------------------\n");CHKERRQ(ierr);
5072     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d detected %02d local vertices\n",PetscGlobalRank,nvc);CHKERRQ(ierr);
5073     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d detected %02d local faces\n",PetscGlobalRank,nfc);CHKERRQ(ierr);
5074     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d detected %02d local edges\n",PetscGlobalRank,nec);CHKERRQ(ierr);
5075     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
5076   }
5077 
5078   ierr = PetscFree(queue_in_global_numbering);CHKERRQ(ierr);
5079   ierr = PetscFree(auxis);CHKERRQ(ierr);
5080   PetscFunctionReturn(0);
5081 
5082 }
5083 
5084 /* -------------------------------------------------------------------------- */
5085 
5086 /* The following code has been adapted from function IsConnectedSubdomain contained
5087    in source file contig.c of METIS library (version 5.0.1)
5088    It finds connected components of each partition labeled from 1 to n_dist  */
5089 
5090 #undef __FUNCT__
5091 #define __FUNCT__ "PCBDDCFindConnectedComponents"
5092 static PetscErrorCode PCBDDCFindConnectedComponents(PCBDDCGraph graph, PetscInt n_dist )
5093 {
5094   PetscInt i, j, k, nvtxs, first, last, nleft, ncmps,pid,cum_queue,n,ncmps_pid;
5095   PetscInt *xadj, *adjncy, *where, *queue;
5096   PetscInt *cptr;
5097   PetscBool *touched;
5098 
5099   PetscFunctionBegin;
5100 
5101   nvtxs   = graph->nvtxs;
5102   xadj    = graph->xadj;
5103   adjncy  = graph->adjncy;
5104   where   = graph->where;
5105   touched = graph->touched;
5106   queue   = graph->queue;
5107   cptr    = graph->cptr;
5108 
5109   for (i=0; i<nvtxs; i++)
5110     touched[i] = PETSC_FALSE;
5111 
5112   cum_queue=0;
5113   ncmps=0;
5114 
5115   for (n=0; n<n_dist; n++) {
5116     pid = n+1;  /* partition labeled by 0 is discarded */
5117     nleft = 0;
5118     for (i=0; i<nvtxs; i++) {
5119       if (where[i] == pid)
5120         nleft++;
5121     }
5122     for (i=0; i<nvtxs; i++) {
5123       if (where[i] == pid)
5124         break;
5125     }
5126     touched[i] = PETSC_TRUE;
5127     queue[cum_queue] = i;
5128     first = 0; last = 1;
5129     cptr[ncmps] = cum_queue;  /* This actually points to queue */
5130     ncmps_pid = 0;
5131     while (first != nleft) {
5132       if (first == last) { /* Find another starting vertex */
5133         cptr[++ncmps] = first+cum_queue;
5134         ncmps_pid++;
5135         for (i=0; i<nvtxs; i++) {
5136           if (where[i] == pid && !touched[i])
5137             break;
5138         }
5139         queue[cum_queue+last] = i;
5140         last++;
5141         touched[i] = PETSC_TRUE;
5142       }
5143       i = queue[cum_queue+first];
5144       first++;
5145       for (j=xadj[i]; j<xadj[i+1]; j++) {
5146         k = adjncy[j];
5147         if (where[k] == pid && !touched[k]) {
5148           queue[cum_queue+last] = k;
5149           last++;
5150           touched[k] = PETSC_TRUE;
5151         }
5152       }
5153     }
5154     cptr[++ncmps] = first+cum_queue;
5155     ncmps_pid++;
5156     cum_queue=cptr[ncmps];
5157     graph->where_ncmps[n] = ncmps_pid;
5158   }
5159   graph->ncmps = ncmps;
5160 
5161   PetscFunctionReturn(0);
5162 }
5163