xref: /petsc/src/ksp/pc/impls/bddc/bddc.c (revision 6bfb181103e60beecc65f13fb5563f4dca53c470)
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   PetscErrorCode  ierr;
1293 
1294   PC_IS*            pcis = (PC_IS*)(pc->data);
1295   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
1296   IS                is_R_local;
1297   VecType           impVecType;
1298   MatType           impMatType;
1299   PetscInt          n_R=0;
1300   PetscInt          n_D=0;
1301   PetscInt          n_B=0;
1302   PetscScalar       zero=0.0;
1303   PetscScalar       one=1.0;
1304   PetscScalar       m_one=-1.0;
1305   PetscScalar*      array;
1306   PetscScalar       *coarse_submat_vals;
1307   PetscInt          *idx_R_local;
1308   PetscReal         *coarsefunctions_errors,*constraints_errors;
1309   /* auxiliary indices */
1310   PetscInt          i,j;
1311   /* for verbose output of bddc */
1312   PetscViewer       viewer=pcbddc->dbg_viewer;
1313   PetscInt          dbg_flag=pcbddc->dbg_flag;
1314   /* for counting coarse dofs */
1315   PetscInt          n_vertices,n_constraints;
1316   PetscInt          size_of_constraint;
1317   PetscInt          *row_cmat_indices;
1318   PetscScalar       *row_cmat_values;
1319   PetscInt          *vertices;
1320 
1321   PetscFunctionBegin;
1322   /* Set Non-overlapping dimensions */
1323   n_B = pcis->n_B; n_D = pcis->n - n_B;
1324 
1325   /* compute matrix after change of basis and extract local submatrices */
1326   ierr = PCBDDCSetUpLocalMatrices(pc);CHKERRQ(ierr);
1327 
1328   /* Change global null space passed in by the user if change of basis has been requested */
1329   if (pcbddc->NullSpace && pcbddc->use_change_of_basis) {
1330     ierr = PCBDDCNullSpaceAdaptGlobal(pc);CHKERRQ(ierr);
1331   }
1332 
1333   /* get number of vertices */
1334   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,NULL);CHKERRQ(ierr);
1335   n_constraints = pcbddc->local_primal_size-n_vertices;
1336   n_R = pcis->n-n_vertices;
1337 
1338   /* Set types for local objects needed by BDDC precondtioner */
1339   impMatType = MATSEQDENSE;
1340   impVecType = VECSEQ;
1341 
1342   /* Allocate needed vectors */
1343   ierr = PCBDDCCreateWorkVectors(pc);CHKERRQ(ierr);
1344 
1345   /* setup local scatters R_to_B and (optionally) R_to_D : PCBDDCCreateWorkVectors should be called first! */
1346   ierr = PCBDDCSetUpLocalScatters(pc,&is_R_local);CHKERRQ(ierr);
1347   ierr = ISGetIndices(is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
1348 
1349   /* setup local solvers ksp_D and ksp_R */
1350   ierr = PCBDDCSetUpLocalSolvers(pc,pcis->is_I_local,is_R_local);CHKERRQ(ierr);
1351 
1352   /* Assemble all remaining stuff needed to apply BDDC  */
1353   {
1354     Mat          A_RV,A_VR,A_VV;
1355     Mat          M1;
1356     Mat          C_CR;
1357     Mat          AUXMAT;
1358     Vec          vec1_C;
1359     Vec          vec2_C;
1360     Vec          vec1_V;
1361     Vec          vec2_V;
1362     IS           is_C_local,is_V_local,is_aux1;
1363     ISLocalToGlobalMapping BtoNmap;
1364     PetscInt     *nnz;
1365     PetscInt     *idx_V_B;
1366     PetscInt     *auxindices;
1367     PetscInt     index;
1368     PetscScalar* array2;
1369     MatFactorInfo matinfo;
1370     PetscBool    setsym=PETSC_FALSE,issym=PETSC_FALSE;
1371 
1372     /* Allocating some extra storage just to be safe */
1373     ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1374     ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&auxindices);CHKERRQ(ierr);
1375     for (i=0;i<pcis->n;i++) auxindices[i]=i;
1376 
1377     ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
1378     /* vertices in boundary numbering */
1379     ierr = PetscMalloc(n_vertices*sizeof(PetscInt),&idx_V_B);CHKERRQ(ierr);
1380     ierr = ISLocalToGlobalMappingCreateIS(pcis->is_B_local,&BtoNmap);CHKERRQ(ierr);
1381     ierr = ISGlobalToLocalMappingApply(BtoNmap,IS_GTOLM_DROP,n_vertices,vertices,&i,idx_V_B);CHKERRQ(ierr);
1382     ierr = ISLocalToGlobalMappingDestroy(&BtoNmap);CHKERRQ(ierr);
1383     if (i != n_vertices) {
1384       SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %d != %d\n",n_vertices,i);
1385     }
1386 
1387     /* some work vectors on vertices and/or constraints */
1388     if (n_vertices) {
1389       ierr = VecCreate(PETSC_COMM_SELF,&vec1_V);CHKERRQ(ierr);
1390       ierr = VecSetSizes(vec1_V,n_vertices,n_vertices);CHKERRQ(ierr);
1391       ierr = VecSetType(vec1_V,impVecType);CHKERRQ(ierr);
1392       ierr = VecDuplicate(vec1_V,&vec2_V);CHKERRQ(ierr);
1393     }
1394     if (n_constraints) {
1395       ierr = VecCreate(PETSC_COMM_SELF,&vec1_C);CHKERRQ(ierr);
1396       ierr = VecSetSizes(vec1_C,n_constraints,n_constraints);CHKERRQ(ierr);
1397       ierr = VecSetType(vec1_C,impVecType);CHKERRQ(ierr);
1398       ierr = VecDuplicate(vec1_C,&vec2_C);CHKERRQ(ierr);
1399       ierr = VecDuplicate(vec1_C,&pcbddc->vec1_C);CHKERRQ(ierr);
1400     }
1401     /* Precompute stuffs needed for preprocessing and application of BDDC*/
1402     if (n_constraints) {
1403       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->local_auxmat2);CHKERRQ(ierr);
1404       ierr = MatSetSizes(pcbddc->local_auxmat2,n_R,n_constraints,n_R,n_constraints);CHKERRQ(ierr);
1405       ierr = MatSetType(pcbddc->local_auxmat2,impMatType);CHKERRQ(ierr);
1406       ierr = MatSeqDenseSetPreallocation(pcbddc->local_auxmat2,NULL);CHKERRQ(ierr);
1407 
1408       /* Create Constraint matrix on R nodes: C_{CR}  */
1409       ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_C_local);CHKERRQ(ierr);
1410       ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_C_local,is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
1411       ierr = ISDestroy(&is_C_local);CHKERRQ(ierr);
1412 
1413       /* Assemble local_auxmat2 = - A_{RR}^{-1} C^T_{CR} needed by BDDC application */
1414       for (i=0;i<n_constraints;i++) {
1415         ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
1416         /* Get row of constraint matrix in R numbering */
1417         ierr = VecGetArray(pcbddc->vec1_R,&array);CHKERRQ(ierr);
1418         ierr = MatGetRow(C_CR,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
1419         for (j=0;j<size_of_constraint;j++) array[row_cmat_indices[j]] = -row_cmat_values[j];
1420         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
1421         ierr = VecRestoreArray(pcbddc->vec1_R,&array);CHKERRQ(ierr);
1422 
1423         /* Solve for row of constraint matrix in R numbering */
1424         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
1425 
1426         /* Set values */
1427         ierr = VecGetArray(pcbddc->vec2_R,&array);CHKERRQ(ierr);
1428         ierr = MatSetValues(pcbddc->local_auxmat2,n_R,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
1429         ierr = VecRestoreArray(pcbddc->vec2_R,&array);CHKERRQ(ierr);
1430       }
1431       ierr = MatAssemblyBegin(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1432       ierr = MatAssemblyEnd(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1433 
1434       /* Assemble AUXMAT = ( LUFactor )( -C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1} */
1435       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&AUXMAT);CHKERRQ(ierr);
1436       ierr = MatFactorInfoInitialize(&matinfo);CHKERRQ(ierr);
1437       ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,0,1,&is_aux1);CHKERRQ(ierr);
1438       ierr = MatLUFactor(AUXMAT,is_aux1,is_aux1,&matinfo);CHKERRQ(ierr);
1439       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
1440 
1441       /* Assemble explicitly M1 = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1} needed in preproc  */
1442       ierr = MatCreate(PETSC_COMM_SELF,&M1);CHKERRQ(ierr);
1443       ierr = MatSetSizes(M1,n_constraints,n_constraints,n_constraints,n_constraints);CHKERRQ(ierr);
1444       ierr = MatSetType(M1,impMatType);CHKERRQ(ierr);
1445       ierr = MatSeqDenseSetPreallocation(M1,NULL);CHKERRQ(ierr);
1446       for (i=0;i<n_constraints;i++) {
1447         ierr = VecSet(vec1_C,zero);CHKERRQ(ierr);
1448         ierr = VecSetValue(vec1_C,i,one,INSERT_VALUES);CHKERRQ(ierr);
1449         ierr = VecAssemblyBegin(vec1_C);CHKERRQ(ierr);
1450         ierr = VecAssemblyEnd(vec1_C);CHKERRQ(ierr);
1451         ierr = MatSolve(AUXMAT,vec1_C,vec2_C);CHKERRQ(ierr);
1452         ierr = VecScale(vec2_C,m_one);CHKERRQ(ierr);
1453         ierr = VecGetArray(vec2_C,&array);CHKERRQ(ierr);
1454         ierr = MatSetValues(M1,n_constraints,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
1455         ierr = VecRestoreArray(vec2_C,&array);CHKERRQ(ierr);
1456       }
1457       ierr = MatAssemblyBegin(M1,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1458       ierr = MatAssemblyEnd(M1,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1459       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
1460       /* Assemble local_auxmat1 = M1*C_{CR} needed by BDDC application in KSP and in preproc */
1461       ierr = MatMatMult(M1,C_CR,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
1462 
1463     }
1464 
1465     /* Get submatrices from subdomain matrix */
1466     if (n_vertices) {
1467       ierr = ISCreateGeneral(PETSC_COMM_SELF,n_vertices,vertices,PETSC_COPY_VALUES,&is_V_local);CHKERRQ(ierr);
1468       ierr = MatGetSubMatrix(pcbddc->local_mat,is_R_local,is_V_local,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
1469       ierr = MatGetSubMatrix(pcbddc->local_mat,is_V_local,is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
1470       ierr = MatGetSubMatrix(pcbddc->local_mat,is_V_local,is_V_local,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
1471       ierr = ISDestroy(&is_V_local);CHKERRQ(ierr);
1472     }
1473 
1474     /* Matrix of coarse basis functions (local) */
1475     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
1476     ierr = MatSetSizes(pcbddc->coarse_phi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
1477     ierr = MatSetType(pcbddc->coarse_phi_B,impMatType);CHKERRQ(ierr);
1478     ierr = MatSeqDenseSetPreallocation(pcbddc->coarse_phi_B,NULL);CHKERRQ(ierr);
1479     if (pcbddc->inexact_prec_type || dbg_flag ) {
1480       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
1481       ierr = MatSetSizes(pcbddc->coarse_phi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
1482       ierr = MatSetType(pcbddc->coarse_phi_D,impMatType);CHKERRQ(ierr);
1483       ierr = MatSeqDenseSetPreallocation(pcbddc->coarse_phi_D,NULL);CHKERRQ(ierr);
1484     }
1485 
1486     if (dbg_flag) {
1487       ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*coarsefunctions_errors),&coarsefunctions_errors);CHKERRQ(ierr);
1488       ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*constraints_errors),&constraints_errors);CHKERRQ(ierr);
1489     }
1490     /* Subdomain contribution (Non-overlapping) to coarse matrix  */
1491     ierr = PetscMalloc ((pcbddc->local_primal_size)*(pcbddc->local_primal_size)*sizeof(PetscScalar),&coarse_submat_vals);CHKERRQ(ierr);
1492 
1493     /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
1494     for (i=0;i<n_vertices;i++){
1495       ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
1496       ierr = VecSetValue(vec1_V,i,one,INSERT_VALUES);CHKERRQ(ierr);
1497       ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
1498       ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
1499       /* solution of saddle point problem */
1500       ierr = MatMult(A_RV,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
1501       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
1502       ierr = VecScale(pcbddc->vec1_R,m_one);CHKERRQ(ierr);
1503       if (n_constraints) {
1504         ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec1_R,vec1_C);CHKERRQ(ierr);
1505         ierr = MatMultAdd(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
1506         ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
1507       }
1508       ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
1509       ierr = MatMultAdd(A_VV,vec1_V,vec2_V,vec2_V);CHKERRQ(ierr);
1510 
1511       /* Set values in coarse basis function and subdomain part of coarse_mat */
1512       /* coarse basis functions */
1513       ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1514       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1515       ierr = VecScatterEnd  (pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1516       ierr = VecGetArray(pcis->vec1_B,&array);CHKERRQ(ierr);
1517       ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
1518       ierr = VecRestoreArray(pcis->vec1_B,&array);CHKERRQ(ierr);
1519       ierr = MatSetValue(pcbddc->coarse_phi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
1520       if ( pcbddc->inexact_prec_type || dbg_flag  ) {
1521         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1522         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1523         ierr = VecGetArray(pcis->vec1_D,&array);CHKERRQ(ierr);
1524         ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
1525         ierr = VecRestoreArray(pcis->vec1_D,&array);CHKERRQ(ierr);
1526       }
1527       /* subdomain contribution to coarse matrix */
1528       ierr = VecGetArray(vec2_V,&array);CHKERRQ(ierr);
1529       for (j=0; j<n_vertices; j++) coarse_submat_vals[i*pcbddc->local_primal_size+j] = array[j];   /* WARNING -> column major ordering */
1530       ierr = VecRestoreArray(vec2_V,&array);CHKERRQ(ierr);
1531       if (n_constraints) {
1532         ierr = VecGetArray(vec1_C,&array);CHKERRQ(ierr);
1533         for (j=0; j<n_constraints; j++) coarse_submat_vals[i*pcbddc->local_primal_size+j+n_vertices] = array[j];   /* WARNING -> column major ordering */
1534         ierr = VecRestoreArray(vec1_C,&array);CHKERRQ(ierr);
1535       }
1536 
1537       if ( dbg_flag ) {
1538         /* assemble subdomain vector on nodes */
1539         ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
1540         ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
1541         ierr = VecGetArray(pcbddc->vec1_R,&array2);CHKERRQ(ierr);
1542         for (j=0;j<n_R;j++) array[idx_R_local[j]] = array2[j];
1543         array[ vertices[i] ] = one;
1544         ierr = VecRestoreArray(pcbddc->vec1_R,&array2);CHKERRQ(ierr);
1545         ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
1546         /* assemble subdomain vector of lagrange multipliers (i.e. primal nodes) */
1547         ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
1548         ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
1549         ierr = VecGetArray(vec2_V,&array);CHKERRQ(ierr);
1550         for (j=0;j<n_vertices;j++) array2[j]=array[j];
1551         ierr = VecRestoreArray(vec2_V,&array);CHKERRQ(ierr);
1552         if (n_constraints) {
1553           ierr = VecGetArray(vec1_C,&array);CHKERRQ(ierr);
1554           for (j=0;j<n_constraints;j++) array2[j+n_vertices]=array[j];
1555           ierr = VecRestoreArray(vec1_C,&array);CHKERRQ(ierr);
1556         }
1557         ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
1558         ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
1559         /* check saddle point solution */
1560         ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
1561         ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
1562         ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i]);CHKERRQ(ierr);
1563         ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
1564         ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
1565         array[i]=array[i]+m_one;  /* shift by the identity matrix */
1566         ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
1567         ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i]);CHKERRQ(ierr);
1568       }
1569     }
1570 
1571     for (i=0;i<n_constraints;i++){
1572       ierr = VecSet(vec2_C,zero);CHKERRQ(ierr);
1573       ierr = VecSetValue(vec2_C,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
1574       ierr = VecAssemblyBegin(vec2_C);CHKERRQ(ierr);
1575       ierr = VecAssemblyEnd(vec2_C);CHKERRQ(ierr);
1576       /* solution of saddle point problem */
1577       ierr = MatMult(M1,vec2_C,vec1_C);CHKERRQ(ierr);
1578       ierr = MatMult(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
1579       ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
1580       if (n_vertices) { ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr); }
1581       /* Set values in coarse basis function and subdomain part of coarse_mat */
1582       /* coarse basis functions */
1583       index=i+n_vertices;
1584       ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1585       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1586       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1587       ierr = VecGetArray(pcis->vec1_B,&array);CHKERRQ(ierr);
1588       ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&index,array,INSERT_VALUES);CHKERRQ(ierr);
1589       ierr = VecRestoreArray(pcis->vec1_B,&array);CHKERRQ(ierr);
1590       if ( pcbddc->inexact_prec_type || dbg_flag ) {
1591         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1592         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1593         ierr = VecGetArray(pcis->vec1_D,&array);CHKERRQ(ierr);
1594         ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&index,array,INSERT_VALUES);CHKERRQ(ierr);
1595         ierr = VecRestoreArray(pcis->vec1_D,&array);CHKERRQ(ierr);
1596       }
1597       /* subdomain contribution to coarse matrix */
1598       if (n_vertices) {
1599         ierr = VecGetArray(vec2_V,&array);CHKERRQ(ierr);
1600         for (j=0; j<n_vertices; j++) coarse_submat_vals[index*pcbddc->local_primal_size+j]=array[j]; /* WARNING -> column major ordering */
1601         ierr = VecRestoreArray(vec2_V,&array);CHKERRQ(ierr);
1602       }
1603       ierr = VecGetArray(vec1_C,&array);CHKERRQ(ierr);
1604       for (j=0; j<n_constraints; j++) coarse_submat_vals[index*pcbddc->local_primal_size+j+n_vertices]=array[j]; /* WARNING -> column major ordering */
1605       ierr = VecRestoreArray(vec1_C,&array);CHKERRQ(ierr);
1606 
1607       if ( dbg_flag ) {
1608         /* assemble subdomain vector on nodes */
1609         ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
1610         ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
1611         ierr = VecGetArray(pcbddc->vec1_R,&array2);CHKERRQ(ierr);
1612         for (j=0;j<n_R;j++) array[idx_R_local[j]] = array2[j];
1613         ierr = VecRestoreArray(pcbddc->vec1_R,&array2);CHKERRQ(ierr);
1614         ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
1615         /* assemble subdomain vector of lagrange multipliers */
1616         ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
1617         ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
1618         if ( n_vertices) {
1619           ierr = VecGetArray(vec2_V,&array);CHKERRQ(ierr);
1620           for (j=0;j<n_vertices;j++) array2[j]=-array[j];
1621           ierr = VecRestoreArray(vec2_V,&array);CHKERRQ(ierr);
1622         }
1623         ierr = VecGetArray(vec1_C,&array);CHKERRQ(ierr);
1624         for (j=0;j<n_constraints;j++) {array2[j+n_vertices]=-array[j];}
1625         ierr = VecRestoreArray(vec1_C,&array);CHKERRQ(ierr);
1626         ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
1627         /* check saddle point solution */
1628         ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
1629         ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
1630         ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[index]);CHKERRQ(ierr);
1631         ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
1632         ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
1633         array[index]=array[index]+m_one; /* shift by the identity matrix */
1634         ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
1635         ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[index]);CHKERRQ(ierr);
1636       }
1637     }
1638     ierr = MatAssemblyBegin(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1639     ierr = MatAssemblyEnd(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1640     if ( pcbddc->inexact_prec_type || dbg_flag ) {
1641       ierr = MatAssemblyBegin(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1642       ierr = MatAssemblyEnd(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1643     }
1644     /* compute other basis functions for non-symmetric problems */
1645     ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
1646     if ( !setsym || (setsym && !issym) ) {
1647       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
1648       ierr = MatSetSizes(pcbddc->coarse_psi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
1649       ierr = MatSetType(pcbddc->coarse_psi_B,impMatType);CHKERRQ(ierr);
1650       ierr = MatSeqDenseSetPreallocation(pcbddc->coarse_psi_B,NULL);CHKERRQ(ierr);
1651       if (pcbddc->inexact_prec_type || dbg_flag ) {
1652         ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
1653         ierr = MatSetSizes(pcbddc->coarse_psi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
1654         ierr = MatSetType(pcbddc->coarse_psi_D,impMatType);CHKERRQ(ierr);
1655         ierr = MatSeqDenseSetPreallocation(pcbddc->coarse_psi_D,NULL);CHKERRQ(ierr);
1656       }
1657       for (i=0;i<pcbddc->local_primal_size;i++) {
1658         if (n_constraints) {
1659           ierr = VecSet(vec1_C,zero);CHKERRQ(ierr);
1660           ierr = VecGetArray(vec1_C,&array);CHKERRQ(ierr);
1661           for (j=0;j<n_constraints;j++) {
1662             array[j]=coarse_submat_vals[(j+n_vertices)*pcbddc->local_primal_size+i];
1663           }
1664           ierr = VecRestoreArray(vec1_C,&array);CHKERRQ(ierr);
1665         }
1666         if (i<n_vertices) {
1667           ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
1668           ierr = VecSetValue(vec1_V,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
1669           ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
1670           ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
1671           ierr = MatMultTranspose(A_VR,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
1672           if (n_constraints) {
1673             ierr = MatMultTransposeAdd(C_CR,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
1674           }
1675         } else {
1676           ierr = MatMultTranspose(C_CR,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
1677         }
1678         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
1679         ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1680         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1681         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1682         ierr = VecGetArray(pcis->vec1_B,&array);CHKERRQ(ierr);
1683         ierr = MatSetValues(pcbddc->coarse_psi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
1684         ierr = VecRestoreArray(pcis->vec1_B,&array);CHKERRQ(ierr);
1685         if (i<n_vertices) {
1686           ierr = MatSetValue(pcbddc->coarse_psi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
1687         }
1688         if ( pcbddc->inexact_prec_type || dbg_flag  ) {
1689           ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1690           ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1691           ierr = VecGetArray(pcis->vec1_D,&array);CHKERRQ(ierr);
1692           ierr = MatSetValues(pcbddc->coarse_psi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
1693           ierr = VecRestoreArray(pcis->vec1_D,&array);CHKERRQ(ierr);
1694         }
1695 
1696         if ( dbg_flag ) {
1697           /* assemble subdomain vector on nodes */
1698           ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
1699           ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
1700           ierr = VecGetArray(pcbddc->vec1_R,&array2);CHKERRQ(ierr);
1701           for (j=0;j<n_R;j++) array[idx_R_local[j]] = array2[j];
1702           if (i<n_vertices) array[vertices[i]] = one;
1703           ierr = VecRestoreArray(pcbddc->vec1_R,&array2);CHKERRQ(ierr);
1704           ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
1705           /* assemble subdomain vector of lagrange multipliers */
1706           ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
1707           for (j=0;j<pcbddc->local_primal_size;j++) {
1708             array[j]=-coarse_submat_vals[j*pcbddc->local_primal_size+i];
1709           }
1710           ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
1711           /* check saddle point solution */
1712           ierr = MatMultTranspose(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
1713           ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
1714           ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
1715           ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
1716           ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
1717           array[i]=array[i]+m_one; /* shift by the identity matrix */
1718           ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
1719           ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
1720         }
1721       }
1722       ierr = MatAssemblyBegin(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1723       ierr = MatAssemblyEnd(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1724       if ( pcbddc->inexact_prec_type || dbg_flag ) {
1725         ierr = MatAssemblyBegin(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1726         ierr = MatAssemblyEnd(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1727       }
1728     }
1729     ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
1730     /* Checking coarse_sub_mat and coarse basis functios */
1731     /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
1732     /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
1733     if (dbg_flag) {
1734       Mat         coarse_sub_mat;
1735       Mat         TM1,TM2,TM3,TM4;
1736       Mat         coarse_phi_D,coarse_phi_B;
1737       Mat         coarse_psi_D,coarse_psi_B;
1738       Mat         A_II,A_BB,A_IB,A_BI;
1739       MatType     checkmattype=MATSEQAIJ;
1740       PetscReal   real_value;
1741 
1742       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
1743       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
1744       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
1745       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
1746       ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
1747       ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
1748       if (pcbddc->coarse_psi_B) {
1749         ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
1750         ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
1751       }
1752       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
1753 
1754       ierr = PetscViewerASCIIPrintf(viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
1755       ierr = PetscViewerASCIIPrintf(viewer,"Check coarse sub mat and local basis functions\n");CHKERRQ(ierr);
1756       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
1757       if (pcbddc->coarse_psi_B) {
1758         ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
1759         ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
1760         ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
1761         ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
1762         ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
1763         ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
1764         ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
1765         ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
1766         ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
1767         ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
1768         ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
1769         ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
1770       } else {
1771         ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
1772         ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
1773         ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
1774         ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
1775         ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
1776         ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
1777         ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
1778         ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
1779       }
1780       ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
1781       ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
1782       ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
1783       ierr = MatConvert(TM1,MATSEQDENSE,MAT_REUSE_MATRIX,&TM1);CHKERRQ(ierr);
1784       ierr = MatAXPY(TM1,m_one,coarse_sub_mat,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
1785       ierr = MatNorm(TM1,NORM_INFINITY,&real_value);CHKERRQ(ierr);
1786       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"----------------------------------\n");CHKERRQ(ierr);
1787       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d \n",PetscGlobalRank);CHKERRQ(ierr);
1788       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"matrix error = % 1.14e\n",real_value);CHKERRQ(ierr);
1789       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"coarse functions (phi) errors\n");CHKERRQ(ierr);
1790       for (i=0;i<pcbddc->local_primal_size;i++) {
1791         ierr = PetscViewerASCIISynchronizedPrintf(viewer,"local %02d-th function error = % 1.14e\n",i,coarsefunctions_errors[i]);CHKERRQ(ierr);
1792       }
1793       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"constraints (phi) errors\n");CHKERRQ(ierr);
1794       for (i=0;i<pcbddc->local_primal_size;i++) {
1795         ierr = PetscViewerASCIISynchronizedPrintf(viewer,"local %02d-th function error = % 1.14e\n",i,constraints_errors[i]);CHKERRQ(ierr);
1796       }
1797       if (pcbddc->coarse_psi_B) {
1798         ierr = PetscViewerASCIISynchronizedPrintf(viewer,"coarse functions (psi) errors\n");CHKERRQ(ierr);
1799         for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
1800           ierr = PetscViewerASCIISynchronizedPrintf(viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,coarsefunctions_errors[i]);CHKERRQ(ierr);
1801         }
1802         ierr = PetscViewerASCIISynchronizedPrintf(viewer,"constraints (psi) errors\n");CHKERRQ(ierr);
1803         for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
1804           ierr = PetscViewerASCIISynchronizedPrintf(viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,constraints_errors[i]);CHKERRQ(ierr);
1805         }
1806       }
1807       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
1808       ierr = MatDestroy(&A_II);CHKERRQ(ierr);
1809       ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
1810       ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
1811       ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
1812       ierr = MatDestroy(&TM1);CHKERRQ(ierr);
1813       ierr = MatDestroy(&TM2);CHKERRQ(ierr);
1814       ierr = MatDestroy(&TM3);CHKERRQ(ierr);
1815       ierr = MatDestroy(&TM4);CHKERRQ(ierr);
1816       ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
1817       ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
1818       if (pcbddc->coarse_psi_B) {
1819         ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
1820         ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
1821       }
1822       ierr = MatDestroy(&coarse_sub_mat);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 = ISRestoreIndices(is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
1849   ierr = ISDestroy(&is_R_local);CHKERRQ(ierr);
1850 
1851   PetscFunctionReturn(0);
1852 }
1853 
1854 /* -------------------------------------------------------------------------- */
1855 
1856 /* BDDC requires metis 5.0.1 for multilevel */
1857 #if defined(PETSC_HAVE_METIS)
1858 #include "metis.h"
1859 #define MetisInt    idx_t
1860 #define MetisScalar real_t
1861 #endif
1862 
1863 #undef __FUNCT__
1864 #define __FUNCT__ "PCBDDCSetUpCoarseEnvironment"
1865 static PetscErrorCode PCBDDCSetUpCoarseEnvironment(PC pc,PetscScalar* coarse_submat_vals)
1866 {
1867 
1868 
1869   Mat_IS    *matis    = (Mat_IS*)pc->pmat->data;
1870   PC_BDDC   *pcbddc   = (PC_BDDC*)pc->data;
1871   PC_IS     *pcis     = (PC_IS*)pc->data;
1872   MPI_Comm  prec_comm;
1873   MPI_Comm  coarse_comm;
1874 
1875   MatNullSpace CoarseNullSpace;
1876 
1877   /* common to all choiches */
1878   PetscScalar *temp_coarse_mat_vals;
1879   PetscScalar *ins_coarse_mat_vals;
1880   PetscInt    *ins_local_primal_indices;
1881   PetscMPIInt *localsizes2,*localdispl2;
1882   PetscMPIInt size_prec_comm;
1883   PetscMPIInt rank_prec_comm;
1884   PetscMPIInt active_rank=MPI_PROC_NULL;
1885   PetscMPIInt master_proc=0;
1886   PetscInt    ins_local_primal_size;
1887   /* specific to MULTILEVEL_BDDC */
1888   PetscMPIInt *ranks_recv=0;
1889   PetscMPIInt count_recv=0;
1890   PetscMPIInt rank_coarse_proc_send_to=-1;
1891   PetscMPIInt coarse_color = MPI_UNDEFINED;
1892   ISLocalToGlobalMapping coarse_ISLG;
1893   /* some other variables */
1894   PetscErrorCode ierr;
1895   MatType coarse_mat_type;
1896   PCType  coarse_pc_type;
1897   KSPType coarse_ksp_type;
1898   PC pc_temp;
1899   PetscInt i,j,k;
1900   PetscInt max_it_coarse_ksp=1;  /* don't increase this value */
1901   /* verbose output viewer */
1902   PetscViewer viewer=pcbddc->dbg_viewer;
1903   PetscInt    dbg_flag=pcbddc->dbg_flag;
1904 
1905   PetscInt      offset,offset2;
1906   PetscMPIInt   im_active,active_procs;
1907   PetscInt      *dnz,*onz;
1908 
1909   PetscBool     setsym,issym=PETSC_FALSE;
1910 
1911   PetscFunctionBegin;
1912   ierr = PetscObjectGetComm((PetscObject)pc,&prec_comm);CHKERRQ(ierr);
1913   ins_local_primal_indices = 0;
1914   ins_coarse_mat_vals      = 0;
1915   localsizes2              = 0;
1916   localdispl2              = 0;
1917   temp_coarse_mat_vals     = 0;
1918   coarse_ISLG              = 0;
1919 
1920   ierr = MPI_Comm_size(prec_comm,&size_prec_comm);CHKERRQ(ierr);
1921   ierr = MPI_Comm_rank(prec_comm,&rank_prec_comm);CHKERRQ(ierr);
1922   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
1923 
1924   /* Assign global numbering to coarse dofs */
1925   {
1926     PetscInt     *auxlocal_primal,*aux_idx;
1927     PetscMPIInt  mpi_local_primal_size;
1928     PetscScalar  coarsesum,*array;
1929 
1930     mpi_local_primal_size = (PetscMPIInt)pcbddc->local_primal_size;
1931 
1932     /* Construct needed data structures for message passing */
1933     j = 0;
1934     if (rank_prec_comm == 0 || pcbddc->coarse_problem_type == REPLICATED_BDDC || pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
1935       j = size_prec_comm;
1936     }
1937     ierr = PetscMalloc(j*sizeof(PetscMPIInt),&pcbddc->local_primal_sizes);CHKERRQ(ierr);
1938     ierr = PetscMalloc(j*sizeof(PetscMPIInt),&pcbddc->local_primal_displacements);CHKERRQ(ierr);
1939     /* Gather local_primal_size information for all processes  */
1940     if (pcbddc->coarse_problem_type == REPLICATED_BDDC || pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
1941       ierr = MPI_Allgather(&mpi_local_primal_size,1,MPIU_INT,&pcbddc->local_primal_sizes[0],1,MPIU_INT,prec_comm);CHKERRQ(ierr);
1942     } else {
1943       ierr = MPI_Gather(&mpi_local_primal_size,1,MPIU_INT,&pcbddc->local_primal_sizes[0],1,MPIU_INT,0,prec_comm);CHKERRQ(ierr);
1944     }
1945     pcbddc->replicated_primal_size = 0;
1946     for (i=0; i<j; i++) {
1947       pcbddc->local_primal_displacements[i] = pcbddc->replicated_primal_size ;
1948       pcbddc->replicated_primal_size += pcbddc->local_primal_sizes[i];
1949     }
1950 
1951     /* First let's count coarse dofs.
1952        This code fragment assumes that the number of local constraints per connected component
1953        is not greater than the number of nodes defined for the connected component
1954        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
1955     ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&auxlocal_primal);CHKERRQ(ierr);
1956     ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&i,&aux_idx);CHKERRQ(ierr);
1957     ierr = PetscMemcpy(auxlocal_primal,aux_idx,i*sizeof(PetscInt));CHKERRQ(ierr);
1958     ierr = PetscFree(aux_idx);CHKERRQ(ierr);
1959     ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&j,&aux_idx);CHKERRQ(ierr);
1960     ierr = PetscMemcpy(&auxlocal_primal[i],aux_idx,j*sizeof(PetscInt));CHKERRQ(ierr);
1961     ierr = PetscFree(aux_idx);CHKERRQ(ierr);
1962     /* Compute number of coarse dofs */
1963     ierr = PCBDDCSubsetNumbering(prec_comm,matis->mapping,pcbddc->local_primal_size,auxlocal_primal,NULL,&pcbddc->coarse_size,&pcbddc->local_primal_indices);CHKERRQ(ierr);
1964 
1965     if (dbg_flag) {
1966       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
1967       ierr = PetscViewerASCIIPrintf(viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
1968       ierr = PetscViewerASCIIPrintf(viewer,"Check coarse indices\n");CHKERRQ(ierr);
1969       ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
1970       ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
1971       for (i=0;i<pcbddc->local_primal_size;i++) array[auxlocal_primal[i]]=1.0;
1972       ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
1973       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
1974       ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1975       ierr = VecScatterEnd  (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1976       ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1977       ierr = VecScatterEnd  (matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1978       ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
1979       for (i=0;i<pcis->n;i++) {
1980         if (array[i] == 1.0) {
1981           ierr = ISLocalToGlobalMappingApply(matis->mapping,1,&i,&j);CHKERRQ(ierr);
1982           ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d: WRONG COARSE INDEX %d (local %d)\n",PetscGlobalRank,j,i);CHKERRQ(ierr);
1983         }
1984       }
1985       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
1986       for (i=0;i<pcis->n;i++) {
1987         if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
1988       }
1989       ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
1990       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
1991       ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1992       ierr = VecScatterEnd  (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1993       ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
1994       ierr = PetscViewerASCIIPrintf(viewer,"Size of coarse problem SHOULD be %lf\n",coarsesum);CHKERRQ(ierr);
1995       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
1996     }
1997     ierr = PetscFree(auxlocal_primal);CHKERRQ(ierr);
1998   }
1999 
2000   if (dbg_flag) {
2001     ierr = PetscViewerASCIIPrintf(viewer,"Size of coarse problem is %d\n",pcbddc->coarse_size);CHKERRQ(ierr);
2002     if (dbg_flag > 1) {
2003       ierr = PetscViewerASCIIPrintf(viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
2004       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2005       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
2006       for (i=0;i<pcbddc->local_primal_size;i++) {
2007         ierr = PetscViewerASCIISynchronizedPrintf(viewer,"local_primal_indices[%d]=%d \n",i,pcbddc->local_primal_indices[i]);
2008       }
2009       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2010     }
2011   }
2012 
2013   im_active = 0;
2014   if (pcis->n) im_active = 1;
2015   ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,prec_comm);CHKERRQ(ierr);
2016 
2017   /* adapt coarse problem type */
2018 #if defined(PETSC_HAVE_METIS)
2019   if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
2020     if (pcbddc->current_level < pcbddc->max_levels) {
2021       if ( (active_procs/pcbddc->coarsening_ratio) < 2 ) {
2022         if (dbg_flag) {
2023           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);
2024          ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2025         }
2026         pcbddc->coarse_problem_type = PARALLEL_BDDC;
2027       }
2028     } else {
2029       if (dbg_flag) {
2030         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);
2031         ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2032       }
2033       pcbddc->coarse_problem_type = PARALLEL_BDDC;
2034     }
2035   }
2036 #else
2037   pcbddc->coarse_problem_type = PARALLEL_BDDC;
2038 #endif
2039 
2040   switch(pcbddc->coarse_problem_type){
2041 
2042     case(MULTILEVEL_BDDC):   /* we define a coarse mesh where subdomains are elements */
2043     {
2044 #if defined(PETSC_HAVE_METIS)
2045       /* we need additional variables */
2046       MetisInt    n_subdomains,n_parts,objval,ncon,faces_nvtxs;
2047       MetisInt    *metis_coarse_subdivision;
2048       MetisInt    options[METIS_NOPTIONS];
2049       PetscMPIInt size_coarse_comm,rank_coarse_comm;
2050       PetscMPIInt procs_jumps_coarse_comm;
2051       PetscMPIInt *coarse_subdivision;
2052       PetscMPIInt *total_count_recv;
2053       PetscMPIInt *total_ranks_recv;
2054       PetscMPIInt *displacements_recv;
2055       PetscMPIInt *my_faces_connectivity;
2056       PetscMPIInt *petsc_faces_adjncy;
2057       MetisInt    *faces_adjncy;
2058       MetisInt    *faces_xadj;
2059       PetscMPIInt *number_of_faces;
2060       PetscMPIInt *faces_displacements;
2061       PetscInt    *array_int;
2062       PetscMPIInt my_faces=0;
2063       PetscMPIInt total_faces=0;
2064       PetscInt    ranks_stretching_ratio;
2065 
2066       /* define some quantities */
2067       pcbddc->coarse_communications_type = SCATTERS_BDDC;
2068       coarse_mat_type = MATIS;
2069       coarse_pc_type  = PCBDDC;
2070       coarse_ksp_type = KSPRICHARDSON;
2071 
2072       /* details of coarse decomposition */
2073       n_subdomains = active_procs;
2074       n_parts      = n_subdomains/pcbddc->coarsening_ratio;
2075       ranks_stretching_ratio = size_prec_comm/active_procs;
2076       procs_jumps_coarse_comm = pcbddc->coarsening_ratio*ranks_stretching_ratio;
2077 
2078 #if 0
2079       PetscMPIInt *old_ranks;
2080       PetscInt    *new_ranks,*jj,*ii;
2081       MatPartitioning mat_part;
2082       IS coarse_new_decomposition,is_numbering;
2083       PetscViewer viewer_test;
2084       MPI_Comm    test_coarse_comm;
2085       PetscMPIInt test_coarse_color;
2086       Mat         mat_adj;
2087       /* Create new communicator for coarse problem splitting the old one */
2088       /* procs with coarse_color = MPI_UNDEFINED will have coarse_comm = MPI_COMM_NULL (from mpi standards)
2089          key = rank_prec_comm -> keep same ordering of ranks from the old to the new communicator */
2090       test_coarse_color = ( im_active ? 0 : MPI_UNDEFINED );
2091       test_coarse_comm = MPI_COMM_NULL;
2092       ierr = MPI_Comm_split(prec_comm,test_coarse_color,rank_prec_comm,&test_coarse_comm);CHKERRQ(ierr);
2093       if (im_active) {
2094         ierr = PetscMalloc(n_subdomains*sizeof(PetscMPIInt),&old_ranks);
2095         ierr = PetscMalloc(size_prec_comm*sizeof(PetscInt),&new_ranks);
2096         ierr = MPI_Comm_rank(test_coarse_comm,&rank_coarse_comm);CHKERRQ(ierr);
2097         ierr = MPI_Comm_size(test_coarse_comm,&j);CHKERRQ(ierr);
2098         ierr = MPI_Allgather(&rank_prec_comm,1,MPIU_INT,old_ranks,1,MPIU_INT,test_coarse_comm);CHKERRQ(ierr);
2099         for (i=0; i<size_prec_comm; i++) new_ranks[i] = -1;
2100         for (i=0; i<n_subdomains; i++) new_ranks[old_ranks[i]] = i;
2101         ierr = PetscViewerASCIIOpen(test_coarse_comm,"test_mat_part.out",&viewer_test);CHKERRQ(ierr);
2102         k = pcis->n_neigh-1;
2103         ierr = PetscMalloc(2*sizeof(PetscInt),&ii);
2104         ii[0]=0;
2105         ii[1]=k;
2106         ierr = PetscMalloc(k*sizeof(PetscInt),&jj);
2107         for (i=0; i<k; i++) jj[i]=new_ranks[pcis->neigh[i+1]];
2108         ierr = PetscSortInt(k,jj);CHKERRQ(ierr);
2109         ierr = MatCreateMPIAdj(test_coarse_comm,1,n_subdomains,ii,jj,NULL,&mat_adj);CHKERRQ(ierr);
2110         ierr = MatView(mat_adj,viewer_test);CHKERRQ(ierr);
2111         ierr = MatPartitioningCreate(test_coarse_comm,&mat_part);CHKERRQ(ierr);
2112         ierr = MatPartitioningSetAdjacency(mat_part,mat_adj);CHKERRQ(ierr);
2113         ierr = MatPartitioningSetFromOptions(mat_part);CHKERRQ(ierr);
2114         printf("Setting Nparts %d\n",n_parts);
2115         ierr = MatPartitioningSetNParts(mat_part,n_parts);CHKERRQ(ierr);
2116         ierr = MatPartitioningView(mat_part,viewer_test);CHKERRQ(ierr);
2117         ierr = MatPartitioningApply(mat_part,&coarse_new_decomposition);CHKERRQ(ierr);
2118         ierr = ISView(coarse_new_decomposition,viewer_test);CHKERRQ(ierr);
2119         ierr = ISPartitioningToNumbering(coarse_new_decomposition,&is_numbering);CHKERRQ(ierr);
2120         ierr = ISView(is_numbering,viewer_test);CHKERRQ(ierr);
2121         ierr = PetscViewerDestroy(&viewer_test);CHKERRQ(ierr);
2122         ierr = ISDestroy(&coarse_new_decomposition);CHKERRQ(ierr);
2123         ierr = ISDestroy(&is_numbering);CHKERRQ(ierr);
2124         ierr = MatPartitioningDestroy(&mat_part);CHKERRQ(ierr);
2125         ierr = PetscFree(old_ranks);CHKERRQ(ierr);
2126         ierr = PetscFree(new_ranks);CHKERRQ(ierr);
2127         ierr = MPI_Comm_free(&test_coarse_comm);CHKERRQ(ierr);
2128       }
2129 #endif
2130 
2131       /* build CSR graph of subdomains' connectivity */
2132       ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&array_int);CHKERRQ(ierr);
2133       ierr = PetscMemzero(array_int,pcis->n*sizeof(PetscInt));CHKERRQ(ierr);
2134       for (i=1;i<pcis->n_neigh;i++){/* i=1 so I don't count myself -> faces nodes counts to 1 */
2135         for (j=0;j<pcis->n_shared[i];j++){
2136           array_int[ pcis->shared[i][j] ]+=1;
2137         }
2138       }
2139       for (i=1;i<pcis->n_neigh;i++){
2140         for (j=0;j<pcis->n_shared[i];j++){
2141           if (array_int[ pcis->shared[i][j] ] > 0 ){
2142             my_faces++;
2143             break;
2144           }
2145         }
2146       }
2147 
2148       ierr = MPI_Reduce(&my_faces,&total_faces,1,MPIU_INT,MPI_SUM,master_proc,prec_comm);CHKERRQ(ierr);
2149       ierr = PetscMalloc (my_faces*sizeof(PetscInt),&my_faces_connectivity);CHKERRQ(ierr);
2150       my_faces=0;
2151       for (i=1;i<pcis->n_neigh;i++){
2152         for (j=0;j<pcis->n_shared[i];j++){
2153           if (array_int[ pcis->shared[i][j] ] > 0 ){
2154             my_faces_connectivity[my_faces]=pcis->neigh[i];
2155             my_faces++;
2156             break;
2157           }
2158         }
2159       }
2160       if (rank_prec_comm == master_proc) {
2161         ierr = PetscMalloc (total_faces*sizeof(PetscMPIInt),&petsc_faces_adjncy);CHKERRQ(ierr);
2162         ierr = PetscMalloc (size_prec_comm*sizeof(PetscMPIInt),&number_of_faces);CHKERRQ(ierr);
2163         ierr = PetscMalloc (total_faces*sizeof(MetisInt),&faces_adjncy);CHKERRQ(ierr);
2164         ierr = PetscMalloc ((n_subdomains+1)*sizeof(MetisInt),&faces_xadj);CHKERRQ(ierr);
2165         ierr = PetscMalloc ((size_prec_comm+1)*sizeof(PetscMPIInt),&faces_displacements);CHKERRQ(ierr);
2166       }
2167       ierr = MPI_Gather(&my_faces,1,MPIU_INT,&number_of_faces[0],1,MPIU_INT,master_proc,prec_comm);CHKERRQ(ierr);
2168       if (rank_prec_comm == master_proc) {
2169         faces_xadj[0]=0;
2170         faces_displacements[0]=0;
2171         j=0;
2172         for (i=1;i<size_prec_comm+1;i++) {
2173           faces_displacements[i]=faces_displacements[i-1]+number_of_faces[i-1];
2174           if (number_of_faces[i-1]) {
2175             j++;
2176             faces_xadj[j]=faces_xadj[j-1]+number_of_faces[i-1];
2177           }
2178         }
2179       }
2180       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);
2181       ierr = PetscFree(my_faces_connectivity);CHKERRQ(ierr);
2182       ierr = PetscFree(array_int);CHKERRQ(ierr);
2183       if (rank_prec_comm == master_proc) {
2184         for (i=0;i<total_faces;i++) faces_adjncy[i]=(MetisInt)(petsc_faces_adjncy[i]/ranks_stretching_ratio); /* cast to MetisInt */
2185         ierr = PetscFree(faces_displacements);CHKERRQ(ierr);
2186         ierr = PetscFree(number_of_faces);CHKERRQ(ierr);
2187         ierr = PetscFree(petsc_faces_adjncy);CHKERRQ(ierr);
2188       }
2189 
2190       if ( rank_prec_comm == master_proc ) {
2191 
2192         PetscInt heuristic_for_metis=3;
2193 
2194         ncon=1;
2195         faces_nvtxs=n_subdomains;
2196         /* partition graoh induced by face connectivity */
2197         ierr = PetscMalloc (n_subdomains*sizeof(MetisInt),&metis_coarse_subdivision);CHKERRQ(ierr);
2198         ierr = METIS_SetDefaultOptions(options);
2199         /* we need a contiguous partition of the coarse mesh */
2200         options[METIS_OPTION_CONTIG]=1;
2201         options[METIS_OPTION_NITER]=30;
2202         if (pcbddc->coarsening_ratio > 1) {
2203           if (n_subdomains>n_parts*heuristic_for_metis) {
2204             options[METIS_OPTION_IPTYPE]=METIS_IPTYPE_EDGE;
2205             options[METIS_OPTION_OBJTYPE]=METIS_OBJTYPE_CUT;
2206             ierr = METIS_PartGraphKway(&faces_nvtxs,&ncon,faces_xadj,faces_adjncy,NULL,NULL,NULL,&n_parts,NULL,NULL,options,&objval,metis_coarse_subdivision);
2207             if (ierr != METIS_OK) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in METIS_PartGraphKway (metis error code %D) called from PCBDDCSetUpCoarseEnvironment\n",ierr);
2208           } else {
2209             ierr = METIS_PartGraphRecursive(&faces_nvtxs,&ncon,faces_xadj,faces_adjncy,NULL,NULL,NULL,&n_parts,NULL,NULL,options,&objval,metis_coarse_subdivision);
2210             if (ierr != METIS_OK) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in METIS_PartGraphRecursive (metis error code %D) called from PCBDDCSetUpCoarseEnvironment\n",ierr);
2211           }
2212         } else {
2213           for (i=0;i<n_subdomains;i++) metis_coarse_subdivision[i]=i;
2214         }
2215         ierr = PetscFree(faces_xadj);CHKERRQ(ierr);
2216         ierr = PetscFree(faces_adjncy);CHKERRQ(ierr);
2217         ierr = PetscMalloc(size_prec_comm*sizeof(PetscMPIInt),&coarse_subdivision);CHKERRQ(ierr);
2218 
2219         /* copy/cast values avoiding possible type conflicts between PETSc, MPI and METIS */
2220         for (i=0;i<size_prec_comm;i++) coarse_subdivision[i]=MPI_PROC_NULL;
2221         for (i=0;i<n_subdomains;i++) coarse_subdivision[ranks_stretching_ratio*i]=(PetscInt)(metis_coarse_subdivision[i]);
2222         ierr = PetscFree(metis_coarse_subdivision);CHKERRQ(ierr);
2223       }
2224 
2225       /* Create new communicator for coarse problem splitting the old one */
2226       if ( !(rank_prec_comm%procs_jumps_coarse_comm) && rank_prec_comm < procs_jumps_coarse_comm*n_parts ){
2227         coarse_color=0;              /* for communicator splitting */
2228         active_rank=rank_prec_comm;  /* for insertion of matrix values */
2229       }
2230       /* procs with coarse_color = MPI_UNDEFINED will have coarse_comm = MPI_COMM_NULL (from mpi standards)
2231          key = rank_prec_comm -> keep same ordering of ranks from the old to the new communicator */
2232       ierr = MPI_Comm_split(prec_comm,coarse_color,rank_prec_comm,&coarse_comm);CHKERRQ(ierr);
2233 
2234       if ( coarse_color == 0 ) {
2235         ierr = MPI_Comm_size(coarse_comm,&size_coarse_comm);CHKERRQ(ierr);
2236         ierr = MPI_Comm_rank(coarse_comm,&rank_coarse_comm);CHKERRQ(ierr);
2237       } else {
2238         rank_coarse_comm = MPI_PROC_NULL;
2239       }
2240 
2241       /* master proc take care of arranging and distributing coarse information */
2242       if (rank_coarse_comm == master_proc) {
2243         ierr = PetscMalloc (size_coarse_comm*sizeof(PetscMPIInt),&displacements_recv);CHKERRQ(ierr);
2244         ierr = PetscMalloc (size_coarse_comm*sizeof(PetscMPIInt),&total_count_recv);CHKERRQ(ierr);
2245         ierr = PetscMalloc (n_subdomains*sizeof(PetscMPIInt),&total_ranks_recv);CHKERRQ(ierr);
2246         /* some initializations */
2247         displacements_recv[0]=0;
2248         ierr = PetscMemzero(total_count_recv,size_coarse_comm*sizeof(PetscMPIInt));CHKERRQ(ierr);
2249         /* count from how many processes the j-th process of the coarse decomposition will receive data */
2250         for (j=0;j<size_coarse_comm;j++) {
2251           for (i=0;i<size_prec_comm;i++) {
2252           if (coarse_subdivision[i]==j) total_count_recv[j]++;
2253           }
2254         }
2255         /* displacements needed for scatterv of total_ranks_recv */
2256       for (i=1; i<size_coarse_comm; i++) displacements_recv[i]=displacements_recv[i-1]+total_count_recv[i-1];
2257 
2258         /* Now fill properly total_ranks_recv -> each coarse process will receive the ranks (in prec_comm communicator) of its friend (sending) processes */
2259         ierr = PetscMemzero(total_count_recv,size_coarse_comm*sizeof(PetscMPIInt));CHKERRQ(ierr);
2260         for (j=0;j<size_coarse_comm;j++) {
2261           for (i=0;i<size_prec_comm;i++) {
2262             if (coarse_subdivision[i]==j) {
2263               total_ranks_recv[displacements_recv[j]+total_count_recv[j]]=i;
2264               total_count_recv[j]+=1;
2265             }
2266           }
2267         }
2268         /*for (j=0;j<size_coarse_comm;j++) {
2269           printf("process %d in new rank will receive from %d processes (original ranks follows)\n",j,total_count_recv[j]);
2270           for (i=0;i<total_count_recv[j];i++) {
2271             printf("%d ",total_ranks_recv[displacements_recv[j]+i]);
2272           }
2273           printf("\n");
2274         }*/
2275 
2276         /* identify new decomposition in terms of ranks in the old communicator */
2277         for (i=0;i<n_subdomains;i++) {
2278           coarse_subdivision[ranks_stretching_ratio*i]=coarse_subdivision[ranks_stretching_ratio*i]*procs_jumps_coarse_comm;
2279         }
2280         /*printf("coarse_subdivision in old end new ranks\n");
2281         for (i=0;i<size_prec_comm;i++)
2282           if (coarse_subdivision[i]!=MPI_PROC_NULL) {
2283             printf("%d=(%d %d), ",i,coarse_subdivision[i],coarse_subdivision[i]/procs_jumps_coarse_comm);
2284           } else {
2285             printf("%d=(%d %d), ",i,coarse_subdivision[i],coarse_subdivision[i]);
2286           }
2287         printf("\n");*/
2288       }
2289 
2290       /* Scatter new decomposition for send details */
2291       ierr = MPI_Scatter(&coarse_subdivision[0],1,MPIU_INT,&rank_coarse_proc_send_to,1,MPIU_INT,master_proc,prec_comm);CHKERRQ(ierr);
2292       /* Scatter receiving details to members of coarse decomposition */
2293       if ( coarse_color == 0) {
2294         ierr = MPI_Scatter(&total_count_recv[0],1,MPIU_INT,&count_recv,1,MPIU_INT,master_proc,coarse_comm);CHKERRQ(ierr);
2295         ierr = PetscMalloc (count_recv*sizeof(PetscMPIInt),&ranks_recv);CHKERRQ(ierr);
2296         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);
2297       }
2298 
2299       /*printf("I will send my matrix data to proc  %d\n",rank_coarse_proc_send_to);
2300       if (coarse_color == 0) {
2301         printf("I will receive some matrix data from %d processes (ranks follows)\n",count_recv);
2302         for (i=0;i<count_recv;i++)
2303           printf("%d ",ranks_recv[i]);
2304         printf("\n");
2305       }*/
2306 
2307       if (rank_prec_comm == master_proc) {
2308         ierr = PetscFree(coarse_subdivision);CHKERRQ(ierr);
2309         ierr = PetscFree(total_count_recv);CHKERRQ(ierr);
2310         ierr = PetscFree(total_ranks_recv);CHKERRQ(ierr);
2311         ierr = PetscFree(displacements_recv);CHKERRQ(ierr);
2312       }
2313 #endif
2314       break;
2315     }
2316 
2317     case(REPLICATED_BDDC):
2318 
2319       pcbddc->coarse_communications_type = GATHERS_BDDC;
2320       coarse_mat_type = MATSEQAIJ;
2321       coarse_pc_type  = PCLU;
2322       coarse_ksp_type  = KSPPREONLY;
2323       coarse_comm = PETSC_COMM_SELF;
2324       active_rank = rank_prec_comm;
2325       break;
2326 
2327     case(PARALLEL_BDDC):
2328 
2329       pcbddc->coarse_communications_type = SCATTERS_BDDC;
2330       coarse_mat_type = MATAIJ;
2331       coarse_pc_type  = PCREDUNDANT;
2332       coarse_ksp_type  = KSPPREONLY;
2333       coarse_comm = prec_comm;
2334       active_rank = rank_prec_comm;
2335       break;
2336 
2337     case(SEQUENTIAL_BDDC):
2338       pcbddc->coarse_communications_type = GATHERS_BDDC;
2339       coarse_mat_type = MATAIJ;
2340       coarse_pc_type = PCLU;
2341       coarse_ksp_type  = KSPPREONLY;
2342       coarse_comm = PETSC_COMM_SELF;
2343       active_rank = master_proc;
2344       break;
2345   }
2346 
2347   switch(pcbddc->coarse_communications_type){
2348 
2349     case(SCATTERS_BDDC):
2350       {
2351         if (pcbddc->coarse_problem_type==MULTILEVEL_BDDC) {
2352 
2353           IS coarse_IS;
2354 
2355           if(pcbddc->coarsening_ratio == 1) {
2356             ins_local_primal_size = pcbddc->local_primal_size;
2357             ins_local_primal_indices = pcbddc->local_primal_indices;
2358             if (coarse_color == 0) { ierr = PetscFree(ranks_recv);CHKERRQ(ierr); }
2359             /* nonzeros */
2360             ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&dnz);CHKERRQ(ierr);
2361             ierr = PetscMemzero(dnz,ins_local_primal_size*sizeof(PetscInt));CHKERRQ(ierr);
2362             for (i=0;i<ins_local_primal_size;i++) {
2363               dnz[i] = ins_local_primal_size;
2364             }
2365           } else {
2366             PetscMPIInt send_size;
2367             PetscMPIInt *send_buffer;
2368             PetscInt    *aux_ins_indices;
2369             PetscInt    ii,jj;
2370             MPI_Request *requests;
2371 
2372             ierr = PetscMalloc(count_recv*sizeof(PetscMPIInt),&localdispl2);CHKERRQ(ierr);
2373             /* reusing pcbddc->local_primal_displacements and pcbddc->replicated_primal_size */
2374             ierr = PetscFree(pcbddc->local_primal_displacements);CHKERRQ(ierr);
2375             ierr = PetscMalloc((count_recv+1)*sizeof(PetscMPIInt),&pcbddc->local_primal_displacements);CHKERRQ(ierr);
2376             pcbddc->replicated_primal_size = count_recv;
2377             j = 0;
2378             for (i=0;i<count_recv;i++) {
2379               pcbddc->local_primal_displacements[i] = j;
2380               j += pcbddc->local_primal_sizes[ranks_recv[i]];
2381             }
2382             pcbddc->local_primal_displacements[count_recv] = j;
2383             ierr = PetscMalloc(j*sizeof(PetscMPIInt),&pcbddc->replicated_local_primal_indices);CHKERRQ(ierr);
2384             /* allocate auxiliary space */
2385             ierr = PetscMalloc(count_recv*sizeof(PetscMPIInt),&localsizes2);CHKERRQ(ierr);
2386             ierr = PetscMalloc(pcbddc->coarse_size*sizeof(PetscInt),&aux_ins_indices);CHKERRQ(ierr);
2387             ierr = PetscMemzero(aux_ins_indices,pcbddc->coarse_size*sizeof(PetscInt));CHKERRQ(ierr);
2388             /* allocate stuffs for message massing */
2389             ierr = PetscMalloc((count_recv+1)*sizeof(MPI_Request),&requests);CHKERRQ(ierr);
2390             for (i=0;i<count_recv+1;i++) { requests[i]=MPI_REQUEST_NULL; }
2391             /* send indices to be inserted */
2392             for (i=0;i<count_recv;i++) {
2393               send_size = pcbddc->local_primal_sizes[ranks_recv[i]];
2394               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);
2395             }
2396             if (rank_coarse_proc_send_to != MPI_PROC_NULL ) {
2397               send_size = pcbddc->local_primal_size;
2398               ierr = PetscMalloc(send_size*sizeof(PetscMPIInt),&send_buffer);CHKERRQ(ierr);
2399               for (i=0;i<send_size;i++) {
2400                 send_buffer[i]=(PetscMPIInt)pcbddc->local_primal_indices[i];
2401               }
2402               ierr = MPI_Isend(send_buffer,send_size,MPIU_INT,rank_coarse_proc_send_to,999,prec_comm,&requests[count_recv]);CHKERRQ(ierr);
2403             }
2404             ierr = MPI_Waitall(count_recv+1,requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2405             if (rank_coarse_proc_send_to != MPI_PROC_NULL ) {
2406               ierr = PetscFree(send_buffer);CHKERRQ(ierr);
2407             }
2408             j = 0;
2409             for (i=0;i<count_recv;i++) {
2410               ii = pcbddc->local_primal_displacements[i+1]-pcbddc->local_primal_displacements[i];
2411               localsizes2[i] = ii*ii;
2412               localdispl2[i] = j;
2413               j += localsizes2[i];
2414               jj = pcbddc->local_primal_displacements[i];
2415               /* it counts the coarse subdomains sharing the coarse node */
2416               for (k=0;k<ii;k++) {
2417                 aux_ins_indices[pcbddc->replicated_local_primal_indices[jj+k]] += 1;
2418               }
2419             }
2420             /* temp_coarse_mat_vals used to store matrix values to be received */
2421             ierr = PetscMalloc(j*sizeof(PetscScalar),&temp_coarse_mat_vals);CHKERRQ(ierr);
2422             /* evaluate how many values I will insert in coarse mat */
2423             ins_local_primal_size = 0;
2424             for (i=0;i<pcbddc->coarse_size;i++) {
2425               if (aux_ins_indices[i]) {
2426                 ins_local_primal_size++;
2427               }
2428             }
2429             /* evaluate indices I will insert in coarse mat */
2430             ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr);
2431             j = 0;
2432             for(i=0;i<pcbddc->coarse_size;i++) {
2433               if(aux_ins_indices[i]) {
2434                 ins_local_primal_indices[j] = i;
2435                 j++;
2436               }
2437             }
2438             /* processes partecipating in coarse problem receive matrix data from their friends */
2439             for (i=0;i<count_recv;i++) {
2440               ierr = MPI_Irecv(&temp_coarse_mat_vals[localdispl2[i]],localsizes2[i],MPIU_SCALAR,ranks_recv[i],666,prec_comm,&requests[i]);CHKERRQ(ierr);
2441             }
2442             if (rank_coarse_proc_send_to != MPI_PROC_NULL ) {
2443               send_size = pcbddc->local_primal_size*pcbddc->local_primal_size;
2444               ierr = MPI_Isend(&coarse_submat_vals[0],send_size,MPIU_SCALAR,rank_coarse_proc_send_to,666,prec_comm,&requests[count_recv]);CHKERRQ(ierr);
2445             }
2446             ierr = MPI_Waitall(count_recv+1,requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2447             /* nonzeros */
2448             ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&dnz);CHKERRQ(ierr);
2449             ierr = PetscMemzero(dnz,ins_local_primal_size*sizeof(PetscInt));CHKERRQ(ierr);
2450             /* use aux_ins_indices to realize a global to local mapping */
2451             j=0;
2452             for(i=0;i<pcbddc->coarse_size;i++){
2453               if(aux_ins_indices[i]==0){
2454                 aux_ins_indices[i]=-1;
2455               } else {
2456                 aux_ins_indices[i]=j;
2457                 j++;
2458               }
2459             }
2460             for (i=0;i<count_recv;i++) {
2461               j = pcbddc->local_primal_sizes[ranks_recv[i]];
2462               for (k=0;k<j;k++) {
2463                 dnz[aux_ins_indices[pcbddc->replicated_local_primal_indices[pcbddc->local_primal_displacements[i]+k]]] += j;
2464               }
2465             }
2466             /* check */
2467             for (i=0;i<ins_local_primal_size;i++) {
2468               if (dnz[i] > ins_local_primal_size) {
2469                 dnz[i] = ins_local_primal_size;
2470               }
2471             }
2472             ierr = PetscFree(requests);CHKERRQ(ierr);
2473             ierr = PetscFree(aux_ins_indices);CHKERRQ(ierr);
2474             if (coarse_color == 0) { ierr = PetscFree(ranks_recv);CHKERRQ(ierr); }
2475           }
2476           /* create local to global mapping needed by coarse MATIS */
2477           if (coarse_comm != MPI_COMM_NULL ) {ierr = MPI_Comm_free(&coarse_comm);CHKERRQ(ierr);}
2478           coarse_comm = prec_comm;
2479           active_rank = rank_prec_comm;
2480           ierr = ISCreateGeneral(coarse_comm,ins_local_primal_size,ins_local_primal_indices,PETSC_COPY_VALUES,&coarse_IS);CHKERRQ(ierr);
2481           ierr = ISLocalToGlobalMappingCreateIS(coarse_IS,&coarse_ISLG);CHKERRQ(ierr);
2482           ierr = ISDestroy(&coarse_IS);CHKERRQ(ierr);
2483         } else if (pcbddc->coarse_problem_type==PARALLEL_BDDC) {
2484           /* arrays for values insertion */
2485           ins_local_primal_size = pcbddc->local_primal_size;
2486           ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr);
2487           ierr = PetscMalloc(ins_local_primal_size*ins_local_primal_size*sizeof(PetscScalar),&ins_coarse_mat_vals);CHKERRQ(ierr);
2488           for (j=0;j<ins_local_primal_size;j++){
2489             ins_local_primal_indices[j]=pcbddc->local_primal_indices[j];
2490             for (i=0;i<ins_local_primal_size;i++) {
2491               ins_coarse_mat_vals[j*ins_local_primal_size+i]=coarse_submat_vals[j*ins_local_primal_size+i];
2492             }
2493           }
2494         }
2495         break;
2496 
2497     }
2498 
2499     case(GATHERS_BDDC):
2500       {
2501 
2502         PetscMPIInt mysize,mysize2;
2503         PetscMPIInt *send_buffer;
2504 
2505         if (rank_prec_comm==active_rank) {
2506           ierr = PetscMalloc ( pcbddc->replicated_primal_size*sizeof(PetscMPIInt),&pcbddc->replicated_local_primal_indices);CHKERRQ(ierr);
2507           ierr = PetscMalloc ( pcbddc->replicated_primal_size*sizeof(PetscScalar),&pcbddc->replicated_local_primal_values);CHKERRQ(ierr);
2508           ierr = PetscMalloc ( size_prec_comm*sizeof(PetscMPIInt),&localsizes2);CHKERRQ(ierr);
2509           ierr = PetscMalloc ( size_prec_comm*sizeof(PetscMPIInt),&localdispl2);CHKERRQ(ierr);
2510           /* arrays for values insertion */
2511       for (i=0;i<size_prec_comm;i++) localsizes2[i]=pcbddc->local_primal_sizes[i]*pcbddc->local_primal_sizes[i];
2512           localdispl2[0]=0;
2513       for (i=1;i<size_prec_comm;i++) localdispl2[i]=localsizes2[i-1]+localdispl2[i-1];
2514           j=0;
2515       for (i=0;i<size_prec_comm;i++) j+=localsizes2[i];
2516           ierr = PetscMalloc ( j*sizeof(PetscScalar),&temp_coarse_mat_vals);CHKERRQ(ierr);
2517         }
2518 
2519         mysize=pcbddc->local_primal_size;
2520         mysize2=pcbddc->local_primal_size*pcbddc->local_primal_size;
2521         ierr = PetscMalloc(mysize*sizeof(PetscMPIInt),&send_buffer);CHKERRQ(ierr);
2522     for (i=0; i<mysize; i++) send_buffer[i]=(PetscMPIInt)pcbddc->local_primal_indices[i];
2523 
2524         if (pcbddc->coarse_problem_type == SEQUENTIAL_BDDC){
2525           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);
2526           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);
2527         } else {
2528           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);
2529           ierr = MPI_Allgatherv(&coarse_submat_vals[0],mysize2,MPIU_SCALAR,&temp_coarse_mat_vals[0],localsizes2,localdispl2,MPIU_SCALAR,prec_comm);CHKERRQ(ierr);
2530         }
2531         ierr = PetscFree(send_buffer);CHKERRQ(ierr);
2532         break;
2533       }/* switch on coarse problem and communications associated with finished */
2534   }
2535 
2536   /* Now create and fill up coarse matrix */
2537   if ( rank_prec_comm == active_rank ) {
2538 
2539     Mat matis_coarse_local_mat;
2540 
2541     if (pcbddc->coarse_problem_type != MULTILEVEL_BDDC) {
2542       ierr = MatCreate(coarse_comm,&pcbddc->coarse_mat);CHKERRQ(ierr);
2543       ierr = MatSetSizes(pcbddc->coarse_mat,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size);CHKERRQ(ierr);
2544       ierr = MatSetType(pcbddc->coarse_mat,coarse_mat_type);CHKERRQ(ierr);
2545       ierr = MatSetOptionsPrefix(pcbddc->coarse_mat,"coarse_");CHKERRQ(ierr);
2546       ierr = MatSetFromOptions(pcbddc->coarse_mat);CHKERRQ(ierr);
2547       ierr = MatSetUp(pcbddc->coarse_mat);CHKERRQ(ierr);
2548       ierr = MatSetOption(pcbddc->coarse_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr); /* local values stored in column major */
2549       ierr = MatSetOption(pcbddc->coarse_mat,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr);
2550     } else {
2551       ierr = MatCreateIS(coarse_comm,1,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size,coarse_ISLG,&pcbddc->coarse_mat);CHKERRQ(ierr);
2552       ierr = MatSetUp(pcbddc->coarse_mat);CHKERRQ(ierr);
2553       ierr = MatISGetLocalMat(pcbddc->coarse_mat,&matis_coarse_local_mat);CHKERRQ(ierr);
2554       ierr = MatSetOptionsPrefix(pcbddc->coarse_mat,"coarse_");CHKERRQ(ierr);
2555       ierr = MatSetFromOptions(pcbddc->coarse_mat);CHKERRQ(ierr);
2556       ierr = MatSetUp(matis_coarse_local_mat);CHKERRQ(ierr);
2557       ierr = MatSetOption(matis_coarse_local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr); /* local values stored in column major */
2558       ierr = MatSetOption(matis_coarse_local_mat,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr);
2559     }
2560     /* preallocation */
2561     if (pcbddc->coarse_problem_type != MULTILEVEL_BDDC) {
2562 
2563       PetscInt lrows,lcols,bs;
2564 
2565       ierr = MatGetLocalSize(pcbddc->coarse_mat,&lrows,&lcols);CHKERRQ(ierr);
2566       ierr = MatPreallocateInitialize(coarse_comm,lrows,lcols,dnz,onz);CHKERRQ(ierr);
2567       ierr = MatGetBlockSize(pcbddc->coarse_mat,&bs);CHKERRQ(ierr);
2568 
2569       if (pcbddc->coarse_problem_type == PARALLEL_BDDC) {
2570 
2571         Vec         vec_dnz,vec_onz;
2572         PetscScalar *my_dnz,*my_onz,*array;
2573         PetscInt    *mat_ranges,*row_ownership;
2574         PetscInt    coarse_index_row,coarse_index_col,owner;
2575 
2576         ierr = VecCreate(prec_comm,&vec_dnz);CHKERRQ(ierr);
2577         ierr = VecSetBlockSize(vec_dnz,bs);CHKERRQ(ierr);
2578         ierr = VecSetSizes(vec_dnz,PETSC_DECIDE,pcbddc->coarse_size);CHKERRQ(ierr);
2579         ierr = VecSetType(vec_dnz,VECMPI);CHKERRQ(ierr);
2580         ierr = VecDuplicate(vec_dnz,&vec_onz);CHKERRQ(ierr);
2581 
2582         ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscScalar),&my_dnz);CHKERRQ(ierr);
2583         ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscScalar),&my_onz);CHKERRQ(ierr);
2584         ierr = PetscMemzero(my_dnz,pcbddc->local_primal_size*sizeof(PetscScalar));CHKERRQ(ierr);
2585         ierr = PetscMemzero(my_onz,pcbddc->local_primal_size*sizeof(PetscScalar));CHKERRQ(ierr);
2586 
2587         ierr = PetscMalloc(pcbddc->coarse_size*sizeof(PetscInt),&row_ownership);CHKERRQ(ierr);
2588         ierr = MatGetOwnershipRanges(pcbddc->coarse_mat,(const PetscInt**)&mat_ranges);CHKERRQ(ierr);
2589         for (i=0;i<size_prec_comm;i++) {
2590           for (j=mat_ranges[i];j<mat_ranges[i+1];j++) {
2591             row_ownership[j]=i;
2592           }
2593         }
2594 
2595         for (i=0;i<pcbddc->local_primal_size;i++) {
2596           coarse_index_row = pcbddc->local_primal_indices[i];
2597           owner = row_ownership[coarse_index_row];
2598           for (j=i;j<pcbddc->local_primal_size;j++) {
2599             owner = row_ownership[coarse_index_row];
2600             coarse_index_col = pcbddc->local_primal_indices[j];
2601             if (coarse_index_col > mat_ranges[owner]-1 && coarse_index_col < mat_ranges[owner+1] ) {
2602               my_dnz[i] += 1.0;
2603             } else {
2604               my_onz[i] += 1.0;
2605             }
2606             if (i != j) {
2607               owner = row_ownership[coarse_index_col];
2608               if (coarse_index_row > mat_ranges[owner]-1 && coarse_index_row < mat_ranges[owner+1] ) {
2609                 my_dnz[j] += 1.0;
2610               } else {
2611                 my_onz[j] += 1.0;
2612               }
2613             }
2614           }
2615         }
2616         ierr = VecSet(vec_dnz,0.0);CHKERRQ(ierr);
2617         ierr = VecSet(vec_onz,0.0);CHKERRQ(ierr);
2618         if (pcbddc->local_primal_size) {
2619           ierr = VecSetValues(vec_dnz,pcbddc->local_primal_size,pcbddc->local_primal_indices,my_dnz,ADD_VALUES);CHKERRQ(ierr);
2620           ierr = VecSetValues(vec_onz,pcbddc->local_primal_size,pcbddc->local_primal_indices,my_onz,ADD_VALUES);CHKERRQ(ierr);
2621         }
2622         ierr = VecAssemblyBegin(vec_dnz);CHKERRQ(ierr);
2623         ierr = VecAssemblyBegin(vec_onz);CHKERRQ(ierr);
2624         ierr = VecAssemblyEnd(vec_dnz);CHKERRQ(ierr);
2625         ierr = VecAssemblyEnd(vec_onz);CHKERRQ(ierr);
2626         j = mat_ranges[rank_prec_comm+1]-mat_ranges[rank_prec_comm];
2627         ierr = VecGetArray(vec_dnz,&array);CHKERRQ(ierr);
2628         for (i=0; i<j; i++) dnz[i] = (PetscInt)PetscRealPart(array[i]);
2629 
2630         ierr = VecRestoreArray(vec_dnz,&array);CHKERRQ(ierr);
2631         ierr = VecGetArray(vec_onz,&array);CHKERRQ(ierr);
2632         for (i=0;i<j;i++) onz[i] = (PetscInt)PetscRealPart(array[i]);
2633 
2634         ierr = VecRestoreArray(vec_onz,&array);CHKERRQ(ierr);
2635         ierr = PetscFree(my_dnz);CHKERRQ(ierr);
2636         ierr = PetscFree(my_onz);CHKERRQ(ierr);
2637         ierr = PetscFree(row_ownership);CHKERRQ(ierr);
2638         ierr = VecDestroy(&vec_dnz);CHKERRQ(ierr);
2639         ierr = VecDestroy(&vec_onz);CHKERRQ(ierr);
2640       } else {
2641         for (k=0;k<size_prec_comm;k++){
2642           offset=pcbddc->local_primal_displacements[k];
2643           offset2=localdispl2[k];
2644           ins_local_primal_size = pcbddc->local_primal_sizes[k];
2645           ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr);
2646           for (j=0;j<ins_local_primal_size;j++){
2647             ins_local_primal_indices[j]=(PetscInt)pcbddc->replicated_local_primal_indices[offset+j];
2648           }
2649           for (j=0;j<ins_local_primal_size;j++) {
2650             ierr = MatPreallocateSet(ins_local_primal_indices[j],ins_local_primal_size,ins_local_primal_indices,dnz,onz);CHKERRQ(ierr);
2651           }
2652           ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr);
2653         }
2654       }
2655 
2656       /* check */
2657       for (i=0;i<lrows;i++) {
2658         if (dnz[i]>lcols) dnz[i]=lcols;
2659         if (onz[i]>pcbddc->coarse_size-lcols) onz[i]=pcbddc->coarse_size-lcols;
2660       }
2661       ierr = MatSeqAIJSetPreallocation(pcbddc->coarse_mat,0,dnz);CHKERRQ(ierr);
2662       ierr = MatMPIAIJSetPreallocation(pcbddc->coarse_mat,0,dnz,0,onz);CHKERRQ(ierr);
2663       ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
2664     } else {
2665       ierr = MatSeqAIJSetPreallocation(matis_coarse_local_mat,0,dnz);CHKERRQ(ierr);
2666       ierr = PetscFree(dnz);CHKERRQ(ierr);
2667     }
2668     /* insert values */
2669     if (pcbddc->coarse_problem_type == PARALLEL_BDDC) {
2670       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);
2671     } else if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
2672       if (pcbddc->coarsening_ratio == 1) {
2673         ins_coarse_mat_vals = coarse_submat_vals;
2674         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);
2675       } else {
2676         ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr);
2677         for (k=0;k<pcbddc->replicated_primal_size;k++) {
2678           offset = pcbddc->local_primal_displacements[k];
2679           offset2 = localdispl2[k];
2680           ins_local_primal_size = pcbddc->local_primal_displacements[k+1]-pcbddc->local_primal_displacements[k];
2681           ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr);
2682           for (j=0;j<ins_local_primal_size;j++){
2683             ins_local_primal_indices[j]=(PetscInt)pcbddc->replicated_local_primal_indices[offset+j];
2684           }
2685           ins_coarse_mat_vals = &temp_coarse_mat_vals[offset2];
2686           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);
2687           ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr);
2688         }
2689       }
2690       ins_local_primal_indices = 0;
2691       ins_coarse_mat_vals = 0;
2692     } else {
2693       for (k=0;k<size_prec_comm;k++){
2694         offset=pcbddc->local_primal_displacements[k];
2695         offset2=localdispl2[k];
2696         ins_local_primal_size = pcbddc->local_primal_sizes[k];
2697         ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr);
2698         for (j=0;j<ins_local_primal_size;j++){
2699           ins_local_primal_indices[j]=(PetscInt)pcbddc->replicated_local_primal_indices[offset+j];
2700         }
2701         ins_coarse_mat_vals = &temp_coarse_mat_vals[offset2];
2702         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);
2703         ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr);
2704       }
2705       ins_local_primal_indices = 0;
2706       ins_coarse_mat_vals = 0;
2707     }
2708     ierr = MatAssemblyBegin(pcbddc->coarse_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2709     ierr = MatAssemblyEnd(pcbddc->coarse_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2710     /* symmetry of coarse matrix */
2711     if (issym) {
2712       ierr = MatSetOption(pcbddc->coarse_mat,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
2713     }
2714     ierr = MatGetVecs(pcbddc->coarse_mat,&pcbddc->coarse_vec,&pcbddc->coarse_rhs);CHKERRQ(ierr);
2715   }
2716 
2717   /* create loc to glob scatters if needed */
2718   if (pcbddc->coarse_communications_type == SCATTERS_BDDC) {
2719      IS local_IS,global_IS;
2720      ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size,0,1,&local_IS);CHKERRQ(ierr);
2721      ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_indices,PETSC_COPY_VALUES,&global_IS);CHKERRQ(ierr);
2722      ierr = VecScatterCreate(pcbddc->vec1_P,local_IS,pcbddc->coarse_vec,global_IS,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
2723      ierr = ISDestroy(&local_IS);CHKERRQ(ierr);
2724      ierr = ISDestroy(&global_IS);CHKERRQ(ierr);
2725   }
2726 
2727   /* free memory no longer needed */
2728   if (coarse_ISLG)              { ierr = ISLocalToGlobalMappingDestroy(&coarse_ISLG);CHKERRQ(ierr); }
2729   if (ins_local_primal_indices) { ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr); }
2730   if (ins_coarse_mat_vals)      { ierr = PetscFree(ins_coarse_mat_vals);CHKERRQ(ierr); }
2731   if (localsizes2)              { ierr = PetscFree(localsizes2);CHKERRQ(ierr); }
2732   if (localdispl2)              { ierr = PetscFree(localdispl2);CHKERRQ(ierr); }
2733   if (temp_coarse_mat_vals)     { ierr = PetscFree(temp_coarse_mat_vals);CHKERRQ(ierr); }
2734 
2735   /* Compute coarse null space */
2736   CoarseNullSpace = 0;
2737   if (pcbddc->NullSpace) {
2738     ierr = PCBDDCNullSpaceAssembleCoarse(pc,&CoarseNullSpace);CHKERRQ(ierr);
2739   }
2740 
2741   /* KSP for coarse problem */
2742   if (rank_prec_comm == active_rank) {
2743     PetscBool isbddc=PETSC_FALSE;
2744 
2745     ierr = KSPCreate(coarse_comm,&pcbddc->coarse_ksp);CHKERRQ(ierr);
2746     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
2747     ierr = KSPSetOperators(pcbddc->coarse_ksp,pcbddc->coarse_mat,pcbddc->coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
2748     ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,max_it_coarse_ksp);CHKERRQ(ierr);
2749     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
2750     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
2751     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
2752     /* Allow user's customization */
2753     ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,"coarse_");CHKERRQ(ierr);
2754     /* Set Up PC for coarse problem BDDC */
2755     if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
2756       i = pcbddc->current_level+1;
2757       ierr = PCBDDCSetLevel(pc_temp,i);CHKERRQ(ierr);
2758       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
2759       ierr = PCBDDCSetMaxLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
2760       ierr = PCBDDCSetCoarseProblemType(pc_temp,MULTILEVEL_BDDC);CHKERRQ(ierr);
2761       if (CoarseNullSpace) {
2762         ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
2763       }
2764       if (dbg_flag) {
2765         ierr = PetscViewerASCIIPrintf(viewer,"----------------Level %d: Setting up level %d---------------\n",pcbddc->current_level,i);CHKERRQ(ierr);
2766         ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2767       }
2768     } else {
2769       if (CoarseNullSpace) {
2770         ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
2771       }
2772     }
2773     ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
2774     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
2775 
2776     ierr = KSPGetTolerances(pcbddc->coarse_ksp,NULL,NULL,NULL,&j);CHKERRQ(ierr);
2777     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
2778     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
2779     if (j == 1) {
2780       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
2781       if (isbddc) {
2782         ierr = PCBDDCSetUseExactDirichlet(pc_temp,PETSC_FALSE);CHKERRQ(ierr);
2783       }
2784     }
2785   }
2786   /* Check coarse problem if requested */
2787   if ( dbg_flag && rank_prec_comm == active_rank ) {
2788     KSP check_ksp;
2789     PC  check_pc;
2790     Vec check_vec;
2791     PetscReal   abs_infty_error,infty_error,lambda_min,lambda_max;
2792     KSPType check_ksp_type;
2793 
2794     /* Create ksp object suitable for extreme eigenvalues' estimation */
2795     ierr = KSPCreate(coarse_comm,&check_ksp);CHKERRQ(ierr);
2796     ierr = KSPSetOperators(check_ksp,pcbddc->coarse_mat,pcbddc->coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
2797     ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
2798     if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
2799       if (issym) check_ksp_type = KSPCG;
2800       else check_ksp_type = KSPGMRES;
2801       ierr = KSPSetComputeSingularValues(check_ksp,PETSC_TRUE);CHKERRQ(ierr);
2802     } else {
2803       check_ksp_type = KSPPREONLY;
2804     }
2805     ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
2806     ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
2807     ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
2808     ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
2809     /* create random vec */
2810     ierr = VecDuplicate(pcbddc->coarse_vec,&check_vec);CHKERRQ(ierr);
2811     ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
2812     if (CoarseNullSpace) {
2813       ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec);CHKERRQ(ierr);
2814     }
2815     ierr = MatMult(pcbddc->coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
2816     /* solve coarse problem */
2817     ierr = KSPSolve(check_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
2818     if (CoarseNullSpace) {
2819       ierr = MatNullSpaceRemove(CoarseNullSpace,pcbddc->coarse_vec);CHKERRQ(ierr);
2820     }
2821     /* check coarse problem residual error */
2822     ierr = VecAXPY(check_vec,-1.0,pcbddc->coarse_vec);CHKERRQ(ierr);
2823     ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
2824     ierr = MatMult(pcbddc->coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
2825     ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
2826     ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
2827     /* get eigenvalue estimation if inexact */
2828     if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
2829       ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
2830       ierr = KSPGetIterationNumber(check_ksp,&k);CHKERRQ(ierr);
2831       ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem eigenvalues estimated with %d iterations of %s.\n",k,check_ksp_type);CHKERRQ(ierr);
2832       ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem eigenvalues: % 1.14e %1.14e\n",lambda_min,lambda_max);CHKERRQ(ierr);
2833     }
2834     ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem exact infty_error   : %1.14e\n",infty_error);CHKERRQ(ierr);
2835     ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem residual infty_error: %1.14e\n",abs_infty_error);CHKERRQ(ierr);
2836     ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
2837   }
2838   if (dbg_flag) {
2839     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2840   }
2841   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
2842 
2843   PetscFunctionReturn(0);
2844 }
2845 
2846