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