xref: /petsc/src/ksp/pc/impls/bddc/bddc.c (revision 9d9e44b646d0e5fe9068ee91ce0972b37bd2c08e)
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 PCBDDCAnalyzeInterface?
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*/  /* includes for fortran wrappers */
23 #include "bddcprivate.h"
24 #include <petscblaslapack.h>
25 
26 /* prototypes for static functions contained in bddc.c */
27 static PetscErrorCode PCBDDCSetUseExactDirichlet(PC,PetscBool);
28 static PetscErrorCode PCBDDCSetLevel(PC,PetscInt);
29 static PetscErrorCode PCBDDCCoarseSetUp(PC);
30 static PetscErrorCode PCBDDCSetUpCoarseEnvironment(PC,PetscScalar*);
31 
32 /* -------------------------------------------------------------------------- */
33 #undef __FUNCT__
34 #define __FUNCT__ "PCSetFromOptions_BDDC"
35 PetscErrorCode PCSetFromOptions_BDDC(PC pc)
36 {
37   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
38   PetscErrorCode ierr;
39 
40   PetscFunctionBegin;
41   ierr = PetscOptionsHead("BDDC options");CHKERRQ(ierr);
42   /* Verbose debugging of main data structures */
43   ierr = PetscOptionsInt("-pc_bddc_check_level"       ,"Verbose (debugging) output for PCBDDC"                       ,"none",pcbddc->dbg_flag      ,&pcbddc->dbg_flag      ,NULL);CHKERRQ(ierr);
44   /* Some customization for default primal space */
45   ierr = PetscOptionsBool("-pc_bddc_vertices_only"   ,"Use only vertices in coarse space (i.e. discard constraints)","none",pcbddc->vertices_flag   ,&pcbddc->vertices_flag   ,NULL);CHKERRQ(ierr);
46   ierr = PetscOptionsBool("-pc_bddc_constraints_only","Use only constraints in coarse space (i.e. discard vertices)","none",pcbddc->constraints_flag,&pcbddc->constraints_flag,NULL);CHKERRQ(ierr);
47   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      ,NULL);CHKERRQ(ierr);
48   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      ,NULL);CHKERRQ(ierr);
49   /* Coarse solver context */
50   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 */
51   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,NULL);CHKERRQ(ierr);
52   /* Two different application of BDDC to the whole set of dofs, internal and interface */
53   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,NULL);CHKERRQ(ierr);
54   ierr = PetscOptionsBool("-pc_bddc_use_change_of_basis","Use change of basis approach for primal space","none",pcbddc->use_change_of_basis,&pcbddc->use_change_of_basis,NULL);CHKERRQ(ierr);
55   ierr = PetscOptionsBool("-pc_bddc_use_change_on_faces","Use change of basis approach for face constraints","none",pcbddc->use_change_on_faces,&pcbddc->use_change_on_faces,NULL);CHKERRQ(ierr);
56   if (!pcbddc->use_change_of_basis) {
57     pcbddc->use_change_on_faces = PETSC_FALSE;
58   }
59   ierr = PetscOptionsInt("-pc_bddc_coarsening_ratio","Set coarsening ratio used in multilevel coarsening","none",pcbddc->coarsening_ratio,&pcbddc->coarsening_ratio,NULL);CHKERRQ(ierr);
60   ierr = PetscOptionsInt("-pc_bddc_max_levels","Set maximum number of levels for multilevel","none",pcbddc->max_levels,&pcbddc->max_levels,NULL);CHKERRQ(ierr);
61   ierr = PetscOptionsBool("-pc_bddc_use_deluxe_scaling","Use deluxe scaling for BDDC","none",pcbddc->use_deluxe_scaling,&pcbddc->use_deluxe_scaling,NULL);CHKERRQ(ierr);
62   ierr = PetscOptionsTail();CHKERRQ(ierr);
63   PetscFunctionReturn(0);
64 }
65 /* -------------------------------------------------------------------------- */
66 #undef __FUNCT__
67 #define __FUNCT__ "PCBDDCSetPrimalVerticesLocalIS_BDDC"
68 static PetscErrorCode PCBDDCSetPrimalVerticesLocalIS_BDDC(PC pc, IS PrimalVertices)
69 {
70   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
71   PetscErrorCode ierr;
72 
73   PetscFunctionBegin;
74   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
75   ierr = PetscObjectReference((PetscObject)PrimalVertices);CHKERRQ(ierr);
76   pcbddc->user_primal_vertices = PrimalVertices;
77   PetscFunctionReturn(0);
78 }
79 #undef __FUNCT__
80 #define __FUNCT__ "PCBDDCSetPrimalVerticesLocalIS"
81 /*@
82  PCBDDCSetPrimalVerticesLocalIS - Set user defined primal vertices in PCBDDC.
83 
84    Not collective
85 
86    Input Parameters:
87 +  pc - the preconditioning context
88 -  PrimalVertices - index sets of primal vertices in local numbering
89 
90    Level: intermediate
91 
92    Notes:
93 
94 .seealso: PCBDDC
95 @*/
96 PetscErrorCode PCBDDCSetPrimalVerticesLocalIS(PC pc, IS PrimalVertices)
97 {
98   PetscErrorCode ierr;
99 
100   PetscFunctionBegin;
101   PetscValidHeaderSpecific(pc,PC_CLASSID,1);
102   PetscValidHeaderSpecific(PrimalVertices,IS_CLASSID,2);
103   ierr = PetscTryMethod(pc,"PCBDDCSetPrimalVerticesLocalIS_C",(PC,IS),(pc,PrimalVertices));CHKERRQ(ierr);
104   PetscFunctionReturn(0);
105 }
106 /* -------------------------------------------------------------------------- */
107 #undef __FUNCT__
108 #define __FUNCT__ "PCBDDCSetCoarseProblemType_BDDC"
109 static PetscErrorCode PCBDDCSetCoarseProblemType_BDDC(PC pc, CoarseProblemType CPT)
110 {
111   PC_BDDC  *pcbddc = (PC_BDDC*)pc->data;
112 
113   PetscFunctionBegin;
114   pcbddc->coarse_problem_type = CPT;
115   PetscFunctionReturn(0);
116 }
117 
118 #undef __FUNCT__
119 #define __FUNCT__ "PCBDDCSetCoarseProblemType"
120 /*@
121  PCBDDCSetCoarseProblemType - Set coarse problem type in PCBDDC.
122 
123    Not collective
124 
125    Input Parameters:
126 +  pc - the preconditioning context
127 -  CoarseProblemType - pick a better name and explain what this is
128 
129    Level: intermediate
130 
131    Notes:
132    Not collective but all procs must call with same arguments.
133 
134 .seealso: PCBDDC
135 @*/
136 PetscErrorCode PCBDDCSetCoarseProblemType(PC pc, CoarseProblemType CPT)
137 {
138   PetscErrorCode ierr;
139 
140   PetscFunctionBegin;
141   PetscValidHeaderSpecific(pc,PC_CLASSID,1);
142   ierr = PetscTryMethod(pc,"PCBDDCSetCoarseProblemType_C",(PC,CoarseProblemType),(pc,CPT));CHKERRQ(ierr);
143   PetscFunctionReturn(0);
144 }
145 /* -------------------------------------------------------------------------- */
146 #undef __FUNCT__
147 #define __FUNCT__ "PCBDDCSetCoarseningRatio_BDDC"
148 static PetscErrorCode PCBDDCSetCoarseningRatio_BDDC(PC pc,PetscInt k)
149 {
150   PC_BDDC  *pcbddc = (PC_BDDC*)pc->data;
151 
152   PetscFunctionBegin;
153   pcbddc->coarsening_ratio=k;
154   PetscFunctionReturn(0);
155 }
156 
157 #undef __FUNCT__
158 #define __FUNCT__ "PCBDDCSetCoarseningRatio"
159 /*@
160  PCBDDCSetCoarseningRatio - Set coarsening ratio used in multilevel coarsening
161 
162    Logically collective on PC
163 
164    Input Parameters:
165 +  pc - the preconditioning context
166 -  k - coarsening ratio
167 
168    Approximatively k subdomains at the finer level will be aggregated into a single subdomain at the coarser level.
169 
170    Level: intermediate
171 
172    Notes:
173 
174 .seealso: PCBDDC
175 @*/
176 PetscErrorCode PCBDDCSetCoarseningRatio(PC pc,PetscInt k)
177 {
178   PetscErrorCode ierr;
179 
180   PetscFunctionBegin;
181   PetscValidHeaderSpecific(pc,PC_CLASSID,1);
182   ierr = PetscTryMethod(pc,"PCBDDCSetCoarseningRatio_C",(PC,PetscInt),(pc,k));CHKERRQ(ierr);
183   PetscFunctionReturn(0);
184 }
185 /* -------------------------------------------------------------------------- */
186 
187 #undef __FUNCT__
188 #define __FUNCT__ "PCBDDCSetMaxLevels_BDDC"
189 static PetscErrorCode PCBDDCSetMaxLevels_BDDC(PC pc,PetscInt max_levels)
190 {
191   PC_BDDC  *pcbddc = (PC_BDDC*)pc->data;
192 
193   PetscFunctionBegin;
194   pcbddc->max_levels=max_levels;
195   PetscFunctionReturn(0);
196 }
197 
198 #undef __FUNCT__
199 #define __FUNCT__ "PCBDDCSetMaxLevels"
200 /*@
201  PCBDDCSetMaxLevels - Sets the maximum number of levels within the multilevel approach.
202 
203    Logically collective on PC
204 
205    Input Parameters:
206 +  pc - the preconditioning context
207 -  max_levels - the maximum number of levels
208 
209    Default value is 1, i.e. coarse problem will be solved inexactly with one application
210    of PCBDDC preconditioner if the multilevel approach is requested.
211 
212    Level: intermediate
213 
214    Notes:
215 
216 .seealso: PCBDDC
217 @*/
218 PetscErrorCode PCBDDCSetMaxLevels(PC pc,PetscInt max_levels)
219 {
220   PetscErrorCode ierr;
221 
222   PetscFunctionBegin;
223   PetscValidHeaderSpecific(pc,PC_CLASSID,1);
224   ierr = PetscTryMethod(pc,"PCBDDCSetMaxLevels_C",(PC,PetscInt),(pc,max_levels));CHKERRQ(ierr);
225   PetscFunctionReturn(0);
226 }
227 /* -------------------------------------------------------------------------- */
228 
229 #undef __FUNCT__
230 #define __FUNCT__ "PCBDDCSetNullSpace_BDDC"
231 static PetscErrorCode PCBDDCSetNullSpace_BDDC(PC pc,MatNullSpace NullSpace)
232 {
233   PC_BDDC  *pcbddc = (PC_BDDC*)pc->data;
234   PetscErrorCode ierr;
235 
236   PetscFunctionBegin;
237   ierr = PetscObjectReference((PetscObject)NullSpace);CHKERRQ(ierr);
238   ierr = MatNullSpaceDestroy(&pcbddc->NullSpace);CHKERRQ(ierr);
239   pcbddc->NullSpace=NullSpace;
240   PetscFunctionReturn(0);
241 }
242 
243 #undef __FUNCT__
244 #define __FUNCT__ "PCBDDCSetNullSpace"
245 /*@
246  PCBDDCSetNullSpace - Set NullSpace of global operator of BDDC preconditioned mat.
247 
248    Logically collective on PC and MatNullSpace
249 
250    Input Parameters:
251 +  pc - the preconditioning context
252 -  NullSpace - Null space of the linear operator to be preconditioned.
253 
254    Level: intermediate
255 
256    Notes:
257 
258 .seealso: PCBDDC
259 @*/
260 PetscErrorCode PCBDDCSetNullSpace(PC pc,MatNullSpace NullSpace)
261 {
262   PetscErrorCode ierr;
263 
264   PetscFunctionBegin;
265   PetscValidHeaderSpecific(pc,PC_CLASSID,1);
266   PetscValidHeaderSpecific(NullSpace,MAT_NULLSPACE_CLASSID,2);
267   ierr = PetscTryMethod(pc,"PCBDDCSetNullSpace_C",(PC,MatNullSpace),(pc,NullSpace));CHKERRQ(ierr);
268   PetscFunctionReturn(0);
269 }
270 /* -------------------------------------------------------------------------- */
271 
272 #undef __FUNCT__
273 #define __FUNCT__ "PCBDDCSetDirichletBoundaries_BDDC"
274 static PetscErrorCode PCBDDCSetDirichletBoundaries_BDDC(PC pc,IS DirichletBoundaries)
275 {
276   PC_BDDC  *pcbddc = (PC_BDDC*)pc->data;
277   PetscErrorCode ierr;
278 
279   PetscFunctionBegin;
280   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
281   ierr = PetscObjectReference((PetscObject)DirichletBoundaries);CHKERRQ(ierr);
282   pcbddc->DirichletBoundaries=DirichletBoundaries;
283   PetscFunctionReturn(0);
284 }
285 
286 #undef __FUNCT__
287 #define __FUNCT__ "PCBDDCSetDirichletBoundaries"
288 /*@
289  PCBDDCSetDirichletBoundaries - Set index set defining subdomain part (in local ordering)
290                               of Dirichlet boundaries for the global problem.
291 
292    Not collective
293 
294    Input Parameters:
295 +  pc - the preconditioning context
296 -  DirichletBoundaries - sequential index set defining the subdomain part of Dirichlet boundaries (can be NULL)
297 
298    Level: intermediate
299 
300    Notes:
301 
302 .seealso: PCBDDC
303 @*/
304 PetscErrorCode PCBDDCSetDirichletBoundaries(PC pc,IS DirichletBoundaries)
305 {
306   PetscErrorCode ierr;
307 
308   PetscFunctionBegin;
309   PetscValidHeaderSpecific(pc,PC_CLASSID,1);
310   PetscValidHeaderSpecific(DirichletBoundaries,IS_CLASSID,2);
311   ierr = PetscTryMethod(pc,"PCBDDCSetDirichletBoundaries_C",(PC,IS),(pc,DirichletBoundaries));CHKERRQ(ierr);
312   PetscFunctionReturn(0);
313 }
314 /* -------------------------------------------------------------------------- */
315 
316 #undef __FUNCT__
317 #define __FUNCT__ "PCBDDCSetNeumannBoundaries_BDDC"
318 static PetscErrorCode PCBDDCSetNeumannBoundaries_BDDC(PC pc,IS NeumannBoundaries)
319 {
320   PC_BDDC  *pcbddc = (PC_BDDC*)pc->data;
321   PetscErrorCode ierr;
322 
323   PetscFunctionBegin;
324   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
325   ierr = PetscObjectReference((PetscObject)NeumannBoundaries);CHKERRQ(ierr);
326   pcbddc->NeumannBoundaries=NeumannBoundaries;
327   PetscFunctionReturn(0);
328 }
329 
330 #undef __FUNCT__
331 #define __FUNCT__ "PCBDDCSetNeumannBoundaries"
332 /*@
333  PCBDDCSetNeumannBoundaries - Set index set defining subdomain part (in local ordering)
334                               of Neumann boundaries for the global problem.
335 
336    Not collective
337 
338    Input Parameters:
339 +  pc - the preconditioning context
340 -  NeumannBoundaries - sequential index set defining the subdomain part of Neumann boundaries (can be NULL)
341 
342    Level: intermediate
343 
344    Notes:
345 
346 .seealso: PCBDDC
347 @*/
348 PetscErrorCode PCBDDCSetNeumannBoundaries(PC pc,IS NeumannBoundaries)
349 {
350   PetscErrorCode ierr;
351 
352   PetscFunctionBegin;
353   PetscValidHeaderSpecific(pc,PC_CLASSID,1);
354   PetscValidHeaderSpecific(NeumannBoundaries,IS_CLASSID,2);
355   ierr = PetscTryMethod(pc,"PCBDDCSetNeumannBoundaries_C",(PC,IS),(pc,NeumannBoundaries));CHKERRQ(ierr);
356   PetscFunctionReturn(0);
357 }
358 /* -------------------------------------------------------------------------- */
359 
360 #undef __FUNCT__
361 #define __FUNCT__ "PCBDDCGetDirichletBoundaries_BDDC"
362 static PetscErrorCode PCBDDCGetDirichletBoundaries_BDDC(PC pc,IS *DirichletBoundaries)
363 {
364   PC_BDDC  *pcbddc = (PC_BDDC*)pc->data;
365 
366   PetscFunctionBegin;
367   *DirichletBoundaries = pcbddc->DirichletBoundaries;
368   PetscFunctionReturn(0);
369 }
370 
371 #undef __FUNCT__
372 #define __FUNCT__ "PCBDDCGetDirichletBoundaries"
373 /*@
374  PCBDDCGetDirichletBoundaries - Get index set defining subdomain part (in local ordering)
375                                 of Dirichlet boundaries for the global problem.
376 
377    Not collective
378 
379    Input Parameters:
380 +  pc - the preconditioning context
381 
382    Output Parameters:
383 +  DirichletBoundaries - index set defining the subdomain part of Dirichlet boundaries
384 
385    Level: intermediate
386 
387    Notes:
388 
389 .seealso: PCBDDC
390 @*/
391 PetscErrorCode PCBDDCGetDirichletBoundaries(PC pc,IS *DirichletBoundaries)
392 {
393   PetscErrorCode ierr;
394 
395   PetscFunctionBegin;
396   PetscValidHeaderSpecific(pc,PC_CLASSID,1);
397   ierr = PetscUseMethod(pc,"PCBDDCGetDirichletBoundaries_C",(PC,IS*),(pc,DirichletBoundaries));CHKERRQ(ierr);
398   PetscFunctionReturn(0);
399 }
400 /* -------------------------------------------------------------------------- */
401 
402 #undef __FUNCT__
403 #define __FUNCT__ "PCBDDCGetNeumannBoundaries_BDDC"
404 static PetscErrorCode PCBDDCGetNeumannBoundaries_BDDC(PC pc,IS *NeumannBoundaries)
405 {
406   PC_BDDC  *pcbddc = (PC_BDDC*)pc->data;
407 
408   PetscFunctionBegin;
409   *NeumannBoundaries = pcbddc->NeumannBoundaries;
410   PetscFunctionReturn(0);
411 }
412 
413 #undef __FUNCT__
414 #define __FUNCT__ "PCBDDCGetNeumannBoundaries"
415 /*@
416  PCBDDCGetNeumannBoundaries - Get index set defining subdomain part (in local ordering)
417                               of Neumann boundaries for the global problem.
418 
419    Not collective
420 
421    Input Parameters:
422 +  pc - the preconditioning context
423 
424    Output Parameters:
425 +  NeumannBoundaries - index set defining the subdomain part of Neumann boundaries
426 
427    Level: intermediate
428 
429    Notes:
430 
431 .seealso: PCBDDC
432 @*/
433 PetscErrorCode PCBDDCGetNeumannBoundaries(PC pc,IS *NeumannBoundaries)
434 {
435   PetscErrorCode ierr;
436 
437   PetscFunctionBegin;
438   PetscValidHeaderSpecific(pc,PC_CLASSID,1);
439   ierr = PetscUseMethod(pc,"PCBDDCGetNeumannBoundaries_C",(PC,IS*),(pc,NeumannBoundaries));CHKERRQ(ierr);
440   PetscFunctionReturn(0);
441 }
442 /* -------------------------------------------------------------------------- */
443 
444 #undef __FUNCT__
445 #define __FUNCT__ "PCBDDCSetLocalAdjacencyGraph_BDDC"
446 static PetscErrorCode PCBDDCSetLocalAdjacencyGraph_BDDC(PC pc, PetscInt nvtxs,const PetscInt xadj[],const PetscInt adjncy[], PetscCopyMode copymode)
447 {
448   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
449   PCBDDCGraph    mat_graph = pcbddc->mat_graph;
450   PetscErrorCode ierr;
451 
452   PetscFunctionBegin;
453   /* free old CSR */
454   ierr = PCBDDCGraphResetCSR(mat_graph);CHKERRQ(ierr);
455   /* get CSR into graph structure */
456   if (copymode == PETSC_COPY_VALUES) {
457     ierr = PetscMalloc((nvtxs+1)*sizeof(PetscInt),&mat_graph->xadj);CHKERRQ(ierr);
458     ierr = PetscMalloc(xadj[nvtxs]*sizeof(PetscInt),&mat_graph->adjncy);CHKERRQ(ierr);
459     ierr = PetscMemcpy(mat_graph->xadj,xadj,(nvtxs+1)*sizeof(PetscInt));CHKERRQ(ierr);
460     ierr = PetscMemcpy(mat_graph->adjncy,adjncy,xadj[nvtxs]*sizeof(PetscInt));CHKERRQ(ierr);
461   } else if (copymode == PETSC_OWN_POINTER) {
462     mat_graph->xadj = (PetscInt*)xadj;
463     mat_graph->adjncy = (PetscInt*)adjncy;
464   }
465   PetscFunctionReturn(0);
466 }
467 
468 #undef __FUNCT__
469 #define __FUNCT__ "PCBDDCSetLocalAdjacencyGraph"
470 /*@
471  PCBDDCSetLocalAdjacencyGraph - Set CSR graph of local matrix for use of PCBDDC.
472 
473    Not collective
474 
475    Input Parameters:
476 +  pc - the preconditioning context
477 -  nvtxs - number of local vertices of the graph
478 -  xadj, adjncy - the CSR graph
479 -  copymode - either PETSC_COPY_VALUES or PETSC_OWN_POINTER. In the former case the user must free the array passed in;
480                                                              in the latter case, memory must be obtained with PetscMalloc.
481 
482    Level: intermediate
483 
484    Notes:
485 
486 .seealso: PCBDDC
487 @*/
488 PetscErrorCode PCBDDCSetLocalAdjacencyGraph(PC pc,PetscInt nvtxs,const PetscInt xadj[],const PetscInt adjncy[], PetscCopyMode copymode)
489 {
490   PetscInt       nrows,ncols;
491   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
492   PetscErrorCode ierr;
493 
494   PetscFunctionBegin;
495   PetscValidHeaderSpecific(pc,PC_CLASSID,1);
496   PetscValidIntPointer(xadj,3);
497   PetscValidIntPointer(xadj,4);
498   if (copymode != PETSC_COPY_VALUES && copymode != PETSC_OWN_POINTER) {
499     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unsupported copy mode %d in %s\n",copymode,__FUNCT__);
500   }
501   /* pcis info could not be available at this point */
502   ierr = MatGetSize(matis->A,&nrows,&ncols);CHKERRQ(ierr);
503   if (nvtxs != nrows) 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);
504   ierr = PetscTryMethod(pc,"PCBDDCSetLocalAdjacencyGraph_C",(PC,PetscInt,const PetscInt[],const PetscInt[],PetscCopyMode),(pc,nvtxs,xadj,adjncy,copymode));CHKERRQ(ierr);
505   PetscFunctionReturn(0);
506 }
507 /* -------------------------------------------------------------------------- */
508 
509 #undef __FUNCT__
510 #define __FUNCT__ "PCBDDCSetDofsSplitting_BDDC"
511 static PetscErrorCode PCBDDCSetDofsSplitting_BDDC(PC pc,PetscInt n_is, IS ISForDofs[])
512 {
513   PC_BDDC  *pcbddc = (PC_BDDC*)pc->data;
514   PetscInt i;
515   PetscErrorCode ierr;
516 
517   PetscFunctionBegin;
518   /* Destroy ISes if they were already set */
519   for (i=0;i<pcbddc->n_ISForDofs;i++) {
520     ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
521   }
522   ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
523   /* allocate space then set */
524   ierr = PetscMalloc(n_is*sizeof(IS),&pcbddc->ISForDofs);CHKERRQ(ierr);
525   for (i=0;i<n_is;i++) {
526     ierr = PetscObjectReference((PetscObject)ISForDofs[i]);CHKERRQ(ierr);
527     pcbddc->ISForDofs[i]=ISForDofs[i];
528   }
529   pcbddc->n_ISForDofs=n_is;
530   PetscFunctionReturn(0);
531 }
532 
533 #undef __FUNCT__
534 #define __FUNCT__ "PCBDDCSetDofsSplitting"
535 /*@
536  PCBDDCSetDofsSplitting - Set index sets defining fields of local mat.
537 
538    Not collective
539 
540    Input Parameters:
541 +  pc - the preconditioning context
542 -  n - number of index sets defining the fields
543 -  IS[] - array of IS describing the fields
544 
545    Level: intermediate
546 
547    Notes:
548 
549 .seealso: PCBDDC
550 @*/
551 PetscErrorCode PCBDDCSetDofsSplitting(PC pc,PetscInt n_is, IS ISForDofs[])
552 {
553   PetscErrorCode ierr;
554 
555   PetscFunctionBegin;
556   PetscValidHeaderSpecific(pc,PC_CLASSID,1);
557   ierr = PetscTryMethod(pc,"PCBDDCSetDofsSplitting_C",(PC,PetscInt,IS[]),(pc,n_is,ISForDofs));CHKERRQ(ierr);
558   PetscFunctionReturn(0);
559 }
560 /* -------------------------------------------------------------------------- */
561 #undef __FUNCT__
562 #define __FUNCT__ "PCPreSolve_BDDC"
563 /* -------------------------------------------------------------------------- */
564 /*
565    PCPreSolve_BDDC - Changes the right hand side and (if necessary) the initial
566                      guess if a transformation of basis approach has been selected.
567 
568    Input Parameter:
569 +  pc - the preconditioner contex
570 
571    Application Interface Routine: PCPreSolve()
572 
573    Notes:
574    The interface routine PCPreSolve() is not usually called directly by
575    the user, but instead is called by KSPSolve().
576 */
577 static PetscErrorCode PCPreSolve_BDDC(PC pc, KSP ksp, Vec rhs, Vec x)
578 {
579   PetscErrorCode ierr;
580   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
581   PC_IS          *pcis = (PC_IS*)(pc->data);
582   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
583   Mat            temp_mat;
584   IS             dirIS;
585   PetscInt       dirsize,i,*is_indices;
586   PetscScalar    *array_x,*array_diagonal;
587   Vec            used_vec;
588   PetscBool      guess_nonzero;
589 
590   PetscFunctionBegin;
591   if (x) {
592     ierr = PetscObjectReference((PetscObject)x);CHKERRQ(ierr);
593     used_vec = x;
594   } else {
595     ierr = PetscObjectReference((PetscObject)pcbddc->temp_solution);CHKERRQ(ierr);
596     used_vec = pcbddc->temp_solution;
597     ierr = VecSet(used_vec,0.0);CHKERRQ(ierr);
598   }
599   /* hack into ksp data structure PCPreSolve comes earlier in src/ksp/ksp/interface/itfunc.c */
600   if (ksp) {
601     ierr = KSPGetInitialGuessNonzero(ksp,&guess_nonzero);CHKERRQ(ierr);
602     if ( !guess_nonzero ) {
603       ierr = VecSet(used_vec,0.0);CHKERRQ(ierr);
604     }
605   }
606   /* store the original rhs */
607   ierr = VecCopy(rhs,pcbddc->original_rhs);CHKERRQ(ierr);
608 
609   /* Take into account zeroed rows -> change rhs and store solution removed */
610   ierr = MatGetDiagonal(pc->pmat,pcis->vec1_global);CHKERRQ(ierr);
611   ierr = VecPointwiseDivide(pcis->vec1_global,rhs,pcis->vec1_global);CHKERRQ(ierr);
612   ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
613   ierr = VecScatterEnd(matis->ctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
614   ierr = VecScatterBegin(matis->ctx,used_vec,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
615   ierr = VecScatterEnd(matis->ctx,used_vec,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
616   ierr = PCBDDCGetDirichletBoundaries(pc,&dirIS);CHKERRQ(ierr);
617   if (dirIS) {
618     ierr = ISGetSize(dirIS,&dirsize);CHKERRQ(ierr);
619     ierr = VecGetArray(pcis->vec1_N,&array_x);CHKERRQ(ierr);
620     ierr = VecGetArray(pcis->vec2_N,&array_diagonal);CHKERRQ(ierr);
621     ierr = ISGetIndices(dirIS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
622     for (i=0; i<dirsize; i++) array_x[is_indices[i]] = array_diagonal[is_indices[i]];
623     ierr = ISRestoreIndices(dirIS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
624     ierr = VecRestoreArray(pcis->vec2_N,&array_diagonal);CHKERRQ(ierr);
625     ierr = VecRestoreArray(pcis->vec1_N,&array_x);CHKERRQ(ierr);
626   }
627   ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,used_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
628   ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,used_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
629 
630   /* remove the computed solution from the rhs */
631   ierr = VecScale(used_vec,-1.0);CHKERRQ(ierr);
632   ierr = MatMultAdd(pc->pmat,used_vec,rhs,rhs);CHKERRQ(ierr);
633   ierr = VecScale(used_vec,-1.0);CHKERRQ(ierr);
634 
635   /* store partially computed solution and set initial guess */
636   if (x) {
637     ierr = VecCopy(used_vec,pcbddc->temp_solution);CHKERRQ(ierr);
638     ierr = VecSet(used_vec,0.0);CHKERRQ(ierr);
639     if (pcbddc->use_exact_dirichlet) {
640       ierr = VecScatterBegin(pcis->global_to_D,rhs,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
641       ierr = VecScatterEnd  (pcis->global_to_D,rhs,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
642       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
643       ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,used_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
644       ierr = VecScatterEnd  (pcis->global_to_D,pcis->vec2_D,used_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
645       if (ksp) {
646         ierr = KSPSetInitialGuessNonzero(ksp,PETSC_TRUE);CHKERRQ(ierr);
647       }
648     }
649   }
650 
651   /* rhs change of basis */
652   if (pcbddc->use_change_of_basis) {
653     /* swap pointers for local matrices */
654     temp_mat = matis->A;
655     matis->A = pcbddc->local_mat;
656     pcbddc->local_mat = temp_mat;
657     /* Get local rhs and apply transformation of basis */
658     ierr = VecScatterBegin(pcis->global_to_B,rhs,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
659     ierr = VecScatterEnd  (pcis->global_to_B,rhs,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
660     /* from original basis to modified basis */
661     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
662     /* put back modified values into the global vec using INSERT_VALUES copy mode */
663     ierr = VecScatterBegin(pcis->global_to_B,pcis->vec2_B,rhs,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
664     ierr = VecScatterEnd  (pcis->global_to_B,pcis->vec2_B,rhs,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
665   }
666   if (ksp && pcbddc->NullSpace) {
667     ierr = MatNullSpaceRemove(pcbddc->NullSpace,used_vec,NULL);CHKERRQ(ierr);
668     ierr = MatNullSpaceRemove(pcbddc->NullSpace,rhs,NULL);CHKERRQ(ierr);
669   }
670   ierr = VecDestroy(&used_vec);CHKERRQ(ierr);
671   PetscFunctionReturn(0);
672 }
673 /* -------------------------------------------------------------------------- */
674 #undef __FUNCT__
675 #define __FUNCT__ "PCPostSolve_BDDC"
676 /* -------------------------------------------------------------------------- */
677 /*
678    PCPostSolve_BDDC - Changes the computed solution if a transformation of basis
679                      approach has been selected. Also, restores rhs to its original state.
680 
681    Input Parameter:
682 +  pc - the preconditioner contex
683 
684    Application Interface Routine: PCPostSolve()
685 
686    Notes:
687    The interface routine PCPostSolve() is not usually called directly by
688    the user, but instead is called by KSPSolve().
689 */
690 static PetscErrorCode PCPostSolve_BDDC(PC pc, KSP ksp, Vec rhs, Vec x)
691 {
692   PetscErrorCode ierr;
693   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
694   PC_IS          *pcis   = (PC_IS*)(pc->data);
695   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
696   Mat            temp_mat;
697 
698   PetscFunctionBegin;
699   if (pcbddc->use_change_of_basis) {
700     /* swap pointers for local matrices */
701     temp_mat = matis->A;
702     matis->A = pcbddc->local_mat;
703     pcbddc->local_mat = temp_mat;
704     /* restore rhs to its original state */
705     if (rhs) {
706       ierr = VecCopy(pcbddc->original_rhs,rhs);CHKERRQ(ierr);
707     }
708     /* Get Local boundary and apply transformation of basis to solution vector */
709     ierr = VecScatterBegin(pcis->global_to_B,x,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
710     ierr = VecScatterEnd  (pcis->global_to_B,x,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
711     /* from modified basis to original basis */
712     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
713     /* put back modified values into the global vec using INSERT_VALUES copy mode */
714     ierr = VecScatterBegin(pcis->global_to_B,pcis->vec2_B,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
715     ierr = VecScatterEnd  (pcis->global_to_B,pcis->vec2_B,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
716   }
717   /* add solution removed in presolve */
718   if (x) {
719     ierr = VecAXPY(x,1.0,pcbddc->temp_solution);CHKERRQ(ierr);
720   }
721   PetscFunctionReturn(0);
722 }
723 /* -------------------------------------------------------------------------- */
724 #undef __FUNCT__
725 #define __FUNCT__ "PCSetUp_BDDC"
726 /* -------------------------------------------------------------------------- */
727 /*
728    PCSetUp_BDDC - Prepares for the use of the BDDC preconditioner
729                   by setting data structures and options.
730 
731    Input Parameter:
732 +  pc - the preconditioner context
733 
734    Application Interface Routine: PCSetUp()
735 
736    Notes:
737    The interface routine PCSetUp() is not usually called directly by
738    the user, but instead is called by PCApply() if necessary.
739 */
740 PetscErrorCode PCSetUp_BDDC(PC pc)
741 {
742   PetscErrorCode ierr;
743   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
744   MatStructure   flag;
745   PetscBool      computeis,computetopography,computesolvers;
746 
747   PetscFunctionBegin;
748   /* the following lines of code should be replaced by a better logic between PCIS, PCNN, PCBDDC and other nonoverlapping preconditioners */
749   /* For BDDC we need to define a local "Neumann" problem different to that defined in PCISSetup
750      So, we set to pcnone the Neumann problem of pcis in order to avoid unneeded computation
751      Also, we decide to directly build the (same) Dirichlet problem */
752   ierr = PetscOptionsSetValue("-is_localN_pc_type","none");CHKERRQ(ierr);
753   ierr = PetscOptionsSetValue("-is_localD_pc_type","none");CHKERRQ(ierr);
754   /* Get stdout for dbg */
755   if (pcbddc->dbg_flag && !pcbddc->dbg_viewer) {
756     ierr = PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject)pc),&pcbddc->dbg_viewer);CHKERRQ(ierr);
757     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
758   }
759   /* first attempt to split work */
760   if (pc->setupcalled) {
761     computeis = PETSC_FALSE;
762     ierr = PCGetOperators(pc,NULL,NULL,&flag);CHKERRQ(ierr);
763     if (flag == SAME_PRECONDITIONER) {
764       computetopography = PETSC_FALSE;
765       computesolvers = PETSC_FALSE;
766     } else if (flag == SAME_NONZERO_PATTERN) {
767       computetopography = PETSC_FALSE;
768       computesolvers = PETSC_TRUE;
769     } else { /* DIFFERENT_NONZERO_PATTERN */
770       computetopography = PETSC_TRUE;
771       computesolvers = PETSC_TRUE;
772     }
773   } else {
774     computeis = PETSC_TRUE;
775     computetopography = PETSC_TRUE;
776     computesolvers = PETSC_TRUE;
777   }
778   /* Set up all the "iterative substructuring" common block */
779   if (computeis) {
780     ierr = PCISSetUp(pc);CHKERRQ(ierr);
781   }
782   /* Analyze interface and set up local constraint and change of basis matrices */
783   if (computetopography) {
784     /* reset data */
785     ierr = PCBDDCResetTopography(pc);CHKERRQ(ierr);
786     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
787     ierr = PCBDDCConstraintsSetUp(pc);CHKERRQ(ierr);
788   }
789   if (computesolvers) {
790     /* reset data */
791     ierr = PCBDDCResetSolvers(pc);CHKERRQ(ierr);
792     ierr = PCBDDCScalingDestroy(pc);CHKERRQ(ierr);
793     /* Create coarse and local stuffs used for evaluating action of preconditioner */
794     ierr = PCBDDCCoarseSetUp(pc);CHKERRQ(ierr);
795     ierr = PCBDDCScalingSetUp(pc);CHKERRQ(ierr);
796   }
797   PetscFunctionReturn(0);
798 }
799 
800 /* -------------------------------------------------------------------------- */
801 /*
802    PCApply_BDDC - Applies the BDDC preconditioner to a vector.
803 
804    Input Parameters:
805 .  pc - the preconditioner context
806 .  r - input vector (global)
807 
808    Output Parameter:
809 .  z - output vector (global)
810 
811    Application Interface Routine: PCApply()
812  */
813 #undef __FUNCT__
814 #define __FUNCT__ "PCApply_BDDC"
815 PetscErrorCode PCApply_BDDC(PC pc,Vec r,Vec z)
816 {
817   PC_IS             *pcis = (PC_IS*)(pc->data);
818   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
819   PetscErrorCode    ierr;
820   const PetscScalar one = 1.0;
821   const PetscScalar m_one = -1.0;
822   const PetscScalar zero = 0.0;
823 
824 /* This code is similar to that provided in nn.c for PCNN
825    NN interface preconditioner changed to BDDC
826    Added support for M_3 preconditioner in the reference article (code is active if pcbddc->inexact_prec_type = PETSC_TRUE) */
827 
828   PetscFunctionBegin;
829   if (!pcbddc->use_exact_dirichlet) {
830     /* First Dirichlet solve */
831     ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
832     ierr = VecScatterEnd  (pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
833     ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
834     /*
835       Assembling right hand side for BDDC operator
836       - pcis->vec1_D for the Dirichlet part (if needed, i.e. prec_flag=PETSC_TRUE)
837       - pcis->vec1_B the interface part of the global vector z
838     */
839     ierr = VecScale(pcis->vec2_D,m_one);CHKERRQ(ierr);
840     ierr = MatMult(pcis->A_BI,pcis->vec2_D,pcis->vec1_B);CHKERRQ(ierr);
841     if (pcbddc->inexact_prec_type) { ierr = MatMultAdd(pcis->A_II,pcis->vec2_D,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
842     ierr = VecScale(pcis->vec2_D,m_one);CHKERRQ(ierr);
843     ierr = VecCopy(r,z);CHKERRQ(ierr);
844     ierr = VecScatterBegin(pcis->global_to_B,pcis->vec1_B,z,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
845     ierr = VecScatterEnd  (pcis->global_to_B,pcis->vec1_B,z,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
846     ierr = PCBDDCScalingRestriction(pc,z,pcis->vec1_B);CHKERRQ(ierr);
847   } else {
848     ierr = VecSet(pcis->vec1_D,zero);CHKERRQ(ierr);
849     ierr = VecSet(pcis->vec2_D,zero);CHKERRQ(ierr);
850     ierr = PCBDDCScalingRestriction(pc,r,pcis->vec1_B);CHKERRQ(ierr);
851   }
852 
853   /* Apply interface preconditioner
854      input/output vecs: pcis->vec1_B and pcis->vec1_D */
855   ierr = PCBDDCApplyInterfacePreconditioner(pc);CHKERRQ(ierr);
856 
857   /* Apply transpose of partition of unity operator */
858   ierr = PCBDDCScalingExtension(pc,pcis->vec1_B,z);CHKERRQ(ierr);
859 
860   /* Second Dirichlet solve and assembling of output */
861   ierr = VecScatterBegin(pcis->global_to_B,z,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
862   ierr = VecScatterEnd  (pcis->global_to_B,z,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
863   ierr = MatMult(pcis->A_IB,pcis->vec1_B,pcis->vec3_D);CHKERRQ(ierr);
864   if (pcbddc->inexact_prec_type) { ierr = MatMultAdd(pcis->A_II,pcis->vec1_D,pcis->vec3_D,pcis->vec3_D);CHKERRQ(ierr); }
865   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec3_D,pcbddc->vec4_D);CHKERRQ(ierr);
866   ierr = VecScale(pcbddc->vec4_D,m_one);CHKERRQ(ierr);
867   if (pcbddc->inexact_prec_type) { ierr = VecAXPY (pcbddc->vec4_D,one,pcis->vec1_D);CHKERRQ(ierr); }
868   ierr = VecAXPY (pcis->vec2_D,one,pcbddc->vec4_D);CHKERRQ(ierr);
869   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
870   ierr = VecScatterEnd  (pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
871   PetscFunctionReturn(0);
872 }
873 /* -------------------------------------------------------------------------- */
874 
875 #undef __FUNCT__
876 #define __FUNCT__ "PCDestroy_BDDC"
877 PetscErrorCode PCDestroy_BDDC(PC pc)
878 {
879   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
880   PetscErrorCode ierr;
881 
882   PetscFunctionBegin;
883   /* free data created by PCIS */
884   ierr = PCISDestroy(pc);CHKERRQ(ierr);
885   /* free BDDC custom data  */
886   ierr = PCBDDCResetCustomization(pc);CHKERRQ(ierr);
887   /* destroy objects related to topography */
888   ierr = PCBDDCResetTopography(pc);CHKERRQ(ierr);
889   /* free allocated graph structure */
890   ierr = PetscFree(pcbddc->mat_graph);CHKERRQ(ierr);
891   /* free data for scaling operator */
892   ierr = PCBDDCScalingDestroy(pc);CHKERRQ(ierr);
893   /* free solvers stuff */
894   ierr = PCBDDCResetSolvers(pc);CHKERRQ(ierr);
895   /* remove functions */
896   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCSetPrimalVerticesLocalIS_C",NULL);CHKERRQ(ierr);
897   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCSetCoarseningRatio_C",NULL);CHKERRQ(ierr);
898   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCSetMaxLevels_C",NULL);CHKERRQ(ierr);
899   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCSetNullSpace_C",NULL);CHKERRQ(ierr);
900   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCSetDirichletBoundaries_C",NULL);CHKERRQ(ierr);
901   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCSetNeumannBoundaries_C",NULL);CHKERRQ(ierr);
902   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCGetDirichletBoundaries_C",NULL);CHKERRQ(ierr);
903   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCGetNeumannBoundaries_C",NULL);CHKERRQ(ierr);
904   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCSetCoarseProblemType_C",NULL);CHKERRQ(ierr);
905   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCSetDofsSplitting_C",NULL);CHKERRQ(ierr);
906   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCSetLocalAdjacencyGraph_C",NULL);CHKERRQ(ierr);
907   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCCreateFETIDPOperators_C",NULL);CHKERRQ(ierr);
908   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCMatFETIDPGetRHS_C",NULL);CHKERRQ(ierr);
909   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCMatFETIDPGetSolution_C",NULL);CHKERRQ(ierr);
910   /* Free the private data structure */
911   ierr = PetscFree(pc->data);CHKERRQ(ierr);
912   PetscFunctionReturn(0);
913 }
914 /* -------------------------------------------------------------------------- */
915 
916 #undef __FUNCT__
917 #define __FUNCT__ "PCBDDCMatFETIDPGetRHS_BDDC"
918 static PetscErrorCode PCBDDCMatFETIDPGetRHS_BDDC(Mat fetidp_mat, Vec standard_rhs, Vec fetidp_flux_rhs)
919 {
920   FETIDPMat_ctx  mat_ctx;
921   PC_IS*         pcis;
922   PC_BDDC*       pcbddc;
923   PetscErrorCode ierr;
924 
925   PetscFunctionBegin;
926   ierr = MatShellGetContext(fetidp_mat,&mat_ctx);CHKERRQ(ierr);
927   pcis = (PC_IS*)mat_ctx->pc->data;
928   pcbddc = (PC_BDDC*)mat_ctx->pc->data;
929 
930   /* change of basis for physical rhs if needed
931      It also changes the rhs in case of dirichlet boundaries */
932   (*mat_ctx->pc->ops->presolve)(mat_ctx->pc,NULL,standard_rhs,NULL);
933   /* store vectors for computation of fetidp final solution */
934   ierr = VecScatterBegin(pcis->global_to_D,standard_rhs,mat_ctx->temp_solution_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
935   ierr = VecScatterEnd(pcis->global_to_D,standard_rhs,mat_ctx->temp_solution_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
936   /* scale rhs since it should be unassembled : TODO use counter scaling? (also below) */
937   ierr = VecScatterBegin(pcis->global_to_B,standard_rhs,mat_ctx->temp_solution_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
938   ierr = VecScatterEnd(pcis->global_to_B,standard_rhs,mat_ctx->temp_solution_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
939   /* Apply partition of unity */
940   ierr = VecPointwiseMult(mat_ctx->temp_solution_B,pcis->D,mat_ctx->temp_solution_B);CHKERRQ(ierr);
941   /* ierr = PCBDDCScalingRestriction(mat_ctx->pc,standard_rhs,mat_ctx->temp_solution_B);CHKERRQ(ierr); */
942   if (!pcbddc->inexact_prec_type) {
943     /* compute partially subassembled Schur complement right-hand side */
944     ierr = KSPSolve(pcbddc->ksp_D,mat_ctx->temp_solution_D,pcis->vec1_D);CHKERRQ(ierr);
945     ierr = MatMult(pcis->A_BI,pcis->vec1_D,pcis->vec1_B);CHKERRQ(ierr);
946     ierr = VecAXPY(mat_ctx->temp_solution_B,-1.0,pcis->vec1_B);CHKERRQ(ierr);
947     ierr = VecSet(standard_rhs,0.0);CHKERRQ(ierr);
948     ierr = VecScatterBegin(pcis->global_to_B,mat_ctx->temp_solution_B,standard_rhs,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
949     ierr = VecScatterEnd(pcis->global_to_B,mat_ctx->temp_solution_B,standard_rhs,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
950     /* ierr = PCBDDCScalingRestriction(mat_ctx->pc,standard_rhs,mat_ctx->temp_solution_B);CHKERRQ(ierr); */
951     ierr = VecScatterBegin(pcis->global_to_B,standard_rhs,mat_ctx->temp_solution_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
952     ierr = VecScatterEnd(pcis->global_to_B,standard_rhs,mat_ctx->temp_solution_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
953     ierr = VecPointwiseMult(mat_ctx->temp_solution_B,pcis->D,mat_ctx->temp_solution_B);CHKERRQ(ierr);
954   }
955   /* BDDC rhs */
956   ierr = VecCopy(mat_ctx->temp_solution_B,pcis->vec1_B);CHKERRQ(ierr);
957   if (pcbddc->inexact_prec_type) {
958     ierr = VecCopy(mat_ctx->temp_solution_D,pcis->vec1_D);CHKERRQ(ierr);
959   }
960   /* apply BDDC */
961   ierr = PCBDDCApplyInterfacePreconditioner(mat_ctx->pc);CHKERRQ(ierr);
962   /* Application of B_delta and assembling of rhs for fetidp fluxes */
963   ierr = VecSet(fetidp_flux_rhs,0.0);CHKERRQ(ierr);
964   ierr = MatMult(mat_ctx->B_delta,pcis->vec1_B,mat_ctx->lambda_local);CHKERRQ(ierr);
965   ierr = VecScatterBegin(mat_ctx->l2g_lambda,mat_ctx->lambda_local,fetidp_flux_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
966   ierr = VecScatterEnd  (mat_ctx->l2g_lambda,mat_ctx->lambda_local,fetidp_flux_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
967   /* restore original rhs */
968   ierr = VecCopy(pcbddc->original_rhs,standard_rhs);CHKERRQ(ierr);
969   PetscFunctionReturn(0);
970 }
971 
972 #undef __FUNCT__
973 #define __FUNCT__ "PCBDDCMatFETIDPGetRHS"
974 /*@
975  PCBDDCMatFETIDPGetRHS - Get rhs for FETIDP linear system.
976 
977    Collective
978 
979    Input Parameters:
980 +  fetidp_mat   - the FETIDP mat obtained by a call to PCBDDCCreateFETIDPOperators
981 +  standard_rhs - the rhs of your linear system
982 
983    Output Parameters:
984 +  fetidp_flux_rhs   - the rhs of the FETIDP linear system
985 
986    Level: developer
987 
988    Notes:
989 
990 .seealso: PCBDDC
991 @*/
992 PetscErrorCode PCBDDCMatFETIDPGetRHS(Mat fetidp_mat, Vec standard_rhs, Vec fetidp_flux_rhs)
993 {
994   FETIDPMat_ctx  mat_ctx;
995   PetscErrorCode ierr;
996 
997   PetscFunctionBegin;
998   ierr = MatShellGetContext(fetidp_mat,&mat_ctx);CHKERRQ(ierr);
999   ierr = PetscTryMethod(mat_ctx->pc,"PCBDDCMatFETIDPGetRHS_C",(Mat,Vec,Vec),(fetidp_mat,standard_rhs,fetidp_flux_rhs));CHKERRQ(ierr);
1000   PetscFunctionReturn(0);
1001 }
1002 /* -------------------------------------------------------------------------- */
1003 
1004 #undef __FUNCT__
1005 #define __FUNCT__ "PCBDDCMatFETIDPGetSolution_BDDC"
1006 static PetscErrorCode PCBDDCMatFETIDPGetSolution_BDDC(Mat fetidp_mat, Vec fetidp_flux_sol, Vec standard_sol)
1007 {
1008   FETIDPMat_ctx  mat_ctx;
1009   PC_IS*         pcis;
1010   PC_BDDC*       pcbddc;
1011   PetscErrorCode ierr;
1012 
1013   PetscFunctionBegin;
1014   ierr = MatShellGetContext(fetidp_mat,&mat_ctx);CHKERRQ(ierr);
1015   pcis = (PC_IS*)mat_ctx->pc->data;
1016   pcbddc = (PC_BDDC*)mat_ctx->pc->data;
1017 
1018   /* apply B_delta^T */
1019   ierr = VecScatterBegin(mat_ctx->l2g_lambda,fetidp_flux_sol,mat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1020   ierr = VecScatterEnd  (mat_ctx->l2g_lambda,fetidp_flux_sol,mat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1021   ierr = MatMultTranspose(mat_ctx->B_delta,mat_ctx->lambda_local,pcis->vec1_B);CHKERRQ(ierr);
1022   /* compute rhs for BDDC application */
1023   ierr = VecAYPX(pcis->vec1_B,-1.0,mat_ctx->temp_solution_B);CHKERRQ(ierr);
1024   if (pcbddc->inexact_prec_type) {
1025     ierr = VecCopy(mat_ctx->temp_solution_D,pcis->vec1_D);CHKERRQ(ierr);
1026   }
1027   /* apply BDDC */
1028   ierr = PCBDDCApplyInterfacePreconditioner(mat_ctx->pc);CHKERRQ(ierr);
1029   /* put values into standard global vector */
1030   ierr = VecScatterBegin(pcis->global_to_B,pcis->vec1_B,standard_sol,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1031   ierr = VecScatterEnd  (pcis->global_to_B,pcis->vec1_B,standard_sol,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1032   if (!pcbddc->inexact_prec_type) {
1033     /* compute values into the interior if solved for the partially subassembled Schur complement */
1034     ierr = MatMult(pcis->A_IB,pcis->vec1_B,pcis->vec1_D);CHKERRQ(ierr);
1035     ierr = VecAXPY(mat_ctx->temp_solution_D,-1.0,pcis->vec1_D);CHKERRQ(ierr);
1036     ierr = KSPSolve(pcbddc->ksp_D,mat_ctx->temp_solution_D,pcis->vec1_D);CHKERRQ(ierr);
1037   }
1038   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec1_D,standard_sol,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1039   ierr = VecScatterEnd  (pcis->global_to_D,pcis->vec1_D,standard_sol,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1040   /* final change of basis if needed
1041      Is also sums the dirichlet part removed during RHS assembling */
1042   (*mat_ctx->pc->ops->postsolve)(mat_ctx->pc,NULL,NULL,standard_sol);
1043   PetscFunctionReturn(0);
1044 
1045 }
1046 
1047 #undef __FUNCT__
1048 #define __FUNCT__ "PCBDDCMatFETIDPGetSolution"
1049 /*@
1050  PCBDDCMatFETIDPGetSolution - Get Solution for FETIDP linear system.
1051 
1052    Collective
1053 
1054    Input Parameters:
1055 +  fetidp_mat        - the FETIDP mat obtained by a call to PCBDDCCreateFETIDPOperators
1056 +  fetidp_flux_sol - the solution of the FETIDP linear system
1057 
1058    Output Parameters:
1059 +  standard_sol      - the solution on the global domain
1060 
1061    Level: developer
1062 
1063    Notes:
1064 
1065 .seealso: PCBDDC
1066 @*/
1067 PetscErrorCode PCBDDCMatFETIDPGetSolution(Mat fetidp_mat, Vec fetidp_flux_sol, Vec standard_sol)
1068 {
1069   FETIDPMat_ctx  mat_ctx;
1070   PetscErrorCode ierr;
1071 
1072   PetscFunctionBegin;
1073   ierr = MatShellGetContext(fetidp_mat,&mat_ctx);CHKERRQ(ierr);
1074   ierr = PetscTryMethod(mat_ctx->pc,"PCBDDCMatFETIDPGetSolution_C",(Mat,Vec,Vec),(fetidp_mat,fetidp_flux_sol,standard_sol));CHKERRQ(ierr);
1075   PetscFunctionReturn(0);
1076 }
1077 /* -------------------------------------------------------------------------- */
1078 
1079 extern PetscErrorCode FETIDPMatMult(Mat,Vec,Vec);
1080 extern PetscErrorCode PCBDDCDestroyFETIDPMat(Mat);
1081 extern PetscErrorCode FETIDPPCApply(PC,Vec,Vec);
1082 extern PetscErrorCode PCBDDCDestroyFETIDPPC(PC);
1083 
1084 #undef __FUNCT__
1085 #define __FUNCT__ "PCBDDCCreateFETIDPOperators_BDDC"
1086 static PetscErrorCode PCBDDCCreateFETIDPOperators_BDDC(PC pc, Mat *fetidp_mat, PC *fetidp_pc)
1087 {
1088 
1089   FETIDPMat_ctx  fetidpmat_ctx;
1090   Mat            newmat;
1091   FETIDPPC_ctx   fetidppc_ctx;
1092   PC             newpc;
1093   MPI_Comm       comm;
1094   PetscErrorCode ierr;
1095 
1096   PetscFunctionBegin;
1097   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
1098   /* FETIDP linear matrix */
1099   ierr = PCBDDCCreateFETIDPMatContext(pc,&fetidpmat_ctx);CHKERRQ(ierr);
1100   ierr = PCBDDCSetupFETIDPMatContext(fetidpmat_ctx);CHKERRQ(ierr);
1101   ierr = MatCreateShell(comm,PETSC_DECIDE,PETSC_DECIDE,fetidpmat_ctx->n_lambda,fetidpmat_ctx->n_lambda,fetidpmat_ctx,&newmat);CHKERRQ(ierr);
1102   ierr = MatShellSetOperation(newmat,MATOP_MULT,(void (*)(void))FETIDPMatMult);CHKERRQ(ierr);
1103   ierr = MatShellSetOperation(newmat,MATOP_DESTROY,(void (*)(void))PCBDDCDestroyFETIDPMat);CHKERRQ(ierr);
1104   ierr = MatSetUp(newmat);CHKERRQ(ierr);
1105   /* FETIDP preconditioner */
1106   ierr = PCBDDCCreateFETIDPPCContext(pc,&fetidppc_ctx);CHKERRQ(ierr);
1107   ierr = PCBDDCSetupFETIDPPCContext(newmat,fetidppc_ctx);CHKERRQ(ierr);
1108   ierr = PCCreate(comm,&newpc);CHKERRQ(ierr);
1109   ierr = PCSetType(newpc,PCSHELL);CHKERRQ(ierr);
1110   ierr = PCShellSetContext(newpc,fetidppc_ctx);CHKERRQ(ierr);
1111   ierr = PCShellSetApply(newpc,FETIDPPCApply);CHKERRQ(ierr);
1112   ierr = PCShellSetDestroy(newpc,PCBDDCDestroyFETIDPPC);CHKERRQ(ierr);
1113   ierr = PCSetOperators(newpc,newmat,newmat,SAME_PRECONDITIONER);CHKERRQ(ierr);
1114   ierr = PCSetUp(newpc);CHKERRQ(ierr);
1115   /* return pointers for objects created */
1116   *fetidp_mat=newmat;
1117   *fetidp_pc=newpc;
1118   PetscFunctionReturn(0);
1119 }
1120 
1121 #undef __FUNCT__
1122 #define __FUNCT__ "PCBDDCCreateFETIDPOperators"
1123 /*@
1124  PCBDDCCreateFETIDPOperators - Create operators for FETIDP.
1125 
1126    Collective
1127 
1128    Input Parameters:
1129 +  pc - the BDDC preconditioning context (setup must be already called)
1130 
1131    Level: developer
1132 
1133    Notes:
1134 
1135 .seealso: PCBDDC
1136 @*/
1137 PetscErrorCode PCBDDCCreateFETIDPOperators(PC pc, Mat *fetidp_mat, PC *fetidp_pc)
1138 {
1139   PetscErrorCode ierr;
1140 
1141   PetscFunctionBegin;
1142   PetscValidHeaderSpecific(pc,PC_CLASSID,1);
1143   if (pc->setupcalled) {
1144     ierr = PetscTryMethod(pc,"PCBDDCCreateFETIDPOperators_C",(PC,Mat*,PC*),(pc,fetidp_mat,fetidp_pc));CHKERRQ(ierr);
1145   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"You must call PCSetup_BDDC() first \n");
1146   PetscFunctionReturn(0);
1147 }
1148 /* -------------------------------------------------------------------------- */
1149 /*MC
1150    PCBDDC - Balancing Domain Decomposition by Constraints.
1151 
1152    Options Database Keys:
1153 .    -pcbddc ??? -
1154 
1155    Level: intermediate
1156 
1157    Notes: The matrix used with this preconditioner must be of type MATIS
1158 
1159           Unlike more 'conventional' interface preconditioners, this iterates over ALL the
1160           degrees of freedom, NOT just those on the interface (this allows the use of approximate solvers
1161           on the subdomains).
1162 
1163           Options for the coarse grid preconditioner can be set with -
1164           Options for the Dirichlet subproblem can be set with -
1165           Options for the Neumann subproblem can be set with -
1166 
1167    Contributed by Stefano Zampini
1168 
1169 .seealso:  PCCreate(), PCSetType(), PCType (for list of available types), PC,  MATIS
1170 M*/
1171 
1172 #undef __FUNCT__
1173 #define __FUNCT__ "PCCreate_BDDC"
1174 PETSC_EXTERN PetscErrorCode PCCreate_BDDC(PC pc)
1175 {
1176   PetscErrorCode      ierr;
1177   PC_BDDC             *pcbddc;
1178 
1179   PetscFunctionBegin;
1180   /* Creates the private data structure for this preconditioner and attach it to the PC object. */
1181   ierr      = PetscNewLog(pc,PC_BDDC,&pcbddc);CHKERRQ(ierr);
1182   pc->data  = (void*)pcbddc;
1183 
1184   /* create PCIS data structure */
1185   ierr = PCISCreate(pc);CHKERRQ(ierr);
1186 
1187   /* BDDC specific */
1188   pcbddc->user_primal_vertices       = 0;
1189   pcbddc->NullSpace                  = 0;
1190   pcbddc->temp_solution              = 0;
1191   pcbddc->original_rhs               = 0;
1192   pcbddc->local_mat                  = 0;
1193   pcbddc->ChangeOfBasisMatrix        = 0;
1194   pcbddc->use_change_of_basis        = PETSC_TRUE;
1195   pcbddc->use_change_on_faces        = PETSC_FALSE;
1196   pcbddc->coarse_vec                 = 0;
1197   pcbddc->coarse_rhs                 = 0;
1198   pcbddc->coarse_ksp                 = 0;
1199   pcbddc->coarse_phi_B               = 0;
1200   pcbddc->coarse_phi_D               = 0;
1201   pcbddc->vec1_P                     = 0;
1202   pcbddc->vec1_R                     = 0;
1203   pcbddc->vec2_R                     = 0;
1204   pcbddc->local_auxmat1              = 0;
1205   pcbddc->local_auxmat2              = 0;
1206   pcbddc->R_to_B                     = 0;
1207   pcbddc->R_to_D                     = 0;
1208   pcbddc->ksp_D                      = 0;
1209   pcbddc->ksp_R                      = 0;
1210   pcbddc->local_primal_indices       = 0;
1211   pcbddc->inexact_prec_type          = PETSC_FALSE;
1212   pcbddc->NeumannBoundaries          = 0;
1213   pcbddc->ISForDofs                  = 0;
1214   pcbddc->ConstraintMatrix           = 0;
1215   pcbddc->use_nnsp_true              = PETSC_FALSE;
1216   pcbddc->local_primal_sizes         = 0;
1217   pcbddc->local_primal_displacements = 0;
1218   pcbddc->coarse_loc_to_glob         = 0;
1219   pcbddc->dbg_flag                   = 0;
1220   pcbddc->coarsening_ratio           = 8;
1221   pcbddc->use_exact_dirichlet        = PETSC_TRUE;
1222   pcbddc->current_level              = 0;
1223   pcbddc->max_levels                 = 1;
1224   pcbddc->replicated_local_primal_indices = 0;
1225   pcbddc->replicated_local_primal_values  = 0;
1226 
1227   /* create local graph structure */
1228   ierr = PCBDDCGraphCreate(&pcbddc->mat_graph);CHKERRQ(ierr);
1229 
1230   /* scaling */
1231   pcbddc->use_deluxe_scaling         = PETSC_FALSE;
1232   pcbddc->work_scaling               = 0;
1233 
1234   /* function pointers */
1235   pc->ops->apply               = PCApply_BDDC;
1236   pc->ops->applytranspose      = 0;
1237   pc->ops->setup               = PCSetUp_BDDC;
1238   pc->ops->destroy             = PCDestroy_BDDC;
1239   pc->ops->setfromoptions      = PCSetFromOptions_BDDC;
1240   pc->ops->view                = 0;
1241   pc->ops->applyrichardson     = 0;
1242   pc->ops->applysymmetricleft  = 0;
1243   pc->ops->applysymmetricright = 0;
1244   pc->ops->presolve            = PCPreSolve_BDDC;
1245   pc->ops->postsolve           = PCPostSolve_BDDC;
1246 
1247   /* composing function */
1248 ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCSetPrimalVerticesLocalIS_C",PCBDDCSetPrimalVerticesLocalIS_BDDC);CHKERRQ(ierr);
1249   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCSetCoarseningRatio_C",PCBDDCSetCoarseningRatio_BDDC);CHKERRQ(ierr);
1250   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCSetMaxLevels_C",PCBDDCSetMaxLevels_BDDC);CHKERRQ(ierr);
1251   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCSetNullSpace_C",PCBDDCSetNullSpace_BDDC);CHKERRQ(ierr);
1252   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCSetDirichletBoundaries_C",PCBDDCSetDirichletBoundaries_BDDC);CHKERRQ(ierr);
1253   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCSetNeumannBoundaries_C",PCBDDCSetNeumannBoundaries_BDDC);CHKERRQ(ierr);
1254   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCGetDirichletBoundaries_C",PCBDDCGetDirichletBoundaries_BDDC);CHKERRQ(ierr);
1255   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCGetNeumannBoundaries_C",PCBDDCGetNeumannBoundaries_BDDC);CHKERRQ(ierr);
1256   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCSetCoarseProblemType_C",PCBDDCSetCoarseProblemType_BDDC);CHKERRQ(ierr);
1257   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCSetDofsSplitting_C",PCBDDCSetDofsSplitting_BDDC);CHKERRQ(ierr);
1258   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCSetLocalAdjacencyGraph_C",PCBDDCSetLocalAdjacencyGraph_BDDC);CHKERRQ(ierr);
1259   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCCreateFETIDPOperators_C",PCBDDCCreateFETIDPOperators_BDDC);CHKERRQ(ierr);
1260   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCMatFETIDPGetRHS_C",PCBDDCMatFETIDPGetRHS_BDDC);CHKERRQ(ierr);
1261   ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCMatFETIDPGetSolution_C",PCBDDCMatFETIDPGetSolution_BDDC);CHKERRQ(ierr);
1262   PetscFunctionReturn(0);
1263 }
1264 
1265 /* -------------------------------------------------------------------------- */
1266 /* All static functions from now on                                           */
1267 /* -------------------------------------------------------------------------- */
1268 
1269 #undef __FUNCT__
1270 #define __FUNCT__ "PCBDDCSetUseExactDirichlet"
1271 static PetscErrorCode PCBDDCSetUseExactDirichlet(PC pc,PetscBool use)
1272 {
1273   PC_BDDC  *pcbddc = (PC_BDDC*)pc->data;
1274 
1275   PetscFunctionBegin;
1276   pcbddc->use_exact_dirichlet=use;
1277   PetscFunctionReturn(0);
1278 }
1279 
1280 #undef __FUNCT__
1281 #define __FUNCT__ "PCBDDCSetLevel"
1282 static PetscErrorCode PCBDDCSetLevel(PC pc,PetscInt level)
1283 {
1284   PC_BDDC  *pcbddc = (PC_BDDC*)pc->data;
1285 
1286   PetscFunctionBegin;
1287   pcbddc->current_level=level;
1288   PetscFunctionReturn(0);
1289 }
1290 
1291 /* -------------------------------------------------------------------------- */
1292 #undef __FUNCT__
1293 #define __FUNCT__ "PCBDDCCoarseSetUp"
1294 static PetscErrorCode PCBDDCCoarseSetUp(PC pc)
1295 {
1296   PetscErrorCode  ierr;
1297 
1298   PC_IS*            pcis = (PC_IS*)(pc->data);
1299   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
1300   Mat_IS            *matis = (Mat_IS*)pc->pmat->data;
1301   Mat               change_mat_all;
1302   IS                is_R_local;
1303   IS                is_V_local;
1304   IS                is_C_local;
1305   IS                is_aux1;
1306   IS                is_aux2;
1307   VecType           impVecType;
1308   MatType           impMatType;
1309   PetscInt          n_R=0;
1310   PetscInt          n_D=0;
1311   PetscInt          n_B=0;
1312   PetscScalar       zero=0.0;
1313   PetscScalar       one=1.0;
1314   PetscScalar       m_one=-1.0;
1315   PetscScalar*      array;
1316   PetscScalar       *coarse_submat_vals;
1317   PetscInt          *idx_R_local;
1318   PetscInt          *idx_V_B;
1319   PetscScalar       *coarsefunctions_errors;
1320   PetscScalar       *constraints_errors;
1321   /* auxiliary indices */
1322   PetscInt          i,j,k;
1323   /* for verbose output of bddc */
1324   PetscViewer       viewer=pcbddc->dbg_viewer;
1325   PetscBool         dbg_flag=pcbddc->dbg_flag;
1326   /* for counting coarse dofs */
1327   PetscInt          n_vertices,n_constraints;
1328   PetscInt          size_of_constraint;
1329   PetscInt          *row_cmat_indices;
1330   PetscScalar       *row_cmat_values;
1331   PetscInt          *vertices,*nnz,*is_indices,*temp_indices;
1332   ISLocalToGlobalMapping BtoNmap;
1333 
1334   PetscFunctionBegin;
1335   /* Set Non-overlapping dimensions */
1336   n_B = pcis->n_B; n_D = pcis->n - n_B;
1337   /* Set types for local objects needed by BDDC precondtioner */
1338   impMatType = MATSEQDENSE;
1339   impVecType = VECSEQ;
1340   /* get vertex indices from constraint matrix */
1341   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
1342   /* Set number of constraints */
1343   n_constraints = pcbddc->local_primal_size-n_vertices;
1344 
1345   /* vertices in boundary numbering */
1346   ierr = PetscMalloc(n_vertices*sizeof(PetscInt),&idx_V_B);CHKERRQ(ierr);
1347   ierr = ISLocalToGlobalMappingCreateIS(pcis->is_B_local,&BtoNmap);CHKERRQ(ierr);
1348   ierr = ISGlobalToLocalMappingApply(BtoNmap,IS_GTOLM_DROP,n_vertices,vertices,&i,idx_V_B);CHKERRQ(ierr);
1349   if (i != n_vertices) {
1350     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %d != %d\n",n_vertices,i);
1351   }
1352 
1353   /* transform local matrices if needed */
1354   if (pcbddc->use_change_of_basis) {
1355     ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1356     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1357     for (i=0;i<n_D;i++) nnz[is_indices[i]] = 1;
1358     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1359     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1360     k=1;
1361     for (i=0;i<n_B;i++) {
1362       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
1363       nnz[is_indices[i]]=j;
1364       if (k < j) k = j;
1365       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
1366     }
1367     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1368     /* assemble change of basis matrix on the whole set of local dofs */
1369     ierr = PetscMalloc(k*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
1370     ierr = MatCreate(PETSC_COMM_SELF,&change_mat_all);CHKERRQ(ierr);
1371     ierr = MatSetSizes(change_mat_all,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
1372     ierr = MatSetType(change_mat_all,MATSEQAIJ);CHKERRQ(ierr);
1373     ierr = MatSeqAIJSetPreallocation(change_mat_all,0,nnz);CHKERRQ(ierr);
1374     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1375     for (i=0;i<n_D;i++) {
1376       ierr = MatSetValue(change_mat_all,is_indices[i],is_indices[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
1377     }
1378     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1379     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1380     for (i=0;i<n_B;i++) {
1381       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
1382       for (k=0; k<j; k++) temp_indices[k]=is_indices[row_cmat_indices[k]];
1383       ierr = MatSetValues(change_mat_all,1,&is_indices[i],j,temp_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
1384       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
1385     }
1386     ierr = MatAssemblyBegin(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1387     ierr = MatAssemblyEnd(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1388     /* TODO: HOW TO WORK WITH BAIJ? PtAP not provided */
1389     ierr = MatGetBlockSize(matis->A,&i);CHKERRQ(ierr);
1390     if (i==1) {
1391       ierr = MatPtAP(matis->A,change_mat_all,MAT_INITIAL_MATRIX,1.0,&pcbddc->local_mat);CHKERRQ(ierr);
1392     } else {
1393       Mat work_mat;
1394       ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
1395       ierr = MatPtAP(work_mat,change_mat_all,MAT_INITIAL_MATRIX,1.0,&pcbddc->local_mat);CHKERRQ(ierr);
1396       ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
1397     }
1398     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
1399     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
1400     ierr = MatDestroy(&pcis->A_BB);CHKERRQ(ierr);
1401     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&pcis->A_IB);CHKERRQ(ierr);
1402     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&pcis->A_BI);CHKERRQ(ierr);
1403     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&pcis->A_BB);CHKERRQ(ierr);
1404     ierr = MatDestroy(&change_mat_all);CHKERRQ(ierr);
1405     ierr = PetscFree(nnz);CHKERRQ(ierr);
1406     ierr = PetscFree(temp_indices);CHKERRQ(ierr);
1407   } else {
1408     /* without change of basis, the local matrix is unchanged */
1409     ierr = PetscObjectReference((PetscObject)matis->A);CHKERRQ(ierr);
1410     pcbddc->local_mat = matis->A;
1411   }
1412   /* Change global null space passed in by the user if change of basis has been requested */
1413   if (pcbddc->NullSpace && pcbddc->use_change_of_basis) {
1414     ierr = PCBDDCNullSpaceAdaptGlobal(pc);CHKERRQ(ierr);
1415   }
1416 
1417   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
1418   ierr = VecSet(pcis->vec1_N,one);CHKERRQ(ierr);
1419   ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
1420   for (i=0;i<n_vertices;i++) array[vertices[i]] = zero;
1421   ierr = PetscMalloc(( pcis->n - n_vertices )*sizeof(PetscInt),&idx_R_local);CHKERRQ(ierr);
1422   for (i=0, n_R=0; i<pcis->n; i++) {
1423     if (array[i] == one) {
1424       idx_R_local[n_R] = i;
1425       n_R++;
1426     }
1427   }
1428   ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
1429   if (dbg_flag) {
1430     ierr = PetscViewerASCIIPrintf(viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
1431     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
1432     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
1433     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
1434     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);
1435     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr);
1436     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
1437   }
1438 
1439   /* Allocate needed vectors */
1440   ierr = VecDuplicate(pcis->vec1_global,&pcbddc->original_rhs);CHKERRQ(ierr);
1441   ierr = VecDuplicate(pcis->vec1_global,&pcbddc->temp_solution);CHKERRQ(ierr);
1442   ierr = VecDuplicate(pcis->vec1_D,&pcbddc->vec4_D);CHKERRQ(ierr);
1443   ierr = VecCreate(PETSC_COMM_SELF,&pcbddc->vec1_R);CHKERRQ(ierr);
1444   ierr = VecSetSizes(pcbddc->vec1_R,n_R,n_R);CHKERRQ(ierr);
1445   ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
1446   ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
1447   ierr = VecCreate(PETSC_COMM_SELF,&pcbddc->vec1_P);CHKERRQ(ierr);
1448   ierr = VecSetSizes(pcbddc->vec1_P,pcbddc->local_primal_size,pcbddc->local_primal_size);CHKERRQ(ierr);
1449   ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
1450 
1451   /* Creating some index sets needed  */
1452   /* For submatrices */
1453   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_R,idx_R_local,PETSC_OWN_POINTER,&is_R_local);CHKERRQ(ierr);
1454   if (n_vertices)    {
1455     ierr = ISCreateGeneral(PETSC_COMM_SELF,n_vertices,vertices,PETSC_OWN_POINTER,&is_V_local);CHKERRQ(ierr);
1456   }
1457   if (n_constraints) {
1458     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_C_local);CHKERRQ(ierr);
1459   }
1460 
1461   /* For VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
1462   {
1463     PetscInt   *aux_array1;
1464     PetscInt   *aux_array2;
1465     PetscInt   *idx_I_local;
1466 
1467     ierr = PetscMalloc( (pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
1468     ierr = PetscMalloc( (pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array2);CHKERRQ(ierr);
1469 
1470     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&idx_I_local);CHKERRQ(ierr);
1471     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
1472     for (i=0; i<n_D; i++) array[idx_I_local[i]] = 0;
1473     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&idx_I_local);CHKERRQ(ierr);
1474     for (i=0, j=0; i<n_R; i++) {
1475       if (array[idx_R_local[i]] == one) {
1476         aux_array1[j] = i;
1477         j++;
1478       }
1479     }
1480     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
1481     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_COPY_VALUES,&is_aux1);CHKERRQ(ierr);
1482     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1483     ierr = VecScatterEnd  (pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1484     ierr = VecGetArray(pcis->vec1_B,&array);CHKERRQ(ierr);
1485     for (i=0, j=0; i<n_B; i++) {
1486       if (array[i] == one) {
1487         aux_array2[j] = i; j++;
1488       }
1489     }
1490     ierr = VecRestoreArray(pcis->vec1_B,&array);CHKERRQ(ierr);
1491     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_COPY_VALUES,&is_aux2);CHKERRQ(ierr);
1492     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
1493     ierr = PetscFree(aux_array1);CHKERRQ(ierr);
1494     ierr = PetscFree(aux_array2);CHKERRQ(ierr);
1495     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
1496     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
1497 
1498     if (pcbddc->inexact_prec_type || dbg_flag ) {
1499       ierr = PetscMalloc(n_D*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
1500       ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
1501       for (i=0, j=0; i<n_R; i++) {
1502         if (array[idx_R_local[i]] == zero) {
1503           aux_array1[j] = i;
1504           j++;
1505         }
1506       }
1507       ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
1508       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_COPY_VALUES,&is_aux1);CHKERRQ(ierr);
1509       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
1510       ierr = PetscFree(aux_array1);CHKERRQ(ierr);
1511       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
1512     }
1513   }
1514 
1515   /* Creating PC contexts for local Dirichlet and Neumann problems */
1516   {
1517     Mat          A_RR;
1518     PC           pc_temp;
1519     MatStructure matstruct;
1520     /* Matrix for Dirichlet problem is A_II */
1521     /* HACK (TODO) A_II can be changed between nonlinear iterations */
1522     ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
1523     if (matstruct == SAME_NONZERO_PATTERN) {
1524       ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_I_local,MAT_REUSE_MATRIX,&pcis->A_II);CHKERRQ(ierr);
1525     } else {
1526       ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
1527       ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&pcis->A_II);CHKERRQ(ierr);
1528     }
1529     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
1530     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
1531     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II,SAME_PRECONDITIONER);CHKERRQ(ierr);
1532     ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
1533     ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,"dirichlet_");CHKERRQ(ierr);
1534     /* default */
1535     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
1536     ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
1537     /* Allow user's customization */
1538     ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
1539     /* umfpack interface has a bug when matrix dimension is zero */
1540     if (!n_D) {
1541       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1542     }
1543     /* Set Up KSP for Dirichlet problem of BDDC */
1544     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
1545     /* set ksp_D into pcis data */
1546     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
1547     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
1548     pcis->ksp_D = pcbddc->ksp_D;
1549     /* Matrix for Neumann problem is A_RR -> we need to create it */
1550     ierr = MatGetSubMatrix(pcbddc->local_mat,is_R_local,is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
1551     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
1552     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
1553     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR,SAME_PRECONDITIONER);CHKERRQ(ierr);
1554     ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
1555     ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,"neumann_");CHKERRQ(ierr);
1556     /* default */
1557     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
1558     ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
1559     /* Allow user's customization */
1560     ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
1561     /* umfpack interface has a bug when matrix dimension is zero */
1562     if (!n_R) {
1563       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1564     }
1565     /* Set Up KSP for Neumann problem of BDDC */
1566     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
1567     /* check Dirichlet and Neumann solvers and adapt them if a nullspace correction is needed */
1568     {
1569       Vec         temp_vec;
1570       PetscReal   value;
1571       PetscMPIInt use_exact,use_exact_reduced;
1572 
1573       ierr = VecDuplicate(pcis->vec1_D,&temp_vec);CHKERRQ(ierr);
1574       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
1575       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1576       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,temp_vec);CHKERRQ(ierr);
1577       ierr = VecAXPY(temp_vec,m_one,pcis->vec1_D);CHKERRQ(ierr);
1578       ierr = VecNorm(temp_vec,NORM_INFINITY,&value);CHKERRQ(ierr);
1579       ierr = VecDestroy(&temp_vec);CHKERRQ(ierr);
1580       use_exact = 1;
1581       if (PetscAbsReal(value) > 1.e-4) use_exact = 0;
1582       ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_INT,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1583       pcbddc->use_exact_dirichlet = (PetscBool) use_exact_reduced;
1584       if (dbg_flag) {
1585         ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
1586         ierr = PetscViewerASCIIPrintf(viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
1587         ierr = PetscViewerASCIIPrintf(viewer,"Checking solution of Dirichlet and Neumann problems\n");CHKERRQ(ierr);
1588         ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d infinity error for Dirichlet solve = % 1.14e \n",PetscGlobalRank,value);CHKERRQ(ierr);
1589         ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
1590       }
1591       if (n_D && pcbddc->NullSpace && !use_exact_reduced && !pcbddc->inexact_prec_type) {
1592         ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcis->is_I_local);
1593       }
1594       ierr = VecDuplicate(pcbddc->vec1_R,&temp_vec);CHKERRQ(ierr);
1595       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
1596       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
1597       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,temp_vec);CHKERRQ(ierr);
1598       ierr = VecAXPY(temp_vec,m_one,pcbddc->vec1_R);CHKERRQ(ierr);
1599       ierr = VecNorm(temp_vec,NORM_INFINITY,&value);CHKERRQ(ierr);
1600       ierr = VecDestroy(&temp_vec);CHKERRQ(ierr);
1601       use_exact = 1;
1602       if (PetscAbsReal(value) > 1.e-4) use_exact = 0;
1603       ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_INT,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1604       if (dbg_flag) {
1605         ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d infinity error for  Neumann  solve = % 1.14e \n",PetscGlobalRank,value);CHKERRQ(ierr);
1606         ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
1607       }
1608       if (n_R && pcbddc->NullSpace && !use_exact_reduced) {
1609         ierr = PCBDDCNullSpaceAssembleCorrection(pc,is_R_local);
1610       }
1611     }
1612     /* free Neumann problem's matrix */
1613     ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1614   }
1615 
1616   /* Assemble all remaining stuff needed to apply BDDC  */
1617   {
1618     Mat          A_RV,A_VR,A_VV;
1619     Mat          M1;
1620     Mat          C_CR;
1621     Mat          AUXMAT;
1622     Vec          vec1_C;
1623     Vec          vec2_C;
1624     Vec          vec1_V;
1625     Vec          vec2_V;
1626     PetscInt     *nnz;
1627     PetscInt     *auxindices;
1628     PetscInt     index;
1629     PetscScalar* array2;
1630     MatFactorInfo matinfo;
1631 
1632     /* Allocating some extra storage just to be safe */
1633     ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1634     ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&auxindices);CHKERRQ(ierr);
1635     for (i=0;i<pcis->n;i++) auxindices[i]=i;
1636 
1637     /* some work vectors on vertices and/or constraints */
1638     if (n_vertices) {
1639       ierr = VecCreate(PETSC_COMM_SELF,&vec1_V);CHKERRQ(ierr);
1640       ierr = VecSetSizes(vec1_V,n_vertices,n_vertices);CHKERRQ(ierr);
1641       ierr = VecSetType(vec1_V,impVecType);CHKERRQ(ierr);
1642       ierr = VecDuplicate(vec1_V,&vec2_V);CHKERRQ(ierr);
1643     }
1644     if (n_constraints) {
1645       ierr = VecCreate(PETSC_COMM_SELF,&vec1_C);CHKERRQ(ierr);
1646       ierr = VecSetSizes(vec1_C,n_constraints,n_constraints);CHKERRQ(ierr);
1647       ierr = VecSetType(vec1_C,impVecType);CHKERRQ(ierr);
1648       ierr = VecDuplicate(vec1_C,&vec2_C);CHKERRQ(ierr);
1649       ierr = VecDuplicate(vec1_C,&pcbddc->vec1_C);CHKERRQ(ierr);
1650     }
1651     /* Precompute stuffs needed for preprocessing and application of BDDC*/
1652     if (n_constraints) {
1653       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->local_auxmat2);CHKERRQ(ierr);
1654       ierr = MatSetSizes(pcbddc->local_auxmat2,n_R,n_constraints,n_R,n_constraints);CHKERRQ(ierr);
1655       ierr = MatSetType(pcbddc->local_auxmat2,impMatType);CHKERRQ(ierr);
1656       ierr = MatSeqDenseSetPreallocation(pcbddc->local_auxmat2,NULL);CHKERRQ(ierr);
1657 
1658       /* Create Constraint matrix on R nodes: C_{CR}  */
1659       ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_C_local,is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
1660       ierr = ISDestroy(&is_C_local);CHKERRQ(ierr);
1661 
1662       /* Assemble local_auxmat2 = - A_{RR}^{-1} C^T_{CR} needed by BDDC application */
1663       for (i=0;i<n_constraints;i++) {
1664         ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
1665         /* Get row of constraint matrix in R numbering */
1666         ierr = VecGetArray(pcbddc->vec1_R,&array);CHKERRQ(ierr);
1667         ierr = MatGetRow(C_CR,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
1668         for (j=0;j<size_of_constraint;j++) array[row_cmat_indices[j]] = -row_cmat_values[j];
1669         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
1670         ierr = VecRestoreArray(pcbddc->vec1_R,&array);CHKERRQ(ierr);
1671 
1672         /* Solve for row of constraint matrix in R numbering */
1673         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
1674 
1675         /* Set values */
1676         ierr = VecGetArray(pcbddc->vec2_R,&array);CHKERRQ(ierr);
1677         ierr = MatSetValues(pcbddc->local_auxmat2,n_R,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
1678         ierr = VecRestoreArray(pcbddc->vec2_R,&array);CHKERRQ(ierr);
1679       }
1680       ierr = MatAssemblyBegin(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1681       ierr = MatAssemblyEnd(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1682 
1683       /* Assemble AUXMAT = ( LUFactor )( -C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1} */
1684       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&AUXMAT);CHKERRQ(ierr);
1685       ierr = MatFactorInfoInitialize(&matinfo);CHKERRQ(ierr);
1686       ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,0,1,&is_aux1);CHKERRQ(ierr);
1687       ierr = MatLUFactor(AUXMAT,is_aux1,is_aux1,&matinfo);CHKERRQ(ierr);
1688       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
1689 
1690       /* Assemble explicitly M1 = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1} needed in preproc  */
1691       ierr = MatCreate(PETSC_COMM_SELF,&M1);CHKERRQ(ierr);
1692       ierr = MatSetSizes(M1,n_constraints,n_constraints,n_constraints,n_constraints);CHKERRQ(ierr);
1693       ierr = MatSetType(M1,impMatType);CHKERRQ(ierr);
1694       ierr = MatSeqDenseSetPreallocation(M1,NULL);CHKERRQ(ierr);
1695       for (i=0;i<n_constraints;i++) {
1696         ierr = VecSet(vec1_C,zero);CHKERRQ(ierr);
1697         ierr = VecSetValue(vec1_C,i,one,INSERT_VALUES);CHKERRQ(ierr);
1698         ierr = VecAssemblyBegin(vec1_C);CHKERRQ(ierr);
1699         ierr = VecAssemblyEnd(vec1_C);CHKERRQ(ierr);
1700         ierr = MatSolve(AUXMAT,vec1_C,vec2_C);CHKERRQ(ierr);
1701         ierr = VecScale(vec2_C,m_one);CHKERRQ(ierr);
1702         ierr = VecGetArray(vec2_C,&array);CHKERRQ(ierr);
1703         ierr = MatSetValues(M1,n_constraints,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
1704         ierr = VecRestoreArray(vec2_C,&array);CHKERRQ(ierr);
1705       }
1706       ierr = MatAssemblyBegin(M1,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1707       ierr = MatAssemblyEnd(M1,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1708       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
1709       /* Assemble local_auxmat1 = M1*C_{CR} needed by BDDC application in KSP and in preproc */
1710       ierr = MatMatMult(M1,C_CR,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
1711 
1712     }
1713 
1714     /* Get submatrices from subdomain matrix */
1715     if (n_vertices){
1716       ierr = MatGetSubMatrix(pcbddc->local_mat,is_R_local,is_V_local,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
1717       ierr = MatGetSubMatrix(pcbddc->local_mat,is_V_local,is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
1718       ierr = MatGetSubMatrix(pcbddc->local_mat,is_V_local,is_V_local,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
1719     }
1720 
1721     /* Matrix of coarse basis functions (local) */
1722     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
1723     ierr = MatSetSizes(pcbddc->coarse_phi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
1724     ierr = MatSetType(pcbddc->coarse_phi_B,impMatType);CHKERRQ(ierr);
1725     ierr = MatSeqDenseSetPreallocation(pcbddc->coarse_phi_B,NULL);CHKERRQ(ierr);
1726     if (pcbddc->inexact_prec_type || dbg_flag ) {
1727       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
1728       ierr = MatSetSizes(pcbddc->coarse_phi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
1729       ierr = MatSetType(pcbddc->coarse_phi_D,impMatType);CHKERRQ(ierr);
1730       ierr = MatSeqDenseSetPreallocation(pcbddc->coarse_phi_D,NULL);CHKERRQ(ierr);
1731     }
1732 
1733     if (dbg_flag) {
1734       ierr = PetscMalloc( pcbddc->local_primal_size*sizeof(PetscScalar),&coarsefunctions_errors);CHKERRQ(ierr);
1735       ierr = PetscMalloc( pcbddc->local_primal_size*sizeof(PetscScalar),&constraints_errors);CHKERRQ(ierr);
1736     }
1737     /* Subdomain contribution (Non-overlapping) to coarse matrix  */
1738     ierr = PetscMalloc ((pcbddc->local_primal_size)*(pcbddc->local_primal_size)*sizeof(PetscScalar),&coarse_submat_vals);CHKERRQ(ierr);
1739 
1740     /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
1741     for (i=0;i<n_vertices;i++){
1742       ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
1743       ierr = VecSetValue(vec1_V,i,one,INSERT_VALUES);CHKERRQ(ierr);
1744       ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
1745       ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
1746       /* solution of saddle point problem */
1747       ierr = MatMult(A_RV,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
1748       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
1749       ierr = VecScale(pcbddc->vec1_R,m_one);CHKERRQ(ierr);
1750       if (n_constraints) {
1751         ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec1_R,vec1_C);CHKERRQ(ierr);
1752         ierr = MatMultAdd(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
1753         ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
1754       }
1755       ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
1756       ierr = MatMultAdd(A_VV,vec1_V,vec2_V,vec2_V);CHKERRQ(ierr);
1757 
1758       /* Set values in coarse basis function and subdomain part of coarse_mat */
1759       /* coarse basis functions */
1760       ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1761       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1762       ierr = VecScatterEnd  (pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1763       ierr = VecGetArray(pcis->vec1_B,&array);CHKERRQ(ierr);
1764       ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
1765       ierr = VecRestoreArray(pcis->vec1_B,&array);CHKERRQ(ierr);
1766       ierr = MatSetValue(pcbddc->coarse_phi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
1767       if ( pcbddc->inexact_prec_type || dbg_flag  ) {
1768         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1769         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1770         ierr = VecGetArray(pcis->vec1_D,&array);CHKERRQ(ierr);
1771         ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
1772         ierr = VecRestoreArray(pcis->vec1_D,&array);CHKERRQ(ierr);
1773       }
1774       /* subdomain contribution to coarse matrix */
1775       ierr = VecGetArray(vec2_V,&array);CHKERRQ(ierr);
1776       for (j=0; j<n_vertices; j++) coarse_submat_vals[i*pcbddc->local_primal_size+j] = array[j];   /* WARNING -> column major ordering */
1777       ierr = VecRestoreArray(vec2_V,&array);CHKERRQ(ierr);
1778       if (n_constraints) {
1779         ierr = VecGetArray(vec1_C,&array);CHKERRQ(ierr);
1780         for (j=0; j<n_constraints; j++) coarse_submat_vals[i*pcbddc->local_primal_size+j+n_vertices] = array[j];   /* WARNING -> column major ordering */
1781         ierr = VecRestoreArray(vec1_C,&array);CHKERRQ(ierr);
1782       }
1783 
1784       if ( dbg_flag ) {
1785         /* assemble subdomain vector on nodes */
1786         ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
1787         ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
1788         ierr = VecGetArray(pcbddc->vec1_R,&array2);CHKERRQ(ierr);
1789         for (j=0;j<n_R;j++) array[idx_R_local[j]] = array2[j];
1790         array[ vertices[i] ] = one;
1791         ierr = VecRestoreArray(pcbddc->vec1_R,&array2);CHKERRQ(ierr);
1792         ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
1793         /* assemble subdomain vector of lagrange multipliers (i.e. primal nodes) */
1794         ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
1795         ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
1796         ierr = VecGetArray(vec2_V,&array);CHKERRQ(ierr);
1797         for (j=0;j<n_vertices;j++) array2[j]=array[j];
1798         ierr = VecRestoreArray(vec2_V,&array);CHKERRQ(ierr);
1799         if (n_constraints) {
1800           ierr = VecGetArray(vec1_C,&array);CHKERRQ(ierr);
1801           for (j=0;j<n_constraints;j++) array2[j+n_vertices]=array[j];
1802           ierr = VecRestoreArray(vec1_C,&array);CHKERRQ(ierr);
1803         }
1804         ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
1805         ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
1806         /* check saddle point solution */
1807         ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
1808         ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
1809         ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i]);CHKERRQ(ierr);
1810         ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
1811         ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
1812         array[i]=array[i]+m_one;  /* shift by the identity matrix */
1813         ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
1814         ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i]);CHKERRQ(ierr);
1815       }
1816     }
1817 
1818     for (i=0;i<n_constraints;i++){
1819       ierr = VecSet(vec2_C,zero);CHKERRQ(ierr);
1820       ierr = VecSetValue(vec2_C,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
1821       ierr = VecAssemblyBegin(vec2_C);CHKERRQ(ierr);
1822       ierr = VecAssemblyEnd(vec2_C);CHKERRQ(ierr);
1823       /* solution of saddle point problem */
1824       ierr = MatMult(M1,vec2_C,vec1_C);CHKERRQ(ierr);
1825       ierr = MatMult(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
1826       ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
1827       if (n_vertices) { ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr); }
1828       /* Set values in coarse basis function and subdomain part of coarse_mat */
1829       /* coarse basis functions */
1830       index=i+n_vertices;
1831       ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1832       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1833       ierr = VecScatterEnd  (pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1834       ierr = VecGetArray(pcis->vec1_B,&array);CHKERRQ(ierr);
1835       ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&index,array,INSERT_VALUES);CHKERRQ(ierr);
1836       ierr = VecRestoreArray(pcis->vec1_B,&array);CHKERRQ(ierr);
1837       if ( pcbddc->inexact_prec_type || dbg_flag ) {
1838         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1839         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1840         ierr = VecGetArray(pcis->vec1_D,&array);CHKERRQ(ierr);
1841         ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&index,array,INSERT_VALUES);CHKERRQ(ierr);
1842         ierr = VecRestoreArray(pcis->vec1_D,&array);CHKERRQ(ierr);
1843       }
1844       /* subdomain contribution to coarse matrix */
1845       if (n_vertices) {
1846         ierr = VecGetArray(vec2_V,&array);CHKERRQ(ierr);
1847         for (j=0; j<n_vertices; j++) coarse_submat_vals[index*pcbddc->local_primal_size+j]=array[j]; /* WARNING -> column major ordering */
1848         ierr = VecRestoreArray(vec2_V,&array);CHKERRQ(ierr);
1849       }
1850       ierr = VecGetArray(vec1_C,&array);CHKERRQ(ierr);
1851       for (j=0; j<n_constraints; j++) coarse_submat_vals[index*pcbddc->local_primal_size+j+n_vertices]=array[j]; /* WARNING -> column major ordering */
1852       ierr = VecRestoreArray(vec1_C,&array);CHKERRQ(ierr);
1853 
1854       if ( dbg_flag ) {
1855         /* assemble subdomain vector on nodes */
1856         ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
1857         ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
1858         ierr = VecGetArray(pcbddc->vec1_R,&array2);CHKERRQ(ierr);
1859         for (j=0;j<n_R;j++) array[idx_R_local[j]] = array2[j];
1860         ierr = VecRestoreArray(pcbddc->vec1_R,&array2);CHKERRQ(ierr);
1861         ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
1862         /* assemble subdomain vector of lagrange multipliers */
1863         ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
1864         ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
1865         if ( n_vertices) {
1866           ierr = VecGetArray(vec2_V,&array);CHKERRQ(ierr);
1867           for (j=0;j<n_vertices;j++) array2[j]=-array[j];
1868           ierr = VecRestoreArray(vec2_V,&array);CHKERRQ(ierr);
1869         }
1870         ierr = VecGetArray(vec1_C,&array);CHKERRQ(ierr);
1871         for (j=0;j<n_constraints;j++) {array2[j+n_vertices]=-array[j];}
1872         ierr = VecRestoreArray(vec1_C,&array);CHKERRQ(ierr);
1873         ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
1874         /* check saddle point solution */
1875         ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
1876         ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
1877         ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[index]);CHKERRQ(ierr);
1878         ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
1879         ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
1880         array[index]=array[index]+m_one; /* shift by the identity matrix */
1881         ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
1882         ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[index]);CHKERRQ(ierr);
1883       }
1884     }
1885     ierr = MatAssemblyBegin(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1886     ierr = MatAssemblyEnd  (pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1887     if ( pcbddc->inexact_prec_type || dbg_flag ) {
1888       ierr = MatAssemblyBegin(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1889       ierr = MatAssemblyEnd  (pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1890     }
1891     /* Checking coarse_sub_mat and coarse basis functios */
1892     /* It shuld be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
1893     if (dbg_flag) {
1894       Mat         coarse_sub_mat;
1895       Mat         TM1,TM2,TM3,TM4;
1896       Mat         coarse_phi_D,coarse_phi_B,A_II,A_BB,A_IB,A_BI;
1897       MatType     checkmattype=MATSEQAIJ;
1898       PetscScalar value;
1899 
1900       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
1901       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
1902       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
1903       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
1904       ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
1905       ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
1906       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
1907       ierr = MatConvert(coarse_sub_mat,checkmattype,MAT_REUSE_MATRIX,&coarse_sub_mat);CHKERRQ(ierr);
1908 
1909       ierr = PetscViewerASCIIPrintf(viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
1910       ierr = PetscViewerASCIIPrintf(viewer,"Check coarse sub mat and local basis functions\n");CHKERRQ(ierr);
1911       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
1912       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
1913       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
1914       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
1915       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
1916       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
1917       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
1918       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
1919       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
1920       ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
1921       ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
1922       ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
1923       ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
1924       ierr = MatNorm(TM1,NORM_INFINITY,&value);CHKERRQ(ierr);
1925       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"----------------------------------\n");CHKERRQ(ierr);
1926       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d \n",PetscGlobalRank);CHKERRQ(ierr);
1927       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"matrix error = % 1.14e\n",value);CHKERRQ(ierr);
1928       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"coarse functions errors\n");CHKERRQ(ierr);
1929       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); }
1930       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"constraints errors\n");CHKERRQ(ierr);
1931       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); }
1932       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
1933       ierr = MatDestroy(&A_II);CHKERRQ(ierr);
1934       ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
1935       ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
1936       ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
1937       ierr = MatDestroy(&TM1);CHKERRQ(ierr);
1938       ierr = MatDestroy(&TM2);CHKERRQ(ierr);
1939       ierr = MatDestroy(&TM3);CHKERRQ(ierr);
1940       ierr = MatDestroy(&TM4);CHKERRQ(ierr);
1941       ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
1942       ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
1943       ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
1944       ierr = PetscFree(coarsefunctions_errors);CHKERRQ(ierr);
1945       ierr = PetscFree(constraints_errors);CHKERRQ(ierr);
1946     }
1947     /* free memory */
1948     if (n_vertices) {
1949       ierr = VecDestroy(&vec1_V);CHKERRQ(ierr);
1950       ierr = VecDestroy(&vec2_V);CHKERRQ(ierr);
1951       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
1952       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
1953       ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
1954     }
1955     if (n_constraints) {
1956       ierr = VecDestroy(&vec1_C);CHKERRQ(ierr);
1957       ierr = VecDestroy(&vec2_C);CHKERRQ(ierr);
1958       ierr = MatDestroy(&M1);CHKERRQ(ierr);
1959       ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
1960     }
1961     ierr = PetscFree(auxindices);CHKERRQ(ierr);
1962     ierr = PetscFree(nnz);CHKERRQ(ierr);
1963     /* create coarse matrix and data structures for message passing associated actual choice of coarse problem type */
1964     ierr = PCBDDCSetUpCoarseEnvironment(pc,coarse_submat_vals);CHKERRQ(ierr);
1965     ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
1966   }
1967   /* free memory */
1968   if (n_vertices) {
1969     ierr = ISDestroy(&is_V_local);CHKERRQ(ierr);
1970   }
1971   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
1972   ierr = ISLocalToGlobalMappingDestroy(&BtoNmap);CHKERRQ(ierr);
1973   ierr = ISDestroy(&is_R_local);CHKERRQ(ierr);
1974 
1975   PetscFunctionReturn(0);
1976 }
1977 
1978 /* -------------------------------------------------------------------------- */
1979 
1980 #undef __FUNCT__
1981 #define __FUNCT__ "PCBDDCSetUpCoarseEnvironment"
1982 static PetscErrorCode PCBDDCSetUpCoarseEnvironment(PC pc,PetscScalar* coarse_submat_vals)
1983 {
1984 
1985 
1986   Mat_IS    *matis    = (Mat_IS*)pc->pmat->data;
1987   PC_BDDC   *pcbddc   = (PC_BDDC*)pc->data;
1988   PC_IS     *pcis     = (PC_IS*)pc->data;
1989   MPI_Comm  prec_comm;
1990   MPI_Comm  coarse_comm;
1991 
1992   MatNullSpace CoarseNullSpace;
1993 
1994   /* common to all choiches */
1995   PetscScalar *temp_coarse_mat_vals;
1996   PetscScalar *ins_coarse_mat_vals;
1997   PetscInt    *ins_local_primal_indices;
1998   PetscMPIInt *localsizes2,*localdispl2;
1999   PetscMPIInt size_prec_comm;
2000   PetscMPIInt rank_prec_comm;
2001   PetscMPIInt active_rank=MPI_PROC_NULL;
2002   PetscMPIInt master_proc=0;
2003   PetscInt    ins_local_primal_size;
2004   /* specific to MULTILEVEL_BDDC */
2005   PetscMPIInt *ranks_recv;
2006   PetscMPIInt count_recv=0;
2007   PetscMPIInt rank_coarse_proc_send_to;
2008   PetscMPIInt coarse_color = MPI_UNDEFINED;
2009   ISLocalToGlobalMapping coarse_ISLG;
2010   /* some other variables */
2011   PetscErrorCode ierr;
2012   MatType coarse_mat_type;
2013   PCType  coarse_pc_type;
2014   KSPType coarse_ksp_type;
2015   PC pc_temp;
2016   PetscInt i,j,k;
2017   PetscInt max_it_coarse_ksp=1;  /* don't increase this value */
2018   /* verbose output viewer */
2019   PetscViewer viewer=pcbddc->dbg_viewer;
2020   PetscBool   dbg_flag=pcbddc->dbg_flag;
2021 
2022   PetscInt      offset,offset2;
2023   PetscMPIInt   im_active,active_procs;
2024   PetscInt      *dnz,*onz;
2025 
2026   PetscBool     setsym,issym=PETSC_FALSE;
2027 
2028   PetscFunctionBegin;
2029   ierr = PetscObjectGetComm((PetscObject)pc,&prec_comm);CHKERRQ(ierr);
2030   ins_local_primal_indices = 0;
2031   ins_coarse_mat_vals      = 0;
2032   localsizes2              = 0;
2033   localdispl2              = 0;
2034   temp_coarse_mat_vals     = 0;
2035   coarse_ISLG              = 0;
2036 
2037   ierr = MPI_Comm_size(prec_comm,&size_prec_comm);CHKERRQ(ierr);
2038   ierr = MPI_Comm_rank(prec_comm,&rank_prec_comm);CHKERRQ(ierr);
2039   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
2040 
2041   /* Assign global numbering to coarse dofs */
2042   {
2043     PetscInt     *auxlocal_primal,*aux_idx;
2044     PetscMPIInt  mpi_local_primal_size;
2045     PetscScalar  coarsesum,*array;
2046 
2047     mpi_local_primal_size = (PetscMPIInt)pcbddc->local_primal_size;
2048 
2049     /* Construct needed data structures for message passing */
2050     j = 0;
2051     if (rank_prec_comm == 0 || pcbddc->coarse_problem_type == REPLICATED_BDDC || pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
2052       j = size_prec_comm;
2053     }
2054     ierr = PetscMalloc(j*sizeof(PetscMPIInt),&pcbddc->local_primal_sizes);CHKERRQ(ierr);
2055     ierr = PetscMalloc(j*sizeof(PetscMPIInt),&pcbddc->local_primal_displacements);CHKERRQ(ierr);
2056     /* Gather local_primal_size information for all processes  */
2057     if (pcbddc->coarse_problem_type == REPLICATED_BDDC || pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
2058       ierr = MPI_Allgather(&mpi_local_primal_size,1,MPIU_INT,&pcbddc->local_primal_sizes[0],1,MPIU_INT,prec_comm);CHKERRQ(ierr);
2059     } else {
2060       ierr = MPI_Gather(&mpi_local_primal_size,1,MPIU_INT,&pcbddc->local_primal_sizes[0],1,MPIU_INT,0,prec_comm);CHKERRQ(ierr);
2061     }
2062     pcbddc->replicated_primal_size = 0;
2063     for (i=0; i<j; i++) {
2064       pcbddc->local_primal_displacements[i] = pcbddc->replicated_primal_size ;
2065       pcbddc->replicated_primal_size += pcbddc->local_primal_sizes[i];
2066     }
2067 
2068     /* First let's count coarse dofs.
2069        This code fragment assumes that the number of local constraints per connected component
2070        is not greater than the number of nodes defined for the connected component
2071        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
2072     ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&auxlocal_primal);CHKERRQ(ierr);
2073     ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&i,&aux_idx);CHKERRQ(ierr);
2074     ierr = PetscMemcpy(auxlocal_primal,aux_idx,i*sizeof(PetscInt));CHKERRQ(ierr);
2075     ierr = PetscFree(aux_idx);CHKERRQ(ierr);
2076     ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&j,&aux_idx);CHKERRQ(ierr);
2077     ierr = PetscMemcpy(&auxlocal_primal[i],aux_idx,j*sizeof(PetscInt));CHKERRQ(ierr);
2078     ierr = PetscFree(aux_idx);CHKERRQ(ierr);
2079     /* Compute number of coarse dofs */
2080     ierr = PCBDDCSubsetNumbering(prec_comm,matis->mapping,pcbddc->local_primal_size,auxlocal_primal,NULL,&pcbddc->coarse_size,&pcbddc->local_primal_indices);CHKERRQ(ierr);
2081 
2082     if (dbg_flag) {
2083       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2084       ierr = PetscViewerASCIIPrintf(viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
2085       ierr = PetscViewerASCIIPrintf(viewer,"Check coarse indices\n");CHKERRQ(ierr);
2086       ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
2087       ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
2088       for (i=0;i<pcbddc->local_primal_size;i++) array[auxlocal_primal[i]]=1.0;
2089       ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
2090       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
2091       ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2092       ierr = VecScatterEnd  (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2093       ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2094       ierr = VecScatterEnd  (matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2095       ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
2096       for (i=0;i<pcis->n;i++) {
2097         if (array[i] == 1.0) {
2098           ierr = ISLocalToGlobalMappingApply(matis->mapping,1,&i,&j);CHKERRQ(ierr);
2099           ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d: WRONG COARSE INDEX %d (local %d)\n",PetscGlobalRank,j,i);CHKERRQ(ierr);
2100         }
2101       }
2102       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2103       for (i=0;i<pcis->n;i++) {
2104         if (array[i] > 0.0) array[i] = 1.0/array[i];
2105       }
2106       ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
2107       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
2108       ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2109       ierr = VecScatterEnd  (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2110       ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
2111       ierr = PetscViewerASCIIPrintf(viewer,"Size of coarse problem SHOULD be %lf\n",coarsesum);CHKERRQ(ierr);
2112       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2113     }
2114     ierr = PetscFree(auxlocal_primal);CHKERRQ(ierr);
2115   }
2116 
2117   if (dbg_flag) {
2118     ierr = PetscViewerASCIIPrintf(viewer,"Size of coarse problem is %d\n",pcbddc->coarse_size);CHKERRQ(ierr);
2119     if (dbg_flag > 1) {
2120       ierr = PetscViewerASCIIPrintf(viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
2121       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2122       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
2123       for (i=0;i<pcbddc->local_primal_size;i++) {
2124         ierr = PetscViewerASCIISynchronizedPrintf(viewer,"local_primal_indices[%d]=%d \n",i,pcbddc->local_primal_indices[i]);
2125       }
2126       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2127     }
2128   }
2129 
2130   im_active = 0;
2131   if (pcis->n) im_active = 1;
2132   ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,prec_comm);CHKERRQ(ierr);
2133 
2134   /* adapt coarse problem type */
2135   if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
2136     if (pcbddc->current_level < pcbddc->max_levels) {
2137       if ( (active_procs/pcbddc->coarsening_ratio) < 2 ) {
2138         if (dbg_flag) {
2139           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);
2140          ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2141         }
2142         pcbddc->coarse_problem_type = PARALLEL_BDDC;
2143       }
2144     } else {
2145       if (dbg_flag) {
2146         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);
2147         ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2148       }
2149       pcbddc->coarse_problem_type = PARALLEL_BDDC;
2150     }
2151   }
2152 
2153   switch(pcbddc->coarse_problem_type){
2154 
2155     case(MULTILEVEL_BDDC):   /* we define a coarse mesh where subdomains are elements */
2156     {
2157       /* we need additional variables */
2158       MetisInt    n_subdomains,n_parts,objval,ncon,faces_nvtxs;
2159       MetisInt    *metis_coarse_subdivision;
2160       MetisInt    options[METIS_NOPTIONS];
2161       PetscMPIInt size_coarse_comm,rank_coarse_comm;
2162       PetscMPIInt procs_jumps_coarse_comm;
2163       PetscMPIInt *coarse_subdivision;
2164       PetscMPIInt *total_count_recv;
2165       PetscMPIInt *total_ranks_recv;
2166       PetscMPIInt *displacements_recv;
2167       PetscMPIInt *my_faces_connectivity;
2168       PetscMPIInt *petsc_faces_adjncy;
2169       MetisInt    *faces_adjncy;
2170       MetisInt    *faces_xadj;
2171       PetscMPIInt *number_of_faces;
2172       PetscMPIInt *faces_displacements;
2173       PetscInt    *array_int;
2174       PetscMPIInt my_faces=0;
2175       PetscMPIInt total_faces=0;
2176       PetscInt    ranks_stretching_ratio;
2177 
2178       /* define some quantities */
2179       pcbddc->coarse_communications_type = SCATTERS_BDDC;
2180       coarse_mat_type = MATIS;
2181       coarse_pc_type  = PCBDDC;
2182       coarse_ksp_type = KSPRICHARDSON;
2183 
2184       /* details of coarse decomposition */
2185       n_subdomains = active_procs;
2186       n_parts      = n_subdomains/pcbddc->coarsening_ratio;
2187       ranks_stretching_ratio = size_prec_comm/active_procs;
2188       procs_jumps_coarse_comm = pcbddc->coarsening_ratio*ranks_stretching_ratio;
2189 
2190 #if 0
2191       PetscMPIInt *old_ranks;
2192       PetscInt    *new_ranks,*jj,*ii;
2193       MatPartitioning mat_part;
2194       IS coarse_new_decomposition,is_numbering;
2195       PetscViewer viewer_test;
2196       MPI_Comm    test_coarse_comm;
2197       PetscMPIInt test_coarse_color;
2198       Mat         mat_adj;
2199       /* Create new communicator for coarse problem splitting the old one */
2200       /* procs with coarse_color = MPI_UNDEFINED will have coarse_comm = MPI_COMM_NULL (from mpi standards)
2201          key = rank_prec_comm -> keep same ordering of ranks from the old to the new communicator */
2202       test_coarse_color = ( im_active ? 0 : MPI_UNDEFINED );
2203       test_coarse_comm = MPI_COMM_NULL;
2204       ierr = MPI_Comm_split(prec_comm,test_coarse_color,rank_prec_comm,&test_coarse_comm);CHKERRQ(ierr);
2205       if (im_active) {
2206         ierr = PetscMalloc(n_subdomains*sizeof(PetscMPIInt),&old_ranks);
2207         ierr = PetscMalloc(size_prec_comm*sizeof(PetscInt),&new_ranks);
2208         ierr = MPI_Comm_rank(test_coarse_comm,&rank_coarse_comm);CHKERRQ(ierr);
2209         ierr = MPI_Comm_size(test_coarse_comm,&j);CHKERRQ(ierr);
2210         ierr = MPI_Allgather(&rank_prec_comm,1,MPIU_INT,old_ranks,1,MPIU_INT,test_coarse_comm);CHKERRQ(ierr);
2211         for (i=0; i<size_prec_comm; i++) new_ranks[i] = -1;
2212         for (i=0; i<n_subdomains; i++) new_ranks[old_ranks[i]] = i;
2213         ierr = PetscViewerASCIIOpen(test_coarse_comm,"test_mat_part.out",&viewer_test);CHKERRQ(ierr);
2214         k = pcis->n_neigh-1;
2215         ierr = PetscMalloc(2*sizeof(PetscInt),&ii);
2216         ii[0]=0;
2217         ii[1]=k;
2218         ierr = PetscMalloc(k*sizeof(PetscInt),&jj);
2219         for (i=0; i<k; i++) jj[i]=new_ranks[pcis->neigh[i+1]];
2220         ierr = PetscSortInt(k,jj);CHKERRQ(ierr);
2221         ierr = MatCreateMPIAdj(test_coarse_comm,1,n_subdomains,ii,jj,NULL,&mat_adj);CHKERRQ(ierr);
2222         ierr = MatView(mat_adj,viewer_test);CHKERRQ(ierr);
2223         ierr = MatPartitioningCreate(test_coarse_comm,&mat_part);CHKERRQ(ierr);
2224         ierr = MatPartitioningSetAdjacency(mat_part,mat_adj);CHKERRQ(ierr);
2225         ierr = MatPartitioningSetFromOptions(mat_part);CHKERRQ(ierr);
2226         printf("Setting Nparts %d\n",n_parts);
2227         ierr = MatPartitioningSetNParts(mat_part,n_parts);CHKERRQ(ierr);
2228         ierr = MatPartitioningView(mat_part,viewer_test);CHKERRQ(ierr);
2229         ierr = MatPartitioningApply(mat_part,&coarse_new_decomposition);CHKERRQ(ierr);
2230         ierr = ISView(coarse_new_decomposition,viewer_test);CHKERRQ(ierr);
2231         ierr = ISPartitioningToNumbering(coarse_new_decomposition,&is_numbering);CHKERRQ(ierr);
2232         ierr = ISView(is_numbering,viewer_test);CHKERRQ(ierr);
2233         ierr = PetscViewerDestroy(&viewer_test);CHKERRQ(ierr);
2234         ierr = ISDestroy(&coarse_new_decomposition);CHKERRQ(ierr);
2235         ierr = ISDestroy(&is_numbering);CHKERRQ(ierr);
2236         ierr = MatPartitioningDestroy(&mat_part);CHKERRQ(ierr);
2237         ierr = PetscFree(old_ranks);CHKERRQ(ierr);
2238         ierr = PetscFree(new_ranks);CHKERRQ(ierr);
2239         ierr = MPI_Comm_free(&test_coarse_comm);CHKERRQ(ierr);
2240       }
2241 #endif
2242 
2243       /* build CSR graph of subdomains' connectivity */
2244       ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&array_int);CHKERRQ(ierr);
2245       ierr = PetscMemzero(array_int,pcis->n*sizeof(PetscInt));CHKERRQ(ierr);
2246       for (i=1;i<pcis->n_neigh;i++){/* i=1 so I don't count myself -> faces nodes counts to 1 */
2247         for (j=0;j<pcis->n_shared[i];j++){
2248           array_int[ pcis->shared[i][j] ]+=1;
2249         }
2250       }
2251       for (i=1;i<pcis->n_neigh;i++){
2252         for (j=0;j<pcis->n_shared[i];j++){
2253           if (array_int[ pcis->shared[i][j] ] > 0 ){
2254             my_faces++;
2255             break;
2256           }
2257         }
2258       }
2259 
2260       ierr = MPI_Reduce(&my_faces,&total_faces,1,MPIU_INT,MPI_SUM,master_proc,prec_comm);CHKERRQ(ierr);
2261       ierr = PetscMalloc (my_faces*sizeof(PetscInt),&my_faces_connectivity);CHKERRQ(ierr);
2262       my_faces=0;
2263       for (i=1;i<pcis->n_neigh;i++){
2264         for (j=0;j<pcis->n_shared[i];j++){
2265           if (array_int[ pcis->shared[i][j] ] > 0 ){
2266             my_faces_connectivity[my_faces]=pcis->neigh[i];
2267             my_faces++;
2268             break;
2269           }
2270         }
2271       }
2272       if (rank_prec_comm == master_proc) {
2273         ierr = PetscMalloc (total_faces*sizeof(PetscMPIInt),&petsc_faces_adjncy);CHKERRQ(ierr);
2274         ierr = PetscMalloc (size_prec_comm*sizeof(PetscMPIInt),&number_of_faces);CHKERRQ(ierr);
2275         ierr = PetscMalloc (total_faces*sizeof(MetisInt),&faces_adjncy);CHKERRQ(ierr);
2276         ierr = PetscMalloc ((n_subdomains+1)*sizeof(MetisInt),&faces_xadj);CHKERRQ(ierr);
2277         ierr = PetscMalloc ((size_prec_comm+1)*sizeof(PetscMPIInt),&faces_displacements);CHKERRQ(ierr);
2278       }
2279       ierr = MPI_Gather(&my_faces,1,MPIU_INT,&number_of_faces[0],1,MPIU_INT,master_proc,prec_comm);CHKERRQ(ierr);
2280       if (rank_prec_comm == master_proc) {
2281         faces_xadj[0]=0;
2282         faces_displacements[0]=0;
2283         j=0;
2284         for (i=1;i<size_prec_comm+1;i++) {
2285           faces_displacements[i]=faces_displacements[i-1]+number_of_faces[i-1];
2286           if (number_of_faces[i-1]) {
2287             j++;
2288             faces_xadj[j]=faces_xadj[j-1]+number_of_faces[i-1];
2289           }
2290         }
2291       }
2292       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);
2293       ierr = PetscFree(my_faces_connectivity);CHKERRQ(ierr);
2294       ierr = PetscFree(array_int);CHKERRQ(ierr);
2295       if (rank_prec_comm == master_proc) {
2296         for (i=0;i<total_faces;i++) faces_adjncy[i]=(MetisInt)(petsc_faces_adjncy[i]/ranks_stretching_ratio); /* cast to MetisInt */
2297         ierr = PetscFree(faces_displacements);CHKERRQ(ierr);
2298         ierr = PetscFree(number_of_faces);CHKERRQ(ierr);
2299         ierr = PetscFree(petsc_faces_adjncy);CHKERRQ(ierr);
2300       }
2301 
2302       if ( rank_prec_comm == master_proc ) {
2303 
2304         PetscInt heuristic_for_metis=3;
2305 
2306         ncon=1;
2307         faces_nvtxs=n_subdomains;
2308         /* partition graoh induced by face connectivity */
2309         ierr = PetscMalloc (n_subdomains*sizeof(MetisInt),&metis_coarse_subdivision);CHKERRQ(ierr);
2310         ierr = METIS_SetDefaultOptions(options);
2311         /* we need a contiguous partition of the coarse mesh */
2312         options[METIS_OPTION_CONTIG]=1;
2313         options[METIS_OPTION_NITER]=30;
2314         if (pcbddc->coarsening_ratio > 1) {
2315           if (n_subdomains>n_parts*heuristic_for_metis) {
2316             options[METIS_OPTION_IPTYPE]=METIS_IPTYPE_EDGE;
2317             options[METIS_OPTION_OBJTYPE]=METIS_OBJTYPE_CUT;
2318             ierr = METIS_PartGraphKway(&faces_nvtxs,&ncon,faces_xadj,faces_adjncy,NULL,NULL,NULL,&n_parts,NULL,NULL,options,&objval,metis_coarse_subdivision);
2319             if (ierr != METIS_OK) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in METIS_PartGraphKway (metis error code %D) called from PCBDDCSetUpCoarseEnvironment\n",ierr);
2320           } else {
2321             ierr = METIS_PartGraphRecursive(&faces_nvtxs,&ncon,faces_xadj,faces_adjncy,NULL,NULL,NULL,&n_parts,NULL,NULL,options,&objval,metis_coarse_subdivision);
2322             if (ierr != METIS_OK) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in METIS_PartGraphRecursive (metis error code %D) called from PCBDDCSetUpCoarseEnvironment\n",ierr);
2323           }
2324         } else {
2325           for (i=0;i<n_subdomains;i++) metis_coarse_subdivision[i]=i;
2326         }
2327         ierr = PetscFree(faces_xadj);CHKERRQ(ierr);
2328         ierr = PetscFree(faces_adjncy);CHKERRQ(ierr);
2329         ierr = PetscMalloc(size_prec_comm*sizeof(PetscMPIInt),&coarse_subdivision);CHKERRQ(ierr);
2330 
2331         /* copy/cast values avoiding possible type conflicts between PETSc, MPI and METIS */
2332         for (i=0;i<size_prec_comm;i++) coarse_subdivision[i]=MPI_PROC_NULL;
2333         for (i=0;i<n_subdomains;i++) coarse_subdivision[ranks_stretching_ratio*i]=(PetscInt)(metis_coarse_subdivision[i]);
2334         ierr = PetscFree(metis_coarse_subdivision);CHKERRQ(ierr);
2335       }
2336 
2337       /* Create new communicator for coarse problem splitting the old one */
2338       if ( !(rank_prec_comm%procs_jumps_coarse_comm) && rank_prec_comm < procs_jumps_coarse_comm*n_parts ){
2339         coarse_color=0;              /* for communicator splitting */
2340         active_rank=rank_prec_comm;  /* for insertion of matrix values */
2341       }
2342       /* procs with coarse_color = MPI_UNDEFINED will have coarse_comm = MPI_COMM_NULL (from mpi standards)
2343          key = rank_prec_comm -> keep same ordering of ranks from the old to the new communicator */
2344       ierr = MPI_Comm_split(prec_comm,coarse_color,rank_prec_comm,&coarse_comm);CHKERRQ(ierr);
2345 
2346       if ( coarse_color == 0 ) {
2347         ierr = MPI_Comm_size(coarse_comm,&size_coarse_comm);CHKERRQ(ierr);
2348         ierr = MPI_Comm_rank(coarse_comm,&rank_coarse_comm);CHKERRQ(ierr);
2349       } else {
2350         rank_coarse_comm = MPI_PROC_NULL;
2351       }
2352 
2353       /* master proc take care of arranging and distributing coarse information */
2354       if (rank_coarse_comm == master_proc) {
2355         ierr = PetscMalloc (size_coarse_comm*sizeof(PetscMPIInt),&displacements_recv);CHKERRQ(ierr);
2356         ierr = PetscMalloc (size_coarse_comm*sizeof(PetscMPIInt),&total_count_recv);CHKERRQ(ierr);
2357         ierr = PetscMalloc (n_subdomains*sizeof(PetscMPIInt),&total_ranks_recv);CHKERRQ(ierr);
2358         /* some initializations */
2359         displacements_recv[0]=0;
2360         ierr = PetscMemzero(total_count_recv,size_coarse_comm*sizeof(PetscMPIInt));CHKERRQ(ierr);
2361         /* count from how many processes the j-th process of the coarse decomposition will receive data */
2362         for (j=0;j<size_coarse_comm;j++) {
2363           for (i=0;i<size_prec_comm;i++) {
2364           if (coarse_subdivision[i]==j) total_count_recv[j]++;
2365           }
2366         }
2367         /* displacements needed for scatterv of total_ranks_recv */
2368       for (i=1; i<size_coarse_comm; i++) displacements_recv[i]=displacements_recv[i-1]+total_count_recv[i-1];
2369 
2370         /* Now fill properly total_ranks_recv -> each coarse process will receive the ranks (in prec_comm communicator) of its friend (sending) processes */
2371         ierr = PetscMemzero(total_count_recv,size_coarse_comm*sizeof(PetscMPIInt));CHKERRQ(ierr);
2372         for (j=0;j<size_coarse_comm;j++) {
2373           for (i=0;i<size_prec_comm;i++) {
2374             if (coarse_subdivision[i]==j) {
2375               total_ranks_recv[displacements_recv[j]+total_count_recv[j]]=i;
2376               total_count_recv[j]+=1;
2377             }
2378           }
2379         }
2380         /*for (j=0;j<size_coarse_comm;j++) {
2381           printf("process %d in new rank will receive from %d processes (original ranks follows)\n",j,total_count_recv[j]);
2382           for (i=0;i<total_count_recv[j];i++) {
2383             printf("%d ",total_ranks_recv[displacements_recv[j]+i]);
2384           }
2385           printf("\n");
2386         }*/
2387 
2388         /* identify new decomposition in terms of ranks in the old communicator */
2389         for (i=0;i<n_subdomains;i++) {
2390           coarse_subdivision[ranks_stretching_ratio*i]=coarse_subdivision[ranks_stretching_ratio*i]*procs_jumps_coarse_comm;
2391         }
2392         /*printf("coarse_subdivision in old end new ranks\n");
2393         for (i=0;i<size_prec_comm;i++)
2394           if (coarse_subdivision[i]!=MPI_PROC_NULL) {
2395             printf("%d=(%d %d), ",i,coarse_subdivision[i],coarse_subdivision[i]/procs_jumps_coarse_comm);
2396           } else {
2397             printf("%d=(%d %d), ",i,coarse_subdivision[i],coarse_subdivision[i]);
2398           }
2399         printf("\n");*/
2400       }
2401 
2402       /* Scatter new decomposition for send details */
2403       ierr = MPI_Scatter(&coarse_subdivision[0],1,MPIU_INT,&rank_coarse_proc_send_to,1,MPIU_INT,master_proc,prec_comm);CHKERRQ(ierr);
2404       /* Scatter receiving details to members of coarse decomposition */
2405       if ( coarse_color == 0) {
2406         ierr = MPI_Scatter(&total_count_recv[0],1,MPIU_INT,&count_recv,1,MPIU_INT,master_proc,coarse_comm);CHKERRQ(ierr);
2407         ierr = PetscMalloc (count_recv*sizeof(PetscMPIInt),&ranks_recv);CHKERRQ(ierr);
2408         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);
2409       }
2410 
2411       /*printf("I will send my matrix data to proc  %d\n",rank_coarse_proc_send_to);
2412       if (coarse_color == 0) {
2413         printf("I will receive some matrix data from %d processes (ranks follows)\n",count_recv);
2414         for (i=0;i<count_recv;i++)
2415           printf("%d ",ranks_recv[i]);
2416         printf("\n");
2417       }*/
2418 
2419       if (rank_prec_comm == master_proc) {
2420         ierr = PetscFree(coarse_subdivision);CHKERRQ(ierr);
2421         ierr = PetscFree(total_count_recv);CHKERRQ(ierr);
2422         ierr = PetscFree(total_ranks_recv);CHKERRQ(ierr);
2423         ierr = PetscFree(displacements_recv);CHKERRQ(ierr);
2424       }
2425       break;
2426     }
2427 
2428     case(REPLICATED_BDDC):
2429 
2430       pcbddc->coarse_communications_type = GATHERS_BDDC;
2431       coarse_mat_type = MATSEQAIJ;
2432       coarse_pc_type  = PCLU;
2433       coarse_ksp_type  = KSPPREONLY;
2434       coarse_comm = PETSC_COMM_SELF;
2435       active_rank = rank_prec_comm;
2436       break;
2437 
2438     case(PARALLEL_BDDC):
2439 
2440       pcbddc->coarse_communications_type = SCATTERS_BDDC;
2441       coarse_mat_type = MATAIJ;
2442       coarse_pc_type  = PCREDUNDANT;
2443       coarse_ksp_type  = KSPPREONLY;
2444       coarse_comm = prec_comm;
2445       active_rank = rank_prec_comm;
2446       break;
2447 
2448     case(SEQUENTIAL_BDDC):
2449       pcbddc->coarse_communications_type = GATHERS_BDDC;
2450       coarse_mat_type = MATAIJ;
2451       coarse_pc_type = PCLU;
2452       coarse_ksp_type  = KSPPREONLY;
2453       coarse_comm = PETSC_COMM_SELF;
2454       active_rank = master_proc;
2455       break;
2456   }
2457 
2458   switch(pcbddc->coarse_communications_type){
2459 
2460     case(SCATTERS_BDDC):
2461       {
2462         if (pcbddc->coarse_problem_type==MULTILEVEL_BDDC) {
2463 
2464           IS coarse_IS;
2465 
2466           if(pcbddc->coarsening_ratio == 1) {
2467             ins_local_primal_size = pcbddc->local_primal_size;
2468             ins_local_primal_indices = pcbddc->local_primal_indices;
2469             if (coarse_color == 0) { ierr = PetscFree(ranks_recv);CHKERRQ(ierr); }
2470             /* nonzeros */
2471             ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&dnz);CHKERRQ(ierr);
2472             ierr = PetscMemzero(dnz,ins_local_primal_size*sizeof(PetscInt));CHKERRQ(ierr);
2473             for (i=0;i<ins_local_primal_size;i++) {
2474               dnz[i] = ins_local_primal_size;
2475             }
2476           } else {
2477             PetscMPIInt send_size;
2478             PetscMPIInt *send_buffer;
2479             PetscInt    *aux_ins_indices;
2480             PetscInt    ii,jj;
2481             MPI_Request *requests;
2482 
2483             ierr = PetscMalloc(count_recv*sizeof(PetscMPIInt),&localdispl2);CHKERRQ(ierr);
2484             /* reusing pcbddc->local_primal_displacements and pcbddc->replicated_primal_size */
2485             ierr = PetscFree(pcbddc->local_primal_displacements);CHKERRQ(ierr);
2486             ierr = PetscMalloc((count_recv+1)*sizeof(PetscMPIInt),&pcbddc->local_primal_displacements);CHKERRQ(ierr);
2487             pcbddc->replicated_primal_size = count_recv;
2488             j = 0;
2489             for (i=0;i<count_recv;i++) {
2490               pcbddc->local_primal_displacements[i] = j;
2491               j += pcbddc->local_primal_sizes[ranks_recv[i]];
2492             }
2493             pcbddc->local_primal_displacements[count_recv] = j;
2494             ierr = PetscMalloc(j*sizeof(PetscMPIInt),&pcbddc->replicated_local_primal_indices);CHKERRQ(ierr);
2495             /* allocate auxiliary space */
2496             ierr = PetscMalloc(count_recv*sizeof(PetscMPIInt),&localsizes2);CHKERRQ(ierr);
2497             ierr = PetscMalloc(pcbddc->coarse_size*sizeof(PetscInt),&aux_ins_indices);CHKERRQ(ierr);
2498             ierr = PetscMemzero(aux_ins_indices,pcbddc->coarse_size*sizeof(PetscInt));CHKERRQ(ierr);
2499             /* allocate stuffs for message massing */
2500             ierr = PetscMalloc((count_recv+1)*sizeof(MPI_Request),&requests);CHKERRQ(ierr);
2501             for (i=0;i<count_recv+1;i++) { requests[i]=MPI_REQUEST_NULL; }
2502             /* send indices to be inserted */
2503             for (i=0;i<count_recv;i++) {
2504               send_size = pcbddc->local_primal_sizes[ranks_recv[i]];
2505               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);
2506             }
2507             if (rank_coarse_proc_send_to != MPI_PROC_NULL ) {
2508               send_size = pcbddc->local_primal_size;
2509               ierr = PetscMalloc(send_size*sizeof(PetscMPIInt),&send_buffer);CHKERRQ(ierr);
2510               for (i=0;i<send_size;i++) {
2511                 send_buffer[i]=(PetscMPIInt)pcbddc->local_primal_indices[i];
2512               }
2513               ierr = MPI_Isend(send_buffer,send_size,MPIU_INT,rank_coarse_proc_send_to,999,prec_comm,&requests[count_recv]);CHKERRQ(ierr);
2514             }
2515             ierr = MPI_Waitall(count_recv+1,requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2516             if (rank_coarse_proc_send_to != MPI_PROC_NULL ) {
2517               ierr = PetscFree(send_buffer);CHKERRQ(ierr);
2518             }
2519             j = 0;
2520             for (i=0;i<count_recv;i++) {
2521               ii = pcbddc->local_primal_displacements[i+1]-pcbddc->local_primal_displacements[i];
2522               localsizes2[i] = ii*ii;
2523               localdispl2[i] = j;
2524               j += localsizes2[i];
2525               jj = pcbddc->local_primal_displacements[i];
2526               /* it counts the coarse subdomains sharing the coarse node */
2527               for (k=0;k<ii;k++) {
2528                 aux_ins_indices[pcbddc->replicated_local_primal_indices[jj+k]] += 1;
2529               }
2530             }
2531             /* temp_coarse_mat_vals used to store matrix values to be received */
2532             ierr = PetscMalloc(j*sizeof(PetscScalar),&temp_coarse_mat_vals);CHKERRQ(ierr);
2533             /* evaluate how many values I will insert in coarse mat */
2534             ins_local_primal_size = 0;
2535             for (i=0;i<pcbddc->coarse_size;i++) {
2536               if (aux_ins_indices[i]) {
2537                 ins_local_primal_size++;
2538               }
2539             }
2540             /* evaluate indices I will insert in coarse mat */
2541             ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr);
2542             j = 0;
2543             for(i=0;i<pcbddc->coarse_size;i++) {
2544               if(aux_ins_indices[i]) {
2545                 ins_local_primal_indices[j] = i;
2546                 j++;
2547               }
2548             }
2549             /* processes partecipating in coarse problem receive matrix data from their friends */
2550             for (i=0;i<count_recv;i++) {
2551               ierr = MPI_Irecv(&temp_coarse_mat_vals[localdispl2[i]],localsizes2[i],MPIU_SCALAR,ranks_recv[i],666,prec_comm,&requests[i]);CHKERRQ(ierr);
2552             }
2553             if (rank_coarse_proc_send_to != MPI_PROC_NULL ) {
2554               send_size = pcbddc->local_primal_size*pcbddc->local_primal_size;
2555               ierr = MPI_Isend(&coarse_submat_vals[0],send_size,MPIU_SCALAR,rank_coarse_proc_send_to,666,prec_comm,&requests[count_recv]);CHKERRQ(ierr);
2556             }
2557             ierr = MPI_Waitall(count_recv+1,requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2558             /* nonzeros */
2559             ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&dnz);CHKERRQ(ierr);
2560             ierr = PetscMemzero(dnz,ins_local_primal_size*sizeof(PetscInt));CHKERRQ(ierr);
2561             /* use aux_ins_indices to realize a global to local mapping */
2562             j=0;
2563             for(i=0;i<pcbddc->coarse_size;i++){
2564               if(aux_ins_indices[i]==0){
2565                 aux_ins_indices[i]=-1;
2566               } else {
2567                 aux_ins_indices[i]=j;
2568                 j++;
2569               }
2570             }
2571             for (i=0;i<count_recv;i++) {
2572               j = pcbddc->local_primal_sizes[ranks_recv[i]];
2573               for (k=0;k<j;k++) {
2574                 dnz[aux_ins_indices[pcbddc->replicated_local_primal_indices[pcbddc->local_primal_displacements[i]+k]]] += j;
2575               }
2576             }
2577             /* check */
2578             for (i=0;i<ins_local_primal_size;i++) {
2579               if (dnz[i] > ins_local_primal_size) {
2580                 dnz[i] = ins_local_primal_size;
2581               }
2582             }
2583             ierr = PetscFree(requests);CHKERRQ(ierr);
2584             ierr = PetscFree(aux_ins_indices);CHKERRQ(ierr);
2585             if (coarse_color == 0) { ierr = PetscFree(ranks_recv);CHKERRQ(ierr); }
2586           }
2587           /* create local to global mapping needed by coarse MATIS */
2588           if (coarse_comm != MPI_COMM_NULL ) {ierr = MPI_Comm_free(&coarse_comm);CHKERRQ(ierr);}
2589           coarse_comm = prec_comm;
2590           active_rank = rank_prec_comm;
2591           ierr = ISCreateGeneral(coarse_comm,ins_local_primal_size,ins_local_primal_indices,PETSC_COPY_VALUES,&coarse_IS);CHKERRQ(ierr);
2592           ierr = ISLocalToGlobalMappingCreateIS(coarse_IS,&coarse_ISLG);CHKERRQ(ierr);
2593           ierr = ISDestroy(&coarse_IS);CHKERRQ(ierr);
2594         } else if (pcbddc->coarse_problem_type==PARALLEL_BDDC) {
2595           /* arrays for values insertion */
2596           ins_local_primal_size = pcbddc->local_primal_size;
2597           ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr);
2598           ierr = PetscMalloc(ins_local_primal_size*ins_local_primal_size*sizeof(PetscScalar),&ins_coarse_mat_vals);CHKERRQ(ierr);
2599           for (j=0;j<ins_local_primal_size;j++){
2600             ins_local_primal_indices[j]=pcbddc->local_primal_indices[j];
2601             for (i=0;i<ins_local_primal_size;i++) {
2602               ins_coarse_mat_vals[j*ins_local_primal_size+i]=coarse_submat_vals[j*ins_local_primal_size+i];
2603             }
2604           }
2605         }
2606         break;
2607 
2608     }
2609 
2610     case(GATHERS_BDDC):
2611       {
2612 
2613         PetscMPIInt mysize,mysize2;
2614         PetscMPIInt *send_buffer;
2615 
2616         if (rank_prec_comm==active_rank) {
2617           ierr = PetscMalloc ( pcbddc->replicated_primal_size*sizeof(PetscMPIInt),&pcbddc->replicated_local_primal_indices);CHKERRQ(ierr);
2618           ierr = PetscMalloc ( pcbddc->replicated_primal_size*sizeof(PetscScalar),&pcbddc->replicated_local_primal_values);CHKERRQ(ierr);
2619           ierr = PetscMalloc ( size_prec_comm*sizeof(PetscMPIInt),&localsizes2);CHKERRQ(ierr);
2620           ierr = PetscMalloc ( size_prec_comm*sizeof(PetscMPIInt),&localdispl2);CHKERRQ(ierr);
2621           /* arrays for values insertion */
2622       for (i=0;i<size_prec_comm;i++) localsizes2[i]=pcbddc->local_primal_sizes[i]*pcbddc->local_primal_sizes[i];
2623           localdispl2[0]=0;
2624       for (i=1;i<size_prec_comm;i++) localdispl2[i]=localsizes2[i-1]+localdispl2[i-1];
2625           j=0;
2626       for (i=0;i<size_prec_comm;i++) j+=localsizes2[i];
2627           ierr = PetscMalloc ( j*sizeof(PetscScalar),&temp_coarse_mat_vals);CHKERRQ(ierr);
2628         }
2629 
2630         mysize=pcbddc->local_primal_size;
2631         mysize2=pcbddc->local_primal_size*pcbddc->local_primal_size;
2632         ierr = PetscMalloc(mysize*sizeof(PetscMPIInt),&send_buffer);CHKERRQ(ierr);
2633     for (i=0; i<mysize; i++) send_buffer[i]=(PetscMPIInt)pcbddc->local_primal_indices[i];
2634 
2635         if (pcbddc->coarse_problem_type == SEQUENTIAL_BDDC){
2636           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);
2637           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);
2638         } else {
2639           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);
2640           ierr = MPI_Allgatherv(&coarse_submat_vals[0],mysize2,MPIU_SCALAR,&temp_coarse_mat_vals[0],localsizes2,localdispl2,MPIU_SCALAR,prec_comm);CHKERRQ(ierr);
2641         }
2642         ierr = PetscFree(send_buffer);CHKERRQ(ierr);
2643         break;
2644       }/* switch on coarse problem and communications associated with finished */
2645   }
2646 
2647   /* Now create and fill up coarse matrix */
2648   if ( rank_prec_comm == active_rank ) {
2649 
2650     Mat matis_coarse_local_mat;
2651 
2652     if (pcbddc->coarse_problem_type != MULTILEVEL_BDDC) {
2653       ierr = MatCreate(coarse_comm,&pcbddc->coarse_mat);CHKERRQ(ierr);
2654       ierr = MatSetSizes(pcbddc->coarse_mat,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size);CHKERRQ(ierr);
2655       ierr = MatSetType(pcbddc->coarse_mat,coarse_mat_type);CHKERRQ(ierr);
2656       ierr = MatSetOptionsPrefix(pcbddc->coarse_mat,"coarse_");CHKERRQ(ierr);
2657       ierr = MatSetFromOptions(pcbddc->coarse_mat);CHKERRQ(ierr);
2658       ierr = MatSetUp(pcbddc->coarse_mat);CHKERRQ(ierr);
2659       ierr = MatSetOption(pcbddc->coarse_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr); /* local values stored in column major */
2660       ierr = MatSetOption(pcbddc->coarse_mat,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr);
2661     } else {
2662       ierr = MatCreateIS(coarse_comm,1,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size,coarse_ISLG,&pcbddc->coarse_mat);CHKERRQ(ierr);
2663       ierr = MatSetUp(pcbddc->coarse_mat);CHKERRQ(ierr);
2664       ierr = MatISGetLocalMat(pcbddc->coarse_mat,&matis_coarse_local_mat);CHKERRQ(ierr);
2665       ierr = MatSetOptionsPrefix(pcbddc->coarse_mat,"coarse_");CHKERRQ(ierr);
2666       ierr = MatSetFromOptions(pcbddc->coarse_mat);CHKERRQ(ierr);
2667       ierr = MatSetUp(matis_coarse_local_mat);CHKERRQ(ierr);
2668       ierr = MatSetOption(matis_coarse_local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr); /* local values stored in column major */
2669       ierr = MatSetOption(matis_coarse_local_mat,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr);
2670     }
2671     /* preallocation */
2672     if (pcbddc->coarse_problem_type != MULTILEVEL_BDDC) {
2673 
2674       PetscInt lrows,lcols,bs;
2675 
2676       ierr = MatGetLocalSize(pcbddc->coarse_mat,&lrows,&lcols);CHKERRQ(ierr);
2677       ierr = MatPreallocateInitialize(coarse_comm,lrows,lcols,dnz,onz);CHKERRQ(ierr);
2678       ierr = MatGetBlockSize(pcbddc->coarse_mat,&bs);CHKERRQ(ierr);
2679 
2680       if (pcbddc->coarse_problem_type == PARALLEL_BDDC) {
2681 
2682         Vec         vec_dnz,vec_onz;
2683         PetscScalar *my_dnz,*my_onz,*array;
2684         PetscInt    *mat_ranges,*row_ownership;
2685         PetscInt    coarse_index_row,coarse_index_col,owner;
2686 
2687         ierr = VecCreate(prec_comm,&vec_dnz);CHKERRQ(ierr);
2688         ierr = VecSetBlockSize(vec_dnz,bs);CHKERRQ(ierr);
2689         ierr = VecSetSizes(vec_dnz,PETSC_DECIDE,pcbddc->coarse_size);CHKERRQ(ierr);
2690         ierr = VecSetType(vec_dnz,VECMPI);CHKERRQ(ierr);
2691         ierr = VecDuplicate(vec_dnz,&vec_onz);CHKERRQ(ierr);
2692 
2693         ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscScalar),&my_dnz);CHKERRQ(ierr);
2694         ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscScalar),&my_onz);CHKERRQ(ierr);
2695         ierr = PetscMemzero(my_dnz,pcbddc->local_primal_size*sizeof(PetscScalar));CHKERRQ(ierr);
2696         ierr = PetscMemzero(my_onz,pcbddc->local_primal_size*sizeof(PetscScalar));CHKERRQ(ierr);
2697 
2698         ierr = PetscMalloc(pcbddc->coarse_size*sizeof(PetscInt),&row_ownership);CHKERRQ(ierr);
2699         ierr = MatGetOwnershipRanges(pcbddc->coarse_mat,(const PetscInt**)&mat_ranges);CHKERRQ(ierr);
2700         for (i=0;i<size_prec_comm;i++) {
2701           for (j=mat_ranges[i];j<mat_ranges[i+1];j++) {
2702             row_ownership[j]=i;
2703           }
2704         }
2705 
2706         for (i=0;i<pcbddc->local_primal_size;i++) {
2707           coarse_index_row = pcbddc->local_primal_indices[i];
2708           owner = row_ownership[coarse_index_row];
2709           for (j=i;j<pcbddc->local_primal_size;j++) {
2710             owner = row_ownership[coarse_index_row];
2711             coarse_index_col = pcbddc->local_primal_indices[j];
2712             if (coarse_index_col > mat_ranges[owner]-1 && coarse_index_col < mat_ranges[owner+1] ) {
2713               my_dnz[i] += 1.0;
2714             } else {
2715               my_onz[i] += 1.0;
2716             }
2717             if (i != j) {
2718               owner = row_ownership[coarse_index_col];
2719               if (coarse_index_row > mat_ranges[owner]-1 && coarse_index_row < mat_ranges[owner+1] ) {
2720                 my_dnz[j] += 1.0;
2721               } else {
2722                 my_onz[j] += 1.0;
2723               }
2724             }
2725           }
2726         }
2727         ierr = VecSet(vec_dnz,0.0);CHKERRQ(ierr);
2728         ierr = VecSet(vec_onz,0.0);CHKERRQ(ierr);
2729         if (pcbddc->local_primal_size) {
2730           ierr = VecSetValues(vec_dnz,pcbddc->local_primal_size,pcbddc->local_primal_indices,my_dnz,ADD_VALUES);CHKERRQ(ierr);
2731           ierr = VecSetValues(vec_onz,pcbddc->local_primal_size,pcbddc->local_primal_indices,my_onz,ADD_VALUES);CHKERRQ(ierr);
2732         }
2733         ierr = VecAssemblyBegin(vec_dnz);CHKERRQ(ierr);
2734         ierr = VecAssemblyBegin(vec_onz);CHKERRQ(ierr);
2735         ierr = VecAssemblyEnd(vec_dnz);CHKERRQ(ierr);
2736         ierr = VecAssemblyEnd(vec_onz);CHKERRQ(ierr);
2737         j = mat_ranges[rank_prec_comm+1]-mat_ranges[rank_prec_comm];
2738         ierr = VecGetArray(vec_dnz,&array);CHKERRQ(ierr);
2739         for (i=0; i<j; i++) dnz[i] = (PetscInt)array[i];
2740 
2741         ierr = VecRestoreArray(vec_dnz,&array);CHKERRQ(ierr);
2742         ierr = VecGetArray(vec_onz,&array);CHKERRQ(ierr);
2743         for (i=0;i<j;i++) onz[i] = (PetscInt)array[i];
2744 
2745         ierr = VecRestoreArray(vec_onz,&array);CHKERRQ(ierr);
2746         ierr = PetscFree(my_dnz);CHKERRQ(ierr);
2747         ierr = PetscFree(my_onz);CHKERRQ(ierr);
2748         ierr = PetscFree(row_ownership);CHKERRQ(ierr);
2749         ierr = VecDestroy(&vec_dnz);CHKERRQ(ierr);
2750         ierr = VecDestroy(&vec_onz);CHKERRQ(ierr);
2751       } else {
2752         for (k=0;k<size_prec_comm;k++){
2753           offset=pcbddc->local_primal_displacements[k];
2754           offset2=localdispl2[k];
2755           ins_local_primal_size = pcbddc->local_primal_sizes[k];
2756           ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr);
2757           for (j=0;j<ins_local_primal_size;j++){
2758             ins_local_primal_indices[j]=(PetscInt)pcbddc->replicated_local_primal_indices[offset+j];
2759           }
2760           for (j=0;j<ins_local_primal_size;j++) {
2761             ierr = MatPreallocateSet(ins_local_primal_indices[j],ins_local_primal_size,ins_local_primal_indices,dnz,onz);CHKERRQ(ierr);
2762           }
2763           ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr);
2764         }
2765       }
2766 
2767       /* check */
2768       for (i=0;i<lrows;i++) {
2769         if (dnz[i]>lcols) dnz[i]=lcols;
2770         if (onz[i]>pcbddc->coarse_size-lcols) onz[i]=pcbddc->coarse_size-lcols;
2771       }
2772       ierr = MatSeqAIJSetPreallocation(pcbddc->coarse_mat,0,dnz);CHKERRQ(ierr);
2773       ierr = MatMPIAIJSetPreallocation(pcbddc->coarse_mat,0,dnz,0,onz);CHKERRQ(ierr);
2774       ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
2775     } else {
2776       ierr = MatSeqAIJSetPreallocation(matis_coarse_local_mat,0,dnz);CHKERRQ(ierr);
2777       ierr = PetscFree(dnz);CHKERRQ(ierr);
2778     }
2779     /* insert values */
2780     if (pcbddc->coarse_problem_type == PARALLEL_BDDC) {
2781       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);
2782     } else if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
2783       if (pcbddc->coarsening_ratio == 1) {
2784         ins_coarse_mat_vals = coarse_submat_vals;
2785         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);
2786       } else {
2787         ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr);
2788         for (k=0;k<pcbddc->replicated_primal_size;k++) {
2789           offset = pcbddc->local_primal_displacements[k];
2790           offset2 = localdispl2[k];
2791           ins_local_primal_size = pcbddc->local_primal_displacements[k+1]-pcbddc->local_primal_displacements[k];
2792           ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr);
2793           for (j=0;j<ins_local_primal_size;j++){
2794             ins_local_primal_indices[j]=(PetscInt)pcbddc->replicated_local_primal_indices[offset+j];
2795           }
2796           ins_coarse_mat_vals = &temp_coarse_mat_vals[offset2];
2797           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);
2798           ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr);
2799         }
2800       }
2801       ins_local_primal_indices = 0;
2802       ins_coarse_mat_vals = 0;
2803     } else {
2804       for (k=0;k<size_prec_comm;k++){
2805         offset=pcbddc->local_primal_displacements[k];
2806         offset2=localdispl2[k];
2807         ins_local_primal_size = pcbddc->local_primal_sizes[k];
2808         ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr);
2809         for (j=0;j<ins_local_primal_size;j++){
2810           ins_local_primal_indices[j]=(PetscInt)pcbddc->replicated_local_primal_indices[offset+j];
2811         }
2812         ins_coarse_mat_vals = &temp_coarse_mat_vals[offset2];
2813         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);
2814         ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr);
2815       }
2816       ins_local_primal_indices = 0;
2817       ins_coarse_mat_vals = 0;
2818     }
2819     ierr = MatAssemblyBegin(pcbddc->coarse_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2820     ierr = MatAssemblyEnd(pcbddc->coarse_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2821     /* symmetry of coarse matrix */
2822     if (issym) {
2823       ierr = MatSetOption(pcbddc->coarse_mat,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
2824     }
2825     ierr = MatGetVecs(pcbddc->coarse_mat,&pcbddc->coarse_vec,&pcbddc->coarse_rhs);CHKERRQ(ierr);
2826   }
2827 
2828   /* create loc to glob scatters if needed */
2829   if (pcbddc->coarse_communications_type == SCATTERS_BDDC) {
2830      IS local_IS,global_IS;
2831      ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size,0,1,&local_IS);CHKERRQ(ierr);
2832      ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_indices,PETSC_COPY_VALUES,&global_IS);CHKERRQ(ierr);
2833      ierr = VecScatterCreate(pcbddc->vec1_P,local_IS,pcbddc->coarse_vec,global_IS,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
2834      ierr = ISDestroy(&local_IS);CHKERRQ(ierr);
2835      ierr = ISDestroy(&global_IS);CHKERRQ(ierr);
2836   }
2837 
2838   /* free memory no longer needed */
2839   if (coarse_ISLG)              { ierr = ISLocalToGlobalMappingDestroy(&coarse_ISLG);CHKERRQ(ierr); }
2840   if (ins_local_primal_indices) { ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr); }
2841   if (ins_coarse_mat_vals)      { ierr = PetscFree(ins_coarse_mat_vals);CHKERRQ(ierr); }
2842   if (localsizes2)              { ierr = PetscFree(localsizes2);CHKERRQ(ierr); }
2843   if (localdispl2)              { ierr = PetscFree(localdispl2);CHKERRQ(ierr); }
2844   if (temp_coarse_mat_vals)     { ierr = PetscFree(temp_coarse_mat_vals);CHKERRQ(ierr); }
2845 
2846   /* Compute coarse null space */
2847   CoarseNullSpace = 0;
2848   if (pcbddc->NullSpace) {
2849     ierr = PCBDDCNullSpaceAssembleCoarse(pc,&CoarseNullSpace);CHKERRQ(ierr);
2850   }
2851 
2852   /* KSP for coarse problem */
2853   if (rank_prec_comm == active_rank) {
2854     PetscBool isbddc=PETSC_FALSE;
2855 
2856     ierr = KSPCreate(coarse_comm,&pcbddc->coarse_ksp);CHKERRQ(ierr);
2857     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
2858     ierr = KSPSetOperators(pcbddc->coarse_ksp,pcbddc->coarse_mat,pcbddc->coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
2859     ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,max_it_coarse_ksp);CHKERRQ(ierr);
2860     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
2861     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
2862     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
2863     /* Allow user's customization */
2864     ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,"coarse_");CHKERRQ(ierr);
2865     /* Set Up PC for coarse problem BDDC */
2866     if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
2867       i = pcbddc->current_level+1;
2868       ierr = PCBDDCSetLevel(pc_temp,i);CHKERRQ(ierr);
2869       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
2870       ierr = PCBDDCSetMaxLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
2871       ierr = PCBDDCSetCoarseProblemType(pc_temp,MULTILEVEL_BDDC);CHKERRQ(ierr);
2872       if (CoarseNullSpace) {
2873         ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
2874       }
2875       if (dbg_flag) {
2876         ierr = PetscViewerASCIIPrintf(viewer,"----------------Level %d: Setting up level %d---------------\n",pcbddc->current_level,i);CHKERRQ(ierr);
2877         ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2878       }
2879     } else {
2880       if (CoarseNullSpace) {
2881         ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
2882       }
2883     }
2884     ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
2885     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
2886 
2887     ierr = KSPGetTolerances(pcbddc->coarse_ksp,NULL,NULL,NULL,&j);CHKERRQ(ierr);
2888     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
2889     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
2890     if (j == 1) {
2891       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
2892       if (isbddc) {
2893         ierr = PCBDDCSetUseExactDirichlet(pc_temp,PETSC_FALSE);CHKERRQ(ierr);
2894       }
2895     }
2896   }
2897   /* Check coarse problem if requested */
2898   if ( dbg_flag && rank_prec_comm == active_rank ) {
2899     KSP check_ksp;
2900     PC  check_pc;
2901     Vec check_vec;
2902     PetscReal   abs_infty_error,infty_error,lambda_min,lambda_max;
2903     KSPType check_ksp_type;
2904 
2905     /* Create ksp object suitable for extreme eigenvalues' estimation */
2906     ierr = KSPCreate(coarse_comm,&check_ksp);CHKERRQ(ierr);
2907     ierr = KSPSetOperators(check_ksp,pcbddc->coarse_mat,pcbddc->coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
2908     ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
2909     if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
2910       if (issym) check_ksp_type = KSPCG;
2911       else check_ksp_type = KSPGMRES;
2912       ierr = KSPSetComputeSingularValues(check_ksp,PETSC_TRUE);CHKERRQ(ierr);
2913     } else {
2914       check_ksp_type = KSPPREONLY;
2915     }
2916     ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
2917     ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
2918     ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
2919     ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
2920     /* create random vec */
2921     ierr = VecDuplicate(pcbddc->coarse_vec,&check_vec);CHKERRQ(ierr);
2922     ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
2923     if (CoarseNullSpace) {
2924       ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec,NULL);CHKERRQ(ierr);
2925     }
2926     ierr = MatMult(pcbddc->coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
2927     /* solve coarse problem */
2928     ierr = KSPSolve(check_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
2929     if (CoarseNullSpace) {
2930       ierr = MatNullSpaceRemove(CoarseNullSpace,pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
2931     }
2932     /* check coarse problem residual error */
2933     ierr = VecAXPY(check_vec,-1.0,pcbddc->coarse_vec);CHKERRQ(ierr);
2934     ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
2935     ierr = MatMult(pcbddc->coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
2936     ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
2937     ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
2938     /* get eigenvalue estimation if inexact */
2939     if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
2940       ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
2941       ierr = KSPGetIterationNumber(check_ksp,&k);CHKERRQ(ierr);
2942       ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem eigenvalues estimated with %d iterations of %s.\n",k,check_ksp_type);CHKERRQ(ierr);
2943       ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem eigenvalues: % 1.14e %1.14e\n",lambda_min,lambda_max);CHKERRQ(ierr);
2944     }
2945     ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem exact infty_error   : %1.14e\n",infty_error);CHKERRQ(ierr);
2946     ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem residual infty_error: %1.14e\n",abs_infty_error);CHKERRQ(ierr);
2947     ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
2948   }
2949   if (dbg_flag) {
2950     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2951   }
2952   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
2953 
2954   PetscFunctionReturn(0);
2955 }
2956 
2957