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