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