xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 674ae81933ad1188dbe7c87a2be01dd8bb4076e0)
1*674ae819SStefano Zampini #include "bddc.h"
2*674ae819SStefano Zampini #include "bddcprivate.h"
3*674ae819SStefano Zampini #include <petscblaslapack.h>
4*674ae819SStefano Zampini 
5*674ae819SStefano Zampini #undef __FUNCT__
6*674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetCustomization"
7*674ae819SStefano Zampini PetscErrorCode PCBDDCResetCustomization(PC pc)
8*674ae819SStefano Zampini {
9*674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
10*674ae819SStefano Zampini   PetscInt       i;
11*674ae819SStefano Zampini   PetscErrorCode ierr;
12*674ae819SStefano Zampini 
13*674ae819SStefano Zampini   PetscFunctionBegin;
14*674ae819SStefano Zampini   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
15*674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
16*674ae819SStefano Zampini   ierr = MatNullSpaceDestroy(&pcbddc->NullSpace);CHKERRQ(ierr);
17*674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
18*674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
19*674ae819SStefano Zampini   for (i=0;i<pcbddc->n_ISForDofs;i++) {
20*674ae819SStefano Zampini     ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
21*674ae819SStefano Zampini   }
22*674ae819SStefano Zampini   ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
23*674ae819SStefano Zampini   PetscFunctionReturn(0);
24*674ae819SStefano Zampini }
25*674ae819SStefano Zampini 
26*674ae819SStefano Zampini #undef __FUNCT__
27*674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetTopography"
28*674ae819SStefano Zampini PetscErrorCode PCBDDCResetTopography(PC pc)
29*674ae819SStefano Zampini {
30*674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
31*674ae819SStefano Zampini   PetscErrorCode ierr;
32*674ae819SStefano Zampini 
33*674ae819SStefano Zampini   PetscFunctionBegin;
34*674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
35*674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
36*674ae819SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
37*674ae819SStefano Zampini   PetscFunctionReturn(0);
38*674ae819SStefano Zampini }
39*674ae819SStefano Zampini 
40*674ae819SStefano Zampini #undef __FUNCT__
41*674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetSolvers"
42*674ae819SStefano Zampini PetscErrorCode PCBDDCResetSolvers(PC pc)
43*674ae819SStefano Zampini {
44*674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
45*674ae819SStefano Zampini   PetscErrorCode ierr;
46*674ae819SStefano Zampini 
47*674ae819SStefano Zampini   PetscFunctionBegin;
48*674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->temp_solution);CHKERRQ(ierr);
49*674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->original_rhs);CHKERRQ(ierr);
50*674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
51*674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
52*674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_rhs);CHKERRQ(ierr);
53*674ae819SStefano Zampini   ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
54*674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_mat);CHKERRQ(ierr);
55*674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
56*674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
57*674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
58*674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
59*674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
60*674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
61*674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
62*674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
63*674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec4_D);CHKERRQ(ierr);
64*674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
65*674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
66*674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
67*674ae819SStefano Zampini   ierr = KSPDestroy(&pcbddc->ksp_D);CHKERRQ(ierr);
68*674ae819SStefano Zampini   ierr = KSPDestroy(&pcbddc->ksp_R);CHKERRQ(ierr);
69*674ae819SStefano Zampini   ierr = PetscFree(pcbddc->local_primal_indices);CHKERRQ(ierr);
70*674ae819SStefano Zampini   ierr = PetscFree(pcbddc->replicated_local_primal_indices);CHKERRQ(ierr);
71*674ae819SStefano Zampini   ierr = PetscFree(pcbddc->replicated_local_primal_values);CHKERRQ(ierr);
72*674ae819SStefano Zampini   ierr = PetscFree(pcbddc->local_primal_displacements);CHKERRQ(ierr);
73*674ae819SStefano Zampini   ierr = PetscFree(pcbddc->local_primal_sizes);CHKERRQ(ierr);
74*674ae819SStefano Zampini   PetscFunctionReturn(0);
75*674ae819SStefano Zampini }
76*674ae819SStefano Zampini 
77*674ae819SStefano Zampini #undef __FUNCT__
78*674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSolveSaddlePoint"
79*674ae819SStefano Zampini static PetscErrorCode  PCBDDCSolveSaddlePoint(PC pc)
80*674ae819SStefano Zampini {
81*674ae819SStefano Zampini   PetscErrorCode ierr;
82*674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
83*674ae819SStefano Zampini 
84*674ae819SStefano Zampini   PetscFunctionBegin;
85*674ae819SStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
86*674ae819SStefano Zampini   if (pcbddc->local_auxmat1) {
87*674ae819SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec2_R,pcbddc->vec1_C);CHKERRQ(ierr);
88*674ae819SStefano Zampini     ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
89*674ae819SStefano Zampini   }
90*674ae819SStefano Zampini   PetscFunctionReturn(0);
91*674ae819SStefano Zampini }
92*674ae819SStefano Zampini 
93*674ae819SStefano Zampini #undef __FUNCT__
94*674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
95*674ae819SStefano Zampini PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc)
96*674ae819SStefano Zampini {
97*674ae819SStefano Zampini   PetscErrorCode ierr;
98*674ae819SStefano Zampini   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
99*674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)  (pc->data);
100*674ae819SStefano Zampini   const PetscScalar zero = 0.0;
101*674ae819SStefano Zampini 
102*674ae819SStefano Zampini   PetscFunctionBegin;
103*674ae819SStefano Zampini   /* Application of PHI^T  */
104*674ae819SStefano Zampini   ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
105*674ae819SStefano Zampini   if (pcbddc->inexact_prec_type) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
106*674ae819SStefano Zampini 
107*674ae819SStefano Zampini   /* Scatter data of coarse_rhs */
108*674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { ierr = VecSet(pcbddc->coarse_rhs,zero);CHKERRQ(ierr); }
109*674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
110*674ae819SStefano Zampini 
111*674ae819SStefano Zampini   /* Local solution on R nodes */
112*674ae819SStefano Zampini   ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
113*674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
114*674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
115*674ae819SStefano Zampini   if (pcbddc->inexact_prec_type) {
116*674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
117*674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
118*674ae819SStefano Zampini   }
119*674ae819SStefano Zampini   ierr = PCBDDCSolveSaddlePoint(pc);CHKERRQ(ierr);
120*674ae819SStefano Zampini   ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
121*674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
122*674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
123*674ae819SStefano Zampini   if (pcbddc->inexact_prec_type) {
124*674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
125*674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
126*674ae819SStefano Zampini   }
127*674ae819SStefano Zampini 
128*674ae819SStefano Zampini   /* Coarse solution */
129*674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
130*674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { /* TODO remove null space when doing multilevel */
131*674ae819SStefano Zampini     ierr = KSPSolve(pcbddc->coarse_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
132*674ae819SStefano Zampini   }
133*674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
134*674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd  (pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
135*674ae819SStefano Zampini 
136*674ae819SStefano Zampini   /* Sum contributions from two levels */
137*674ae819SStefano Zampini   ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
138*674ae819SStefano Zampini   if (pcbddc->inexact_prec_type) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
139*674ae819SStefano Zampini   PetscFunctionReturn(0);
140*674ae819SStefano Zampini }
141*674ae819SStefano Zampini 
142*674ae819SStefano Zampini #undef __FUNCT__
143*674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
144*674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
145*674ae819SStefano Zampini {
146*674ae819SStefano Zampini   PetscErrorCode ierr;
147*674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
148*674ae819SStefano Zampini 
149*674ae819SStefano Zampini   PetscFunctionBegin;
150*674ae819SStefano Zampini   switch (pcbddc->coarse_communications_type) {
151*674ae819SStefano Zampini     case SCATTERS_BDDC:
152*674ae819SStefano Zampini       ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
153*674ae819SStefano Zampini       break;
154*674ae819SStefano Zampini     case GATHERS_BDDC:
155*674ae819SStefano Zampini       break;
156*674ae819SStefano Zampini   }
157*674ae819SStefano Zampini   PetscFunctionReturn(0);
158*674ae819SStefano Zampini }
159*674ae819SStefano Zampini 
160*674ae819SStefano Zampini #undef __FUNCT__
161*674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
162*674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
163*674ae819SStefano Zampini {
164*674ae819SStefano Zampini   PetscErrorCode ierr;
165*674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
166*674ae819SStefano Zampini   PetscScalar*   array_to;
167*674ae819SStefano Zampini   PetscScalar*   array_from;
168*674ae819SStefano Zampini   MPI_Comm       comm;
169*674ae819SStefano Zampini   PetscInt       i;
170*674ae819SStefano Zampini 
171*674ae819SStefano Zampini   PetscFunctionBegin;
172*674ae819SStefano Zampini   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
173*674ae819SStefano Zampini   switch (pcbddc->coarse_communications_type) {
174*674ae819SStefano Zampini     case SCATTERS_BDDC:
175*674ae819SStefano Zampini       ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
176*674ae819SStefano Zampini       break;
177*674ae819SStefano Zampini     case GATHERS_BDDC:
178*674ae819SStefano Zampini       if (vec_from) {
179*674ae819SStefano Zampini         ierr = VecGetArray(vec_from,&array_from);CHKERRQ(ierr);
180*674ae819SStefano Zampini       }
181*674ae819SStefano Zampini       if (vec_to) {
182*674ae819SStefano Zampini         ierr = VecGetArray(vec_to,&array_to);CHKERRQ(ierr);
183*674ae819SStefano Zampini       }
184*674ae819SStefano Zampini       switch(pcbddc->coarse_problem_type){
185*674ae819SStefano Zampini         case SEQUENTIAL_BDDC:
186*674ae819SStefano Zampini           if (smode == SCATTER_FORWARD) {
187*674ae819SStefano Zampini             ierr = MPI_Gatherv(&array_from[0],pcbddc->local_primal_size,MPIU_SCALAR,&pcbddc->replicated_local_primal_values[0],pcbddc->local_primal_sizes,pcbddc->local_primal_displacements,MPIU_SCALAR,0,comm);CHKERRQ(ierr);
188*674ae819SStefano Zampini             if (vec_to) {
189*674ae819SStefano Zampini               if (imode == ADD_VALUES) {
190*674ae819SStefano Zampini                 for (i=0;i<pcbddc->replicated_primal_size;i++) {
191*674ae819SStefano Zampini                   array_to[pcbddc->replicated_local_primal_indices[i]]+=pcbddc->replicated_local_primal_values[i];
192*674ae819SStefano Zampini                 }
193*674ae819SStefano Zampini               } else {
194*674ae819SStefano Zampini                 for (i=0;i<pcbddc->replicated_primal_size;i++) {
195*674ae819SStefano Zampini                   array_to[pcbddc->replicated_local_primal_indices[i]]=pcbddc->replicated_local_primal_values[i];
196*674ae819SStefano Zampini                 }
197*674ae819SStefano Zampini               }
198*674ae819SStefano Zampini             }
199*674ae819SStefano Zampini           } else {
200*674ae819SStefano Zampini             if (vec_from) {
201*674ae819SStefano Zampini               if (imode == ADD_VALUES) {
202*674ae819SStefano Zampini                 MPI_Comm vec_from_comm;
203*674ae819SStefano Zampini                 ierr = PetscObjectGetComm((PetscObject)(vec_from),&vec_from_comm);CHKERRQ(ierr);
204*674ae819SStefano Zampini                 SETERRQ2(vec_from_comm,PETSC_ERR_SUP,"Unsupported insert mode ADD_VALUES for SCATTER_REVERSE in %s for case %d\n",__FUNCT__,pcbddc->coarse_problem_type);
205*674ae819SStefano Zampini               }
206*674ae819SStefano Zampini               for (i=0;i<pcbddc->replicated_primal_size;i++) {
207*674ae819SStefano Zampini                 pcbddc->replicated_local_primal_values[i]=array_from[pcbddc->replicated_local_primal_indices[i]];
208*674ae819SStefano Zampini               }
209*674ae819SStefano Zampini             }
210*674ae819SStefano Zampini             ierr = MPI_Scatterv(&pcbddc->replicated_local_primal_values[0],pcbddc->local_primal_sizes,pcbddc->local_primal_displacements,MPIU_SCALAR,&array_to[0],pcbddc->local_primal_size,MPIU_SCALAR,0,comm);CHKERRQ(ierr);
211*674ae819SStefano Zampini           }
212*674ae819SStefano Zampini           break;
213*674ae819SStefano Zampini         case REPLICATED_BDDC:
214*674ae819SStefano Zampini           if (smode == SCATTER_FORWARD) {
215*674ae819SStefano Zampini             ierr = MPI_Allgatherv(&array_from[0],pcbddc->local_primal_size,MPIU_SCALAR,&pcbddc->replicated_local_primal_values[0],pcbddc->local_primal_sizes,pcbddc->local_primal_displacements,MPIU_SCALAR,comm);CHKERRQ(ierr);
216*674ae819SStefano Zampini             if (imode == ADD_VALUES) {
217*674ae819SStefano Zampini               for (i=0;i<pcbddc->replicated_primal_size;i++) {
218*674ae819SStefano Zampini                 array_to[pcbddc->replicated_local_primal_indices[i]]+=pcbddc->replicated_local_primal_values[i];
219*674ae819SStefano Zampini               }
220*674ae819SStefano Zampini             } else {
221*674ae819SStefano Zampini               for (i=0;i<pcbddc->replicated_primal_size;i++) {
222*674ae819SStefano Zampini                 array_to[pcbddc->replicated_local_primal_indices[i]]=pcbddc->replicated_local_primal_values[i];
223*674ae819SStefano Zampini               }
224*674ae819SStefano Zampini             }
225*674ae819SStefano Zampini           } else { /* no communications needed for SCATTER_REVERSE since needed data is already present */
226*674ae819SStefano Zampini             if (imode == ADD_VALUES) {
227*674ae819SStefano Zampini               for (i=0;i<pcbddc->local_primal_size;i++) {
228*674ae819SStefano Zampini                 array_to[i]+=array_from[pcbddc->local_primal_indices[i]];
229*674ae819SStefano Zampini               }
230*674ae819SStefano Zampini             } else {
231*674ae819SStefano Zampini               for (i=0;i<pcbddc->local_primal_size;i++) {
232*674ae819SStefano Zampini                 array_to[i]=array_from[pcbddc->local_primal_indices[i]];
233*674ae819SStefano Zampini               }
234*674ae819SStefano Zampini             }
235*674ae819SStefano Zampini           }
236*674ae819SStefano Zampini           break;
237*674ae819SStefano Zampini         case MULTILEVEL_BDDC:
238*674ae819SStefano Zampini           break;
239*674ae819SStefano Zampini         case PARALLEL_BDDC:
240*674ae819SStefano Zampini           break;
241*674ae819SStefano Zampini       }
242*674ae819SStefano Zampini       if (vec_from) {
243*674ae819SStefano Zampini         ierr = VecRestoreArray(vec_from,&array_from);CHKERRQ(ierr);
244*674ae819SStefano Zampini       }
245*674ae819SStefano Zampini       if (vec_to) {
246*674ae819SStefano Zampini         ierr = VecRestoreArray(vec_to,&array_to);CHKERRQ(ierr);
247*674ae819SStefano Zampini       }
248*674ae819SStefano Zampini       break;
249*674ae819SStefano Zampini   }
250*674ae819SStefano Zampini   PetscFunctionReturn(0);
251*674ae819SStefano Zampini }
252*674ae819SStefano Zampini 
253*674ae819SStefano Zampini #undef __FUNCT__
254*674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp"
255*674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
256*674ae819SStefano Zampini {
257*674ae819SStefano Zampini   PetscErrorCode ierr;
258*674ae819SStefano Zampini   PC_IS*         pcis = (PC_IS*)(pc->data);
259*674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
260*674ae819SStefano Zampini   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
261*674ae819SStefano Zampini   PetscInt       *nnz,*is_indices;
262*674ae819SStefano Zampini   PetscScalar    *temp_quadrature_constraint;
263*674ae819SStefano Zampini   PetscInt       *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B,*local_to_B;
264*674ae819SStefano Zampini   PetscInt       local_primal_size,i,j,k,total_counts,max_size_of_constraint;
265*674ae819SStefano Zampini   PetscInt       n_vertices,size_of_constraint;
266*674ae819SStefano Zampini   PetscScalar    quad_value;
267*674ae819SStefano Zampini   PetscBool      nnsp_has_cnst=PETSC_FALSE,use_nnsp_true=pcbddc->use_nnsp_true;
268*674ae819SStefano Zampini   PetscInt       nnsp_size=0,nnsp_addone=0,temp_constraints,temp_start_ptr,n_ISForFaces,n_ISForEdges;
269*674ae819SStefano Zampini   IS             *used_IS,ISForVertices,*ISForFaces,*ISForEdges;
270*674ae819SStefano Zampini   MatType        impMatType=MATSEQAIJ;
271*674ae819SStefano Zampini   PetscBLASInt   Bs,Bt,lwork,lierr;
272*674ae819SStefano Zampini   PetscReal      tol=1.0e-8;
273*674ae819SStefano Zampini   MatNullSpace   nearnullsp;
274*674ae819SStefano Zampini   const Vec      *nearnullvecs;
275*674ae819SStefano Zampini   Vec            *localnearnullsp;
276*674ae819SStefano Zampini   PetscScalar    *work,*temp_basis,*array_vector,*correlation_mat;
277*674ae819SStefano Zampini   PetscReal      *rwork,*singular_vals;
278*674ae819SStefano Zampini   PetscBLASInt   Bone=1,*ipiv;
279*674ae819SStefano Zampini   Vec            temp_vec;
280*674ae819SStefano Zampini   Mat            temp_mat;
281*674ae819SStefano Zampini   KSP            temp_ksp;
282*674ae819SStefano Zampini   PC             temp_pc;
283*674ae819SStefano Zampini   PetscInt       s,start_constraint,dual_dofs;
284*674ae819SStefano Zampini   PetscBool      compute_submatrix,useksp=PETSC_FALSE;
285*674ae819SStefano Zampini   PetscInt       *aux_primal_permutation,*aux_primal_numbering;
286*674ae819SStefano Zampini   PetscBool      boolforface,*change_basis;
287*674ae819SStefano Zampini /* some ugly conditional declarations */
288*674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
289*674ae819SStefano Zampini   PetscScalar    one=1.0,zero=0.0;
290*674ae819SStefano Zampini   PetscInt       ii;
291*674ae819SStefano Zampini   PetscScalar    *singular_vectors;
292*674ae819SStefano Zampini   PetscBLASInt   *iwork,*ifail;
293*674ae819SStefano Zampini   PetscReal      dummy_real,abs_tol;
294*674ae819SStefano Zampini   PetscBLASInt   eigs_found;
295*674ae819SStefano Zampini #endif
296*674ae819SStefano Zampini   PetscBLASInt   dummy_int;
297*674ae819SStefano Zampini   PetscScalar    dummy_scalar;
298*674ae819SStefano Zampini   PetscBool      used_vertex,get_faces,get_edges,get_vertices;
299*674ae819SStefano Zampini 
300*674ae819SStefano Zampini   PetscFunctionBegin;
301*674ae819SStefano Zampini   /* Get index sets for faces, edges and vertices from graph */
302*674ae819SStefano Zampini   get_faces = PETSC_TRUE;
303*674ae819SStefano Zampini   get_edges = PETSC_TRUE;
304*674ae819SStefano Zampini   get_vertices = PETSC_TRUE;
305*674ae819SStefano Zampini   if (pcbddc->vertices_flag) {
306*674ae819SStefano Zampini     get_faces = PETSC_FALSE;
307*674ae819SStefano Zampini     get_edges = PETSC_FALSE;
308*674ae819SStefano Zampini   }
309*674ae819SStefano Zampini   if (pcbddc->constraints_flag) {
310*674ae819SStefano Zampini     get_vertices = PETSC_FALSE;
311*674ae819SStefano Zampini   }
312*674ae819SStefano Zampini   if (pcbddc->faces_flag) {
313*674ae819SStefano Zampini     get_edges = PETSC_FALSE;
314*674ae819SStefano Zampini   }
315*674ae819SStefano Zampini   if (pcbddc->edges_flag) {
316*674ae819SStefano Zampini     get_faces = PETSC_FALSE;
317*674ae819SStefano Zampini   }
318*674ae819SStefano Zampini   /* default */
319*674ae819SStefano Zampini   if (!get_faces && !get_edges && !get_vertices) {
320*674ae819SStefano Zampini     get_vertices = PETSC_TRUE;
321*674ae819SStefano Zampini   }
322*674ae819SStefano Zampini   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,get_faces,get_edges,get_vertices,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);
323*674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
324*674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
325*674ae819SStefano Zampini     i = 0;
326*674ae819SStefano Zampini     if (ISForVertices) {
327*674ae819SStefano Zampini       ierr = ISGetSize(ISForVertices,&i);CHKERRQ(ierr);
328*674ae819SStefano Zampini     }
329*674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices\n",PetscGlobalRank,i);CHKERRQ(ierr);
330*674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces\n",PetscGlobalRank,n_ISForFaces);CHKERRQ(ierr);
331*674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges\n",PetscGlobalRank,n_ISForEdges);CHKERRQ(ierr);
332*674ae819SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
333*674ae819SStefano Zampini   }
334*674ae819SStefano Zampini   /* check if near null space is attached to global mat */
335*674ae819SStefano Zampini   ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
336*674ae819SStefano Zampini   if (nearnullsp) {
337*674ae819SStefano Zampini     ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
338*674ae819SStefano Zampini   } else { /* if near null space is not provided it uses constants */
339*674ae819SStefano Zampini     nnsp_has_cnst = PETSC_TRUE;
340*674ae819SStefano Zampini     use_nnsp_true = PETSC_TRUE;
341*674ae819SStefano Zampini   }
342*674ae819SStefano Zampini   if (nnsp_has_cnst) {
343*674ae819SStefano Zampini     nnsp_addone = 1;
344*674ae819SStefano Zampini   }
345*674ae819SStefano Zampini   /*
346*674ae819SStefano Zampini        Evaluate maximum storage size needed by the procedure
347*674ae819SStefano Zampini        - temp_indices will contain start index of each constraint stored as follows
348*674ae819SStefano Zampini        - temp_indices_to_constraint  [temp_indices[i],...,temp[indices[i+1]-1] will contain the indices (in local numbering) on which the constraint acts
349*674ae819SStefano Zampini        - temp_indices_to_constraint_B[temp_indices[i],...,temp[indices[i+1]-1] will contain the indices (in boundary numbering) on which the constraint acts
350*674ae819SStefano Zampini        - temp_quadrature_constraint  [temp_indices[i],...,temp[indices[i+1]-1] will contain the scalars representing the constraint itself
351*674ae819SStefano Zampini                                                                                                                                                          */
352*674ae819SStefano Zampini   total_counts = n_ISForFaces+n_ISForEdges;
353*674ae819SStefano Zampini   total_counts *= (nnsp_addone+nnsp_size);
354*674ae819SStefano Zampini   n_vertices = 0;
355*674ae819SStefano Zampini   if (ISForVertices) {
356*674ae819SStefano Zampini     ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
357*674ae819SStefano Zampini   }
358*674ae819SStefano Zampini   total_counts += n_vertices;
359*674ae819SStefano Zampini   ierr = PetscMalloc((total_counts+1)*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
360*674ae819SStefano Zampini   ierr = PetscMalloc((total_counts+1)*sizeof(PetscBool),&change_basis);CHKERRQ(ierr);
361*674ae819SStefano Zampini   total_counts = 0;
362*674ae819SStefano Zampini   max_size_of_constraint = 0;
363*674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
364*674ae819SStefano Zampini     if (i<n_ISForEdges) {
365*674ae819SStefano Zampini       used_IS = &ISForEdges[i];
366*674ae819SStefano Zampini     } else {
367*674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
368*674ae819SStefano Zampini     }
369*674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
370*674ae819SStefano Zampini     total_counts += j;
371*674ae819SStefano Zampini     max_size_of_constraint = PetscMax(j,max_size_of_constraint);
372*674ae819SStefano Zampini   }
373*674ae819SStefano Zampini   total_counts *= (nnsp_addone+nnsp_size);
374*674ae819SStefano Zampini   total_counts += n_vertices;
375*674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&temp_quadrature_constraint);CHKERRQ(ierr);
376*674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint);CHKERRQ(ierr);
377*674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint_B);CHKERRQ(ierr);
378*674ae819SStefano Zampini   ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&local_to_B);CHKERRQ(ierr);
379*674ae819SStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
380*674ae819SStefano Zampini   for (i=0;i<pcis->n;i++) {
381*674ae819SStefano Zampini     local_to_B[i]=-1;
382*674ae819SStefano Zampini   }
383*674ae819SStefano Zampini   for (i=0;i<pcis->n_B;i++) {
384*674ae819SStefano Zampini     local_to_B[is_indices[i]]=i;
385*674ae819SStefano Zampini   }
386*674ae819SStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
387*674ae819SStefano Zampini 
388*674ae819SStefano Zampini   /* First we issue queries to allocate optimal workspace for LAPACKgesvd or LAPACKsyev/LAPACKheev */
389*674ae819SStefano Zampini   rwork = 0;
390*674ae819SStefano Zampini   work = 0;
391*674ae819SStefano Zampini   singular_vals = 0;
392*674ae819SStefano Zampini   temp_basis = 0;
393*674ae819SStefano Zampini   correlation_mat = 0;
394*674ae819SStefano Zampini   if (!pcbddc->use_nnsp_true) {
395*674ae819SStefano Zampini     PetscScalar temp_work;
396*674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
397*674ae819SStefano Zampini     /* POD */
398*674ae819SStefano Zampini     PetscInt max_n;
399*674ae819SStefano Zampini     max_n = nnsp_addone+nnsp_size;
400*674ae819SStefano Zampini     /* using some techniques borrowed from Proper Orthogonal Decomposition */
401*674ae819SStefano Zampini     ierr = PetscMalloc(max_n*max_n*sizeof(PetscScalar),&correlation_mat);CHKERRQ(ierr);
402*674ae819SStefano Zampini     ierr = PetscMalloc(max_n*max_n*sizeof(PetscScalar),&singular_vectors);CHKERRQ(ierr);
403*674ae819SStefano Zampini     ierr = PetscMalloc(max_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
404*674ae819SStefano Zampini     ierr = PetscMalloc(max_size_of_constraint*(nnsp_addone+nnsp_size)*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr);
405*674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
406*674ae819SStefano Zampini     ierr = PetscMalloc(3*max_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
407*674ae819SStefano Zampini #endif
408*674ae819SStefano Zampini     ierr = PetscMalloc(5*max_n*sizeof(PetscBLASInt),&iwork);CHKERRQ(ierr);
409*674ae819SStefano Zampini     ierr = PetscMalloc(max_n*sizeof(PetscBLASInt),&ifail);CHKERRQ(ierr);
410*674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
411*674ae819SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Bt);CHKERRQ(ierr);
412*674ae819SStefano Zampini     lwork=-1;
413*674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
414*674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
415*674ae819SStefano Zampini     abs_tol=1.e-8;
416*674ae819SStefano Zampini /*    LAPACKsyev_("V","U",&Bt,correlation_mat,&Bt,singular_vals,&temp_work,&lwork,&lierr); */
417*674ae819SStefano Zampini     LAPACKsyevx_("V","A","U",&Bt,correlation_mat,&Bt,&dummy_real,&dummy_real,&dummy_int,&dummy_int,
418*674ae819SStefano Zampini                  &abs_tol,&eigs_found,singular_vals,singular_vectors,&Bt,&temp_work,&lwork,iwork,ifail,&lierr);
419*674ae819SStefano Zampini #else
420*674ae819SStefano Zampini /*    LAPACKsyev_("V","U",&Bt,correlation_mat,&Bt,singular_vals,&temp_work,&lwork,rwork,&lierr); */
421*674ae819SStefano Zampini /*  LAPACK call is missing here! TODO */
422*674ae819SStefano Zampini     SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Not yet implemented for complexes when PETSC_MISSING_GESVD = 1");
423*674ae819SStefano Zampini #endif
424*674ae819SStefano Zampini     if ( lierr ) {
425*674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEVX Lapack routine %d",(int)lierr);
426*674ae819SStefano Zampini     }
427*674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
428*674ae819SStefano Zampini #else /* on missing GESVD */
429*674ae819SStefano Zampini     /* SVD */
430*674ae819SStefano Zampini     PetscInt max_n,min_n;
431*674ae819SStefano Zampini     max_n = max_size_of_constraint;
432*674ae819SStefano Zampini     min_n = nnsp_addone+nnsp_size;
433*674ae819SStefano Zampini     if (max_size_of_constraint < ( nnsp_addone+nnsp_size ) ) {
434*674ae819SStefano Zampini       min_n = max_size_of_constraint;
435*674ae819SStefano Zampini       max_n = nnsp_addone+nnsp_size;
436*674ae819SStefano Zampini     }
437*674ae819SStefano Zampini     ierr = PetscMalloc(min_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
438*674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
439*674ae819SStefano Zampini     ierr = PetscMalloc(5*min_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
440*674ae819SStefano Zampini #endif
441*674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
442*674ae819SStefano Zampini     lwork=-1;
443*674ae819SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Bs);CHKERRQ(ierr);
444*674ae819SStefano Zampini     ierr = PetscBLASIntCast(min_n,&Bt);CHKERRQ(ierr);
445*674ae819SStefano Zampini     dummy_int = Bs;
446*674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
447*674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
448*674ae819SStefano Zampini     LAPACKgesvd_("O","N",&Bs,&Bt,&temp_quadrature_constraint[0],&Bs,singular_vals,
449*674ae819SStefano Zampini                  &dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,&temp_work,&lwork,&lierr);
450*674ae819SStefano Zampini #else
451*674ae819SStefano Zampini     LAPACKgesvd_("O","N",&Bs,&Bt,&temp_quadrature_constraint[0],&Bs,singular_vals,
452*674ae819SStefano Zampini                  &dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,&temp_work,&lwork,rwork,&lierr);
453*674ae819SStefano Zampini #endif
454*674ae819SStefano Zampini     if ( lierr ) {
455*674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SVD Lapack routine %d",(int)lierr);
456*674ae819SStefano Zampini     }
457*674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
458*674ae819SStefano Zampini #endif
459*674ae819SStefano Zampini     /* Allocate optimal workspace */
460*674ae819SStefano Zampini     ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
461*674ae819SStefano Zampini     total_counts = (PetscInt)lwork;
462*674ae819SStefano Zampini     ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&work);CHKERRQ(ierr);
463*674ae819SStefano Zampini   }
464*674ae819SStefano Zampini   /* get local part of global near null space vectors */
465*674ae819SStefano Zampini   ierr = PetscMalloc(nnsp_size*sizeof(Vec),&localnearnullsp);CHKERRQ(ierr);
466*674ae819SStefano Zampini   for (k=0;k<nnsp_size;k++) {
467*674ae819SStefano Zampini     ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
468*674ae819SStefano Zampini     ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
469*674ae819SStefano Zampini     ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
470*674ae819SStefano Zampini   }
471*674ae819SStefano Zampini   /* Now we can loop on constraining sets */
472*674ae819SStefano Zampini   total_counts = 0;
473*674ae819SStefano Zampini   temp_indices[0] = 0;
474*674ae819SStefano Zampini   /* vertices */
475*674ae819SStefano Zampini   if (ISForVertices) {
476*674ae819SStefano Zampini     ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
477*674ae819SStefano Zampini     if (nnsp_has_cnst) { /* consider all vertices */
478*674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
479*674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
480*674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
481*674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
482*674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+1;
483*674ae819SStefano Zampini         change_basis[total_counts]=PETSC_FALSE;
484*674ae819SStefano Zampini         total_counts++;
485*674ae819SStefano Zampini       }
486*674ae819SStefano Zampini     } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
487*674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
488*674ae819SStefano Zampini         used_vertex=PETSC_FALSE;
489*674ae819SStefano Zampini         k=0;
490*674ae819SStefano Zampini         while (!used_vertex && k<nnsp_size) {
491*674ae819SStefano Zampini           ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array_vector);CHKERRQ(ierr);
492*674ae819SStefano Zampini           if (PetscAbsScalar(array_vector[is_indices[i]])>0.0) {
493*674ae819SStefano Zampini             temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
494*674ae819SStefano Zampini             temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
495*674ae819SStefano Zampini             temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
496*674ae819SStefano Zampini             temp_indices[total_counts+1]=temp_indices[total_counts]+1;
497*674ae819SStefano Zampini             change_basis[total_counts]=PETSC_FALSE;
498*674ae819SStefano Zampini             total_counts++;
499*674ae819SStefano Zampini             used_vertex=PETSC_TRUE;
500*674ae819SStefano Zampini           }
501*674ae819SStefano Zampini           ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array_vector);CHKERRQ(ierr);
502*674ae819SStefano Zampini           k++;
503*674ae819SStefano Zampini         }
504*674ae819SStefano Zampini       }
505*674ae819SStefano Zampini     }
506*674ae819SStefano Zampini     ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
507*674ae819SStefano Zampini     n_vertices = total_counts;
508*674ae819SStefano Zampini   }
509*674ae819SStefano Zampini   /* edges and faces */
510*674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
511*674ae819SStefano Zampini     if (i<n_ISForEdges) {
512*674ae819SStefano Zampini       used_IS = &ISForEdges[i];
513*674ae819SStefano Zampini       boolforface = pcbddc->use_change_of_basis;
514*674ae819SStefano Zampini     } else {
515*674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
516*674ae819SStefano Zampini       boolforface = pcbddc->use_change_on_faces;
517*674ae819SStefano Zampini     }
518*674ae819SStefano Zampini     temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
519*674ae819SStefano Zampini     temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
520*674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
521*674ae819SStefano Zampini     ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
522*674ae819SStefano Zampini     if (nnsp_has_cnst) {
523*674ae819SStefano Zampini       temp_constraints++;
524*674ae819SStefano Zampini       quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
525*674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
526*674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
527*674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
528*674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
529*674ae819SStefano Zampini       }
530*674ae819SStefano Zampini       temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
531*674ae819SStefano Zampini       change_basis[total_counts]=boolforface;
532*674ae819SStefano Zampini       total_counts++;
533*674ae819SStefano Zampini     }
534*674ae819SStefano Zampini     for (k=0;k<nnsp_size;k++) {
535*674ae819SStefano Zampini       ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array_vector);CHKERRQ(ierr);
536*674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
537*674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
538*674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
539*674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=array_vector[is_indices[j]];
540*674ae819SStefano Zampini       }
541*674ae819SStefano Zampini       ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array_vector);CHKERRQ(ierr);
542*674ae819SStefano Zampini       quad_value = 1.0;
543*674ae819SStefano Zampini       if (use_nnsp_true) { /* check if array is null on the connected component in case use_nnsp_true has been requested */
544*674ae819SStefano Zampini         ierr = PetscBLASIntCast(size_of_constraint,&Bs);CHKERRQ(ierr);
545*674ae819SStefano Zampini         quad_value = BLASasum_(&Bs,&temp_quadrature_constraint[temp_indices[total_counts]],&Bone);
546*674ae819SStefano Zampini       }
547*674ae819SStefano Zampini       if (quad_value > 0.0) { /* keep indices and values */
548*674ae819SStefano Zampini         temp_constraints++;
549*674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
550*674ae819SStefano Zampini         change_basis[total_counts]=boolforface;
551*674ae819SStefano Zampini         total_counts++;
552*674ae819SStefano Zampini       }
553*674ae819SStefano Zampini     }
554*674ae819SStefano Zampini     ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
555*674ae819SStefano Zampini     /* perform SVD on the constraint if use_nnsp_true has not be requested by the user */
556*674ae819SStefano Zampini     if (!use_nnsp_true) {
557*674ae819SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Bs);CHKERRQ(ierr);
558*674ae819SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Bt);CHKERRQ(ierr);
559*674ae819SStefano Zampini 
560*674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
561*674ae819SStefano Zampini       ierr = PetscMemzero(correlation_mat,Bt*Bt*sizeof(PetscScalar));CHKERRQ(ierr);
562*674ae819SStefano Zampini       /* Store upper triangular part of correlation matrix */
563*674ae819SStefano Zampini       for (j=0;j<temp_constraints;j++) {
564*674ae819SStefano Zampini         for (k=0;k<j+1;k++) {
565*674ae819SStefano Zampini           correlation_mat[j*temp_constraints+k]=BLASdot_(&Bs,&temp_quadrature_constraint[temp_indices[temp_start_ptr+j]],&Bone,
566*674ae819SStefano Zampini                                                          &temp_quadrature_constraint[temp_indices[temp_start_ptr+k]],&Bone);
567*674ae819SStefano Zampini 
568*674ae819SStefano Zampini         }
569*674ae819SStefano Zampini       }
570*674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
571*674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
572*674ae819SStefano Zampini /*      LAPACKsyev_("V","U",&Bt,correlation_mat,&Bt,singular_vals,work,&lwork,&lierr); */
573*674ae819SStefano Zampini       LAPACKsyevx_("V","A","U",&Bt,correlation_mat,&Bt,&dummy_real,&dummy_real,&dummy_int,&dummy_int,
574*674ae819SStefano Zampini                  &abs_tol,&eigs_found,singular_vals,singular_vectors,&Bt,work,&lwork,iwork,ifail,&lierr);
575*674ae819SStefano Zampini #else
576*674ae819SStefano Zampini /*  LAPACK call is missing here! TODO */
577*674ae819SStefano Zampini       SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Not yet implemented for complexes when PETSC_MISSING_GESVD = 1");
578*674ae819SStefano Zampini #endif
579*674ae819SStefano Zampini       if (lierr) {
580*674ae819SStefano Zampini         SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEVX Lapack routine %d",(int)lierr);
581*674ae819SStefano Zampini       }
582*674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
583*674ae819SStefano Zampini       /* retain eigenvalues greater than tol: note that lapack SYEV gives eigs in ascending order */
584*674ae819SStefano Zampini       j=0;
585*674ae819SStefano Zampini       while (j < Bt && singular_vals[j] < tol) j++;
586*674ae819SStefano Zampini       total_counts=total_counts-j;
587*674ae819SStefano Zampini       if (j<temp_constraints) {
588*674ae819SStefano Zampini         for (k=j;k<Bt;k++) {
589*674ae819SStefano Zampini           singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]);
590*674ae819SStefano Zampini         }
591*674ae819SStefano Zampini         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
592*674ae819SStefano Zampini         BLASgemm_("N","N",&Bs,&Bt,&Bt,&one,&temp_quadrature_constraint[temp_indices[temp_start_ptr]],&Bs,correlation_mat,&Bt,&zero,temp_basis,&Bs);
593*674ae819SStefano Zampini         ierr = PetscFPTrapPop();CHKERRQ(ierr);
594*674ae819SStefano Zampini         /* copy POD basis into used quadrature memory */
595*674ae819SStefano Zampini         for (k=0;k<Bt-j;k++) {
596*674ae819SStefano Zampini           for (ii=0;ii<size_of_constraint;ii++) {
597*674ae819SStefano Zampini             temp_quadrature_constraint[temp_indices[temp_start_ptr+k]+ii]=singular_vals[Bt-1-k]*temp_basis[(Bt-1-k)*size_of_constraint+ii];
598*674ae819SStefano Zampini           }
599*674ae819SStefano Zampini         }
600*674ae819SStefano Zampini       }
601*674ae819SStefano Zampini 
602*674ae819SStefano Zampini #else  /* on missing GESVD */
603*674ae819SStefano Zampini       PetscInt min_n = temp_constraints;
604*674ae819SStefano Zampini       if (min_n > size_of_constraint) min_n = size_of_constraint;
605*674ae819SStefano Zampini       dummy_int = Bs;
606*674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
607*674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
608*674ae819SStefano Zampini       LAPACKgesvd_("O","N",&Bs,&Bt,&temp_quadrature_constraint[temp_indices[temp_start_ptr]],&Bs,singular_vals,
609*674ae819SStefano Zampini                    &dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,work,&lwork,&lierr);
610*674ae819SStefano Zampini #else
611*674ae819SStefano Zampini       LAPACKgesvd_("O","N",&Bs,&Bt,&temp_quadrature_constraint[temp_indices[temp_start_ptr]],&Bs,singular_vals,
612*674ae819SStefano Zampini                    &dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,work,&lwork,rwork,&lierr);
613*674ae819SStefano Zampini #endif
614*674ae819SStefano Zampini       if (lierr) {
615*674ae819SStefano Zampini         SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SVD Lapack routine %d",(int)lierr);
616*674ae819SStefano Zampini       }
617*674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
618*674ae819SStefano Zampini       /* retain eigenvalues greater than tol: note that lapack SVD gives eigs in descending order */
619*674ae819SStefano Zampini       j = 0;
620*674ae819SStefano Zampini       while (j < min_n && singular_vals[min_n-j-1] < tol) j++;
621*674ae819SStefano Zampini       total_counts = total_counts-(PetscInt)Bt+(min_n-j);
622*674ae819SStefano Zampini #endif
623*674ae819SStefano Zampini     }
624*674ae819SStefano Zampini   }
625*674ae819SStefano Zampini   /* free index sets of faces, edges and vertices */
626*674ae819SStefano Zampini   for (i=0;i<n_ISForFaces;i++) {
627*674ae819SStefano Zampini     ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
628*674ae819SStefano Zampini   }
629*674ae819SStefano Zampini   ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
630*674ae819SStefano Zampini   for (i=0;i<n_ISForEdges;i++) {
631*674ae819SStefano Zampini     ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
632*674ae819SStefano Zampini   }
633*674ae819SStefano Zampini   ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
634*674ae819SStefano Zampini   ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
635*674ae819SStefano Zampini 
636*674ae819SStefano Zampini   /* set quantities in pcbddc data structure */
637*674ae819SStefano Zampini   /* n_vertices defines the number of point primal dofs */
638*674ae819SStefano Zampini   /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */
639*674ae819SStefano Zampini   local_primal_size = total_counts;
640*674ae819SStefano Zampini   pcbddc->n_vertices = n_vertices;
641*674ae819SStefano Zampini   pcbddc->n_constraints = total_counts-n_vertices;
642*674ae819SStefano Zampini   pcbddc->local_primal_size = local_primal_size;
643*674ae819SStefano Zampini 
644*674ae819SStefano Zampini   /* Create constraint matrix */
645*674ae819SStefano Zampini   /* The constraint matrix is used to compute the l2g map of primal dofs */
646*674ae819SStefano Zampini   /* so we need to set it up properly either with or without change of basis */
647*674ae819SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
648*674ae819SStefano Zampini   ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr);
649*674ae819SStefano Zampini   ierr = MatSetSizes(pcbddc->ConstraintMatrix,local_primal_size,pcis->n,local_primal_size,pcis->n);CHKERRQ(ierr);
650*674ae819SStefano Zampini   /* compute a local numbering of constraints : vertices first then constraints */
651*674ae819SStefano Zampini   ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
652*674ae819SStefano Zampini   ierr = VecGetArray(pcis->vec1_N,&array_vector);CHKERRQ(ierr);
653*674ae819SStefano Zampini   ierr = PetscMalloc(local_primal_size*sizeof(PetscInt),&aux_primal_numbering);CHKERRQ(ierr);
654*674ae819SStefano Zampini   ierr = PetscMalloc(local_primal_size*sizeof(PetscInt),&aux_primal_permutation);CHKERRQ(ierr);
655*674ae819SStefano Zampini   total_counts=0;
656*674ae819SStefano Zampini   /* find vertices: subdomain corners plus dofs with basis changed */
657*674ae819SStefano Zampini   for (i=0;i<local_primal_size;i++) {
658*674ae819SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
659*674ae819SStefano Zampini     if (change_basis[i] || size_of_constraint == 1) {
660*674ae819SStefano Zampini       k=0;
661*674ae819SStefano Zampini       while(k < size_of_constraint && array_vector[temp_indices_to_constraint[temp_indices[i]+size_of_constraint-k-1]] != 0.0) {
662*674ae819SStefano Zampini         k=k+1;
663*674ae819SStefano Zampini       }
664*674ae819SStefano Zampini       j=temp_indices_to_constraint[temp_indices[i]+size_of_constraint-k-1];
665*674ae819SStefano Zampini       array_vector[j] = 1.0;
666*674ae819SStefano Zampini       aux_primal_numbering[total_counts]=j;
667*674ae819SStefano Zampini       aux_primal_permutation[total_counts]=total_counts;
668*674ae819SStefano Zampini       total_counts++;
669*674ae819SStefano Zampini     }
670*674ae819SStefano Zampini   }
671*674ae819SStefano Zampini   ierr = VecRestoreArray(pcis->vec1_N,&array_vector);CHKERRQ(ierr);
672*674ae819SStefano Zampini   /* permute indices in order to have a sorted set of vertices */
673*674ae819SStefano Zampini   ierr = PetscSortIntWithPermutation(total_counts,aux_primal_numbering,aux_primal_permutation);
674*674ae819SStefano Zampini   /* nonzero structure */
675*674ae819SStefano Zampini   ierr = PetscMalloc(local_primal_size*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
676*674ae819SStefano Zampini   for (i=0;i<total_counts;i++) {
677*674ae819SStefano Zampini     nnz[i]=1;
678*674ae819SStefano Zampini   }
679*674ae819SStefano Zampini   j=total_counts;
680*674ae819SStefano Zampini   for (i=n_vertices;i<local_primal_size;i++) {
681*674ae819SStefano Zampini     if (!change_basis[i]) {
682*674ae819SStefano Zampini       nnz[j]=temp_indices[i+1]-temp_indices[i];
683*674ae819SStefano Zampini       j++;
684*674ae819SStefano Zampini     }
685*674ae819SStefano Zampini   }
686*674ae819SStefano Zampini   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
687*674ae819SStefano Zampini   ierr = PetscFree(nnz);CHKERRQ(ierr);
688*674ae819SStefano Zampini   /* set values in constraint matrix */
689*674ae819SStefano Zampini   for (i=0;i<total_counts;i++) {
690*674ae819SStefano Zampini     j = aux_primal_permutation[i];
691*674ae819SStefano Zampini     k = aux_primal_numbering[j];
692*674ae819SStefano Zampini     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,k,1.0,INSERT_VALUES);CHKERRQ(ierr);
693*674ae819SStefano Zampini   }
694*674ae819SStefano Zampini   for (i=n_vertices;i<local_primal_size;i++) {
695*674ae819SStefano Zampini     if (!change_basis[i]) {
696*674ae819SStefano Zampini       size_of_constraint=temp_indices[i+1]-temp_indices[i];
697*674ae819SStefano Zampini       ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&total_counts,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],&temp_quadrature_constraint[temp_indices[i]],INSERT_VALUES);CHKERRQ(ierr);
698*674ae819SStefano Zampini       total_counts++;
699*674ae819SStefano Zampini     }
700*674ae819SStefano Zampini   }
701*674ae819SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
702*674ae819SStefano Zampini   ierr = PetscFree(aux_primal_permutation);CHKERRQ(ierr);
703*674ae819SStefano Zampini   /* assembling */
704*674ae819SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
705*674ae819SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
706*674ae819SStefano Zampini 
707*674ae819SStefano Zampini   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
708*674ae819SStefano Zampini   if (pcbddc->use_change_of_basis) {
709*674ae819SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
710*674ae819SStefano Zampini     ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr);
711*674ae819SStefano Zampini     ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr);
712*674ae819SStefano Zampini     /* work arrays */
713*674ae819SStefano Zampini     /* we need to reuse these arrays, so we free them */
714*674ae819SStefano Zampini     ierr = PetscFree(temp_basis);CHKERRQ(ierr);
715*674ae819SStefano Zampini     ierr = PetscFree(work);CHKERRQ(ierr);
716*674ae819SStefano Zampini     ierr = PetscMalloc(pcis->n_B*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
717*674ae819SStefano Zampini     ierr = PetscMalloc((nnsp_addone+nnsp_size)*(nnsp_addone+nnsp_size)*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr);
718*674ae819SStefano Zampini     ierr = PetscMalloc((nnsp_addone+nnsp_size)*sizeof(PetscScalar),&work);CHKERRQ(ierr);
719*674ae819SStefano Zampini     ierr = PetscMalloc((nnsp_addone+nnsp_size)*sizeof(PetscBLASInt),&ipiv);CHKERRQ(ierr);
720*674ae819SStefano Zampini     for (i=0;i<pcis->n_B;i++) {
721*674ae819SStefano Zampini       nnz[i]=1;
722*674ae819SStefano Zampini     }
723*674ae819SStefano Zampini     /* Overestimated nonzeros per row */
724*674ae819SStefano Zampini     k=1;
725*674ae819SStefano Zampini     for (i=pcbddc->n_vertices;i<local_primal_size;i++) {
726*674ae819SStefano Zampini       if (change_basis[i]) {
727*674ae819SStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
728*674ae819SStefano Zampini         if (k < size_of_constraint) {
729*674ae819SStefano Zampini           k = size_of_constraint;
730*674ae819SStefano Zampini         }
731*674ae819SStefano Zampini         for (j=0;j<size_of_constraint;j++) {
732*674ae819SStefano Zampini           nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
733*674ae819SStefano Zampini         }
734*674ae819SStefano Zampini       }
735*674ae819SStefano Zampini     }
736*674ae819SStefano Zampini     ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
737*674ae819SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
738*674ae819SStefano Zampini     /* Temporary array to store indices */
739*674ae819SStefano Zampini     ierr = PetscMalloc(k*sizeof(PetscInt),&is_indices);CHKERRQ(ierr);
740*674ae819SStefano Zampini     /* Set initial identity in the matrix */
741*674ae819SStefano Zampini     for (i=0;i<pcis->n_B;i++) {
742*674ae819SStefano Zampini       ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
743*674ae819SStefano Zampini     }
744*674ae819SStefano Zampini     /* Now we loop on the constraints which need a change of basis */
745*674ae819SStefano Zampini     /* Change of basis matrix is evaluated as the FIRST APPROACH in */
746*674ae819SStefano Zampini     /* Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (6.2.1) */
747*674ae819SStefano Zampini     temp_constraints = 0;
748*674ae819SStefano Zampini     if (pcbddc->n_vertices < local_primal_size) {
749*674ae819SStefano Zampini       temp_start_ptr = temp_indices_to_constraint_B[temp_indices[pcbddc->n_vertices]];
750*674ae819SStefano Zampini     }
751*674ae819SStefano Zampini     for (i=pcbddc->n_vertices;i<local_primal_size;i++) {
752*674ae819SStefano Zampini       if (change_basis[i]) {
753*674ae819SStefano Zampini         compute_submatrix = PETSC_FALSE;
754*674ae819SStefano Zampini         useksp = PETSC_FALSE;
755*674ae819SStefano Zampini         if (temp_start_ptr == temp_indices_to_constraint_B[temp_indices[i]]) {
756*674ae819SStefano Zampini           temp_constraints++;
757*674ae819SStefano Zampini           if (i == local_primal_size -1 ||  temp_start_ptr != temp_indices_to_constraint_B[temp_indices[i+1]]) {
758*674ae819SStefano Zampini             compute_submatrix = PETSC_TRUE;
759*674ae819SStefano Zampini           }
760*674ae819SStefano Zampini         }
761*674ae819SStefano Zampini         if (compute_submatrix) {
762*674ae819SStefano Zampini           if (temp_constraints > 1 || pcbddc->use_nnsp_true) {
763*674ae819SStefano Zampini             useksp = PETSC_TRUE;
764*674ae819SStefano Zampini           }
765*674ae819SStefano Zampini           size_of_constraint = temp_indices[i+1]-temp_indices[i];
766*674ae819SStefano Zampini           if (useksp) { /* experimental TODO: reuse KSP and MAT instead of creating them each time */
767*674ae819SStefano Zampini             ierr = MatCreate(PETSC_COMM_SELF,&temp_mat);CHKERRQ(ierr);
768*674ae819SStefano Zampini             ierr = MatSetType(temp_mat,impMatType);CHKERRQ(ierr);
769*674ae819SStefano Zampini             ierr = MatSetSizes(temp_mat,size_of_constraint,size_of_constraint,size_of_constraint,size_of_constraint);CHKERRQ(ierr);
770*674ae819SStefano Zampini             ierr = MatSeqAIJSetPreallocation(temp_mat,size_of_constraint,NULL);CHKERRQ(ierr);
771*674ae819SStefano Zampini           }
772*674ae819SStefano Zampini           /* First _size_of_constraint-temp_constraints_ columns */
773*674ae819SStefano Zampini           dual_dofs = size_of_constraint-temp_constraints;
774*674ae819SStefano Zampini           start_constraint = i+1-temp_constraints;
775*674ae819SStefano Zampini           for (s=0;s<dual_dofs;s++) {
776*674ae819SStefano Zampini             is_indices[0] = s;
777*674ae819SStefano Zampini             for (j=0;j<temp_constraints;j++) {
778*674ae819SStefano Zampini               for (k=0;k<temp_constraints;k++) {
779*674ae819SStefano Zampini                 temp_basis[j*temp_constraints+k]=temp_quadrature_constraint[temp_indices[start_constraint+k]+s+j+1];
780*674ae819SStefano Zampini               }
781*674ae819SStefano Zampini               work[j]=-temp_quadrature_constraint[temp_indices[start_constraint+j]+s];
782*674ae819SStefano Zampini               is_indices[j+1]=s+j+1;
783*674ae819SStefano Zampini             }
784*674ae819SStefano Zampini             Bt = temp_constraints;
785*674ae819SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
786*674ae819SStefano Zampini             LAPACKgesv_(&Bt,&Bone,temp_basis,&Bt,ipiv,work,&Bt,&lierr);
787*674ae819SStefano Zampini             if ( lierr ) {
788*674ae819SStefano Zampini               SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESV Lapack routine %d",(int)lierr);
789*674ae819SStefano Zampini             }
790*674ae819SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
791*674ae819SStefano Zampini             j = temp_indices_to_constraint_B[temp_indices[start_constraint]+s];
792*674ae819SStefano Zampini             ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,temp_constraints,&temp_indices_to_constraint_B[temp_indices[start_constraint]+s+1],1,&j,work,INSERT_VALUES);CHKERRQ(ierr);
793*674ae819SStefano Zampini             if (useksp) {
794*674ae819SStefano Zampini               /* temp mat with transposed rows and columns */
795*674ae819SStefano Zampini               ierr = MatSetValues(temp_mat,1,&s,temp_constraints,&is_indices[1],work,INSERT_VALUES);CHKERRQ(ierr);
796*674ae819SStefano Zampini               ierr = MatSetValue(temp_mat,is_indices[0],is_indices[0],1.0,INSERT_VALUES);CHKERRQ(ierr);
797*674ae819SStefano Zampini             }
798*674ae819SStefano Zampini           }
799*674ae819SStefano Zampini           if (useksp) {
800*674ae819SStefano Zampini             /* last rows of temp_mat */
801*674ae819SStefano Zampini             for (j=0;j<size_of_constraint;j++) {
802*674ae819SStefano Zampini               is_indices[j] = j;
803*674ae819SStefano Zampini             }
804*674ae819SStefano Zampini             for (s=0;s<temp_constraints;s++) {
805*674ae819SStefano Zampini               k = s + dual_dofs;
806*674ae819SStefano Zampini               ierr = MatSetValues(temp_mat,1,&k,size_of_constraint,is_indices,&temp_quadrature_constraint[temp_indices[start_constraint+s]],INSERT_VALUES);CHKERRQ(ierr);
807*674ae819SStefano Zampini             }
808*674ae819SStefano Zampini             ierr = MatAssemblyBegin(temp_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
809*674ae819SStefano Zampini             ierr = MatAssemblyEnd(temp_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
810*674ae819SStefano Zampini             ierr = MatGetVecs(temp_mat,&temp_vec,NULL);CHKERRQ(ierr);
811*674ae819SStefano Zampini             ierr = KSPCreate(PETSC_COMM_SELF,&temp_ksp);CHKERRQ(ierr);
812*674ae819SStefano Zampini             ierr = KSPSetOperators(temp_ksp,temp_mat,temp_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
813*674ae819SStefano Zampini             ierr = KSPSetType(temp_ksp,KSPPREONLY);CHKERRQ(ierr);
814*674ae819SStefano Zampini             ierr = KSPGetPC(temp_ksp,&temp_pc);CHKERRQ(ierr);
815*674ae819SStefano Zampini             ierr = PCSetType(temp_pc,PCLU);CHKERRQ(ierr);
816*674ae819SStefano Zampini             ierr = KSPSetUp(temp_ksp);CHKERRQ(ierr);
817*674ae819SStefano Zampini             for (s=0;s<temp_constraints;s++) {
818*674ae819SStefano Zampini               ierr = VecSet(temp_vec,0.0);CHKERRQ(ierr);
819*674ae819SStefano Zampini               ierr = VecSetValue(temp_vec,s+dual_dofs,1.0,INSERT_VALUES);CHKERRQ(ierr);
820*674ae819SStefano Zampini               ierr = VecAssemblyBegin(temp_vec);CHKERRQ(ierr);
821*674ae819SStefano Zampini               ierr = VecAssemblyEnd(temp_vec);CHKERRQ(ierr);
822*674ae819SStefano Zampini               ierr = KSPSolve(temp_ksp,temp_vec,temp_vec);CHKERRQ(ierr);
823*674ae819SStefano Zampini               ierr = VecGetArray(temp_vec,&array_vector);CHKERRQ(ierr);
824*674ae819SStefano Zampini               j = temp_indices_to_constraint_B[temp_indices[start_constraint+s]+size_of_constraint-s-1];
825*674ae819SStefano Zampini               /* last columns of change of basis matrix associated to new primal dofs */
826*674ae819SStefano Zampini               ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,&temp_indices_to_constraint_B[temp_indices[start_constraint+s]],1,&j,array_vector,INSERT_VALUES);CHKERRQ(ierr);
827*674ae819SStefano Zampini               ierr = VecRestoreArray(temp_vec,&array_vector);CHKERRQ(ierr);
828*674ae819SStefano Zampini             }
829*674ae819SStefano Zampini             ierr = MatDestroy(&temp_mat);CHKERRQ(ierr);
830*674ae819SStefano Zampini             ierr = KSPDestroy(&temp_ksp);CHKERRQ(ierr);
831*674ae819SStefano Zampini             ierr = VecDestroy(&temp_vec);CHKERRQ(ierr);
832*674ae819SStefano Zampini           } else {
833*674ae819SStefano Zampini             /* last columns of change of basis matrix associated to new primal dofs */
834*674ae819SStefano Zampini             for (s=0;s<temp_constraints;s++) {
835*674ae819SStefano Zampini               j = temp_indices_to_constraint_B[temp_indices[start_constraint+s]+size_of_constraint-s-1];
836*674ae819SStefano Zampini               ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,&temp_indices_to_constraint_B[temp_indices[start_constraint+s]],1,&j,&temp_quadrature_constraint[temp_indices[start_constraint+s]],INSERT_VALUES);CHKERRQ(ierr);
837*674ae819SStefano Zampini             }
838*674ae819SStefano Zampini           }
839*674ae819SStefano Zampini           /* prepare for the next cycle */
840*674ae819SStefano Zampini           temp_constraints = 0;
841*674ae819SStefano Zampini           if (i != local_primal_size -1 ) {
842*674ae819SStefano Zampini             temp_start_ptr = temp_indices_to_constraint_B[temp_indices[i+1]];
843*674ae819SStefano Zampini           }
844*674ae819SStefano Zampini         }
845*674ae819SStefano Zampini       }
846*674ae819SStefano Zampini     }
847*674ae819SStefano Zampini     /* assembling */
848*674ae819SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
849*674ae819SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
850*674ae819SStefano Zampini     ierr = PetscFree(ipiv);CHKERRQ(ierr);
851*674ae819SStefano Zampini     ierr = PetscFree(is_indices);CHKERRQ(ierr);
852*674ae819SStefano Zampini   }
853*674ae819SStefano Zampini   /* free workspace no longer needed */
854*674ae819SStefano Zampini   ierr = PetscFree(rwork);CHKERRQ(ierr);
855*674ae819SStefano Zampini   ierr = PetscFree(work);CHKERRQ(ierr);
856*674ae819SStefano Zampini   ierr = PetscFree(temp_basis);CHKERRQ(ierr);
857*674ae819SStefano Zampini   ierr = PetscFree(singular_vals);CHKERRQ(ierr);
858*674ae819SStefano Zampini   ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
859*674ae819SStefano Zampini   ierr = PetscFree(temp_indices);CHKERRQ(ierr);
860*674ae819SStefano Zampini   ierr = PetscFree(change_basis);CHKERRQ(ierr);
861*674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr);
862*674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
863*674ae819SStefano Zampini   ierr = PetscFree(local_to_B);CHKERRQ(ierr);
864*674ae819SStefano Zampini   ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr);
865*674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
866*674ae819SStefano Zampini   ierr = PetscFree(iwork);CHKERRQ(ierr);
867*674ae819SStefano Zampini   ierr = PetscFree(ifail);CHKERRQ(ierr);
868*674ae819SStefano Zampini   ierr = PetscFree(singular_vectors);CHKERRQ(ierr);
869*674ae819SStefano Zampini #endif
870*674ae819SStefano Zampini   for (k=0;k<nnsp_size;k++) {
871*674ae819SStefano Zampini     ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
872*674ae819SStefano Zampini   }
873*674ae819SStefano Zampini   ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
874*674ae819SStefano Zampini   PetscFunctionReturn(0);
875*674ae819SStefano Zampini }
876*674ae819SStefano Zampini 
877*674ae819SStefano Zampini #undef __FUNCT__
878*674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
879*674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
880*674ae819SStefano Zampini {
881*674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
882*674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
883*674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
884*674ae819SStefano Zampini   PetscInt    bs,ierr,i,vertex_size;
885*674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
886*674ae819SStefano Zampini 
887*674ae819SStefano Zampini   PetscFunctionBegin;
888*674ae819SStefano Zampini   /* Init local Graph struct */
889*674ae819SStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr);
890*674ae819SStefano Zampini 
891*674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
892*674ae819SStefano Zampini   if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) {
893*674ae819SStefano Zampini     Mat mat_adj;
894*674ae819SStefano Zampini     const PetscInt *xadj,*adjncy;
895*674ae819SStefano Zampini     PetscBool flg_row=PETSC_TRUE;
896*674ae819SStefano Zampini 
897*674ae819SStefano Zampini     ierr = MatConvert(matis->A,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr);
898*674ae819SStefano Zampini     ierr = MatGetRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
899*674ae819SStefano Zampini     if (!flg_row) {
900*674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ called in %s\n",__FUNCT__);
901*674ae819SStefano Zampini     }
902*674ae819SStefano Zampini     ierr = PCBDDCSetLocalAdjacencyGraph(pc,i,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
903*674ae819SStefano Zampini     ierr = MatRestoreRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
904*674ae819SStefano Zampini     if (!flg_row) {
905*674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__);
906*674ae819SStefano Zampini     }
907*674ae819SStefano Zampini     ierr = MatDestroy(&mat_adj);CHKERRQ(ierr);
908*674ae819SStefano Zampini   }
909*674ae819SStefano Zampini 
910*674ae819SStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting */
911*674ae819SStefano Zampini   vertex_size = 1;
912*674ae819SStefano Zampini   if (!pcbddc->n_ISForDofs) {
913*674ae819SStefano Zampini     IS *custom_ISForDofs;
914*674ae819SStefano Zampini 
915*674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&bs);CHKERRQ(ierr);
916*674ae819SStefano Zampini     ierr = PetscMalloc(bs*sizeof(IS),&custom_ISForDofs);CHKERRQ(ierr);
917*674ae819SStefano Zampini     for (i=0;i<bs;i++) {
918*674ae819SStefano Zampini       ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n/bs,i,bs,&custom_ISForDofs[i]);CHKERRQ(ierr);
919*674ae819SStefano Zampini     }
920*674ae819SStefano Zampini     ierr = PCBDDCSetDofsSplitting(pc,bs,custom_ISForDofs);CHKERRQ(ierr);
921*674ae819SStefano Zampini     /* remove my references to IS objects */
922*674ae819SStefano Zampini     for (i=0;i<bs;i++) {
923*674ae819SStefano Zampini       ierr = ISDestroy(&custom_ISForDofs[i]);CHKERRQ(ierr);
924*674ae819SStefano Zampini     }
925*674ae819SStefano Zampini     ierr = PetscFree(custom_ISForDofs);CHKERRQ(ierr);
926*674ae819SStefano Zampini   } else { /* mat block size as vertex size (used for elasticity) */
927*674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
928*674ae819SStefano Zampini   }
929*674ae819SStefano Zampini 
930*674ae819SStefano Zampini   /* Setup of Graph */
931*674ae819SStefano Zampini   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundaries,pcbddc->DirichletBoundaries,pcbddc->n_ISForDofs,pcbddc->ISForDofs,pcbddc->user_primal_vertices);
932*674ae819SStefano Zampini 
933*674ae819SStefano Zampini   /* Graph's connected components analysis */
934*674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
935*674ae819SStefano Zampini 
936*674ae819SStefano Zampini   /* print some info to stdout */
937*674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
938*674ae819SStefano Zampini     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,viewer);
939*674ae819SStefano Zampini   }
940*674ae819SStefano Zampini   PetscFunctionReturn(0);
941*674ae819SStefano Zampini }
942*674ae819SStefano Zampini 
943*674ae819SStefano Zampini #undef __FUNCT__
944*674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx"
945*674ae819SStefano Zampini PetscErrorCode  PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt *vertices_idx[])
946*674ae819SStefano Zampini {
947*674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
948*674ae819SStefano Zampini   PetscInt       *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size;
949*674ae819SStefano Zampini   PetscErrorCode ierr;
950*674ae819SStefano Zampini 
951*674ae819SStefano Zampini   PetscFunctionBegin;
952*674ae819SStefano Zampini   n = 0;
953*674ae819SStefano Zampini   vertices = 0;
954*674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
955*674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr);
956*674ae819SStefano Zampini     ierr = PetscMalloc(local_primal_size*sizeof(PetscInt),&vertices);CHKERRQ(ierr);
957*674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
958*674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
959*674ae819SStefano Zampini       if (size_of_constraint == 1) {
960*674ae819SStefano Zampini         vertices[n++]=row_cmat_indices[0];
961*674ae819SStefano Zampini       }
962*674ae819SStefano Zampini     ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
963*674ae819SStefano Zampini     }
964*674ae819SStefano Zampini   }
965*674ae819SStefano Zampini   *n_vertices = n;
966*674ae819SStefano Zampini   *vertices_idx = vertices;
967*674ae819SStefano Zampini   PetscFunctionReturn(0);
968*674ae819SStefano Zampini }
969*674ae819SStefano Zampini 
970*674ae819SStefano Zampini #undef __FUNCT__
971*674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx"
972*674ae819SStefano Zampini PetscErrorCode  PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt *constraints_idx[])
973*674ae819SStefano Zampini {
974*674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
975*674ae819SStefano Zampini   PetscInt       *constraints_index,*row_cmat_indices,*row_cmat_global_indices;
976*674ae819SStefano Zampini   PetscInt       n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc;
977*674ae819SStefano Zampini   PetscBool      *touched;
978*674ae819SStefano Zampini   PetscErrorCode ierr;
979*674ae819SStefano Zampini 
980*674ae819SStefano Zampini   PetscFunctionBegin;
981*674ae819SStefano Zampini   n = 0;
982*674ae819SStefano Zampini   constraints_index = 0;
983*674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
984*674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr);
985*674ae819SStefano Zampini     max_size_of_constraint = 0;
986*674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
987*674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
988*674ae819SStefano Zampini       if (size_of_constraint > 1) {
989*674ae819SStefano Zampini         n++;
990*674ae819SStefano Zampini       }
991*674ae819SStefano Zampini       max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint);
992*674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
993*674ae819SStefano Zampini     }
994*674ae819SStefano Zampini     ierr = PetscMalloc(n*sizeof(PetscInt),&constraints_index);CHKERRQ(ierr);
995*674ae819SStefano Zampini     ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&row_cmat_global_indices);CHKERRQ(ierr);
996*674ae819SStefano Zampini     ierr = PetscMalloc(local_size*sizeof(PetscBool),&touched);CHKERRQ(ierr);
997*674ae819SStefano Zampini     ierr = PetscMemzero(touched,local_size*sizeof(PetscBool));CHKERRQ(ierr);
998*674ae819SStefano Zampini     n = 0;
999*674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
1000*674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
1001*674ae819SStefano Zampini       if (size_of_constraint > 1) {
1002*674ae819SStefano Zampini         ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr);
1003*674ae819SStefano Zampini         min_index = row_cmat_global_indices[0];
1004*674ae819SStefano Zampini         min_loc = 0;
1005*674ae819SStefano Zampini         for (j=1;j<size_of_constraint;j++) {
1006*674ae819SStefano Zampini           /* there can be more than one constraint on a single connected component */
1007*674ae819SStefano Zampini           if (min_index > row_cmat_global_indices[j] && !touched[row_cmat_indices[j]]) {
1008*674ae819SStefano Zampini             min_index = row_cmat_global_indices[j];
1009*674ae819SStefano Zampini             min_loc = j;
1010*674ae819SStefano Zampini           }
1011*674ae819SStefano Zampini         }
1012*674ae819SStefano Zampini         touched[row_cmat_indices[min_loc]] = PETSC_TRUE;
1013*674ae819SStefano Zampini         constraints_index[n++] = row_cmat_indices[min_loc];
1014*674ae819SStefano Zampini       }
1015*674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
1016*674ae819SStefano Zampini     }
1017*674ae819SStefano Zampini   }
1018*674ae819SStefano Zampini   ierr = PetscFree(touched);CHKERRQ(ierr);
1019*674ae819SStefano Zampini   ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr);
1020*674ae819SStefano Zampini   *n_constraints = n;
1021*674ae819SStefano Zampini   *constraints_idx = constraints_index;
1022*674ae819SStefano Zampini   PetscFunctionReturn(0);
1023*674ae819SStefano Zampini }
1024*674ae819SStefano Zampini 
1025*674ae819SStefano Zampini /* the next two functions has been adapted from pcis.c */
1026*674ae819SStefano Zampini #undef __FUNCT__
1027*674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchur"
1028*674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchur(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
1029*674ae819SStefano Zampini {
1030*674ae819SStefano Zampini   PetscErrorCode ierr;
1031*674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
1032*674ae819SStefano Zampini 
1033*674ae819SStefano Zampini   PetscFunctionBegin;
1034*674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
1035*674ae819SStefano Zampini   ierr = MatMult(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
1036*674ae819SStefano Zampini   ierr = MatMult(pcis->A_IB,v,vec1_D);CHKERRQ(ierr);
1037*674ae819SStefano Zampini   ierr = KSPSolve(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
1038*674ae819SStefano Zampini   ierr = MatMult(pcis->A_BI,vec2_D,vec2_B);CHKERRQ(ierr);
1039*674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
1040*674ae819SStefano Zampini   PetscFunctionReturn(0);
1041*674ae819SStefano Zampini }
1042*674ae819SStefano Zampini 
1043*674ae819SStefano Zampini #undef __FUNCT__
1044*674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchurTranspose"
1045*674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchurTranspose(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
1046*674ae819SStefano Zampini {
1047*674ae819SStefano Zampini   PetscErrorCode ierr;
1048*674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
1049*674ae819SStefano Zampini 
1050*674ae819SStefano Zampini   PetscFunctionBegin;
1051*674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
1052*674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
1053*674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BI,v,vec1_D);CHKERRQ(ierr);
1054*674ae819SStefano Zampini   ierr = KSPSolveTranspose(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
1055*674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_IB,vec2_D,vec2_B);CHKERRQ(ierr);
1056*674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
1057*674ae819SStefano Zampini   PetscFunctionReturn(0);
1058*674ae819SStefano Zampini }
1059*674ae819SStefano Zampini 
1060*674ae819SStefano Zampini #undef __FUNCT__
1061*674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
1062*674ae819SStefano Zampini PetscErrorCode PCBDDCSubsetNumbering(MPI_Comm comm,ISLocalToGlobalMapping l2gmap, PetscInt n_local_dofs, PetscInt local_dofs[], PetscInt local_dofs_mult[], PetscInt* n_global_subset, PetscInt* global_numbering_subset[])
1063*674ae819SStefano Zampini {
1064*674ae819SStefano Zampini   Vec            local_vec,global_vec;
1065*674ae819SStefano Zampini   IS             seqis,paris;
1066*674ae819SStefano Zampini   VecScatter     scatter_ctx;
1067*674ae819SStefano Zampini   PetscScalar    *array;
1068*674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
1069*674ae819SStefano Zampini   PetscScalar    globalsum;
1070*674ae819SStefano Zampini   PetscInt       i,j,s;
1071*674ae819SStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local;
1072*674ae819SStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm,max_global;
1073*674ae819SStefano Zampini   PetscMPIInt    *dof_sizes,*dof_displs;
1074*674ae819SStefano Zampini   PetscBool      first_found;
1075*674ae819SStefano Zampini   PetscErrorCode ierr;
1076*674ae819SStefano Zampini 
1077*674ae819SStefano Zampini   PetscFunctionBegin;
1078*674ae819SStefano Zampini   /* mpi buffers */
1079*674ae819SStefano Zampini   MPI_Comm_size(comm,&size_prec_comm);
1080*674ae819SStefano Zampini   MPI_Comm_rank(comm,&rank_prec_comm);
1081*674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
1082*674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_sizes),&dof_sizes);CHKERRQ(ierr);
1083*674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_displs),&dof_displs);CHKERRQ(ierr);
1084*674ae819SStefano Zampini   /* get maximum size of subset */
1085*674ae819SStefano Zampini   ierr = PetscMalloc(n_local_dofs*sizeof(PetscInt),&temp_global_dofs);CHKERRQ(ierr);
1086*674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
1087*674ae819SStefano Zampini   max_local = 0;
1088*674ae819SStefano Zampini   if (n_local_dofs) {
1089*674ae819SStefano Zampini     max_local = temp_global_dofs[0];
1090*674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
1091*674ae819SStefano Zampini       if (max_local < temp_global_dofs[i] ) {
1092*674ae819SStefano Zampini         max_local = temp_global_dofs[i];
1093*674ae819SStefano Zampini       }
1094*674ae819SStefano Zampini     }
1095*674ae819SStefano Zampini   }
1096*674ae819SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);
1097*674ae819SStefano Zampini   max_global++;
1098*674ae819SStefano Zampini   max_local = 0;
1099*674ae819SStefano Zampini   if (n_local_dofs) {
1100*674ae819SStefano Zampini     max_local = local_dofs[0];
1101*674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
1102*674ae819SStefano Zampini       if (max_local < local_dofs[i] ) {
1103*674ae819SStefano Zampini         max_local = local_dofs[i];
1104*674ae819SStefano Zampini       }
1105*674ae819SStefano Zampini     }
1106*674ae819SStefano Zampini   }
1107*674ae819SStefano Zampini   max_local++;
1108*674ae819SStefano Zampini   /* allocate workspace */
1109*674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
1110*674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
1111*674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
1112*674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
1113*674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
1114*674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
1115*674ae819SStefano Zampini   /* create scatter */
1116*674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
1117*674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
1118*674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
1119*674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
1120*674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
1121*674ae819SStefano Zampini   /* init array */
1122*674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
1123*674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
1124*674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
1125*674ae819SStefano Zampini   if (local_dofs_mult) {
1126*674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
1127*674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
1128*674ae819SStefano Zampini     }
1129*674ae819SStefano Zampini   } else {
1130*674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
1131*674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
1132*674ae819SStefano Zampini     }
1133*674ae819SStefano Zampini   }
1134*674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
1135*674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
1136*674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1137*674ae819SStefano Zampini   ierr = VecScatterEnd  (scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1138*674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
1139*674ae819SStefano Zampini   *n_global_subset = (PetscInt)globalsum;
1140*674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
1141*674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
1142*674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
1143*674ae819SStefano Zampini   nlocals = 0;
1144*674ae819SStefano Zampini   first_index = -1;
1145*674ae819SStefano Zampini   first_found = PETSC_FALSE;
1146*674ae819SStefano Zampini   for (i=0;i<s;i++) {
1147*674ae819SStefano Zampini     if (!first_found && array[i] > 0.0) {
1148*674ae819SStefano Zampini       first_found = PETSC_TRUE;
1149*674ae819SStefano Zampini       first_index = i;
1150*674ae819SStefano Zampini     }
1151*674ae819SStefano Zampini     nlocals += (PetscInt)array[i];
1152*674ae819SStefano Zampini   }
1153*674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
1154*674ae819SStefano Zampini   if (!rank_prec_comm) {
1155*674ae819SStefano Zampini     dof_displs[0]=0;
1156*674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
1157*674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
1158*674ae819SStefano Zampini     }
1159*674ae819SStefano Zampini   }
1160*674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
1161*674ae819SStefano Zampini   if (first_found) {
1162*674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
1163*674ae819SStefano Zampini     old_index = first_index;
1164*674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
1165*674ae819SStefano Zampini       if (array[i] > 0.0) {
1166*674ae819SStefano Zampini         array[i] += array[old_index];
1167*674ae819SStefano Zampini         old_index = i;
1168*674ae819SStefano Zampini       }
1169*674ae819SStefano Zampini     }
1170*674ae819SStefano Zampini   }
1171*674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
1172*674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
1173*674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1174*674ae819SStefano Zampini   ierr = VecScatterEnd  (scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1175*674ae819SStefano Zampini   /* get global ordering of local dofs */
1176*674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
1177*674ae819SStefano Zampini   if (local_dofs_mult) {
1178*674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
1179*674ae819SStefano Zampini       temp_global_dofs[i] = (PetscInt)array[local_dofs[i]]-local_dofs_mult[i];
1180*674ae819SStefano Zampini     }
1181*674ae819SStefano Zampini   } else {
1182*674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
1183*674ae819SStefano Zampini       temp_global_dofs[i] = (PetscInt)array[local_dofs[i]]-1;
1184*674ae819SStefano Zampini     }
1185*674ae819SStefano Zampini   }
1186*674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
1187*674ae819SStefano Zampini   /* free workspace */
1188*674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
1189*674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
1190*674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
1191*674ae819SStefano Zampini   ierr = PetscFree(dof_sizes);CHKERRQ(ierr);
1192*674ae819SStefano Zampini   ierr = PetscFree(dof_displs);CHKERRQ(ierr);
1193*674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
1194*674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
1195*674ae819SStefano Zampini   PetscFunctionReturn(0);
1196*674ae819SStefano Zampini }
1197