xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision b7d8b9f8d1200181c0d1a3244f3c8804b4e1de29)
1674ae819SStefano Zampini #include "bddc.h"
2674ae819SStefano Zampini #include "bddcprivate.h"
3674ae819SStefano Zampini #include <petscblaslapack.h>
4674ae819SStefano Zampini 
5674ae819SStefano Zampini #undef __FUNCT__
6674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetCustomization"
7674ae819SStefano Zampini PetscErrorCode PCBDDCResetCustomization(PC pc)
8674ae819SStefano Zampini {
9674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
10674ae819SStefano Zampini   PetscInt       i;
11674ae819SStefano Zampini   PetscErrorCode ierr;
12674ae819SStefano Zampini 
13674ae819SStefano Zampini   PetscFunctionBegin;
14674ae819SStefano Zampini   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
15674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
16674ae819SStefano Zampini   ierr = MatNullSpaceDestroy(&pcbddc->NullSpace);CHKERRQ(ierr);
17674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
18674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
19674ae819SStefano Zampini   for (i=0;i<pcbddc->n_ISForDofs;i++) {
20674ae819SStefano Zampini     ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
21674ae819SStefano Zampini   }
22674ae819SStefano Zampini   ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
23674ae819SStefano Zampini   PetscFunctionReturn(0);
24674ae819SStefano Zampini }
25674ae819SStefano Zampini 
26674ae819SStefano Zampini #undef __FUNCT__
27674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetTopography"
28674ae819SStefano Zampini PetscErrorCode PCBDDCResetTopography(PC pc)
29674ae819SStefano Zampini {
30674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
31674ae819SStefano Zampini   PetscErrorCode ierr;
32674ae819SStefano Zampini 
33674ae819SStefano Zampini   PetscFunctionBegin;
34674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
35674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
36674ae819SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
37674ae819SStefano Zampini   PetscFunctionReturn(0);
38674ae819SStefano Zampini }
39674ae819SStefano Zampini 
40674ae819SStefano Zampini #undef __FUNCT__
41674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetSolvers"
42674ae819SStefano Zampini PetscErrorCode PCBDDCResetSolvers(PC pc)
43674ae819SStefano Zampini {
44674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
45674ae819SStefano Zampini   PetscErrorCode ierr;
46674ae819SStefano Zampini 
47674ae819SStefano Zampini   PetscFunctionBegin;
48674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->temp_solution);CHKERRQ(ierr);
49674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->original_rhs);CHKERRQ(ierr);
50674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
51674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
52674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_rhs);CHKERRQ(ierr);
53674ae819SStefano Zampini   ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
54674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_mat);CHKERRQ(ierr);
55674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
56674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
5715aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
5815aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
59674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
60674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
61674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
62674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
63674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
64674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
65674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec4_D);CHKERRQ(ierr);
66674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
67674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
68674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
69674ae819SStefano Zampini   ierr = KSPDestroy(&pcbddc->ksp_D);CHKERRQ(ierr);
70674ae819SStefano Zampini   ierr = KSPDestroy(&pcbddc->ksp_R);CHKERRQ(ierr);
71674ae819SStefano Zampini   ierr = PetscFree(pcbddc->local_primal_indices);CHKERRQ(ierr);
72674ae819SStefano Zampini   ierr = PetscFree(pcbddc->replicated_local_primal_indices);CHKERRQ(ierr);
73674ae819SStefano Zampini   ierr = PetscFree(pcbddc->replicated_local_primal_values);CHKERRQ(ierr);
74674ae819SStefano Zampini   ierr = PetscFree(pcbddc->local_primal_displacements);CHKERRQ(ierr);
75674ae819SStefano Zampini   ierr = PetscFree(pcbddc->local_primal_sizes);CHKERRQ(ierr);
76674ae819SStefano Zampini   PetscFunctionReturn(0);
77674ae819SStefano Zampini }
78674ae819SStefano Zampini 
79674ae819SStefano Zampini #undef __FUNCT__
80674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSolveSaddlePoint"
81674ae819SStefano Zampini static PetscErrorCode  PCBDDCSolveSaddlePoint(PC pc)
82674ae819SStefano Zampini {
83674ae819SStefano Zampini   PetscErrorCode ierr;
84674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
85674ae819SStefano Zampini 
86674ae819SStefano Zampini   PetscFunctionBegin;
87674ae819SStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
88674ae819SStefano Zampini   if (pcbddc->local_auxmat1) {
89674ae819SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec2_R,pcbddc->vec1_C);CHKERRQ(ierr);
90674ae819SStefano Zampini     ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
91674ae819SStefano Zampini   }
92674ae819SStefano Zampini   PetscFunctionReturn(0);
93674ae819SStefano Zampini }
94674ae819SStefano Zampini 
95674ae819SStefano Zampini #undef __FUNCT__
96674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
97674ae819SStefano Zampini PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc)
98674ae819SStefano Zampini {
99674ae819SStefano Zampini   PetscErrorCode ierr;
100674ae819SStefano Zampini   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
101674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)  (pc->data);
102674ae819SStefano Zampini   const PetscScalar zero = 0.0;
103674ae819SStefano Zampini 
104674ae819SStefano Zampini   PetscFunctionBegin;
10515aaf578SStefano Zampini   /* Application of PHI^T (or PSI^T)  */
10615aaf578SStefano Zampini   if (pcbddc->coarse_psi_B) {
10715aaf578SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
10815aaf578SStefano Zampini     if (pcbddc->inexact_prec_type) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
10915aaf578SStefano Zampini   } else {
110674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
111674ae819SStefano Zampini     if (pcbddc->inexact_prec_type) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
11215aaf578SStefano Zampini   }
113674ae819SStefano Zampini   /* Scatter data of coarse_rhs */
114674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { ierr = VecSet(pcbddc->coarse_rhs,zero);CHKERRQ(ierr); }
115674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
116674ae819SStefano Zampini 
117674ae819SStefano Zampini   /* Local solution on R nodes */
118674ae819SStefano Zampini   ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
119674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
120674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
121674ae819SStefano Zampini   if (pcbddc->inexact_prec_type) {
122674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
123674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
124674ae819SStefano Zampini   }
125674ae819SStefano Zampini   ierr = PCBDDCSolveSaddlePoint(pc);CHKERRQ(ierr);
126674ae819SStefano Zampini   ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
127674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
128674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
129674ae819SStefano Zampini   if (pcbddc->inexact_prec_type) {
130674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
131674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
132674ae819SStefano Zampini   }
133674ae819SStefano Zampini 
134674ae819SStefano Zampini   /* Coarse solution */
135674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
136674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { /* TODO remove null space when doing multilevel */
137674ae819SStefano Zampini     ierr = KSPSolve(pcbddc->coarse_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
138674ae819SStefano Zampini   }
139674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
140674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd  (pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
141674ae819SStefano Zampini 
142674ae819SStefano Zampini   /* Sum contributions from two levels */
143674ae819SStefano Zampini   ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
144674ae819SStefano Zampini   if (pcbddc->inexact_prec_type) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
145674ae819SStefano Zampini   PetscFunctionReturn(0);
146674ae819SStefano Zampini }
147674ae819SStefano Zampini 
148674ae819SStefano Zampini #undef __FUNCT__
149674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
150674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
151674ae819SStefano Zampini {
152674ae819SStefano Zampini   PetscErrorCode ierr;
153674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
154674ae819SStefano Zampini 
155674ae819SStefano Zampini   PetscFunctionBegin;
156674ae819SStefano Zampini   switch (pcbddc->coarse_communications_type) {
157674ae819SStefano Zampini     case SCATTERS_BDDC:
158674ae819SStefano Zampini       ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
159674ae819SStefano Zampini       break;
160674ae819SStefano Zampini     case GATHERS_BDDC:
161674ae819SStefano Zampini       break;
162674ae819SStefano Zampini   }
163674ae819SStefano Zampini   PetscFunctionReturn(0);
164674ae819SStefano Zampini }
165674ae819SStefano Zampini 
166674ae819SStefano Zampini #undef __FUNCT__
167674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
168674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
169674ae819SStefano Zampini {
170674ae819SStefano Zampini   PetscErrorCode ierr;
171674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
172674ae819SStefano Zampini   PetscScalar*   array_to;
173674ae819SStefano Zampini   PetscScalar*   array_from;
174674ae819SStefano Zampini   MPI_Comm       comm;
175674ae819SStefano Zampini   PetscInt       i;
176674ae819SStefano Zampini 
177674ae819SStefano Zampini   PetscFunctionBegin;
178674ae819SStefano Zampini   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
179674ae819SStefano Zampini   switch (pcbddc->coarse_communications_type) {
180674ae819SStefano Zampini     case SCATTERS_BDDC:
181674ae819SStefano Zampini       ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
182674ae819SStefano Zampini       break;
183674ae819SStefano Zampini     case GATHERS_BDDC:
184674ae819SStefano Zampini       if (vec_from) {
185674ae819SStefano Zampini         ierr = VecGetArray(vec_from,&array_from);CHKERRQ(ierr);
186674ae819SStefano Zampini       }
187674ae819SStefano Zampini       if (vec_to) {
188674ae819SStefano Zampini         ierr = VecGetArray(vec_to,&array_to);CHKERRQ(ierr);
189674ae819SStefano Zampini       }
190674ae819SStefano Zampini       switch(pcbddc->coarse_problem_type){
191674ae819SStefano Zampini         case SEQUENTIAL_BDDC:
192674ae819SStefano Zampini           if (smode == SCATTER_FORWARD) {
193674ae819SStefano 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);
194674ae819SStefano Zampini             if (vec_to) {
195674ae819SStefano Zampini               if (imode == ADD_VALUES) {
196674ae819SStefano Zampini                 for (i=0;i<pcbddc->replicated_primal_size;i++) {
197674ae819SStefano Zampini                   array_to[pcbddc->replicated_local_primal_indices[i]]+=pcbddc->replicated_local_primal_values[i];
198674ae819SStefano Zampini                 }
199674ae819SStefano Zampini               } else {
200674ae819SStefano Zampini                 for (i=0;i<pcbddc->replicated_primal_size;i++) {
201674ae819SStefano Zampini                   array_to[pcbddc->replicated_local_primal_indices[i]]=pcbddc->replicated_local_primal_values[i];
202674ae819SStefano Zampini                 }
203674ae819SStefano Zampini               }
204674ae819SStefano Zampini             }
205674ae819SStefano Zampini           } else {
206674ae819SStefano Zampini             if (vec_from) {
207674ae819SStefano Zampini               if (imode == ADD_VALUES) {
208674ae819SStefano Zampini                 MPI_Comm vec_from_comm;
209674ae819SStefano Zampini                 ierr = PetscObjectGetComm((PetscObject)(vec_from),&vec_from_comm);CHKERRQ(ierr);
210674ae819SStefano 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);
211674ae819SStefano Zampini               }
212674ae819SStefano Zampini               for (i=0;i<pcbddc->replicated_primal_size;i++) {
213674ae819SStefano Zampini                 pcbddc->replicated_local_primal_values[i]=array_from[pcbddc->replicated_local_primal_indices[i]];
214674ae819SStefano Zampini               }
215674ae819SStefano Zampini             }
216674ae819SStefano 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);
217674ae819SStefano Zampini           }
218674ae819SStefano Zampini           break;
219674ae819SStefano Zampini         case REPLICATED_BDDC:
220674ae819SStefano Zampini           if (smode == SCATTER_FORWARD) {
221674ae819SStefano 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);
222674ae819SStefano Zampini             if (imode == ADD_VALUES) {
223674ae819SStefano Zampini               for (i=0;i<pcbddc->replicated_primal_size;i++) {
224674ae819SStefano Zampini                 array_to[pcbddc->replicated_local_primal_indices[i]]+=pcbddc->replicated_local_primal_values[i];
225674ae819SStefano Zampini               }
226674ae819SStefano Zampini             } else {
227674ae819SStefano Zampini               for (i=0;i<pcbddc->replicated_primal_size;i++) {
228674ae819SStefano Zampini                 array_to[pcbddc->replicated_local_primal_indices[i]]=pcbddc->replicated_local_primal_values[i];
229674ae819SStefano Zampini               }
230674ae819SStefano Zampini             }
231674ae819SStefano Zampini           } else { /* no communications needed for SCATTER_REVERSE since needed data is already present */
232674ae819SStefano Zampini             if (imode == ADD_VALUES) {
233674ae819SStefano Zampini               for (i=0;i<pcbddc->local_primal_size;i++) {
234674ae819SStefano Zampini                 array_to[i]+=array_from[pcbddc->local_primal_indices[i]];
235674ae819SStefano Zampini               }
236674ae819SStefano Zampini             } else {
237674ae819SStefano Zampini               for (i=0;i<pcbddc->local_primal_size;i++) {
238674ae819SStefano Zampini                 array_to[i]=array_from[pcbddc->local_primal_indices[i]];
239674ae819SStefano Zampini               }
240674ae819SStefano Zampini             }
241674ae819SStefano Zampini           }
242674ae819SStefano Zampini           break;
243674ae819SStefano Zampini         case MULTILEVEL_BDDC:
244674ae819SStefano Zampini           break;
245674ae819SStefano Zampini         case PARALLEL_BDDC:
246674ae819SStefano Zampini           break;
247674ae819SStefano Zampini       }
248674ae819SStefano Zampini       if (vec_from) {
249674ae819SStefano Zampini         ierr = VecRestoreArray(vec_from,&array_from);CHKERRQ(ierr);
250674ae819SStefano Zampini       }
251674ae819SStefano Zampini       if (vec_to) {
252674ae819SStefano Zampini         ierr = VecRestoreArray(vec_to,&array_to);CHKERRQ(ierr);
253674ae819SStefano Zampini       }
254674ae819SStefano Zampini       break;
255674ae819SStefano Zampini   }
256674ae819SStefano Zampini   PetscFunctionReturn(0);
257674ae819SStefano Zampini }
258674ae819SStefano Zampini 
259984c4197SStefano Zampini /* uncomment for testing purposes */
260984c4197SStefano Zampini /* #define PETSC_MISSING_LAPACK_GESVD 1 */
261674ae819SStefano Zampini #undef __FUNCT__
262674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp"
263674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
264674ae819SStefano Zampini {
265674ae819SStefano Zampini   PetscErrorCode    ierr;
266674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
267674ae819SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
268674ae819SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
269984c4197SStefano Zampini   /* constraint and (optionally) change of basis matrix implemented as SeqAIJ */
270674ae819SStefano Zampini   MatType           impMatType=MATSEQAIJ;
271984c4197SStefano Zampini   /* one and zero */
272984c4197SStefano Zampini   PetscScalar       one=1.0,zero=0.0;
273984c4197SStefano Zampini   /* space to store constraints and their local indices */
274984c4197SStefano Zampini   PetscScalar       *temp_quadrature_constraint;
275984c4197SStefano Zampini   PetscInt          *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B;
276984c4197SStefano Zampini   /* iterators */
277984c4197SStefano Zampini   PetscInt          i,j,k,total_counts,temp_start_ptr;
278984c4197SStefano Zampini   /* stuff to store connected components stored in pcbddc->mat_graph */
279984c4197SStefano Zampini   IS                ISForVertices,*ISForFaces,*ISForEdges,*used_IS;
280984c4197SStefano Zampini   PetscInt          n_ISForFaces,n_ISForEdges;
281984c4197SStefano Zampini   PetscBool         get_faces,get_edges,get_vertices;
282984c4197SStefano Zampini   /* near null space stuff */
283674ae819SStefano Zampini   MatNullSpace      nearnullsp;
284674ae819SStefano Zampini   const Vec         *nearnullvecs;
285674ae819SStefano Zampini   Vec               *localnearnullsp;
286984c4197SStefano Zampini   PetscBool         nnsp_has_cnst;
287984c4197SStefano Zampini   PetscInt          nnsp_size;
288984c4197SStefano Zampini   PetscScalar       *array;
289984c4197SStefano Zampini   /* BLAS integers */
290984c4197SStefano Zampini   PetscBLASInt      Bs,Bt,lwork,lierr,Bone=1;
291984c4197SStefano Zampini   /* LAPACK working arrays for SVD or POD */
292242a89d7SStefano Zampini   PetscBool         skip_lapack;
293984c4197SStefano Zampini   PetscScalar       *work;
294984c4197SStefano Zampini   PetscReal         *singular_vals;
295984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
296984c4197SStefano Zampini   PetscReal         *rwork;
297674ae819SStefano Zampini #endif
298984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
299c8244a33SStefano Zampini   PetscBLASInt      Blas_N,Blas_LDA;
300984c4197SStefano Zampini   PetscScalar       *temp_basis,*correlation_mat;
301*b7d8b9f8SStefano Zampini #else
302*b7d8b9f8SStefano Zampini   PetscBLASInt      Blas_LDA;
303*b7d8b9f8SStefano Zampini   PetscBLASInt      dummy_int_1=1,dummy_int_2=1;
304*b7d8b9f8SStefano Zampini   PetscScalar       dummy_scalar_1=0.0,dummy_scalar_2=0.0;
305984c4197SStefano Zampini #endif
306984c4197SStefano Zampini   /* change of basis */
307984c4197SStefano Zampini   PetscInt          *aux_primal_numbering,*aux_primal_minloc,*global_indices;
308984c4197SStefano Zampini   PetscBool         boolforchange,*change_basis,*touched;
309984c4197SStefano Zampini   /* auxiliary stuff */
310984c4197SStefano Zampini   PetscInt          *nnz,*is_indices,*local_to_B;
311984c4197SStefano Zampini   /* some quantities */
312984c4197SStefano Zampini   PetscInt          n_vertices,total_primal_vertices;
313984c4197SStefano Zampini   PetscInt          size_of_constraint,max_size_of_constraint,max_constraints,temp_constraints;
314984c4197SStefano Zampini 
315674ae819SStefano Zampini 
316674ae819SStefano Zampini   PetscFunctionBegin;
317674ae819SStefano Zampini   /* Get index sets for faces, edges and vertices from graph */
318674ae819SStefano Zampini   get_faces = PETSC_TRUE;
319674ae819SStefano Zampini   get_edges = PETSC_TRUE;
320674ae819SStefano Zampini   get_vertices = PETSC_TRUE;
321674ae819SStefano Zampini   if (pcbddc->vertices_flag) {
322674ae819SStefano Zampini     get_faces = PETSC_FALSE;
323674ae819SStefano Zampini     get_edges = PETSC_FALSE;
324674ae819SStefano Zampini   }
325674ae819SStefano Zampini   if (pcbddc->constraints_flag) {
326674ae819SStefano Zampini     get_vertices = PETSC_FALSE;
327674ae819SStefano Zampini   }
328674ae819SStefano Zampini   if (pcbddc->faces_flag) {
329674ae819SStefano Zampini     get_edges = PETSC_FALSE;
330674ae819SStefano Zampini   }
331674ae819SStefano Zampini   if (pcbddc->edges_flag) {
332674ae819SStefano Zampini     get_faces = PETSC_FALSE;
333674ae819SStefano Zampini   }
334674ae819SStefano Zampini   /* default */
335674ae819SStefano Zampini   if (!get_faces && !get_edges && !get_vertices) {
336674ae819SStefano Zampini     get_vertices = PETSC_TRUE;
337674ae819SStefano Zampini   }
338674ae819SStefano Zampini   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,get_faces,get_edges,get_vertices,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);
339984c4197SStefano Zampini   /* print some info */
340674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
341674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
342674ae819SStefano Zampini     i = 0;
343674ae819SStefano Zampini     if (ISForVertices) {
344674ae819SStefano Zampini       ierr = ISGetSize(ISForVertices,&i);CHKERRQ(ierr);
345674ae819SStefano Zampini     }
346674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices\n",PetscGlobalRank,i);CHKERRQ(ierr);
347674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges\n",PetscGlobalRank,n_ISForEdges);CHKERRQ(ierr);
34815aaf578SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces\n",PetscGlobalRank,n_ISForFaces);CHKERRQ(ierr);
349674ae819SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
350674ae819SStefano Zampini   }
351674ae819SStefano Zampini   /* check if near null space is attached to global mat */
352674ae819SStefano Zampini   ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
353674ae819SStefano Zampini   if (nearnullsp) {
354674ae819SStefano Zampini     ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
355984c4197SStefano Zampini   } else { /* if near null space is not provided BDDC uses constants by default */
356984c4197SStefano Zampini     nnsp_size = 0;
357674ae819SStefano Zampini     nnsp_has_cnst = PETSC_TRUE;
358674ae819SStefano Zampini   }
359984c4197SStefano Zampini   /* get max number of constraints on a single cc */
360984c4197SStefano Zampini   max_constraints = nnsp_size;
361984c4197SStefano Zampini   if (nnsp_has_cnst) max_constraints++;
362984c4197SStefano Zampini 
363674ae819SStefano Zampini   /*
364674ae819SStefano Zampini        Evaluate maximum storage size needed by the procedure
365674ae819SStefano Zampini        - temp_indices will contain start index of each constraint stored as follows
366674ae819SStefano 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
367674ae819SStefano 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
368674ae819SStefano Zampini        - temp_quadrature_constraint  [temp_indices[i],...,temp[indices[i+1]-1] will contain the scalars representing the constraint itself
369674ae819SStefano Zampini                                                                                                                                                          */
370674ae819SStefano Zampini   total_counts = n_ISForFaces+n_ISForEdges;
371984c4197SStefano Zampini   total_counts *= max_constraints;
372674ae819SStefano Zampini   n_vertices = 0;
373674ae819SStefano Zampini   if (ISForVertices) {
374674ae819SStefano Zampini     ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
375674ae819SStefano Zampini   }
376674ae819SStefano Zampini   total_counts += n_vertices;
377674ae819SStefano Zampini   ierr = PetscMalloc((total_counts+1)*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
378674ae819SStefano Zampini   ierr = PetscMalloc((total_counts+1)*sizeof(PetscBool),&change_basis);CHKERRQ(ierr);
379674ae819SStefano Zampini   total_counts = 0;
380674ae819SStefano Zampini   max_size_of_constraint = 0;
381674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
382674ae819SStefano Zampini     if (i<n_ISForEdges) {
383674ae819SStefano Zampini       used_IS = &ISForEdges[i];
384674ae819SStefano Zampini     } else {
385674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
386674ae819SStefano Zampini     }
387674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
388674ae819SStefano Zampini     total_counts += j;
389674ae819SStefano Zampini     max_size_of_constraint = PetscMax(j,max_size_of_constraint);
390674ae819SStefano Zampini   }
391984c4197SStefano Zampini   total_counts *= max_constraints;
392674ae819SStefano Zampini   total_counts += n_vertices;
393674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&temp_quadrature_constraint);CHKERRQ(ierr);
394674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint);CHKERRQ(ierr);
395674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint_B);CHKERRQ(ierr);
396984c4197SStefano Zampini   /* local to boundary numbering */
397674ae819SStefano Zampini   ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&local_to_B);CHKERRQ(ierr);
398674ae819SStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
399984c4197SStefano Zampini   for (i=0;i<pcis->n;i++) local_to_B[i]=-1;
400984c4197SStefano Zampini   for (i=0;i<pcis->n_B;i++) local_to_B[is_indices[i]]=i;
401674ae819SStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
402984c4197SStefano Zampini   /* get local part of global near null space vectors */
403984c4197SStefano Zampini   ierr = PetscMalloc(nnsp_size*sizeof(Vec),&localnearnullsp);CHKERRQ(ierr);
404984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
405984c4197SStefano Zampini     ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
406984c4197SStefano Zampini     ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
407984c4197SStefano Zampini     ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
408984c4197SStefano Zampini   }
409674ae819SStefano Zampini 
410242a89d7SStefano Zampini   /* whether or not to skip lapack calls */
411242a89d7SStefano Zampini   skip_lapack = PETSC_TRUE;
412242a89d7SStefano Zampini   if (n_ISForFaces+n_ISForEdges) skip_lapack = PETSC_FALSE;
413242a89d7SStefano Zampini 
414984c4197SStefano Zampini   /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
415242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
416674ae819SStefano Zampini     PetscScalar temp_work;
417674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
418984c4197SStefano Zampini     /* Proper Orthogonal Decomposition (POD) using the snapshot method */
419984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*max_constraints*sizeof(PetscScalar),&correlation_mat);CHKERRQ(ierr);
420984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
421984c4197SStefano Zampini     ierr = PetscMalloc(max_size_of_constraint*max_constraints*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr);
422674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
423984c4197SStefano Zampini     ierr = PetscMalloc(3*max_constraints*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
424674ae819SStefano Zampini #endif
425674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
426c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
427c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
428674ae819SStefano Zampini     lwork = -1;
429674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
430674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
431c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
432674ae819SStefano Zampini #else
433c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
434674ae819SStefano Zampini #endif
435674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
436984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
437674ae819SStefano Zampini #else /* on missing GESVD */
438674ae819SStefano Zampini     /* SVD */
439674ae819SStefano Zampini     PetscInt max_n,min_n;
440674ae819SStefano Zampini     max_n = max_size_of_constraint;
441984c4197SStefano Zampini     min_n = max_constraints;
442984c4197SStefano Zampini     if (max_size_of_constraint < max_constraints) {
443674ae819SStefano Zampini       min_n = max_size_of_constraint;
444984c4197SStefano Zampini       max_n = max_constraints;
445674ae819SStefano Zampini     }
446674ae819SStefano Zampini     ierr = PetscMalloc(min_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
447674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
448674ae819SStefano Zampini     ierr = PetscMalloc(5*min_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
449674ae819SStefano Zampini #endif
450674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
451674ae819SStefano Zampini     lwork = -1;
452674ae819SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Bs);CHKERRQ(ierr);
453674ae819SStefano Zampini     ierr = PetscBLASIntCast(min_n,&Bt);CHKERRQ(ierr);
454*b7d8b9f8SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
455674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
456674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
457*b7d8b9f8SStefano Zampini     PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Bs,&Bt,&temp_quadrature_constraint[0],&Blas_LDA,singular_vals,&dummy_scalar_1,&dummy_int_1,&dummy_scalar_2,&dummy_int_2,&temp_work,&lwork,&lierr));
458674ae819SStefano Zampini #else
459*b7d8b9f8SStefano Zampini     PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Bs,&Bt,&temp_quadrature_constraint[0],&Blas_LDA,singular_vals,&dummy_scalar_1,&dummy_int_1,&dummy_scalar_2,&dummy_int_2,&temp_work,&lwork,rwork,&lierr));
460674ae819SStefano Zampini #endif
461674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
462984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
463984c4197SStefano Zampini #endif /* on missing GESVD */
464674ae819SStefano Zampini     /* Allocate optimal workspace */
465674ae819SStefano Zampini     ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
466984c4197SStefano Zampini     ierr = PetscMalloc((PetscInt)lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
467674ae819SStefano Zampini   }
468674ae819SStefano Zampini   /* Now we can loop on constraining sets */
469674ae819SStefano Zampini   total_counts = 0;
470674ae819SStefano Zampini   temp_indices[0] = 0;
471674ae819SStefano Zampini   /* vertices */
472674ae819SStefano Zampini   if (ISForVertices) {
473674ae819SStefano Zampini     ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
474674ae819SStefano Zampini     if (nnsp_has_cnst) { /* consider all vertices */
475674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
476674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
477674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
478674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
479674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+1;
480674ae819SStefano Zampini         change_basis[total_counts]=PETSC_FALSE;
481674ae819SStefano Zampini         total_counts++;
482674ae819SStefano Zampini       }
483674ae819SStefano Zampini     } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
484984c4197SStefano Zampini       PetscBool used_vertex;
485674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
486674ae819SStefano Zampini         used_vertex = PETSC_FALSE;
487674ae819SStefano Zampini         k = 0;
488674ae819SStefano Zampini         while (!used_vertex && k<nnsp_size) {
489984c4197SStefano Zampini           ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
490984c4197SStefano Zampini           if (PetscAbsScalar(array[is_indices[i]])>0.0) {
491674ae819SStefano Zampini             temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
492674ae819SStefano Zampini             temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
493674ae819SStefano Zampini             temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
494674ae819SStefano Zampini             temp_indices[total_counts+1]=temp_indices[total_counts]+1;
495674ae819SStefano Zampini             change_basis[total_counts]=PETSC_FALSE;
496674ae819SStefano Zampini             total_counts++;
497674ae819SStefano Zampini             used_vertex = PETSC_TRUE;
498674ae819SStefano Zampini           }
499984c4197SStefano Zampini           ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
500674ae819SStefano Zampini           k++;
501674ae819SStefano Zampini         }
502674ae819SStefano Zampini       }
503674ae819SStefano Zampini     }
504674ae819SStefano Zampini     ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
505674ae819SStefano Zampini     n_vertices = total_counts;
506674ae819SStefano Zampini   }
507984c4197SStefano Zampini 
508674ae819SStefano Zampini   /* edges and faces */
509674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
510674ae819SStefano Zampini     if (i<n_ISForEdges) {
511674ae819SStefano Zampini       used_IS = &ISForEdges[i];
512984c4197SStefano Zampini       boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
513674ae819SStefano Zampini     } else {
514674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
515984c4197SStefano Zampini       boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
516674ae819SStefano Zampini     }
517674ae819SStefano Zampini     temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
518674ae819SStefano Zampini     temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
519674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
520674ae819SStefano Zampini     ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
521984c4197SStefano Zampini     /* change of basis should not be performed on local periodic nodes */
522984c4197SStefano Zampini     if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
523674ae819SStefano Zampini     if (nnsp_has_cnst) {
5245b08dc53SStefano Zampini       PetscScalar quad_value;
525674ae819SStefano Zampini       temp_constraints++;
526674ae819SStefano Zampini       quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
527674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
528674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
529674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
530674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
531674ae819SStefano Zampini       }
532674ae819SStefano Zampini       temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
53351b0f6cfSStefano Zampini       change_basis[total_counts]=boolforchange;
534674ae819SStefano Zampini       total_counts++;
535674ae819SStefano Zampini     }
536674ae819SStefano Zampini     for (k=0;k<nnsp_size;k++) {
537984c4197SStefano Zampini       PetscReal real_value;
538984c4197SStefano Zampini       ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
539674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
540674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
541674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
542984c4197SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=array[is_indices[j]];
543674ae819SStefano Zampini       }
544984c4197SStefano Zampini       ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
545984c4197SStefano Zampini       /* check if array is null on the connected component */
546674ae819SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Bs);CHKERRQ(ierr);
5475b08dc53SStefano Zampini       PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Bs,&temp_quadrature_constraint[temp_indices[total_counts]],&Bone));
5485b08dc53SStefano Zampini       if (real_value > 0.0) { /* keep indices and values */
549674ae819SStefano Zampini         temp_constraints++;
550674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
55151b0f6cfSStefano Zampini         change_basis[total_counts]=boolforchange;
552674ae819SStefano Zampini         total_counts++;
553674ae819SStefano Zampini       }
554674ae819SStefano Zampini     }
555674ae819SStefano Zampini     ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
556984c4197SStefano Zampini     /* perform SVD on the constraints if use_nnsp_true has not be requested by the user */
557984c4197SStefano Zampini     if (!pcbddc->use_nnsp_true) {
558984c4197SStefano Zampini       PetscReal tol = 1.0e-8; /* tolerance for retaining eigenmodes */
559984c4197SStefano Zampini 
560674ae819SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Bs);CHKERRQ(ierr);
561674ae819SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Bt);CHKERRQ(ierr);
562674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
563984c4197SStefano Zampini       /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
564984c4197SStefano Zampini          POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
565984c4197SStefano Zampini          -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
566984c4197SStefano Zampini             the constraints basis will differ (by a complex factor with absolute value equal to 1)
567984c4197SStefano Zampini             from that computed using LAPACKgesvd
568984c4197SStefano Zampini          -> This is due to a different computation of eigenvectors in LAPACKheev
569984c4197SStefano Zampini          -> The quality of the POD-computed basis will be the same */
570c8244a33SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
571c8244a33SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
572984c4197SStefano Zampini       ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
573674ae819SStefano Zampini       /* Store upper triangular part of correlation matrix */
574984c4197SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
575674ae819SStefano Zampini       for (j=0;j<temp_constraints;j++) {
576674ae819SStefano Zampini         for (k=0;k<j+1;k++) {
577984c4197SStefano Zampini           PetscStackCallBLAS("BLASdot",correlation_mat[j*temp_constraints+k]=BLASdot_(&Bs,&temp_quadrature_constraint[temp_indices[temp_start_ptr+k]],&Bone,&temp_quadrature_constraint[temp_indices[temp_start_ptr+j]],&Bone));
578674ae819SStefano Zampini         }
579674ae819SStefano Zampini       }
580674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
581c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
582674ae819SStefano Zampini #else
583c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
584674ae819SStefano Zampini #endif
585674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
586984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
587984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
588674ae819SStefano Zampini       j=0;
589984c4197SStefano Zampini       while (j < temp_constraints && singular_vals[j] < tol) j++;
590674ae819SStefano Zampini       total_counts=total_counts-j;
591674ae819SStefano Zampini       if (j<temp_constraints) {
592984c4197SStefano Zampini         PetscInt ii;
593984c4197SStefano Zampini         for (k=j;k<temp_constraints;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]);
594674ae819SStefano Zampini         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
595984c4197SStefano Zampini         PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&Bs,&Bt,&Bt,&one,&temp_quadrature_constraint[temp_indices[temp_start_ptr]],&Bs,correlation_mat,&Bt,&zero,temp_basis,&Bs));
596674ae819SStefano Zampini         ierr = PetscFPTrapPop();CHKERRQ(ierr);
597984c4197SStefano Zampini         /* scale and copy POD basis into used quadrature memory */
598984c4197SStefano Zampini         for (k=0;k<temp_constraints-j;k++) {
599674ae819SStefano Zampini           for (ii=0;ii<size_of_constraint;ii++) {
600984c4197SStefano Zampini             temp_quadrature_constraint[temp_indices[temp_start_ptr+k]+ii]=singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
601674ae819SStefano Zampini           }
602674ae819SStefano Zampini         }
603674ae819SStefano Zampini       }
604674ae819SStefano Zampini #else  /* on missing GESVD */
605*b7d8b9f8SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
606674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
607674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
608*b7d8b9f8SStefano Zampini       PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Bs,&Bt,&temp_quadrature_constraint[temp_indices[temp_start_ptr]],&Blas_LDA,singular_vals,&dummy_scalar_1,&dummy_int_1,&dummy_scalar_2,&dummy_int_2,work,&lwork,&lierr));
609674ae819SStefano Zampini #else
610*b7d8b9f8SStefano Zampini       PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Bs,&Bt,&temp_quadrature_constraint[temp_indices[temp_start_ptr]],&Blas_LDA,singular_vals,&dummy_scalar_1,&dummy_int_1,&dummy_scalar_2,&dummy_int_2,work,&lwork,rwork,&lierr));
611674ae819SStefano Zampini #endif
612984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
613674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
614984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
615*b7d8b9f8SStefano Zampini       PetscInt min_n = temp_constraints;
616*b7d8b9f8SStefano Zampini       if (min_n > size_of_constraint) min_n = size_of_constraint;
617674ae819SStefano Zampini       j = 0;
618674ae819SStefano Zampini       while (j < min_n && singular_vals[min_n-j-1] < tol) j++;
619984c4197SStefano Zampini       total_counts = total_counts-temp_constraints+min_n-j;
620984c4197SStefano Zampini #endif /* on missing GESVD */
621674ae819SStefano Zampini     }
622674ae819SStefano Zampini   }
623674ae819SStefano Zampini   /* free index sets of faces, edges and vertices */
624674ae819SStefano Zampini   for (i=0;i<n_ISForFaces;i++) {
625674ae819SStefano Zampini     ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
626674ae819SStefano Zampini   }
627674ae819SStefano Zampini   ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
628674ae819SStefano Zampini   for (i=0;i<n_ISForEdges;i++) {
629674ae819SStefano Zampini     ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
630674ae819SStefano Zampini   }
631674ae819SStefano Zampini   ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
632674ae819SStefano Zampini   ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
633674ae819SStefano Zampini 
634984c4197SStefano Zampini   /* free workspace */
635242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
636984c4197SStefano Zampini     ierr = PetscFree(work);CHKERRQ(ierr);
637984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
638984c4197SStefano Zampini     ierr = PetscFree(rwork);CHKERRQ(ierr);
639984c4197SStefano Zampini #endif
640984c4197SStefano Zampini     ierr = PetscFree(singular_vals);CHKERRQ(ierr);
641984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
642984c4197SStefano Zampini     ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
643984c4197SStefano Zampini     ierr = PetscFree(temp_basis);CHKERRQ(ierr);
644984c4197SStefano Zampini #endif
645984c4197SStefano Zampini   }
646984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
647984c4197SStefano Zampini     ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
648984c4197SStefano Zampini   }
649984c4197SStefano Zampini   ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
650984c4197SStefano Zampini 
651674ae819SStefano Zampini   /* set quantities in pcbddc data structure */
652984c4197SStefano Zampini   /* n_vertices defines the number of subdomain corners in the primal space */
653674ae819SStefano Zampini   /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */
654984c4197SStefano Zampini   pcbddc->local_primal_size = total_counts;
655674ae819SStefano Zampini   pcbddc->n_vertices = n_vertices;
656984c4197SStefano Zampini   pcbddc->n_constraints = pcbddc->local_primal_size-pcbddc->n_vertices;
657674ae819SStefano Zampini 
658674ae819SStefano Zampini   /* Create constraint matrix */
659674ae819SStefano Zampini   /* The constraint matrix is used to compute the l2g map of primal dofs */
660674ae819SStefano Zampini   /* so we need to set it up properly either with or without change of basis */
661674ae819SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
662674ae819SStefano Zampini   ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr);
663984c4197SStefano Zampini   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
664984c4197SStefano Zampini   /* array to compute a local numbering of constraints : vertices first then constraints */
665984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_numbering);CHKERRQ(ierr);
666984c4197SStefano Zampini   /* array to select the proper local node (of minimum index with respect to global ordering) when changing the basis */
667984c4197SStefano Zampini   /* note: it should not be needed since IS for faces and edges are already sorted by global ordering when analyzing the graph but... just in case */
668984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_minloc);CHKERRQ(ierr);
669984c4197SStefano Zampini   /* auxiliary stuff for basis change */
670984c4197SStefano Zampini   ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&global_indices);CHKERRQ(ierr);
671984c4197SStefano Zampini   ierr = PetscMalloc(pcis->n_B*sizeof(PetscBool),&touched);CHKERRQ(ierr);
672984c4197SStefano Zampini   ierr = PetscMemzero(touched,pcis->n_B*sizeof(PetscBool));CHKERRQ(ierr);
673984c4197SStefano Zampini 
674984c4197SStefano Zampini   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
675984c4197SStefano Zampini   total_primal_vertices=0;
676984c4197SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
677674ae819SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
678984c4197SStefano Zampini     if (size_of_constraint == 1) {
679984c4197SStefano Zampini       touched[temp_indices_to_constraint_B[temp_indices[i]]]=PETSC_TRUE;
680984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]];
681984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=0;
682984c4197SStefano Zampini       total_primal_vertices++;
683984c4197SStefano Zampini     } else if (change_basis[i]) { /* Same procedure used in PCBDDCGetPrimalConstraintsLocalIdx */
684984c4197SStefano Zampini       PetscInt min_loc,min_index;
685984c4197SStefano Zampini       ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],global_indices);CHKERRQ(ierr);
686984c4197SStefano Zampini       /* find first untouched local node */
687674ae819SStefano Zampini       k = 0;
688984c4197SStefano Zampini       while (touched[temp_indices_to_constraint_B[temp_indices[i]+k]]) k++;
689984c4197SStefano Zampini       min_index = global_indices[k];
690984c4197SStefano Zampini       min_loc = k;
691984c4197SStefano Zampini       /* search the minimum among global nodes already untouched on the cc */
692984c4197SStefano Zampini       for (k=1;k<size_of_constraint;k++) {
693984c4197SStefano Zampini         /* there can be more than one constraint on a single connected component */
694984c4197SStefano Zampini         if (min_index > global_indices[k] && !touched[temp_indices_to_constraint_B[temp_indices[i]+k]]) {
695984c4197SStefano Zampini           min_index = global_indices[k];
696984c4197SStefano Zampini           min_loc = k;
697674ae819SStefano Zampini         }
698674ae819SStefano Zampini       }
699984c4197SStefano Zampini       touched[temp_indices_to_constraint_B[temp_indices[i]+min_loc]] = PETSC_TRUE;
700984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]+min_loc];
701984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=min_loc;
702984c4197SStefano Zampini       total_primal_vertices++;
703984c4197SStefano Zampini     }
704984c4197SStefano Zampini   }
705984c4197SStefano Zampini   /* free workspace */
706984c4197SStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
707984c4197SStefano Zampini   ierr = PetscFree(touched);CHKERRQ(ierr);
708674ae819SStefano Zampini   /* permute indices in order to have a sorted set of vertices */
709984c4197SStefano Zampini   ierr = PetscSortInt(total_primal_vertices,aux_primal_numbering);
710984c4197SStefano Zampini 
711984c4197SStefano Zampini   /* nonzero structure of constraint matrix */
712984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
713984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) nnz[i]=1;
714984c4197SStefano Zampini   j=total_primal_vertices;
715984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
716674ae819SStefano Zampini     if (!change_basis[i]) {
717674ae819SStefano Zampini       nnz[j]=temp_indices[i+1]-temp_indices[i];
718674ae819SStefano Zampini       j++;
719674ae819SStefano Zampini     }
720674ae819SStefano Zampini   }
721674ae819SStefano Zampini   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
722674ae819SStefano Zampini   ierr = PetscFree(nnz);CHKERRQ(ierr);
723674ae819SStefano Zampini   /* set values in constraint matrix */
724984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) {
725984c4197SStefano Zampini     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,aux_primal_numbering[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
726674ae819SStefano Zampini   }
727984c4197SStefano Zampini   total_counts = total_primal_vertices;
728984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
729674ae819SStefano Zampini     if (!change_basis[i]) {
730674ae819SStefano Zampini       size_of_constraint=temp_indices[i+1]-temp_indices[i];
731674ae819SStefano 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);
732674ae819SStefano Zampini       total_counts++;
733674ae819SStefano Zampini     }
734674ae819SStefano Zampini   }
735674ae819SStefano Zampini   /* assembling */
736674ae819SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
737674ae819SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
738984c4197SStefano Zampini   /*
739984c4197SStefano Zampini   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
740984c4197SStefano Zampini   */
741674ae819SStefano Zampini   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
742674ae819SStefano Zampini   if (pcbddc->use_change_of_basis) {
743984c4197SStefano Zampini     PetscBool qr_needed = PETSC_FALSE;
744984c4197SStefano Zampini     /* change of basis acts on local interfaces -> dimension is n_B x n_B */
745674ae819SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
746674ae819SStefano Zampini     ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr);
747674ae819SStefano Zampini     ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr);
748674ae819SStefano Zampini     /* work arrays */
749674ae819SStefano Zampini     ierr = PetscMalloc(pcis->n_B*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
750984c4197SStefano Zampini     for (i=0;i<pcis->n_B;i++) nnz[i]=1;
751984c4197SStefano Zampini     /* nonzeros per row */
752984c4197SStefano Zampini     for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
753674ae819SStefano Zampini       if (change_basis[i]) {
754984c4197SStefano Zampini         qr_needed = PETSC_TRUE;
755674ae819SStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
756984c4197SStefano Zampini         for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
757674ae819SStefano Zampini       }
758674ae819SStefano Zampini     }
759674ae819SStefano Zampini     ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
760674ae819SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
761674ae819SStefano Zampini     /* Set initial identity in the matrix */
762674ae819SStefano Zampini     for (i=0;i<pcis->n_B;i++) {
763674ae819SStefano Zampini       ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
764674ae819SStefano Zampini     }
765984c4197SStefano Zampini 
766674ae819SStefano Zampini     /* Now we loop on the constraints which need a change of basis */
767674ae819SStefano Zampini     /* Change of basis matrix is evaluated as the FIRST APPROACH in */
768984c4197SStefano Zampini     /* Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1) */
769984c4197SStefano Zampini     /* Change of basis matrix T computed via QR decomposition of constraints */
770984c4197SStefano Zampini     if (qr_needed) {
771026de310SStefano Zampini       /* dual and primal dofs on a single cc */
772984c4197SStefano Zampini       PetscInt     dual_dofs,primal_dofs;
773026de310SStefano Zampini       /* iterator on aux_primal_minloc (ordered as read from nearnullspace: vertices, edges and then constraints) */
774026de310SStefano Zampini       PetscInt     primal_counter;
775984c4197SStefano Zampini       /* working stuff for GEQRF */
776984c4197SStefano Zampini       PetscScalar  *qr_basis,*qr_tau,*qr_work,lqr_work_t;
777984c4197SStefano Zampini       PetscBLASInt lqr_work;
778984c4197SStefano Zampini       /* working stuff for UNGQR */
779984c4197SStefano Zampini       PetscScalar  *gqr_work,lgqr_work_t;
780984c4197SStefano Zampini       PetscBLASInt lgqr_work;
781984c4197SStefano Zampini       /* working stuff for TRTRS */
782984c4197SStefano Zampini       PetscScalar  *trs_rhs;
783984c4197SStefano Zampini       /* pointers for values insertion into change of basis matrix */
784984c4197SStefano Zampini       PetscInt     *start_rows,*start_cols;
785984c4197SStefano Zampini       PetscScalar  *start_vals;
786984c4197SStefano Zampini       /* working stuff for values insertion */
787984c4197SStefano Zampini       PetscBool    *is_primal;
788984c4197SStefano Zampini 
789984c4197SStefano Zampini       /* space to store Q */
790984c4197SStefano Zampini       ierr = PetscMalloc((max_size_of_constraint)*(max_size_of_constraint)*sizeof(PetscScalar),&qr_basis);CHKERRQ(ierr);
791984c4197SStefano Zampini       /* first we issue queries for optimal work */
792984c4197SStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Bs);CHKERRQ(ierr);
793984c4197SStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Bt);CHKERRQ(ierr);
794984c4197SStefano Zampini       lqr_work = -1;
795984c4197SStefano Zampini       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Bs,&Bt,qr_basis,&Bs,qr_tau,&lqr_work_t,&lqr_work,&lierr));
796984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
797984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
798984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lqr_work_t)*sizeof(*qr_work),&qr_work);CHKERRQ(ierr);
799984c4197SStefano Zampini       lgqr_work = -1;
800984c4197SStefano Zampini       if (Bt>Bs) Bt=Bs; /* adjust Bt just for computing optimal work */
801984c4197SStefano Zampini       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Bs,&Bs,&Bt,qr_basis,&Bs,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
802984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
803984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
804984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lgqr_work_t)*sizeof(*gqr_work),&gqr_work);CHKERRQ(ierr);
805984c4197SStefano Zampini       /* array to store scaling factors for reflectors */
806984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*sizeof(*qr_tau),&qr_tau);CHKERRQ(ierr);
807984c4197SStefano Zampini       /* array to store rhs and solution of triangular solver */
808984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*max_constraints*sizeof(*trs_rhs),&trs_rhs);CHKERRQ(ierr);
809984c4197SStefano Zampini       /* array to store whether a node is primal or not */
810984c4197SStefano Zampini       ierr = PetscMalloc(pcis->n_B*sizeof(*is_primal),&is_primal);CHKERRQ(ierr);
811984c4197SStefano Zampini       ierr = PetscMemzero(is_primal,pcis->n_B*sizeof(*is_primal));CHKERRQ(ierr);
812984c4197SStefano Zampini       for (i=0;i<total_primal_vertices;i++) is_primal[local_to_B[aux_primal_numbering[i]]] = PETSC_TRUE;
813984c4197SStefano Zampini 
814984c4197SStefano Zampini       /* allocating workspace for check */
815984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
816984c4197SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
817984c4197SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
818984c4197SStefano Zampini         ierr = PetscMalloc(max_size_of_constraint*(max_constraints+max_size_of_constraint)*sizeof(*work),&work);CHKERRQ(ierr);
819674ae819SStefano Zampini       }
820984c4197SStefano Zampini 
821026de310SStefano Zampini       /* loop on constraints and see whether or not they need a change of basis */
822026de310SStefano Zampini       /* -> using implicit ordering contained in temp_indices data */
823026de310SStefano Zampini       total_counts = pcbddc->n_vertices;
824026de310SStefano Zampini       primal_counter = total_counts;
825026de310SStefano Zampini       while (total_counts<pcbddc->local_primal_size) {
826026de310SStefano Zampini         primal_dofs = 1;
827026de310SStefano Zampini         if (change_basis[total_counts]) {
828026de310SStefano Zampini           /* get all constraints with same support: if more then one constraint is present on the cc then surely indices are stored contiguosly */
829026de310SStefano Zampini           while (total_counts+primal_dofs < pcbddc->local_primal_size && temp_indices_to_constraint_B[temp_indices[total_counts]] == temp_indices_to_constraint_B[temp_indices[total_counts+primal_dofs]]) {
830026de310SStefano Zampini             primal_dofs++;
831674ae819SStefano Zampini           }
832984c4197SStefano Zampini           /* get constraint info */
833026de310SStefano Zampini           size_of_constraint = temp_indices[total_counts+1]-temp_indices[total_counts];
834984c4197SStefano Zampini           dual_dofs = size_of_constraint-primal_dofs;
835984c4197SStefano Zampini           /* get BLAS dims */
836984c4197SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Bs);CHKERRQ(ierr);
837984c4197SStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Bt);CHKERRQ(ierr);
838984c4197SStefano Zampini 
839984c4197SStefano Zampini           /* copy quadrature constraints for change of basis check */
840984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
841026de310SStefano Zampini             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d to %d need a change of basis (size %d)\n",total_counts,total_counts+primal_dofs,size_of_constraint);CHKERRQ(ierr);
842026de310SStefano Zampini             ierr = PetscMemcpy(work,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
843674ae819SStefano Zampini           }
844984c4197SStefano Zampini 
845984c4197SStefano Zampini           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
846026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
847984c4197SStefano Zampini 
848984c4197SStefano Zampini           /* compute QR decomposition of constraints */
849674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
850984c4197SStefano Zampini           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Bs,&Bt,qr_basis,&Bs,qr_tau,qr_work,&lqr_work,&lierr));
851984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
852674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
853984c4197SStefano Zampini 
854984c4197SStefano Zampini           /* explictly compute R^-T */
855984c4197SStefano Zampini           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
856984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
857984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
858984c4197SStefano Zampini           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Bt,&Bt,qr_basis,&Bs,trs_rhs,&Bt,&lierr));
859984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
860984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
861984c4197SStefano Zampini 
862984c4197SStefano Zampini           /* explcitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
863984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
864984c4197SStefano Zampini           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Bs,&Bs,&Bt,qr_basis,&Bs,qr_tau,gqr_work,&lgqr_work,&lierr));
865984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
866984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
867984c4197SStefano Zampini 
868984c4197SStefano Zampini           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
869984c4197SStefano Zampini              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
870984c4197SStefano Zampini              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
871984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
872026de310SStefano Zampini           PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&Bs,&Bt,&Bt,&one,qr_basis,&Bs,trs_rhs,&Bt,&zero,&temp_quadrature_constraint[temp_indices[total_counts]],&Bs));
873984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
874026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
875984c4197SStefano Zampini 
876984c4197SStefano Zampini           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
877026de310SStefano Zampini           start_rows = &temp_indices_to_constraint_B[temp_indices[total_counts]];
878984c4197SStefano Zampini           /* insert cols for primal dofs */
879984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) {
880984c4197SStefano Zampini             start_vals = &qr_basis[j*size_of_constraint];
881026de310SStefano Zampini             start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter+j]];
882984c4197SStefano Zampini             ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
883984c4197SStefano Zampini           }
884984c4197SStefano Zampini           /* insert cols for dual dofs */
885984c4197SStefano Zampini           for (j=0,k=0;j<dual_dofs;k++) {
886026de310SStefano Zampini             if (!is_primal[temp_indices_to_constraint_B[temp_indices[total_counts]+k]]) {
887984c4197SStefano Zampini               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
888026de310SStefano Zampini               start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+k];
889984c4197SStefano Zampini               ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
890984c4197SStefano Zampini               j++;
891674ae819SStefano Zampini             }
892674ae819SStefano Zampini           }
893984c4197SStefano Zampini 
894984c4197SStefano Zampini           /* check change of basis */
895984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
896984c4197SStefano Zampini             PetscInt   ii,jj;
897984c4197SStefano Zampini             PetscBool valid_qr=PETSC_TRUE;
898984c4197SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
899984c4197SStefano Zampini             PetscStackCallBLAS("BLASgemm",BLASgemm_("T","N",&Bt,&Bs,&Bs,&one,work,&Bs,qr_basis,&Bs,&zero,&work[size_of_constraint*primal_dofs],&Bt));
900984c4197SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
901984c4197SStefano Zampini             for (jj=0;jj<size_of_constraint;jj++) {
902984c4197SStefano Zampini               for (ii=0;ii<primal_dofs;ii++) {
903984c4197SStefano Zampini                 if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
904984c4197SStefano Zampini                 if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
905674ae819SStefano Zampini               }
906674ae819SStefano Zampini             }
907984c4197SStefano Zampini             if (!valid_qr) {
908984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
909984c4197SStefano Zampini               for (jj=0;jj<size_of_constraint;jj++) {
910984c4197SStefano Zampini                 for (ii=0;ii<primal_dofs;ii++) {
911984c4197SStefano Zampini                   if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
912984c4197SStefano Zampini                     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\tQr basis function %d is not orthogonal to constraint %d (%1.14e)!\n",jj,ii,PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]));
913674ae819SStefano Zampini                   }
914984c4197SStefano Zampini                   if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
915984c4197SStefano Zampini                     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\tQr basis function %d is not unitary w.r.t constraint %d (%1.14e)!\n",jj,ii,PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]));
916984c4197SStefano Zampini                   }
917984c4197SStefano Zampini                 }
918984c4197SStefano Zampini               }
919674ae819SStefano Zampini             } else {
920984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
921674ae819SStefano Zampini             }
922674ae819SStefano Zampini           }
923026de310SStefano Zampini           /* increment primal counter */
924026de310SStefano Zampini           primal_counter += primal_dofs;
925984c4197SStefano Zampini         } else {
926984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
927026de310SStefano Zampini             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d does not need a change of basis (size %d)\n",total_counts,temp_indices[total_counts+1]-temp_indices[total_counts]);CHKERRQ(ierr);
928674ae819SStefano Zampini           }
929674ae819SStefano Zampini         }
930026de310SStefano Zampini         /* increment constraint counter total_counts */
931026de310SStefano Zampini         total_counts += primal_dofs;
932674ae819SStefano Zampini       }
933984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
934984c4197SStefano Zampini         ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
935984c4197SStefano Zampini         ierr = PetscFree(work);CHKERRQ(ierr);
936984c4197SStefano Zampini       }
937984c4197SStefano Zampini       /* free workspace */
938984c4197SStefano Zampini       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
939984c4197SStefano Zampini       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
940984c4197SStefano Zampini       ierr = PetscFree(qr_work);CHKERRQ(ierr);
941984c4197SStefano Zampini       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
942984c4197SStefano Zampini       ierr = PetscFree(is_primal);CHKERRQ(ierr);
943984c4197SStefano Zampini       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
944674ae819SStefano Zampini     }
945674ae819SStefano Zampini     /* assembling */
946674ae819SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
947674ae819SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
948984c4197SStefano Zampini     /*
949984c4197SStefano Zampini     ierr = MatView(pcbddc->ChangeOfBasisMatrix,(PetscViewer)0);CHKERRQ(ierr);
950984c4197SStefano Zampini     */
951674ae819SStefano Zampini   }
952674ae819SStefano Zampini   /* free workspace no longer needed */
953984c4197SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
954984c4197SStefano Zampini   ierr = PetscFree(aux_primal_minloc);CHKERRQ(ierr);
955674ae819SStefano Zampini   ierr = PetscFree(temp_indices);CHKERRQ(ierr);
956674ae819SStefano Zampini   ierr = PetscFree(change_basis);CHKERRQ(ierr);
957674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr);
958674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
959674ae819SStefano Zampini   ierr = PetscFree(local_to_B);CHKERRQ(ierr);
960674ae819SStefano Zampini   ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr);
961674ae819SStefano Zampini   PetscFunctionReturn(0);
962674ae819SStefano Zampini }
963674ae819SStefano Zampini 
964674ae819SStefano Zampini #undef __FUNCT__
965674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
966674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
967674ae819SStefano Zampini {
968674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
969674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
970674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
971674ae819SStefano Zampini   PetscInt    bs,ierr,i,vertex_size;
972674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
973674ae819SStefano Zampini 
974674ae819SStefano Zampini   PetscFunctionBegin;
975674ae819SStefano Zampini   /* Init local Graph struct */
976674ae819SStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr);
977674ae819SStefano Zampini 
978575ad6abSStefano Zampini   /* Check validity of the csr graph passed in by the user */
979575ad6abSStefano Zampini   if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) {
980575ad6abSStefano Zampini     ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
981575ad6abSStefano Zampini   }
982674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
983674ae819SStefano Zampini   if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) {
984674ae819SStefano Zampini     Mat mat_adj;
985674ae819SStefano Zampini     const PetscInt *xadj,*adjncy;
986674ae819SStefano Zampini     PetscBool flg_row=PETSC_TRUE;
987674ae819SStefano Zampini 
988674ae819SStefano Zampini     ierr = MatConvert(matis->A,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr);
989674ae819SStefano Zampini     ierr = MatGetRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
990674ae819SStefano Zampini     if (!flg_row) {
991674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ called in %s\n",__FUNCT__);
992674ae819SStefano Zampini     }
993674ae819SStefano Zampini     ierr = PCBDDCSetLocalAdjacencyGraph(pc,i,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
994674ae819SStefano Zampini     ierr = MatRestoreRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
995674ae819SStefano Zampini     if (!flg_row) {
996674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__);
997674ae819SStefano Zampini     }
998674ae819SStefano Zampini     ierr = MatDestroy(&mat_adj);CHKERRQ(ierr);
999674ae819SStefano Zampini   }
1000674ae819SStefano Zampini 
1001674ae819SStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting */
1002674ae819SStefano Zampini   vertex_size = 1;
1003674ae819SStefano Zampini   if (!pcbddc->n_ISForDofs) {
1004674ae819SStefano Zampini     IS *custom_ISForDofs;
1005674ae819SStefano Zampini 
1006674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&bs);CHKERRQ(ierr);
1007674ae819SStefano Zampini     ierr = PetscMalloc(bs*sizeof(IS),&custom_ISForDofs);CHKERRQ(ierr);
1008674ae819SStefano Zampini     for (i=0;i<bs;i++) {
1009674ae819SStefano Zampini       ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n/bs,i,bs,&custom_ISForDofs[i]);CHKERRQ(ierr);
1010674ae819SStefano Zampini     }
1011674ae819SStefano Zampini     ierr = PCBDDCSetDofsSplitting(pc,bs,custom_ISForDofs);CHKERRQ(ierr);
1012674ae819SStefano Zampini     /* remove my references to IS objects */
1013674ae819SStefano Zampini     for (i=0;i<bs;i++) {
1014674ae819SStefano Zampini       ierr = ISDestroy(&custom_ISForDofs[i]);CHKERRQ(ierr);
1015674ae819SStefano Zampini     }
1016674ae819SStefano Zampini     ierr = PetscFree(custom_ISForDofs);CHKERRQ(ierr);
1017674ae819SStefano Zampini   } else { /* mat block size as vertex size (used for elasticity) */
1018674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
1019674ae819SStefano Zampini   }
1020674ae819SStefano Zampini 
1021674ae819SStefano Zampini   /* Setup of Graph */
1022674ae819SStefano Zampini   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundaries,pcbddc->DirichletBoundaries,pcbddc->n_ISForDofs,pcbddc->ISForDofs,pcbddc->user_primal_vertices);
1023674ae819SStefano Zampini 
1024674ae819SStefano Zampini   /* Graph's connected components analysis */
1025674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
1026674ae819SStefano Zampini 
1027674ae819SStefano Zampini   /* print some info to stdout */
1028674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
1029e49050b4SStefano Zampini     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer);
1030674ae819SStefano Zampini   }
1031674ae819SStefano Zampini   PetscFunctionReturn(0);
1032674ae819SStefano Zampini }
1033674ae819SStefano Zampini 
1034674ae819SStefano Zampini #undef __FUNCT__
1035674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx"
1036674ae819SStefano Zampini PetscErrorCode  PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt *vertices_idx[])
1037674ae819SStefano Zampini {
1038674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
1039674ae819SStefano Zampini   PetscInt       *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size;
1040674ae819SStefano Zampini   PetscErrorCode ierr;
1041674ae819SStefano Zampini 
1042674ae819SStefano Zampini   PetscFunctionBegin;
1043674ae819SStefano Zampini   n = 0;
1044674ae819SStefano Zampini   vertices = 0;
1045674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
1046674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr);
1047b120a5c6SStefano Zampini     for (i=0;i<local_primal_size;i++) {
1048b120a5c6SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
1049b120a5c6SStefano Zampini       if (size_of_constraint == 1) n++;
1050b120a5c6SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
1051b120a5c6SStefano Zampini     }
1052b120a5c6SStefano Zampini     ierr = PetscMalloc(n*sizeof(PetscInt),&vertices);CHKERRQ(ierr);
1053b120a5c6SStefano Zampini     n = 0;
1054674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
1055674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
1056674ae819SStefano Zampini       if (size_of_constraint == 1) {
1057674ae819SStefano Zampini         vertices[n++]=row_cmat_indices[0];
1058674ae819SStefano Zampini       }
1059674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
1060674ae819SStefano Zampini     }
1061674ae819SStefano Zampini   }
1062674ae819SStefano Zampini   *n_vertices = n;
1063674ae819SStefano Zampini   *vertices_idx = vertices;
1064674ae819SStefano Zampini   PetscFunctionReturn(0);
1065674ae819SStefano Zampini }
1066674ae819SStefano Zampini 
1067674ae819SStefano Zampini #undef __FUNCT__
1068674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx"
1069674ae819SStefano Zampini PetscErrorCode  PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt *constraints_idx[])
1070674ae819SStefano Zampini {
1071674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
1072674ae819SStefano Zampini   PetscInt       *constraints_index,*row_cmat_indices,*row_cmat_global_indices;
1073674ae819SStefano Zampini   PetscInt       n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc;
1074674ae819SStefano Zampini   PetscBool      *touched;
1075674ae819SStefano Zampini   PetscErrorCode ierr;
1076674ae819SStefano Zampini 
1077674ae819SStefano Zampini   PetscFunctionBegin;
1078674ae819SStefano Zampini   n = 0;
1079674ae819SStefano Zampini   constraints_index = 0;
1080674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
1081674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr);
1082674ae819SStefano Zampini     max_size_of_constraint = 0;
1083674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
1084674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
1085674ae819SStefano Zampini       if (size_of_constraint > 1) {
1086674ae819SStefano Zampini         n++;
1087674ae819SStefano Zampini       }
1088674ae819SStefano Zampini       max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint);
1089674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
1090674ae819SStefano Zampini     }
1091674ae819SStefano Zampini     ierr = PetscMalloc(n*sizeof(PetscInt),&constraints_index);CHKERRQ(ierr);
1092674ae819SStefano Zampini     ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&row_cmat_global_indices);CHKERRQ(ierr);
1093674ae819SStefano Zampini     ierr = PetscMalloc(local_size*sizeof(PetscBool),&touched);CHKERRQ(ierr);
1094674ae819SStefano Zampini     ierr = PetscMemzero(touched,local_size*sizeof(PetscBool));CHKERRQ(ierr);
1095674ae819SStefano Zampini     n = 0;
1096674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
1097674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
1098674ae819SStefano Zampini       if (size_of_constraint > 1) {
1099674ae819SStefano Zampini         ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr);
1100674ae819SStefano Zampini         min_index = row_cmat_global_indices[0];
1101674ae819SStefano Zampini         min_loc = 0;
1102674ae819SStefano Zampini         for (j=1;j<size_of_constraint;j++) {
1103674ae819SStefano Zampini           /* there can be more than one constraint on a single connected component */
1104674ae819SStefano Zampini           if (min_index > row_cmat_global_indices[j] && !touched[row_cmat_indices[j]]) {
1105674ae819SStefano Zampini             min_index = row_cmat_global_indices[j];
1106674ae819SStefano Zampini             min_loc = j;
1107674ae819SStefano Zampini           }
1108674ae819SStefano Zampini         }
1109674ae819SStefano Zampini         touched[row_cmat_indices[min_loc]] = PETSC_TRUE;
1110674ae819SStefano Zampini         constraints_index[n++] = row_cmat_indices[min_loc];
1111674ae819SStefano Zampini       }
1112674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
1113674ae819SStefano Zampini     }
1114674ae819SStefano Zampini   }
1115674ae819SStefano Zampini   ierr = PetscFree(touched);CHKERRQ(ierr);
1116674ae819SStefano Zampini   ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr);
1117674ae819SStefano Zampini   *n_constraints = n;
1118674ae819SStefano Zampini   *constraints_idx = constraints_index;
1119674ae819SStefano Zampini   PetscFunctionReturn(0);
1120674ae819SStefano Zampini }
1121674ae819SStefano Zampini 
1122674ae819SStefano Zampini /* the next two functions has been adapted from pcis.c */
1123674ae819SStefano Zampini #undef __FUNCT__
1124674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchur"
1125674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchur(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
1126674ae819SStefano Zampini {
1127674ae819SStefano Zampini   PetscErrorCode ierr;
1128674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
1129674ae819SStefano Zampini 
1130674ae819SStefano Zampini   PetscFunctionBegin;
1131674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
1132674ae819SStefano Zampini   ierr = MatMult(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
1133674ae819SStefano Zampini   ierr = MatMult(pcis->A_IB,v,vec1_D);CHKERRQ(ierr);
1134674ae819SStefano Zampini   ierr = KSPSolve(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
1135674ae819SStefano Zampini   ierr = MatMult(pcis->A_BI,vec2_D,vec2_B);CHKERRQ(ierr);
1136674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
1137674ae819SStefano Zampini   PetscFunctionReturn(0);
1138674ae819SStefano Zampini }
1139674ae819SStefano Zampini 
1140674ae819SStefano Zampini #undef __FUNCT__
1141674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchurTranspose"
1142674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchurTranspose(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
1143674ae819SStefano Zampini {
1144674ae819SStefano Zampini   PetscErrorCode ierr;
1145674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
1146674ae819SStefano Zampini 
1147674ae819SStefano Zampini   PetscFunctionBegin;
1148674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
1149674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
1150674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BI,v,vec1_D);CHKERRQ(ierr);
1151674ae819SStefano Zampini   ierr = KSPSolveTranspose(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
1152674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_IB,vec2_D,vec2_B);CHKERRQ(ierr);
1153674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
1154674ae819SStefano Zampini   PetscFunctionReturn(0);
1155674ae819SStefano Zampini }
1156674ae819SStefano Zampini 
1157674ae819SStefano Zampini #undef __FUNCT__
1158674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
1159674ae819SStefano 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[])
1160674ae819SStefano Zampini {
1161674ae819SStefano Zampini   Vec            local_vec,global_vec;
1162674ae819SStefano Zampini   IS             seqis,paris;
1163674ae819SStefano Zampini   VecScatter     scatter_ctx;
1164674ae819SStefano Zampini   PetscScalar    *array;
1165674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
1166674ae819SStefano Zampini   PetscScalar    globalsum;
1167674ae819SStefano Zampini   PetscInt       i,j,s;
1168674ae819SStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local;
1169674ae819SStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm,max_global;
1170674ae819SStefano Zampini   PetscMPIInt    *dof_sizes,*dof_displs;
1171674ae819SStefano Zampini   PetscBool      first_found;
1172674ae819SStefano Zampini   PetscErrorCode ierr;
1173674ae819SStefano Zampini 
1174674ae819SStefano Zampini   PetscFunctionBegin;
1175674ae819SStefano Zampini   /* mpi buffers */
1176674ae819SStefano Zampini   MPI_Comm_size(comm,&size_prec_comm);
1177674ae819SStefano Zampini   MPI_Comm_rank(comm,&rank_prec_comm);
1178674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
1179674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_sizes),&dof_sizes);CHKERRQ(ierr);
1180674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_displs),&dof_displs);CHKERRQ(ierr);
1181674ae819SStefano Zampini   /* get maximum size of subset */
1182674ae819SStefano Zampini   ierr = PetscMalloc(n_local_dofs*sizeof(PetscInt),&temp_global_dofs);CHKERRQ(ierr);
1183674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
1184674ae819SStefano Zampini   max_local = 0;
1185674ae819SStefano Zampini   if (n_local_dofs) {
1186674ae819SStefano Zampini     max_local = temp_global_dofs[0];
1187674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
1188674ae819SStefano Zampini       if (max_local < temp_global_dofs[i] ) {
1189674ae819SStefano Zampini         max_local = temp_global_dofs[i];
1190674ae819SStefano Zampini       }
1191674ae819SStefano Zampini     }
1192674ae819SStefano Zampini   }
1193674ae819SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);
1194674ae819SStefano Zampini   max_global++;
1195674ae819SStefano Zampini   max_local = 0;
1196674ae819SStefano Zampini   if (n_local_dofs) {
1197674ae819SStefano Zampini     max_local = local_dofs[0];
1198674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
1199674ae819SStefano Zampini       if (max_local < local_dofs[i] ) {
1200674ae819SStefano Zampini         max_local = local_dofs[i];
1201674ae819SStefano Zampini       }
1202674ae819SStefano Zampini     }
1203674ae819SStefano Zampini   }
1204674ae819SStefano Zampini   max_local++;
1205674ae819SStefano Zampini   /* allocate workspace */
1206674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
1207674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
1208674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
1209674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
1210674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
1211674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
1212674ae819SStefano Zampini   /* create scatter */
1213674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
1214674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
1215674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
1216674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
1217674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
1218674ae819SStefano Zampini   /* init array */
1219674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
1220674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
1221674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
1222674ae819SStefano Zampini   if (local_dofs_mult) {
1223674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
1224674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
1225674ae819SStefano Zampini     }
1226674ae819SStefano Zampini   } else {
1227674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
1228674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
1229674ae819SStefano Zampini     }
1230674ae819SStefano Zampini   }
1231674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
1232674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
1233674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1234674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1235674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
12365b08dc53SStefano Zampini   *n_global_subset = (PetscInt)PetscRealPart(globalsum);
1237674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
1238674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
1239674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
1240674ae819SStefano Zampini   nlocals = 0;
1241674ae819SStefano Zampini   first_index = -1;
1242674ae819SStefano Zampini   first_found = PETSC_FALSE;
1243674ae819SStefano Zampini   for (i=0;i<s;i++) {
12445b08dc53SStefano Zampini     if (!first_found && PetscRealPart(array[i]) > 0.0) {
1245674ae819SStefano Zampini       first_found = PETSC_TRUE;
1246674ae819SStefano Zampini       first_index = i;
1247674ae819SStefano Zampini     }
12485b08dc53SStefano Zampini     nlocals += (PetscInt)PetscRealPart(array[i]);
1249674ae819SStefano Zampini   }
1250674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
1251674ae819SStefano Zampini   if (!rank_prec_comm) {
1252674ae819SStefano Zampini     dof_displs[0]=0;
1253674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
1254674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
1255674ae819SStefano Zampini     }
1256674ae819SStefano Zampini   }
1257674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
1258674ae819SStefano Zampini   if (first_found) {
1259674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
1260674ae819SStefano Zampini     old_index = first_index;
1261674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
12625b08dc53SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) {
1263674ae819SStefano Zampini         array[i] += array[old_index];
1264674ae819SStefano Zampini         old_index = i;
1265674ae819SStefano Zampini       }
1266674ae819SStefano Zampini     }
1267674ae819SStefano Zampini   }
1268674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
1269674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
1270674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1271674ae819SStefano Zampini   ierr = VecScatterEnd  (scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1272674ae819SStefano Zampini   /* get global ordering of local dofs */
1273674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
1274674ae819SStefano Zampini   if (local_dofs_mult) {
1275674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
12765b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i];
1277674ae819SStefano Zampini     }
1278674ae819SStefano Zampini   } else {
1279674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
12805b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1;
1281674ae819SStefano Zampini     }
1282674ae819SStefano Zampini   }
1283674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
1284674ae819SStefano Zampini   /* free workspace */
1285674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
1286674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
1287674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
1288674ae819SStefano Zampini   ierr = PetscFree(dof_sizes);CHKERRQ(ierr);
1289674ae819SStefano Zampini   ierr = PetscFree(dof_displs);CHKERRQ(ierr);
1290674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
1291674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
1292674ae819SStefano Zampini   PetscFunctionReturn(0);
1293674ae819SStefano Zampini }
1294