xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 12edc857407aaf0aa7a6c094ef0e6aef4d7f191b)
1674ae819SStefano Zampini #include "bddc.h"
2674ae819SStefano Zampini #include "bddcprivate.h"
3674ae819SStefano Zampini #include <petscblaslapack.h>
4674ae819SStefano Zampini 
5674ae819SStefano Zampini #undef __FUNCT__
6c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpSolvers"
7c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpSolvers(PC pc)
8c8587f34SStefano Zampini {
9c8587f34SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
108629588bSStefano Zampini   PetscScalar    *coarse_submat_vals;
11c8587f34SStefano Zampini   PetscErrorCode ierr;
12c8587f34SStefano Zampini 
13c8587f34SStefano Zampini   PetscFunctionBegin;
14c8587f34SStefano Zampini   /* Compute matrix after change of basis and extract local submatrices */
15c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalMatrices(pc);CHKERRQ(ierr);
16c8587f34SStefano Zampini 
17f4ddd8eeSStefano Zampini   /* Setup local scatters R_to_B and (optionally) R_to_D */
18f4ddd8eeSStefano Zampini   /* PCBDDCSetUpLocalWorkVectors and PCBDDCSetUpLocalMatrices should be called first! */
19c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
20c8587f34SStefano Zampini 
21c8587f34SStefano Zampini   /* Setup local solvers ksp_D and ksp_R */
220fccc4e9SStefano Zampini   /* PCBDDCSetUpLocalScatters should be called first! */
23c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalSolvers(pc);CHKERRQ(ierr);
24c8587f34SStefano Zampini 
25c8587f34SStefano Zampini   /* Change global null space passed in by the user if change of basis has been requested */
26c8587f34SStefano Zampini   if (pcbddc->NullSpace && pcbddc->use_change_of_basis) {
27c8587f34SStefano Zampini     ierr = PCBDDCNullSpaceAdaptGlobal(pc);CHKERRQ(ierr);
28c8587f34SStefano Zampini   }
29c8587f34SStefano Zampini 
308629588bSStefano Zampini   /*
318629588bSStefano Zampini      Setup local correction and local part of coarse basis.
328629588bSStefano Zampini      Gives back the dense local part of the coarse matrix in column major ordering
338629588bSStefano Zampini   */
3447f4ddc3SStefano Zampini   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
358629588bSStefano Zampini 
368629588bSStefano Zampini   /* Compute total number of coarse nodes and setup coarse solver */
378629588bSStefano Zampini   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
388629588bSStefano Zampini 
398629588bSStefano Zampini   /* free */
408629588bSStefano Zampini   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
41c8587f34SStefano Zampini   PetscFunctionReturn(0);
42c8587f34SStefano Zampini }
43c8587f34SStefano Zampini 
44c8587f34SStefano Zampini #undef __FUNCT__
45674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetCustomization"
46674ae819SStefano Zampini PetscErrorCode PCBDDCResetCustomization(PC pc)
47674ae819SStefano Zampini {
48674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
49674ae819SStefano Zampini   PetscErrorCode ierr;
50674ae819SStefano Zampini 
51674ae819SStefano Zampini   PetscFunctionBegin;
52674ae819SStefano Zampini   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
53674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
54674ae819SStefano Zampini   ierr = MatNullSpaceDestroy(&pcbddc->NullSpace);CHKERRQ(ierr);
55674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
56785d1243SStefano Zampini   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
57674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
58f4ddd8eeSStefano Zampini   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
59f4ddd8eeSStefano Zampini   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
60785d1243SStefano Zampini   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
6163602bcaSStefano Zampini   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
6263602bcaSStefano Zampini   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
63674ae819SStefano Zampini   PetscFunctionReturn(0);
64674ae819SStefano Zampini }
65674ae819SStefano Zampini 
66674ae819SStefano Zampini #undef __FUNCT__
67674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetTopography"
68674ae819SStefano Zampini PetscErrorCode PCBDDCResetTopography(PC pc)
69674ae819SStefano Zampini {
70674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
71674ae819SStefano Zampini   PetscErrorCode ierr;
72674ae819SStefano Zampini 
73674ae819SStefano Zampini   PetscFunctionBegin;
74674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
75674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
76674ae819SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
77674ae819SStefano Zampini   PetscFunctionReturn(0);
78674ae819SStefano Zampini }
79674ae819SStefano Zampini 
80674ae819SStefano Zampini #undef __FUNCT__
81674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetSolvers"
82674ae819SStefano Zampini PetscErrorCode PCBDDCResetSolvers(PC pc)
83674ae819SStefano Zampini {
84674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
85674ae819SStefano Zampini   PetscErrorCode ierr;
86674ae819SStefano Zampini 
87674ae819SStefano Zampini   PetscFunctionBegin;
88674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
89674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_rhs);CHKERRQ(ierr);
90674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
91674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
9215aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
9315aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
94674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
95674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
96674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
97674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
98674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
99674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
1008ce42a96SStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
101674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
102674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
103674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
104f4ddd8eeSStefano Zampini   ierr = KSPDestroy(&pcbddc->ksp_D);CHKERRQ(ierr);
105f4ddd8eeSStefano Zampini   ierr = KSPDestroy(&pcbddc->ksp_R);CHKERRQ(ierr);
106f4ddd8eeSStefano Zampini   ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
107f4ddd8eeSStefano Zampini   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
108727cdba6SStefano Zampini   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
109f4ddd8eeSStefano Zampini   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
11070cf5478SStefano Zampini   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
111674ae819SStefano Zampini   PetscFunctionReturn(0);
112674ae819SStefano Zampini }
113674ae819SStefano Zampini 
114674ae819SStefano Zampini #undef __FUNCT__
115f4ddd8eeSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalWorkVectors"
116f4ddd8eeSStefano Zampini PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
1176bfb1811SStefano Zampini {
1186bfb1811SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1196bfb1811SStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
1206bfb1811SStefano Zampini   VecType        impVecType;
121e9189074SStefano Zampini   PetscInt       n_constraints,n_R,old_size;
1226bfb1811SStefano Zampini   PetscErrorCode ierr;
1236bfb1811SStefano Zampini 
1246bfb1811SStefano Zampini   PetscFunctionBegin;
125f4ddd8eeSStefano Zampini   if (!pcbddc->ConstraintMatrix) {
126f4ddd8eeSStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Constraint matrix has not been created");
127f4ddd8eeSStefano Zampini   }
128e7b262bdSStefano Zampini   /* get sizes */
129e9189074SStefano Zampini   n_constraints = pcbddc->local_primal_size - pcbddc->n_actual_vertices;
130e9189074SStefano Zampini   n_R = pcis->n-pcbddc->n_actual_vertices;
1316bfb1811SStefano Zampini   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
132e7b262bdSStefano Zampini   /* local work vectors (try to avoid unneeded work)*/
133e7b262bdSStefano Zampini   /* R nodes */
134e7b262bdSStefano Zampini   old_size = -1;
135e7b262bdSStefano Zampini   if (pcbddc->vec1_R) {
136e7b262bdSStefano Zampini     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
137e7b262bdSStefano Zampini   }
138e7b262bdSStefano Zampini   if (n_R != old_size) {
139e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
140e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
1416bfb1811SStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
1426bfb1811SStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
1436bfb1811SStefano Zampini     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
1446bfb1811SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
145e7b262bdSStefano Zampini   }
146e7b262bdSStefano Zampini   /* local primal dofs */
147e7b262bdSStefano Zampini   old_size = -1;
148e7b262bdSStefano Zampini   if (pcbddc->vec1_P) {
149e7b262bdSStefano Zampini     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
150e7b262bdSStefano Zampini   }
151e9189074SStefano Zampini   if (pcbddc->local_primal_size != old_size) {
152e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
15383b7ccabSStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
154e9189074SStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
1556bfb1811SStefano Zampini     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
156e7b262bdSStefano Zampini   }
157e7b262bdSStefano Zampini   /* local explicit constraints */
158e7b262bdSStefano Zampini   old_size = -1;
159e7b262bdSStefano Zampini   if (pcbddc->vec1_C) {
160e7b262bdSStefano Zampini     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
161e7b262bdSStefano Zampini   }
162e7b262bdSStefano Zampini   if (n_constraints && n_constraints != old_size) {
163e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
16483b7ccabSStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
16583b7ccabSStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
16683b7ccabSStefano Zampini     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
16783b7ccabSStefano Zampini   }
1686bfb1811SStefano Zampini   PetscFunctionReturn(0);
1696bfb1811SStefano Zampini }
1706bfb1811SStefano Zampini 
1716bfb1811SStefano Zampini #undef __FUNCT__
17247f4ddc3SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCorrection"
17347f4ddc3SStefano Zampini PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
17488ebb749SStefano Zampini {
17525084f0cSStefano Zampini   PetscErrorCode         ierr;
17625084f0cSStefano Zampini   /* pointers to pcis and pcbddc */
17788ebb749SStefano Zampini   PC_IS*                 pcis = (PC_IS*)pc->data;
17888ebb749SStefano Zampini   PC_BDDC*               pcbddc = (PC_BDDC*)pc->data;
17925084f0cSStefano Zampini   /* submatrices of local problem */
18088ebb749SStefano Zampini   Mat                    A_RV,A_VR,A_VV;
18125084f0cSStefano Zampini   /* working matrices */
18225084f0cSStefano Zampini   Mat                    M1,M2,M3,C_CR;
18325084f0cSStefano Zampini   /* working vectors */
18425084f0cSStefano Zampini   Vec                    vec1_C,vec2_C,vec1_V,vec2_V;
18525084f0cSStefano Zampini   /* additional working stuff */
18625084f0cSStefano Zampini   IS                     is_aux;
18725084f0cSStefano Zampini   PetscScalar            *coarse_submat_vals; /* TODO: use a PETSc matrix */
18825084f0cSStefano Zampini   const PetscScalar      *array,*row_cmat_values;
18925084f0cSStefano Zampini   const PetscInt         *row_cmat_indices,*idx_R_local;
190e9189074SStefano Zampini   PetscInt               *idx_V_B,*auxindices;
19125084f0cSStefano Zampini   PetscInt               n_vertices,n_constraints,size_of_constraint;
19225084f0cSStefano Zampini   PetscInt               i,j,n_R,n_D,n_B;
193c0553b1fSStefano Zampini   PetscBool              setsym=PETSC_FALSE,issym=PETSC_FALSE,unsymmetric_check;
19445a1bb75SStefano Zampini   /* matrix type (vector type propagated downstream from vec1_C and local matrix type) */
19588ebb749SStefano Zampini   MatType                impMatType;
19625084f0cSStefano Zampini   /* some shortcuts to scalars */
19725084f0cSStefano Zampini   PetscScalar            zero=0.0,one=1.0,m_one=-1.0;
19825084f0cSStefano Zampini   /* for debugging purposes */
19988ebb749SStefano Zampini   PetscReal              *coarsefunctions_errors,*constraints_errors;
20088ebb749SStefano Zampini 
20188ebb749SStefano Zampini   PetscFunctionBegin;
202e9189074SStefano Zampini   /* get number of vertices (corners plus constraints with change of basis)
203e9189074SStefano Zampini      pcbddc->n_actual_vertices stores the actual number of vertices, pcbddc->n_vertices the number of corners computed */
204e9189074SStefano Zampini   n_vertices = pcbddc->n_actual_vertices;
20588ebb749SStefano Zampini   n_constraints = pcbddc->local_primal_size-n_vertices;
20688ebb749SStefano Zampini   /* Set Non-overlapping dimensions */
20788ebb749SStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
20888ebb749SStefano Zampini   n_R = pcis->n-n_vertices;
20988ebb749SStefano Zampini 
21088ebb749SStefano Zampini   /* Set types for local objects needed by BDDC precondtioner */
21188ebb749SStefano Zampini   impMatType = MATSEQDENSE;
21288ebb749SStefano Zampini 
21388ebb749SStefano Zampini   /* Allocating some extra storage just to be safe */
21488ebb749SStefano Zampini   ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&auxindices);CHKERRQ(ierr);
21588ebb749SStefano Zampini   for (i=0;i<pcis->n;i++) auxindices[i]=i;
21688ebb749SStefano Zampini 
21788ebb749SStefano Zampini   /* vertices in boundary numbering */
21888ebb749SStefano Zampini   ierr = PetscMalloc(n_vertices*sizeof(PetscInt),&idx_V_B);CHKERRQ(ierr);
219e9189074SStefano Zampini   ierr = ISGlobalToLocalMappingApply(pcbddc->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->primal_indices_local_idxs,&i,idx_V_B);CHKERRQ(ierr);
22088ebb749SStefano Zampini   if (i != n_vertices) {
22122d5777bSStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %d != %d\n",n_vertices,i);
22288ebb749SStefano Zampini   }
22388ebb749SStefano Zampini 
22488ebb749SStefano Zampini   /* Precompute stuffs needed for preprocessing and application of BDDC*/
22588ebb749SStefano Zampini   if (n_constraints) {
226f4ddd8eeSStefano Zampini     /* see if we can save some allocations */
227f4ddd8eeSStefano Zampini     if (pcbddc->local_auxmat2) {
228f4ddd8eeSStefano Zampini       PetscInt on_R,on_constraints;
229f4ddd8eeSStefano Zampini       ierr = MatGetSize(pcbddc->local_auxmat2,&on_R,&on_constraints);CHKERRQ(ierr);
230f4ddd8eeSStefano Zampini       if (on_R != n_R || on_constraints != n_constraints) {
231f4ddd8eeSStefano Zampini         ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
232f4ddd8eeSStefano Zampini         ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
233f4ddd8eeSStefano Zampini       }
234f4ddd8eeSStefano Zampini     }
23545a1bb75SStefano Zampini     /* work vectors */
23645a1bb75SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec1_C);CHKERRQ(ierr);
23745a1bb75SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec2_C);CHKERRQ(ierr);
23845a1bb75SStefano Zampini     /* auxiliary matrices */
239f4ddd8eeSStefano Zampini     if (!pcbddc->local_auxmat2) {
24088ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->local_auxmat2);CHKERRQ(ierr);
24125084f0cSStefano Zampini       ierr = MatSetSizes(pcbddc->local_auxmat2,n_R,n_constraints,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
24288ebb749SStefano Zampini       ierr = MatSetType(pcbddc->local_auxmat2,impMatType);CHKERRQ(ierr);
24325084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->local_auxmat2);CHKERRQ(ierr);
244f4ddd8eeSStefano Zampini     }
24588ebb749SStefano Zampini 
24625084f0cSStefano Zampini     /* Extract constraints on R nodes: C_{CR}  */
24725084f0cSStefano Zampini     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
2488ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
24925084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
25088ebb749SStefano Zampini 
25188ebb749SStefano Zampini     /* Assemble local_auxmat2 = - A_{RR}^{-1} C^T_{CR} needed by BDDC application */
25288ebb749SStefano Zampini     for (i=0;i<n_constraints;i++) {
25388ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
25488ebb749SStefano Zampini       /* Get row of constraint matrix in R numbering */
25525084f0cSStefano Zampini       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
25625084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_R,size_of_constraint,row_cmat_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
25725084f0cSStefano Zampini       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
25825084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_R);CHKERRQ(ierr);
25925084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_R);CHKERRQ(ierr);
26088ebb749SStefano Zampini       /* Solve for row of constraint matrix in R numbering */
26188ebb749SStefano Zampini       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
26225084f0cSStefano Zampini       /* Set values in local_auxmat2 */
26325084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
26488ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->local_auxmat2,n_R,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
26525084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
26688ebb749SStefano Zampini     }
26788ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
26888ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
26925084f0cSStefano Zampini     ierr = MatScale(pcbddc->local_auxmat2,m_one);CHKERRQ(ierr);
27088ebb749SStefano Zampini 
27188ebb749SStefano Zampini     /* Assemble explicitly M1 = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1} needed in preproc  */
27225084f0cSStefano Zampini     ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
27325084f0cSStefano Zampini     ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
27488ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&M1);CHKERRQ(ierr);
27588ebb749SStefano Zampini     ierr = MatSetSizes(M1,n_constraints,n_constraints,n_constraints,n_constraints);CHKERRQ(ierr);
27688ebb749SStefano Zampini     ierr = MatSetType(M1,impMatType);CHKERRQ(ierr);
27725084f0cSStefano Zampini     ierr = MatSetUp(M1);CHKERRQ(ierr);
27825084f0cSStefano Zampini     ierr = MatDuplicate(M1,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
27925084f0cSStefano Zampini     ierr = MatZeroEntries(M2);CHKERRQ(ierr);
28025084f0cSStefano Zampini     ierr = VecSet(vec1_C,m_one);CHKERRQ(ierr);
28125084f0cSStefano Zampini     ierr = MatDiagonalSet(M2,vec1_C,INSERT_VALUES);CHKERRQ(ierr);
28225084f0cSStefano Zampini     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
28325084f0cSStefano Zampini     ierr = MatDestroy(&M2);CHKERRQ(ierr);
28425084f0cSStefano Zampini     ierr = MatDestroy(&M3);CHKERRQ(ierr);
28588ebb749SStefano Zampini     /* Assemble local_auxmat1 = M1*C_{CR} needed by BDDC application in KSP and in preproc */
286f4ddd8eeSStefano Zampini     if (!pcbddc->local_auxmat1) {
28788ebb749SStefano Zampini       ierr = MatMatMult(M1,C_CR,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
288f4ddd8eeSStefano Zampini     } else {
289f4ddd8eeSStefano Zampini       ierr = MatMatMult(M1,C_CR,MAT_REUSE_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
290f4ddd8eeSStefano Zampini     }
29188ebb749SStefano Zampini   }
29288ebb749SStefano Zampini 
29388ebb749SStefano Zampini   /* Get submatrices from subdomain matrix */
29488ebb749SStefano Zampini   if (n_vertices) {
2953a50541eSStefano Zampini     PetscInt ibs,mbs;
2963a50541eSStefano Zampini     PetscBool issbaij;
297af732b37SStefano Zampini     Mat newmat;
2983a50541eSStefano Zampini 
2993a50541eSStefano Zampini     ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
3009577ea80SStefano Zampini     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
3019577ea80SStefano Zampini     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
3023a50541eSStefano Zampini     if (ibs != mbs) { /* need to convert to SEQAIJ */
3039577ea80SStefano Zampini       ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
3049577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3059577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3069577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3079577ea80SStefano Zampini       ierr = MatDestroy(&newmat);CHKERRQ(ierr);
3089577ea80SStefano Zampini     } else {
3093a50541eSStefano Zampini       /* this is safe */
3109577ea80SStefano Zampini       ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3113a50541eSStefano Zampini       ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
3123a50541eSStefano Zampini       if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
3133a50541eSStefano Zampini         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
31445a1bb75SStefano Zampini         /* which of the two approaches is faster? */
3153a50541eSStefano Zampini         /* ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3163a50541eSStefano Zampini         ierr = MatCreateTranspose(A_RV,&A_VR);CHKERRQ(ierr);*/
3173a50541eSStefano Zampini         ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3183a50541eSStefano Zampini         ierr = MatCreateTranspose(A_VR,&A_RV);CHKERRQ(ierr);
3193a50541eSStefano Zampini         ierr = MatDestroy(&newmat);CHKERRQ(ierr);
3203a50541eSStefano Zampini       } else {
3219577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3229577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3239577ea80SStefano Zampini       }
3243a50541eSStefano Zampini     }
32545a1bb75SStefano Zampini     ierr = MatGetVecs(A_RV,&vec1_V,NULL);CHKERRQ(ierr);
32645a1bb75SStefano Zampini     ierr = VecDuplicate(vec1_V,&vec2_V);CHKERRQ(ierr);
32725084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
32888ebb749SStefano Zampini   }
32988ebb749SStefano Zampini 
33088ebb749SStefano Zampini   /* Matrix of coarse basis functions (local) */
331f4ddd8eeSStefano Zampini   if (pcbddc->coarse_phi_B) {
332f4ddd8eeSStefano Zampini     PetscInt on_B,on_primal;
333f4ddd8eeSStefano Zampini     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
334f4ddd8eeSStefano Zampini     if (on_B != n_B || on_primal != pcbddc->local_primal_size) {
335f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
336f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
337f4ddd8eeSStefano Zampini     }
338f4ddd8eeSStefano Zampini   }
339f4ddd8eeSStefano Zampini   if (pcbddc->coarse_phi_D) {
340f4ddd8eeSStefano Zampini     PetscInt on_D,on_primal;
341f4ddd8eeSStefano Zampini     ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,&on_primal);CHKERRQ(ierr);
342f4ddd8eeSStefano Zampini     if (on_D != n_D || on_primal != pcbddc->local_primal_size) {
343f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
344f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
345f4ddd8eeSStefano Zampini     }
346f4ddd8eeSStefano Zampini   }
347f4ddd8eeSStefano Zampini   if (!pcbddc->coarse_phi_B) {
34888ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
34988ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_phi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
35088ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_phi_B,impMatType);CHKERRQ(ierr);
35125084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_phi_B);CHKERRQ(ierr);
352f4ddd8eeSStefano Zampini   }
353f4ddd8eeSStefano Zampini   if ( (pcbddc->switch_static || pcbddc->dbg_flag) && !pcbddc->coarse_phi_D ) {
35488ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
35588ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_phi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
35688ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_phi_D,impMatType);CHKERRQ(ierr);
35725084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_phi_D);CHKERRQ(ierr);
35888ebb749SStefano Zampini   }
35988ebb749SStefano Zampini 
36025084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
3618ce42a96SStefano Zampini     ierr = ISGetIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
36288ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*coarsefunctions_errors),&coarsefunctions_errors);CHKERRQ(ierr);
36388ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*constraints_errors),&constraints_errors);CHKERRQ(ierr);
36488ebb749SStefano Zampini   }
36588ebb749SStefano Zampini   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
36688ebb749SStefano Zampini   ierr = PetscMalloc((pcbddc->local_primal_size)*(pcbddc->local_primal_size)*sizeof(PetscScalar),&coarse_submat_vals);CHKERRQ(ierr);
36788ebb749SStefano Zampini 
36888ebb749SStefano Zampini   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
36925084f0cSStefano Zampini 
37025084f0cSStefano Zampini   /* vertices */
37188ebb749SStefano Zampini   for (i=0;i<n_vertices;i++) {
37245a1bb75SStefano Zampini     /* this should not be needed, but MatMult_BAIJ is broken when using compressed row routines */
373f4ddd8eeSStefano Zampini     ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr); /* TODO: REMOVE IT */
37488ebb749SStefano Zampini     ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
37588ebb749SStefano Zampini     ierr = VecSetValue(vec1_V,i,one,INSERT_VALUES);CHKERRQ(ierr);
37688ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
37788ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
37825084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on constraints multipliers */
37988ebb749SStefano Zampini     ierr = MatMult(A_RV,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
38088ebb749SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
38188ebb749SStefano Zampini     ierr = VecScale(pcbddc->vec1_R,m_one);CHKERRQ(ierr);
38288ebb749SStefano Zampini     if (n_constraints) {
38388ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec1_R,vec1_C);CHKERRQ(ierr);
38488ebb749SStefano Zampini       ierr = MatMultAdd(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
38588ebb749SStefano Zampini       ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
38688ebb749SStefano Zampini     }
38788ebb749SStefano Zampini     ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
38888ebb749SStefano Zampini     ierr = MatMultAdd(A_VV,vec1_V,vec2_V,vec2_V);CHKERRQ(ierr);
38988ebb749SStefano Zampini 
39088ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
39188ebb749SStefano Zampini     /* coarse basis functions */
39288ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
39388ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
39488ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
39525084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
39688ebb749SStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
39725084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
39888ebb749SStefano Zampini     ierr = MatSetValue(pcbddc->coarse_phi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
3998eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
40088ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40188ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40225084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
40388ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
40425084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
40588ebb749SStefano Zampini     }
40625084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
40725084f0cSStefano Zampini     ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
40825084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
40925084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
41088ebb749SStefano Zampini     if (n_constraints) {
41125084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
41225084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
41325084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
41488ebb749SStefano Zampini     }
41588ebb749SStefano Zampini 
41625084f0cSStefano Zampini     /* check */
41725084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
41825084f0cSStefano Zampini       /* assemble subdomain vector on local nodes */
41988ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
42025084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
42125084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
42225084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
423e9189074SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],one,INSERT_VALUES);CHKERRQ(ierr);
42425084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
42525084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
42688ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers (i.e. primal nodes) */
42788ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
42825084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
42925084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
43025084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
43188ebb749SStefano Zampini       if (n_constraints) {
43225084f0cSStefano Zampini         ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
43325084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
43425084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
43588ebb749SStefano Zampini       }
43625084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
43725084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
43888ebb749SStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
43988ebb749SStefano Zampini       /* check saddle point solution */
44088ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
44188ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
44288ebb749SStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i]);CHKERRQ(ierr);
44388ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
44425084f0cSStefano Zampini       /* shift by the identity matrix */
44525084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
44625084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
44725084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
44888ebb749SStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i]);CHKERRQ(ierr);
44988ebb749SStefano Zampini     }
45088ebb749SStefano Zampini   }
45188ebb749SStefano Zampini 
45225084f0cSStefano Zampini   /* constraints */
45388ebb749SStefano Zampini   for (i=0;i<n_constraints;i++) {
45488ebb749SStefano Zampini     ierr = VecSet(vec2_C,zero);CHKERRQ(ierr);
45588ebb749SStefano Zampini     ierr = VecSetValue(vec2_C,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
45688ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec2_C);CHKERRQ(ierr);
45788ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec2_C);CHKERRQ(ierr);
45825084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on vertices multipliers */
45988ebb749SStefano Zampini     ierr = MatMult(M1,vec2_C,vec1_C);CHKERRQ(ierr);
46088ebb749SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
46188ebb749SStefano Zampini     ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
46225084f0cSStefano Zampini     if (n_vertices) {
46325084f0cSStefano Zampini       ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
46425084f0cSStefano Zampini     }
46588ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
46688ebb749SStefano Zampini     /* coarse basis functions */
46725084f0cSStefano Zampini     j = i+n_vertices; /* don't touch this! */
46888ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
46988ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
47088ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
47125084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
47225084f0cSStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
47325084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
4748eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
47588ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
47688ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
47725084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
47825084f0cSStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
47925084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
48088ebb749SStefano Zampini     }
48125084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
48288ebb749SStefano Zampini     if (n_vertices) {
48325084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
48425084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
48525084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
48688ebb749SStefano Zampini     }
48725084f0cSStefano Zampini     ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
48825084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
48925084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
49088ebb749SStefano Zampini 
49125084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
49288ebb749SStefano Zampini       /* assemble subdomain vector on nodes */
49388ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
49425084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
49525084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
49625084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
49725084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
49825084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
49988ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers */
50088ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
50188ebb749SStefano Zampini       if (n_vertices) {
50225084f0cSStefano Zampini         ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
50325084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
50425084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
50588ebb749SStefano Zampini       }
50625084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
50725084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
50825084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
50925084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
51025084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
51125084f0cSStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
51288ebb749SStefano Zampini       /* check saddle point solution */
51388ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
51488ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
51525084f0cSStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[j]);CHKERRQ(ierr);
51688ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
51725084f0cSStefano Zampini       /* shift by the identity matrix */
51825084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,j,m_one,ADD_VALUES);CHKERRQ(ierr);
51925084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
52025084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
52125084f0cSStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[j]);CHKERRQ(ierr);
52288ebb749SStefano Zampini     }
52388ebb749SStefano Zampini   }
52425084f0cSStefano Zampini   /* call assembling routines for local coarse basis */
52588ebb749SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
52688ebb749SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5278eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
52888ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
52988ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
53088ebb749SStefano Zampini   }
53125084f0cSStefano Zampini 
53288ebb749SStefano Zampini   /* compute other basis functions for non-symmetric problems */
53388ebb749SStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
53488ebb749SStefano Zampini   if (!setsym || (setsym && !issym)) {
535f4ddd8eeSStefano Zampini     if (!pcbddc->coarse_psi_B) {
53688ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
53788ebb749SStefano Zampini       ierr = MatSetSizes(pcbddc->coarse_psi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
53888ebb749SStefano Zampini       ierr = MatSetType(pcbddc->coarse_psi_B,impMatType);CHKERRQ(ierr);
53925084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->coarse_psi_B);CHKERRQ(ierr);
540f4ddd8eeSStefano Zampini     }
541f4ddd8eeSStefano Zampini     if ( (pcbddc->switch_static || pcbddc->dbg_flag) && !pcbddc->coarse_psi_D) {
54288ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
54388ebb749SStefano Zampini       ierr = MatSetSizes(pcbddc->coarse_psi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
54488ebb749SStefano Zampini       ierr = MatSetType(pcbddc->coarse_psi_D,impMatType);CHKERRQ(ierr);
54525084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->coarse_psi_D);CHKERRQ(ierr);
54688ebb749SStefano Zampini     }
54788ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
54888ebb749SStefano Zampini       if (n_constraints) {
54988ebb749SStefano Zampini         ierr = VecSet(vec1_C,zero);CHKERRQ(ierr);
55088ebb749SStefano Zampini         for (j=0;j<n_constraints;j++) {
55125084f0cSStefano Zampini           ierr = VecSetValue(vec1_C,j,coarse_submat_vals[(j+n_vertices)*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
55288ebb749SStefano Zampini         }
55325084f0cSStefano Zampini         ierr = VecAssemblyBegin(vec1_C);CHKERRQ(ierr);
55425084f0cSStefano Zampini         ierr = VecAssemblyEnd(vec1_C);CHKERRQ(ierr);
55588ebb749SStefano Zampini       }
55688ebb749SStefano Zampini       if (i<n_vertices) {
55788ebb749SStefano Zampini         ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
55888ebb749SStefano Zampini         ierr = VecSetValue(vec1_V,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
55988ebb749SStefano Zampini         ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
56088ebb749SStefano Zampini         ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
56188ebb749SStefano Zampini         ierr = MatMultTranspose(A_VR,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
56288ebb749SStefano Zampini         if (n_constraints) {
56388ebb749SStefano Zampini           ierr = MatMultTransposeAdd(C_CR,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
56488ebb749SStefano Zampini         }
56588ebb749SStefano Zampini       } else {
56688ebb749SStefano Zampini         ierr = MatMultTranspose(C_CR,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
56788ebb749SStefano Zampini       }
56888ebb749SStefano Zampini       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
56988ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
57088ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
57188ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
57225084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
57388ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_psi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
57425084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
57588ebb749SStefano Zampini       if (i<n_vertices) {
57688ebb749SStefano Zampini         ierr = MatSetValue(pcbddc->coarse_psi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
57788ebb749SStefano Zampini       }
5788eeda7d8SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
57988ebb749SStefano Zampini         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
58088ebb749SStefano Zampini         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
58125084f0cSStefano Zampini         ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
58288ebb749SStefano Zampini         ierr = MatSetValues(pcbddc->coarse_psi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
58325084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
58488ebb749SStefano Zampini       }
58588ebb749SStefano Zampini 
58625084f0cSStefano Zampini       if (pcbddc->dbg_flag) {
58788ebb749SStefano Zampini         /* assemble subdomain vector on nodes */
58888ebb749SStefano Zampini         ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
58925084f0cSStefano Zampini         ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
59025084f0cSStefano Zampini         ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
59125084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
59225084f0cSStefano Zampini         if (i<n_vertices) {
593e9189074SStefano Zampini           ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],one,INSERT_VALUES);CHKERRQ(ierr);
59488ebb749SStefano Zampini         }
59525084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
59625084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
59725084f0cSStefano Zampini         /* assemble subdomain vector of lagrange multipliers */
59825084f0cSStefano Zampini         for (j=0;j<pcbddc->local_primal_size;j++) {
59925084f0cSStefano Zampini           ierr = VecSetValue(pcbddc->vec1_P,j,-coarse_submat_vals[j*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
60025084f0cSStefano Zampini         }
60125084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
60225084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
60388ebb749SStefano Zampini         /* check saddle point solution */
60488ebb749SStefano Zampini         ierr = MatMultTranspose(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
60588ebb749SStefano Zampini         ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
60688ebb749SStefano Zampini         ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
60788ebb749SStefano Zampini         ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
60825084f0cSStefano Zampini         /* shift by the identity matrix */
60925084f0cSStefano Zampini         ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
61025084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
61125084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
61288ebb749SStefano Zampini         ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
61388ebb749SStefano Zampini       }
61488ebb749SStefano Zampini     }
61588ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
61688ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6178eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
61888ebb749SStefano Zampini       ierr = MatAssemblyBegin(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
61988ebb749SStefano Zampini       ierr = MatAssemblyEnd(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
62088ebb749SStefano Zampini     }
621c0553b1fSStefano Zampini     unsymmetric_check = PETSC_TRUE;
622c0553b1fSStefano Zampini   } else { /* take references to already computed coarse basis */
623c0553b1fSStefano Zampini     unsymmetric_check = PETSC_FALSE;
624c0553b1fSStefano Zampini     ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
625c0553b1fSStefano Zampini     pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
626c0553b1fSStefano Zampini     if (pcbddc->coarse_phi_D) {
627c0553b1fSStefano Zampini       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
628c0553b1fSStefano Zampini       pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
629c0553b1fSStefano Zampini     }
63088ebb749SStefano Zampini   }
63188ebb749SStefano Zampini   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
63288ebb749SStefano Zampini   /* Checking coarse_sub_mat and coarse basis functios */
63388ebb749SStefano Zampini   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
63488ebb749SStefano Zampini   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
63525084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
63688ebb749SStefano Zampini     Mat         coarse_sub_mat;
63725084f0cSStefano Zampini     Mat         AUXMAT,TM1,TM2,TM3,TM4;
63888ebb749SStefano Zampini     Mat         coarse_phi_D,coarse_phi_B;
63988ebb749SStefano Zampini     Mat         coarse_psi_D,coarse_psi_B;
64088ebb749SStefano Zampini     Mat         A_II,A_BB,A_IB,A_BI;
64188ebb749SStefano Zampini     MatType     checkmattype=MATSEQAIJ;
64288ebb749SStefano Zampini     PetscReal   real_value;
64388ebb749SStefano Zampini 
64488ebb749SStefano Zampini     ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
64588ebb749SStefano Zampini     ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
64688ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
64788ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
64888ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
64988ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
650c0553b1fSStefano Zampini     if (unsymmetric_check) {
65188ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
65288ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
65388ebb749SStefano Zampini     }
65488ebb749SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
65588ebb749SStefano Zampini 
65625084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
65725084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat and local basis functions\n");CHKERRQ(ierr);
65825084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
659c0553b1fSStefano Zampini     if (unsymmetric_check) {
66088ebb749SStefano Zampini       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
66188ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
66288ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
66388ebb749SStefano Zampini       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
66488ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
66588ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
66688ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
66788ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
66888ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
66988ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
67088ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
67188ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
67288ebb749SStefano Zampini     } else {
67388ebb749SStefano Zampini       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
67488ebb749SStefano Zampini       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
67588ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
67688ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
67788ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
67888ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
67988ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
68088ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
68188ebb749SStefano Zampini     }
68288ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
68388ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
68488ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
68588ebb749SStefano Zampini     ierr = MatConvert(TM1,MATSEQDENSE,MAT_REUSE_MATRIX,&TM1);CHKERRQ(ierr);
68688ebb749SStefano Zampini     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
68788ebb749SStefano Zampini     ierr = MatNorm(TM1,NORM_INFINITY,&real_value);CHKERRQ(ierr);
6880fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
68925084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"----------------------------------\n");CHKERRQ(ierr);
69025084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d \n",PetscGlobalRank);CHKERRQ(ierr);
69125084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"matrix error = % 1.14e\n",real_value);CHKERRQ(ierr);
69225084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (phi) errors\n");CHKERRQ(ierr);
69388ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
69425084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,coarsefunctions_errors[i]);CHKERRQ(ierr);
69588ebb749SStefano Zampini     }
69625084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (phi) errors\n");CHKERRQ(ierr);
69788ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
69825084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,constraints_errors[i]);CHKERRQ(ierr);
69988ebb749SStefano Zampini     }
700c0553b1fSStefano Zampini     if (unsymmetric_check) {
70125084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (psi) errors\n");CHKERRQ(ierr);
70288ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
70325084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,coarsefunctions_errors[i]);CHKERRQ(ierr);
70488ebb749SStefano Zampini       }
70525084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (psi) errors\n");CHKERRQ(ierr);
70688ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
70725084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,constraints_errors[i]);CHKERRQ(ierr);
70888ebb749SStefano Zampini       }
70988ebb749SStefano Zampini     }
71025084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
71188ebb749SStefano Zampini     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
71288ebb749SStefano Zampini     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
71388ebb749SStefano Zampini     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
71488ebb749SStefano Zampini     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
71588ebb749SStefano Zampini     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
71688ebb749SStefano Zampini     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
71788ebb749SStefano Zampini     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
71888ebb749SStefano Zampini     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
71988ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
72088ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
721c0553b1fSStefano Zampini     if (unsymmetric_check) {
72288ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
72388ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
72488ebb749SStefano Zampini     }
72588ebb749SStefano Zampini     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
7268ce42a96SStefano Zampini     ierr = ISRestoreIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
72788ebb749SStefano Zampini     ierr = PetscFree(coarsefunctions_errors);CHKERRQ(ierr);
72888ebb749SStefano Zampini     ierr = PetscFree(constraints_errors);CHKERRQ(ierr);
72988ebb749SStefano Zampini   }
73088ebb749SStefano Zampini   /* free memory */
73188ebb749SStefano Zampini   if (n_vertices) {
73288ebb749SStefano Zampini     ierr = VecDestroy(&vec1_V);CHKERRQ(ierr);
73388ebb749SStefano Zampini     ierr = VecDestroy(&vec2_V);CHKERRQ(ierr);
73488ebb749SStefano Zampini     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
73588ebb749SStefano Zampini     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
73688ebb749SStefano Zampini     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
73788ebb749SStefano Zampini   }
73888ebb749SStefano Zampini   if (n_constraints) {
73988ebb749SStefano Zampini     ierr = VecDestroy(&vec1_C);CHKERRQ(ierr);
74088ebb749SStefano Zampini     ierr = VecDestroy(&vec2_C);CHKERRQ(ierr);
74188ebb749SStefano Zampini     ierr = MatDestroy(&M1);CHKERRQ(ierr);
74288ebb749SStefano Zampini     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
74388ebb749SStefano Zampini   }
74488ebb749SStefano Zampini   ierr = PetscFree(auxindices);CHKERRQ(ierr);
7458629588bSStefano Zampini   /* get back data */
7468629588bSStefano Zampini   *coarse_submat_vals_n = coarse_submat_vals;
74788ebb749SStefano Zampini   PetscFunctionReturn(0);
74888ebb749SStefano Zampini }
74988ebb749SStefano Zampini 
75088ebb749SStefano Zampini #undef __FUNCT__
751aa0d41d4SStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalMatrices"
752aa0d41d4SStefano Zampini PetscErrorCode PCBDDCSetUpLocalMatrices(PC pc)
753aa0d41d4SStefano Zampini {
754aa0d41d4SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
755aa0d41d4SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
756aa0d41d4SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
75722d5777bSStefano Zampini   PetscBool         issbaij,isseqaij;
758aa0d41d4SStefano Zampini   /* manage repeated solves */
759aa0d41d4SStefano Zampini   MatReuse          reuse;
760aa0d41d4SStefano Zampini   MatStructure      matstruct;
761aa0d41d4SStefano Zampini   PetscErrorCode    ierr;
762aa0d41d4SStefano Zampini 
763aa0d41d4SStefano Zampini   PetscFunctionBegin;
764f4ddd8eeSStefano Zampini   if (pcbddc->use_change_of_basis && !pcbddc->ChangeOfBasisMatrix) {
765f4ddd8eeSStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Change of basis matrix has not been created");
766f4ddd8eeSStefano Zampini   }
767aa0d41d4SStefano Zampini   /* get mat flags */
768aa0d41d4SStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
769aa0d41d4SStefano Zampini   reuse = MAT_INITIAL_MATRIX;
770aa0d41d4SStefano Zampini   if (pc->setupcalled) {
771aa0d41d4SStefano Zampini     /* when matstruct is SAME_PRECONDITIONER, we shouldn't be here */
772aa0d41d4SStefano Zampini     if (matstruct == SAME_PRECONDITIONER) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen");
773aa0d41d4SStefano Zampini     if (matstruct == SAME_NONZERO_PATTERN) {
774aa0d41d4SStefano Zampini       reuse = MAT_REUSE_MATRIX;
775aa0d41d4SStefano Zampini     } else {
776aa0d41d4SStefano Zampini       reuse = MAT_INITIAL_MATRIX;
777aa0d41d4SStefano Zampini     }
778aa0d41d4SStefano Zampini   }
779aa0d41d4SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
780aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
781aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
782aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
783aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BB);CHKERRQ(ierr);
784aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
785aa0d41d4SStefano Zampini   }
786aa0d41d4SStefano Zampini 
787aa0d41d4SStefano Zampini   /* transform local matrices if needed */
788aa0d41d4SStefano Zampini   if (pcbddc->use_change_of_basis) {
789aa0d41d4SStefano Zampini     Mat         change_mat_all;
790aa0d41d4SStefano Zampini     PetscScalar *row_cmat_values;
791aa0d41d4SStefano Zampini     PetscInt    *row_cmat_indices;
792aa0d41d4SStefano Zampini     PetscInt    *nnz,*is_indices,*temp_indices;
793aa0d41d4SStefano Zampini     PetscInt    i,j,k,n_D,n_B;
794aa0d41d4SStefano Zampini 
795aa0d41d4SStefano Zampini     /* Get Non-overlapping dimensions */
796aa0d41d4SStefano Zampini     n_B = pcis->n_B;
797aa0d41d4SStefano Zampini     n_D = pcis->n-n_B;
798aa0d41d4SStefano Zampini 
799aa0d41d4SStefano Zampini     /* compute nonzero structure of change of basis on all local nodes */
800aa0d41d4SStefano Zampini     ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
801aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
802aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) nnz[is_indices[i]] = 1;
803aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
804aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
805aa0d41d4SStefano Zampini     k=1;
806aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
807aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
808aa0d41d4SStefano Zampini       nnz[is_indices[i]]=j;
809aa0d41d4SStefano Zampini       if (k < j) k = j;
810aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
811aa0d41d4SStefano Zampini     }
812aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
813aa0d41d4SStefano Zampini     /* assemble change of basis matrix on the whole set of local dofs */
814aa0d41d4SStefano Zampini     ierr = PetscMalloc(k*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
815aa0d41d4SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&change_mat_all);CHKERRQ(ierr);
816aa0d41d4SStefano Zampini     ierr = MatSetSizes(change_mat_all,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
817aa0d41d4SStefano Zampini     ierr = MatSetType(change_mat_all,MATSEQAIJ);CHKERRQ(ierr);
818aa0d41d4SStefano Zampini     ierr = MatSeqAIJSetPreallocation(change_mat_all,0,nnz);CHKERRQ(ierr);
819aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
820aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) {
821aa0d41d4SStefano Zampini       ierr = MatSetValue(change_mat_all,is_indices[i],is_indices[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
822aa0d41d4SStefano Zampini     }
823aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
824aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
825aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
826aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
827aa0d41d4SStefano Zampini       for (k=0; k<j; k++) temp_indices[k]=is_indices[row_cmat_indices[k]];
828aa0d41d4SStefano Zampini       ierr = MatSetValues(change_mat_all,1,&is_indices[i],j,temp_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
829aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
830aa0d41d4SStefano Zampini     }
831aa0d41d4SStefano Zampini     ierr = MatAssemblyBegin(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
832aa0d41d4SStefano Zampini     ierr = MatAssemblyEnd(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
83322d5777bSStefano Zampini     /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
83422d5777bSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQBAIJ,&isseqaij);CHKERRQ(ierr);
83522d5777bSStefano Zampini     if (isseqaij) {
836aa0d41d4SStefano Zampini       ierr = MatPtAP(matis->A,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
837aa0d41d4SStefano Zampini     } else {
838aa0d41d4SStefano Zampini       Mat work_mat;
839aa0d41d4SStefano Zampini       ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
840aa0d41d4SStefano Zampini       ierr = MatPtAP(work_mat,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
841aa0d41d4SStefano Zampini       ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
842aa0d41d4SStefano Zampini     }
84345a1bb75SStefano Zampini     /*
84445a1bb75SStefano Zampini     ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
84545a1bb75SStefano Zampini     ierr = MatView(change_mat_all,(PetscViewer)0);CHKERRQ(ierr);
84645a1bb75SStefano Zampini     */
847aa0d41d4SStefano Zampini     ierr = MatDestroy(&change_mat_all);CHKERRQ(ierr);
848aa0d41d4SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
849aa0d41d4SStefano Zampini     ierr = PetscFree(temp_indices);CHKERRQ(ierr);
850aa0d41d4SStefano Zampini   } else {
851aa0d41d4SStefano Zampini     /* without change of basis, the local matrix is unchanged */
852aa0d41d4SStefano Zampini     if (!pcbddc->local_mat) {
853aa0d41d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)matis->A);CHKERRQ(ierr);
854aa0d41d4SStefano Zampini       pcbddc->local_mat = matis->A;
855aa0d41d4SStefano Zampini     }
856aa0d41d4SStefano Zampini   }
857aa0d41d4SStefano Zampini 
858aa0d41d4SStefano Zampini   /* get submatrices */
859aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_I_local,reuse,&pcis->A_II);CHKERRQ(ierr);
8609577ea80SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_B_local,reuse,&pcis->A_BB);CHKERRQ(ierr);
8619577ea80SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
8629577ea80SStefano Zampini   if (!issbaij) {
863aa0d41d4SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
864aa0d41d4SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
8659577ea80SStefano Zampini   } else {
8669577ea80SStefano Zampini     Mat newmat;
8679577ea80SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
8689577ea80SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
8699577ea80SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
8709577ea80SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
8719577ea80SStefano Zampini   }
872aa0d41d4SStefano Zampini   PetscFunctionReturn(0);
873aa0d41d4SStefano Zampini }
874aa0d41d4SStefano Zampini 
875aa0d41d4SStefano Zampini #undef __FUNCT__
876a64d13efSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalScatters"
8778ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
878a64d13efSStefano Zampini {
879a64d13efSStefano Zampini   PC_IS*         pcis = (PC_IS*)(pc->data);
880a64d13efSStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8818ce42a96SStefano Zampini   IS             is_aux1,is_aux2;
882e9189074SStefano Zampini   PetscInt       *aux_array1,*aux_array2,*is_indices,*idx_R_local;
8833a50541eSStefano Zampini   PetscInt       n_vertices,i,j,n_R,n_D,n_B;
8843a50541eSStefano Zampini   PetscInt       vbs,bs;
8854641a718SStefano Zampini   PetscBT        bitmask;
886a64d13efSStefano Zampini   PetscErrorCode ierr;
887a64d13efSStefano Zampini 
888a64d13efSStefano Zampini   PetscFunctionBegin;
889b23d619eSStefano Zampini   /*
890b23d619eSStefano Zampini     No need to setup local scatters if
891b23d619eSStefano Zampini       - primal space is unchanged
892b23d619eSStefano Zampini         AND
893b23d619eSStefano Zampini       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
894b23d619eSStefano Zampini         AND
895b23d619eSStefano Zampini       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
896b23d619eSStefano Zampini   */
897b23d619eSStefano Zampini   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
898f4ddd8eeSStefano Zampini     PetscFunctionReturn(0);
899f4ddd8eeSStefano Zampini   }
900f4ddd8eeSStefano Zampini   /* destroy old objects */
901f4ddd8eeSStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
902f4ddd8eeSStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
903f4ddd8eeSStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
904a64d13efSStefano Zampini   /* Set Non-overlapping dimensions */
905a64d13efSStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
906e9189074SStefano Zampini   n_vertices = pcbddc->n_actual_vertices;
9074641a718SStefano Zampini   /* create auxiliary bitmask */
9084641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
9094641a718SStefano Zampini   for (i=0;i<n_vertices;i++) {
910e9189074SStefano Zampini     ierr = PetscBTSet(bitmask,pcbddc->primal_indices_local_idxs[i]);CHKERRQ(ierr);
9114641a718SStefano Zampini   }
9123a50541eSStefano Zampini 
913a64d13efSStefano Zampini   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
914a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n-n_vertices)*sizeof(PetscInt),&idx_R_local);CHKERRQ(ierr);
915a64d13efSStefano Zampini   for (i=0, n_R=0; i<pcis->n; i++) {
9164641a718SStefano Zampini     if (!PetscBTLookup(bitmask,i)) {
917a64d13efSStefano Zampini       idx_R_local[n_R] = i;
918a64d13efSStefano Zampini       n_R++;
919a64d13efSStefano Zampini     }
920a64d13efSStefano Zampini   }
9213a50541eSStefano Zampini 
9223a50541eSStefano Zampini   /* Block code */
9233a50541eSStefano Zampini   vbs = 1;
9243a50541eSStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
9253a50541eSStefano Zampini   if (bs>1 && !(n_vertices%bs)) {
9263a50541eSStefano Zampini     PetscBool is_blocked = PETSC_TRUE;
9273a50541eSStefano Zampini     PetscInt  *vary;
9283a50541eSStefano Zampini     /* Verify if the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
9293a50541eSStefano Zampini     ierr = PetscMalloc(pcis->n/bs*sizeof(PetscInt),&vary);CHKERRQ(ierr);
9303a50541eSStefano Zampini     ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
931e9189074SStefano Zampini     for (i=0; i<n_vertices; i++) vary[pcbddc->primal_indices_local_idxs[i]/bs]++;
9323a50541eSStefano Zampini     for (i=0; i<n_vertices; i++) {
9333a50541eSStefano Zampini       if (vary[i]!=0 && vary[i]!=bs) {
9343a50541eSStefano Zampini         is_blocked = PETSC_FALSE;
9353a50541eSStefano Zampini         break;
9363a50541eSStefano Zampini       }
9373a50541eSStefano Zampini     }
9383a50541eSStefano Zampini     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
9393a50541eSStefano Zampini       vbs = bs;
9403a50541eSStefano Zampini       for (i=0;i<n_R/vbs;i++) {
9413a50541eSStefano Zampini         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
9423a50541eSStefano Zampini       }
9433a50541eSStefano Zampini     }
9443a50541eSStefano Zampini     ierr = PetscFree(vary);CHKERRQ(ierr);
9453a50541eSStefano Zampini   }
9463a50541eSStefano Zampini   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
9473a50541eSStefano Zampini   ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
948a64d13efSStefano Zampini 
949a64d13efSStefano Zampini   /* print some info if requested */
950a64d13efSStefano Zampini   if (pcbddc->dbg_flag) {
951a64d13efSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
952a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
9530fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
954a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
955a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
9563a50541eSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"r_size = %d, v_size = %d, constraints = %d, local_primal_size = %d\n",n_R,n_vertices,pcbddc->local_primal_size-n_vertices,pcbddc->local_primal_size);CHKERRQ(ierr);
957a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr);
958a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
959a64d13efSStefano Zampini   }
960a64d13efSStefano Zampini 
961a64d13efSStefano Zampini   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
9623a50541eSStefano Zampini   ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
963a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
964a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array2);CHKERRQ(ierr);
965a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
9664641a718SStefano Zampini   for (i=0; i<n_D; i++) {
9674641a718SStefano Zampini     ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
9684641a718SStefano Zampini   }
969a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
970a64d13efSStefano Zampini   for (i=0, j=0; i<n_R; i++) {
9714641a718SStefano Zampini     if (!PetscBTLookup(bitmask,idx_R_local[i])) {
9724641a718SStefano Zampini       aux_array1[j++] = i;
973a64d13efSStefano Zampini     }
974a64d13efSStefano Zampini   }
975a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
976a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
977a64d13efSStefano Zampini   for (i=0, j=0; i<n_B; i++) {
9784641a718SStefano Zampini     if (!PetscBTLookup(bitmask,is_indices[i])) {
9794641a718SStefano Zampini       aux_array2[j++] = i;
980a64d13efSStefano Zampini     }
981a64d13efSStefano Zampini   }
982a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
983a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
984a64d13efSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
985a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
986a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
987a64d13efSStefano Zampini 
9888eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
989a64d13efSStefano Zampini     ierr = PetscMalloc(n_D*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
990a64d13efSStefano Zampini     for (i=0, j=0; i<n_R; i++) {
9914641a718SStefano Zampini       if (PetscBTLookup(bitmask,idx_R_local[i])) {
9924641a718SStefano Zampini         aux_array1[j++] = i;
993a64d13efSStefano Zampini       }
994a64d13efSStefano Zampini     }
995a64d13efSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
996a64d13efSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
997a64d13efSStefano Zampini     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
998a64d13efSStefano Zampini   }
9994641a718SStefano Zampini   ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
10003a50541eSStefano Zampini   ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
1001a64d13efSStefano Zampini   PetscFunctionReturn(0);
1002a64d13efSStefano Zampini }
1003a64d13efSStefano Zampini 
1004304d26faSStefano Zampini 
1005304d26faSStefano Zampini #undef __FUNCT__
1006304d26faSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
10078ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc)
1008304d26faSStefano Zampini {
1009304d26faSStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1010304d26faSStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
1011304d26faSStefano Zampini   PC             pc_temp;
1012304d26faSStefano Zampini   Mat            A_RR;
1013304d26faSStefano Zampini   MatStructure   matstruct;
1014f4ddd8eeSStefano Zampini   MatReuse       reuse;
1015304d26faSStefano Zampini   PetscScalar    m_one = -1.0;
1016304d26faSStefano Zampini   PetscReal      value;
1017af732b37SStefano Zampini   PetscInt       n_D,n_R,ibs,mbs;
10189577ea80SStefano Zampini   PetscBool      use_exact,use_exact_reduced,issbaij;
1019304d26faSStefano Zampini   PetscErrorCode ierr;
1020e604994aSStefano Zampini   /* prefixes stuff */
1021312be037SStefano Zampini   char           dir_prefix[256],neu_prefix[256],str_level[16];
1022e604994aSStefano Zampini   size_t         len;
1023304d26faSStefano Zampini 
1024304d26faSStefano Zampini   PetscFunctionBegin;
1025304d26faSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
1026304d26faSStefano Zampini 
1027e604994aSStefano Zampini   /* compute prefixes */
1028e604994aSStefano Zampini   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
1029e604994aSStefano Zampini   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
1030e604994aSStefano Zampini   if (!pcbddc->current_level) {
1031e604994aSStefano Zampini     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
1032e604994aSStefano Zampini     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
1033e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
1034e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
1035e604994aSStefano Zampini   } else {
1036e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
1037312be037SStefano Zampini     sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
1038e604994aSStefano Zampini     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
1039e604994aSStefano Zampini     len -= 15; /* remove "pc_bddc_coarse_" */
1040312be037SStefano Zampini     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
1041312be037SStefano Zampini     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
1042e604994aSStefano Zampini     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
1043e604994aSStefano Zampini     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
1044e604994aSStefano Zampini     *(dir_prefix+len)='\0';
1045e604994aSStefano Zampini     *(neu_prefix+len)='\0';
1046e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
1047e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
1048e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
1049e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
1050e604994aSStefano Zampini   }
1051e604994aSStefano Zampini 
1052304d26faSStefano Zampini   /* DIRICHLET PROBLEM */
1053ac78edfcSStefano Zampini   /* Matrix for Dirichlet problem is pcis->A_II */
10548ce42a96SStefano Zampini   ierr = ISGetSize(pcis->is_I_local,&n_D);CHKERRQ(ierr);
1055304d26faSStefano Zampini   if (!pcbddc->ksp_D) { /* create object if not yet build */
1056304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
1057304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
1058304d26faSStefano Zampini     /* default */
1059304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
1060e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
10619577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
1062304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
10639577ea80SStefano Zampini     if (issbaij) {
10649577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
10659577ea80SStefano Zampini     } else {
1066304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
10679577ea80SStefano Zampini     }
1068304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1069304d26faSStefano Zampini     /* Allow user's customization */
1070304d26faSStefano Zampini     ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
1071312be037SStefano Zampini   }
1072312be037SStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II,matstruct);CHKERRQ(ierr);
1073304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1074304d26faSStefano Zampini   if (!n_D) {
1075304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
1076304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1077304d26faSStefano Zampini   }
1078304d26faSStefano Zampini   /* Set Up KSP for Dirichlet problem of BDDC */
1079304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
1080304d26faSStefano Zampini   /* set ksp_D into pcis data */
1081304d26faSStefano Zampini   ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
1082304d26faSStefano Zampini   ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
1083304d26faSStefano Zampini   pcis->ksp_D = pcbddc->ksp_D;
1084304d26faSStefano Zampini 
1085304d26faSStefano Zampini   /* NEUMANN PROBLEM */
1086f4ddd8eeSStefano Zampini   /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
10878ce42a96SStefano Zampini   ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
1088f4ddd8eeSStefano Zampini   if (pcbddc->ksp_R) { /* already created ksp */
1089f4ddd8eeSStefano Zampini     PetscInt nn_R;
1090f4ddd8eeSStefano Zampini     ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR,NULL);CHKERRQ(ierr);
1091f4ddd8eeSStefano Zampini     ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
1092f4ddd8eeSStefano Zampini     ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
1093f4ddd8eeSStefano Zampini     if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
1094f4ddd8eeSStefano Zampini       ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
1095f4ddd8eeSStefano Zampini       ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1096f4ddd8eeSStefano Zampini       reuse = MAT_INITIAL_MATRIX;
1097f4ddd8eeSStefano Zampini     } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
1098727cdba6SStefano Zampini       if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
1099f4ddd8eeSStefano Zampini         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1100f4ddd8eeSStefano Zampini         reuse = MAT_INITIAL_MATRIX;
1101f4ddd8eeSStefano Zampini       } else { /* safe to reuse the matrix */
1102f4ddd8eeSStefano Zampini         reuse = MAT_REUSE_MATRIX;
1103f4ddd8eeSStefano Zampini       }
1104f4ddd8eeSStefano Zampini     }
1105f4ddd8eeSStefano Zampini     /* last check */
1106f4ddd8eeSStefano Zampini     if (matstruct == DIFFERENT_NONZERO_PATTERN) {
1107f4ddd8eeSStefano Zampini       ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1108f4ddd8eeSStefano Zampini       reuse = MAT_INITIAL_MATRIX;
1109f4ddd8eeSStefano Zampini     }
1110f4ddd8eeSStefano Zampini   } else { /* first time, so we need to create the matrix */
1111f4ddd8eeSStefano Zampini     reuse = MAT_INITIAL_MATRIX;
1112f4ddd8eeSStefano Zampini   }
1113f4ddd8eeSStefano Zampini   /* extract A_RR */
1114af732b37SStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
1115af732b37SStefano Zampini   ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
11163a50541eSStefano Zampini   if (ibs != mbs) {
1117af732b37SStefano Zampini     Mat newmat;
1118af732b37SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
1119f4ddd8eeSStefano Zampini     ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
1120af732b37SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
1121af732b37SStefano Zampini   } else {
1122f4ddd8eeSStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
1123af732b37SStefano Zampini   }
1124f4ddd8eeSStefano Zampini   if (!pcbddc->ksp_R) { /* create object if not present */
1125304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
1126304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
1127304d26faSStefano Zampini     /* default */
1128304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
1129e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
1130304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
11319577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
11329577ea80SStefano Zampini     if (issbaij) {
11339577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
11349577ea80SStefano Zampini     } else {
1135304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
11369577ea80SStefano Zampini     }
1137304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1138304d26faSStefano Zampini     /* Allow user's customization */
1139304d26faSStefano Zampini     ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
1140312be037SStefano Zampini   }
1141312be037SStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR,matstruct);CHKERRQ(ierr);
1142304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1143304d26faSStefano Zampini   if (!n_R) {
1144304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
1145304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1146304d26faSStefano Zampini   }
1147304d26faSStefano Zampini   /* Set Up KSP for Neumann problem of BDDC */
1148304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
1149304d26faSStefano Zampini 
1150304d26faSStefano Zampini   /* check Dirichlet and Neumann solvers and adapt them if a nullspace correction is needed */
11510fccc4e9SStefano Zampini   if (pcbddc->NullSpace || pcbddc->dbg_flag) {
1152304d26faSStefano Zampini     /* Dirichlet */
11530fccc4e9SStefano Zampini     ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
11540fccc4e9SStefano Zampini     ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
11550fccc4e9SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
11560fccc4e9SStefano Zampini     ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
11570fccc4e9SStefano Zampini     ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
1158304d26faSStefano Zampini     /* need to be adapted? */
1159b8ffe317SStefano Zampini     use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1160b8ffe317SStefano Zampini     ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1161b8ffe317SStefano Zampini     ierr = PCBDDCSetUseExactDirichlet(pc,use_exact_reduced);CHKERRQ(ierr);
1162304d26faSStefano Zampini     /* print info */
1163304d26faSStefano Zampini     if (pcbddc->dbg_flag) {
1164304d26faSStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
11650fccc4e9SStefano Zampini       ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
1166304d26faSStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
1167304d26faSStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Checking solution of Dirichlet and Neumann problems\n");CHKERRQ(ierr);
1168e604994aSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Dirichlet solve (%s) = % 1.14e \n",PetscGlobalRank,((PetscObject)(pcbddc->ksp_D))->prefix,value);CHKERRQ(ierr);
1169304d26faSStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1170304d26faSStefano Zampini     }
1171b8ffe317SStefano Zampini     if (pcbddc->NullSpace && !use_exact_reduced && !pcbddc->switch_static) {
11728ce42a96SStefano Zampini       ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcis->is_I_local);CHKERRQ(ierr);
1173304d26faSStefano Zampini     }
1174304d26faSStefano Zampini 
1175304d26faSStefano Zampini     /* Neumann */
11760fccc4e9SStefano Zampini     ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
11770fccc4e9SStefano Zampini     ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
11780fccc4e9SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
11790fccc4e9SStefano Zampini     ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
11800fccc4e9SStefano Zampini     ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
1181304d26faSStefano Zampini     /* need to be adapted? */
1182b8ffe317SStefano Zampini     use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1183b8ffe317SStefano Zampini     ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1184304d26faSStefano Zampini     /* print info */
1185304d26faSStefano Zampini     if (pcbddc->dbg_flag) {
1186e604994aSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Neumann solve (%s) = % 1.14e \n",PetscGlobalRank,((PetscObject)(pcbddc->ksp_R))->prefix,value);CHKERRQ(ierr);
1187304d26faSStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1188304d26faSStefano Zampini     }
1189b8ffe317SStefano Zampini     if (pcbddc->NullSpace && !use_exact_reduced) { /* is it the right logic? */
11908ce42a96SStefano Zampini       ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcbddc->is_R_local);CHKERRQ(ierr);
1191304d26faSStefano Zampini     }
11920fccc4e9SStefano Zampini   }
1193304d26faSStefano Zampini   /* free Neumann problem's matrix */
1194304d26faSStefano Zampini   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1195304d26faSStefano Zampini   PetscFunctionReturn(0);
1196304d26faSStefano Zampini }
1197304d26faSStefano Zampini 
1198304d26faSStefano Zampini #undef __FUNCT__
1199ba15a52eSStefano Zampini #define __FUNCT__ "PCBDDCSolveSubstructureCorrection"
120020c7b377SStefano Zampini static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec rhs, Vec sol, Vec work, PetscBool applytranspose)
1201674ae819SStefano Zampini {
1202674ae819SStefano Zampini   PetscErrorCode ierr;
1203674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1204674ae819SStefano Zampini 
1205674ae819SStefano Zampini   PetscFunctionBegin;
120620c7b377SStefano Zampini   if (applytranspose) {
1207674ae819SStefano Zampini     if (pcbddc->local_auxmat1) {
120820c7b377SStefano Zampini       ierr = MatMultTranspose(pcbddc->local_auxmat2,rhs,work);CHKERRQ(ierr);
120920c7b377SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,work,rhs,rhs);CHKERRQ(ierr);
121020c7b377SStefano Zampini     }
121120c7b377SStefano Zampini     ierr = KSPSolveTranspose(pcbddc->ksp_R,rhs,sol);CHKERRQ(ierr);
121220c7b377SStefano Zampini   } else {
121320c7b377SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,rhs,sol);CHKERRQ(ierr);
121420c7b377SStefano Zampini     if (pcbddc->local_auxmat1) {
121520c7b377SStefano Zampini       ierr = MatMult(pcbddc->local_auxmat1,sol,work);CHKERRQ(ierr);
121620c7b377SStefano Zampini       ierr = MatMultAdd(pcbddc->local_auxmat2,work,sol,sol);CHKERRQ(ierr);
121720c7b377SStefano Zampini     }
1218674ae819SStefano Zampini   }
1219674ae819SStefano Zampini   PetscFunctionReturn(0);
1220674ae819SStefano Zampini }
1221674ae819SStefano Zampini 
1222dc359a40SStefano Zampini /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
1223674ae819SStefano Zampini #undef __FUNCT__
1224674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
1225dc359a40SStefano Zampini PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
1226674ae819SStefano Zampini {
1227674ae819SStefano Zampini   PetscErrorCode ierr;
1228674ae819SStefano Zampini   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
1229674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)  (pc->data);
1230674ae819SStefano Zampini   const PetscScalar zero = 0.0;
1231674ae819SStefano Zampini 
1232674ae819SStefano Zampini   PetscFunctionBegin;
1233dc359a40SStefano Zampini   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
1234dc359a40SStefano Zampini   if (applytranspose) {
1235674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
12368eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
1237dc359a40SStefano Zampini   } else {
1238674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
1239674ae819SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
124015aaf578SStefano Zampini   }
1241*12edc857SStefano Zampini   /* start communications from local primal nodes to rhs of coarse solver */
1242*12edc857SStefano Zampini   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
1243*12edc857SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1244*12edc857SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1245*12edc857SStefano Zampini 
1246*12edc857SStefano Zampini   /* Coarse solution -> rhs and sol updated in PCBDDCScattarCoarseDataBegin/End */
1247*12edc857SStefano Zampini   /* TODO remove null space when doing multilevel */
1248*12edc857SStefano Zampini   if (pcbddc->coarse_ksp) {
1249*12edc857SStefano Zampini     if (applytranspose) {
1250*12edc857SStefano Zampini       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,NULL,NULL);CHKERRQ(ierr);
1251*12edc857SStefano Zampini     } else {
1252*12edc857SStefano Zampini       ierr = KSPSolve(pcbddc->coarse_ksp,NULL,NULL);CHKERRQ(ierr);
1253*12edc857SStefano Zampini     }
1254*12edc857SStefano Zampini   }
1255*12edc857SStefano Zampini   /* start communications from coarse solver solution to local primal nodes */
1256*12edc857SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1257674ae819SStefano Zampini 
1258674ae819SStefano Zampini   /* Local solution on R nodes */
1259674ae819SStefano Zampini   ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
1260674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1261674ae819SStefano Zampini   ierr = VecScatterEnd(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
12628eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1263674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1264674ae819SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1265674ae819SStefano Zampini   }
126620c7b377SStefano Zampini   ierr = PCBDDCSolveSubstructureCorrection(pc,pcbddc->vec1_R,pcbddc->vec2_R,pcbddc->vec1_C,applytranspose);CHKERRQ(ierr);
1267674ae819SStefano Zampini   ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1268674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1269674ae819SStefano Zampini   ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
12708eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1271674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1272674ae819SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1273674ae819SStefano Zampini   }
1274674ae819SStefano Zampini 
1275*12edc857SStefano Zampini   /* complete communications from coarse sol to local primal nodes */
1276*12edc857SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1277674ae819SStefano Zampini 
1278674ae819SStefano Zampini   /* Sum contributions from two levels */
1279dc359a40SStefano Zampini   if (applytranspose) {
1280dc359a40SStefano Zampini     ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
1281dc359a40SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1282dc359a40SStefano Zampini   } else {
1283674ae819SStefano Zampini     ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
12848eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1285dc359a40SStefano Zampini   }
1286674ae819SStefano Zampini   PetscFunctionReturn(0);
1287674ae819SStefano Zampini }
1288674ae819SStefano Zampini 
1289*12edc857SStefano Zampini /* TODO: the following two function can be optimized using VecPlaceArray whenever possible and using overlap flag */
1290674ae819SStefano Zampini #undef __FUNCT__
1291674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
1292*12edc857SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
1293674ae819SStefano Zampini {
1294674ae819SStefano Zampini   PetscErrorCode ierr;
1295674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1296*12edc857SStefano Zampini   PetscScalar    *array,*array2;
1297*12edc857SStefano Zampini   Vec            from,to;
1298674ae819SStefano Zampini 
1299674ae819SStefano Zampini   PetscFunctionBegin;
1300*12edc857SStefano Zampini   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
1301*12edc857SStefano Zampini     from = pcbddc->coarse_vec;
1302*12edc857SStefano Zampini     to = pcbddc->vec1_P;
1303*12edc857SStefano Zampini     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
1304*12edc857SStefano Zampini       Vec tvec;
1305*12edc857SStefano Zampini       PetscInt lsize;
1306*12edc857SStefano Zampini       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
1307*12edc857SStefano Zampini       ierr = VecGetLocalSize(tvec,&lsize);CHKERRQ(ierr);
1308*12edc857SStefano Zampini       ierr = VecGetArrayRead(tvec,(const PetscScalar**)&array);CHKERRQ(ierr);
1309*12edc857SStefano Zampini       ierr = VecGetArray(from,&array2);CHKERRQ(ierr);
1310*12edc857SStefano Zampini       ierr = PetscMemcpy(array2,array,lsize*sizeof(PetscScalar));CHKERRQ(ierr);
1311*12edc857SStefano Zampini       ierr = VecRestoreArrayRead(tvec,(const PetscScalar**)&array);CHKERRQ(ierr);
1312*12edc857SStefano Zampini       ierr = VecRestoreArray(from,&array2);CHKERRQ(ierr);
1313*12edc857SStefano Zampini     }
1314*12edc857SStefano Zampini   } else { /* from local to global -> put data in coarse right hand side */
1315*12edc857SStefano Zampini     from = pcbddc->vec1_P;
1316*12edc857SStefano Zampini     to = pcbddc->coarse_vec;
1317*12edc857SStefano Zampini   }
1318*12edc857SStefano Zampini   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
1319674ae819SStefano Zampini   PetscFunctionReturn(0);
1320674ae819SStefano Zampini }
1321674ae819SStefano Zampini 
1322674ae819SStefano Zampini #undef __FUNCT__
1323674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
1324*12edc857SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
1325674ae819SStefano Zampini {
1326674ae819SStefano Zampini   PetscErrorCode ierr;
1327674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1328*12edc857SStefano Zampini   PetscScalar    *array,*array2;
1329*12edc857SStefano Zampini   Vec            from,to;
1330674ae819SStefano Zampini 
1331674ae819SStefano Zampini   PetscFunctionBegin;
1332*12edc857SStefano Zampini   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
1333*12edc857SStefano Zampini     from = pcbddc->coarse_vec;
1334*12edc857SStefano Zampini     to = pcbddc->vec1_P;
1335*12edc857SStefano Zampini   } else { /* from local to global -> put data in coarse right hand side */
1336*12edc857SStefano Zampini     from = pcbddc->vec1_P;
1337*12edc857SStefano Zampini     to = pcbddc->coarse_vec;
1338*12edc857SStefano Zampini   }
1339*12edc857SStefano Zampini   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
1340*12edc857SStefano Zampini   if (smode == SCATTER_FORWARD) {
1341*12edc857SStefano Zampini     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
1342*12edc857SStefano Zampini       Vec tvec;
1343*12edc857SStefano Zampini       PetscInt lsize;
1344*12edc857SStefano Zampini       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
1345*12edc857SStefano Zampini       ierr = VecGetLocalSize(tvec,&lsize);CHKERRQ(ierr);
1346*12edc857SStefano Zampini       ierr = VecGetArrayRead(to,(const PetscScalar**)&array);CHKERRQ(ierr);
1347*12edc857SStefano Zampini       ierr = VecGetArray(tvec,&array2);CHKERRQ(ierr);
1348*12edc857SStefano Zampini       ierr = PetscMemcpy(array2,array,lsize*sizeof(PetscScalar));CHKERRQ(ierr);
1349*12edc857SStefano Zampini       ierr = VecRestoreArrayRead(to,(const PetscScalar**)&array);CHKERRQ(ierr);
1350*12edc857SStefano Zampini       ierr = VecRestoreArray(tvec,&array2);CHKERRQ(ierr);
1351*12edc857SStefano Zampini     }
1352*12edc857SStefano Zampini   }
1353674ae819SStefano Zampini   PetscFunctionReturn(0);
1354674ae819SStefano Zampini }
1355674ae819SStefano Zampini 
1356984c4197SStefano Zampini /* uncomment for testing purposes */
1357984c4197SStefano Zampini /* #define PETSC_MISSING_LAPACK_GESVD 1 */
1358674ae819SStefano Zampini #undef __FUNCT__
1359674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp"
1360674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
1361674ae819SStefano Zampini {
1362674ae819SStefano Zampini   PetscErrorCode    ierr;
1363674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
1364674ae819SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
1365674ae819SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
1366984c4197SStefano Zampini   /* constraint and (optionally) change of basis matrix implemented as SeqAIJ */
1367674ae819SStefano Zampini   MatType           impMatType=MATSEQAIJ;
1368984c4197SStefano Zampini   /* one and zero */
1369984c4197SStefano Zampini   PetscScalar       one=1.0,zero=0.0;
1370984c4197SStefano Zampini   /* space to store constraints and their local indices */
1371984c4197SStefano Zampini   PetscScalar       *temp_quadrature_constraint;
1372984c4197SStefano Zampini   PetscInt          *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B;
1373984c4197SStefano Zampini   /* iterators */
1374984c4197SStefano Zampini   PetscInt          i,j,k,total_counts,temp_start_ptr;
1375984c4197SStefano Zampini   /* stuff to store connected components stored in pcbddc->mat_graph */
1376984c4197SStefano Zampini   IS                ISForVertices,*ISForFaces,*ISForEdges,*used_IS;
1377984c4197SStefano Zampini   PetscInt          n_ISForFaces,n_ISForEdges;
1378984c4197SStefano Zampini   /* near null space stuff */
1379674ae819SStefano Zampini   MatNullSpace      nearnullsp;
1380674ae819SStefano Zampini   const Vec         *nearnullvecs;
1381674ae819SStefano Zampini   Vec               *localnearnullsp;
1382984c4197SStefano Zampini   PetscBool         nnsp_has_cnst;
1383984c4197SStefano Zampini   PetscInt          nnsp_size;
1384984c4197SStefano Zampini   PetscScalar       *array;
1385984c4197SStefano Zampini   /* BLAS integers */
1386e310c8b4SStefano Zampini   PetscBLASInt      lwork,lierr;
1387e310c8b4SStefano Zampini   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
1388c4303822SStefano Zampini   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
1389984c4197SStefano Zampini   /* LAPACK working arrays for SVD or POD */
1390242a89d7SStefano Zampini   PetscBool         skip_lapack;
1391984c4197SStefano Zampini   PetscScalar       *work;
1392984c4197SStefano Zampini   PetscReal         *singular_vals;
1393984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1394984c4197SStefano Zampini   PetscReal         *rwork;
1395674ae819SStefano Zampini #endif
1396984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1397e310c8b4SStefano Zampini   PetscBLASInt      Blas_one_2=1;
1398984c4197SStefano Zampini   PetscScalar       *temp_basis,*correlation_mat;
1399b7d8b9f8SStefano Zampini #else
1400b7d8b9f8SStefano Zampini   PetscBLASInt      dummy_int_1=1,dummy_int_2=1;
1401b7d8b9f8SStefano Zampini   PetscScalar       dummy_scalar_1=0.0,dummy_scalar_2=0.0;
1402984c4197SStefano Zampini #endif
1403727cdba6SStefano Zampini   /* reuse */
1404727cdba6SStefano Zampini   PetscInt          olocal_primal_size;
1405727cdba6SStefano Zampini   PetscInt          *oprimal_indices_local_idxs;
1406984c4197SStefano Zampini   /* change of basis */
1407984c4197SStefano Zampini   PetscInt          *aux_primal_numbering,*aux_primal_minloc,*global_indices;
1408a717540cSStefano Zampini   PetscBool         boolforchange,qr_needed;
1409a717540cSStefano Zampini   PetscBT           touched,change_basis,qr_needed_idx;
1410984c4197SStefano Zampini   /* auxiliary stuff */
141139e2fb2aSStefano Zampini   PetscInt          *nnz,*is_indices,*aux_primal_numbering_B;
1412984c4197SStefano Zampini   /* some quantities */
141345a1bb75SStefano Zampini   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
1414984c4197SStefano Zampini   PetscInt          size_of_constraint,max_size_of_constraint,max_constraints,temp_constraints;
1415984c4197SStefano Zampini 
1416674ae819SStefano Zampini 
1417674ae819SStefano Zampini   PetscFunctionBegin;
14188e61c736SStefano Zampini   /* Destroy Mat objects computed previously */
14198e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
14208e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1421674ae819SStefano Zampini   /* Get index sets for faces, edges and vertices from graph */
14228eeda7d8SStefano Zampini   if (!pcbddc->use_faces && !pcbddc->use_edges && !pcbddc->use_vertices) {
14238eeda7d8SStefano Zampini     pcbddc->use_vertices = PETSC_TRUE;
1424674ae819SStefano Zampini   }
14258eeda7d8SStefano Zampini   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,pcbddc->use_faces,pcbddc->use_edges,pcbddc->use_vertices,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);
1426b8ffe317SStefano Zampini   /* HACK: provide functions to set change of basis */
1427b8ffe317SStefano Zampini   if (!ISForVertices && pcbddc->NullSpace) {
1428b8ffe317SStefano Zampini     pcbddc->use_change_of_basis = PETSC_TRUE;
1429b8ffe317SStefano Zampini     pcbddc->use_change_on_faces = PETSC_FALSE;
1430b8ffe317SStefano Zampini   }
1431984c4197SStefano Zampini   /* print some info */
1432674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
14330fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
1434674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1435674ae819SStefano Zampini     i = 0;
1436674ae819SStefano Zampini     if (ISForVertices) {
1437674ae819SStefano Zampini       ierr = ISGetSize(ISForVertices,&i);CHKERRQ(ierr);
1438674ae819SStefano Zampini     }
1439674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices\n",PetscGlobalRank,i);CHKERRQ(ierr);
1440674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges\n",PetscGlobalRank,n_ISForEdges);CHKERRQ(ierr);
144115aaf578SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces\n",PetscGlobalRank,n_ISForFaces);CHKERRQ(ierr);
1442674ae819SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1443674ae819SStefano Zampini   }
1444674ae819SStefano Zampini   /* check if near null space is attached to global mat */
1445674ae819SStefano Zampini   ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
1446674ae819SStefano Zampini   if (nearnullsp) {
1447674ae819SStefano Zampini     ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
1448f4ddd8eeSStefano Zampini     /* remove any stored info */
1449f4ddd8eeSStefano Zampini     ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
1450f4ddd8eeSStefano Zampini     ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1451f4ddd8eeSStefano Zampini     /* store information for BDDC solver reuse */
1452f4ddd8eeSStefano Zampini     ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
1453f4ddd8eeSStefano Zampini     pcbddc->onearnullspace = nearnullsp;
1454f4ddd8eeSStefano Zampini     ierr = PetscMalloc(nnsp_size*sizeof(PetscObjectState),&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1455f4ddd8eeSStefano Zampini     for (i=0;i<nnsp_size;i++) {
1456f4ddd8eeSStefano Zampini       ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
1457f4ddd8eeSStefano Zampini     }
1458984c4197SStefano Zampini   } else { /* if near null space is not provided BDDC uses constants by default */
1459984c4197SStefano Zampini     nnsp_size = 0;
1460674ae819SStefano Zampini     nnsp_has_cnst = PETSC_TRUE;
1461674ae819SStefano Zampini   }
1462984c4197SStefano Zampini   /* get max number of constraints on a single cc */
1463984c4197SStefano Zampini   max_constraints = nnsp_size;
1464984c4197SStefano Zampini   if (nnsp_has_cnst) max_constraints++;
1465984c4197SStefano Zampini 
1466674ae819SStefano Zampini   /*
1467674ae819SStefano Zampini        Evaluate maximum storage size needed by the procedure
1468674ae819SStefano Zampini        - temp_indices will contain start index of each constraint stored as follows
1469674ae819SStefano 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
1470674ae819SStefano 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
1471674ae819SStefano Zampini        - temp_quadrature_constraint  [temp_indices[i],...,temp[indices[i+1]-1] will contain the scalars representing the constraint itself
1472674ae819SStefano Zampini                                                                                                                                                          */
1473674ae819SStefano Zampini   total_counts = n_ISForFaces+n_ISForEdges;
1474984c4197SStefano Zampini   total_counts *= max_constraints;
1475674ae819SStefano Zampini   n_vertices = 0;
1476674ae819SStefano Zampini   if (ISForVertices) {
1477674ae819SStefano Zampini     ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
1478674ae819SStefano Zampini   }
1479674ae819SStefano Zampini   total_counts += n_vertices;
1480674ae819SStefano Zampini   ierr = PetscMalloc((total_counts+1)*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
14814641a718SStefano Zampini   ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
1482674ae819SStefano Zampini   total_counts = 0;
1483674ae819SStefano Zampini   max_size_of_constraint = 0;
1484674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1485674ae819SStefano Zampini     if (i<n_ISForEdges) {
1486674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1487674ae819SStefano Zampini     } else {
1488674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1489674ae819SStefano Zampini     }
1490674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
1491674ae819SStefano Zampini     total_counts += j;
1492674ae819SStefano Zampini     max_size_of_constraint = PetscMax(j,max_size_of_constraint);
1493674ae819SStefano Zampini   }
1494984c4197SStefano Zampini   total_counts *= max_constraints;
1495674ae819SStefano Zampini   total_counts += n_vertices;
1496674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&temp_quadrature_constraint);CHKERRQ(ierr);
1497674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint);CHKERRQ(ierr);
1498674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint_B);CHKERRQ(ierr);
1499984c4197SStefano Zampini   /* get local part of global near null space vectors */
1500984c4197SStefano Zampini   ierr = PetscMalloc(nnsp_size*sizeof(Vec),&localnearnullsp);CHKERRQ(ierr);
1501984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1502984c4197SStefano Zampini     ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
1503984c4197SStefano Zampini     ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1504984c4197SStefano Zampini     ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1505984c4197SStefano Zampini   }
1506674ae819SStefano Zampini 
1507242a89d7SStefano Zampini   /* whether or not to skip lapack calls */
1508242a89d7SStefano Zampini   skip_lapack = PETSC_TRUE;
1509242a89d7SStefano Zampini   if (n_ISForFaces+n_ISForEdges) skip_lapack = PETSC_FALSE;
1510242a89d7SStefano Zampini 
1511984c4197SStefano Zampini   /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
1512242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1513674ae819SStefano Zampini     PetscScalar temp_work;
1514674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1515984c4197SStefano Zampini     /* Proper Orthogonal Decomposition (POD) using the snapshot method */
1516984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*max_constraints*sizeof(PetscScalar),&correlation_mat);CHKERRQ(ierr);
1517984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1518984c4197SStefano Zampini     ierr = PetscMalloc(max_size_of_constraint*max_constraints*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr);
1519674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1520984c4197SStefano Zampini     ierr = PetscMalloc(3*max_constraints*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1521674ae819SStefano Zampini #endif
1522674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1523c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
1524c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
1525674ae819SStefano Zampini     lwork = -1;
1526674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1527674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1528c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
1529674ae819SStefano Zampini #else
1530c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
1531674ae819SStefano Zampini #endif
1532674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1533984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
1534674ae819SStefano Zampini #else /* on missing GESVD */
1535674ae819SStefano Zampini     /* SVD */
1536674ae819SStefano Zampini     PetscInt max_n,min_n;
1537674ae819SStefano Zampini     max_n = max_size_of_constraint;
1538984c4197SStefano Zampini     min_n = max_constraints;
1539984c4197SStefano Zampini     if (max_size_of_constraint < max_constraints) {
1540674ae819SStefano Zampini       min_n = max_size_of_constraint;
1541984c4197SStefano Zampini       max_n = max_constraints;
1542674ae819SStefano Zampini     }
1543674ae819SStefano Zampini     ierr = PetscMalloc(min_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1544674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1545674ae819SStefano Zampini     ierr = PetscMalloc(5*min_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1546674ae819SStefano Zampini #endif
1547674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1548674ae819SStefano Zampini     lwork = -1;
1549e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
1550e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
1551b7d8b9f8SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
1552674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1553674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1554e310c8b4SStefano Zampini     PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,&temp_quadrature_constraint[0],&Blas_LDA,singular_vals,&dummy_scalar_1,&dummy_int_1,&dummy_scalar_2,&dummy_int_2,&temp_work,&lwork,&lierr));
1555674ae819SStefano Zampini #else
1556e310c8b4SStefano Zampini     PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,&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));
1557674ae819SStefano Zampini #endif
1558674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1559984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
1560984c4197SStefano Zampini #endif /* on missing GESVD */
1561674ae819SStefano Zampini     /* Allocate optimal workspace */
1562674ae819SStefano Zampini     ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
1563984c4197SStefano Zampini     ierr = PetscMalloc((PetscInt)lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
1564674ae819SStefano Zampini   }
1565674ae819SStefano Zampini   /* Now we can loop on constraining sets */
1566674ae819SStefano Zampini   total_counts = 0;
1567674ae819SStefano Zampini   temp_indices[0] = 0;
1568674ae819SStefano Zampini   /* vertices */
1569674ae819SStefano Zampini   if (ISForVertices) {
1570674ae819SStefano Zampini     ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1571674ae819SStefano Zampini     if (nnsp_has_cnst) { /* consider all vertices */
157239e2fb2aSStefano Zampini       ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
1573674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1574674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1575674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1576674ae819SStefano Zampini         total_counts++;
1577674ae819SStefano Zampini       }
1578674ae819SStefano Zampini     } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
1579984c4197SStefano Zampini       PetscBool used_vertex;
1580674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1581674ae819SStefano Zampini         used_vertex = PETSC_FALSE;
1582674ae819SStefano Zampini         k = 0;
1583674ae819SStefano Zampini         while (!used_vertex && k<nnsp_size) {
1584984c4197SStefano Zampini           ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1585984c4197SStefano Zampini           if (PetscAbsScalar(array[is_indices[i]])>0.0) {
1586674ae819SStefano Zampini             temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1587674ae819SStefano Zampini             temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1588674ae819SStefano Zampini             temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1589674ae819SStefano Zampini             total_counts++;
1590674ae819SStefano Zampini             used_vertex = PETSC_TRUE;
1591674ae819SStefano Zampini           }
1592984c4197SStefano Zampini           ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1593674ae819SStefano Zampini           k++;
1594674ae819SStefano Zampini         }
1595674ae819SStefano Zampini       }
1596674ae819SStefano Zampini     }
1597674ae819SStefano Zampini     ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1598674ae819SStefano Zampini     n_vertices = total_counts;
1599674ae819SStefano Zampini   }
1600984c4197SStefano Zampini 
1601674ae819SStefano Zampini   /* edges and faces */
1602674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1603674ae819SStefano Zampini     if (i<n_ISForEdges) {
1604674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1605984c4197SStefano Zampini       boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
1606674ae819SStefano Zampini     } else {
1607674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1608984c4197SStefano Zampini       boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
1609674ae819SStefano Zampini     }
1610674ae819SStefano Zampini     temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
1611674ae819SStefano Zampini     temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
1612674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
1613674ae819SStefano Zampini     ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1614984c4197SStefano Zampini     /* change of basis should not be performed on local periodic nodes */
1615984c4197SStefano Zampini     if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
1616674ae819SStefano Zampini     if (nnsp_has_cnst) {
16175b08dc53SStefano Zampini       PetscScalar quad_value;
1618674ae819SStefano Zampini       temp_constraints++;
1619674ae819SStefano Zampini       quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
162039e2fb2aSStefano Zampini       ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
1621674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1622674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
1623674ae819SStefano Zampini       }
1624674ae819SStefano Zampini       temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
1625674ae819SStefano Zampini       total_counts++;
1626674ae819SStefano Zampini     }
1627674ae819SStefano Zampini     for (k=0;k<nnsp_size;k++) {
1628984c4197SStefano Zampini       PetscReal real_value;
1629984c4197SStefano Zampini       ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
163039e2fb2aSStefano Zampini       ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
1631674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1632984c4197SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=array[is_indices[j]];
1633674ae819SStefano Zampini       }
1634984c4197SStefano Zampini       ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1635984c4197SStefano Zampini       /* check if array is null on the connected component */
1636e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1637e310c8b4SStefano Zampini       PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_one));
16385b08dc53SStefano Zampini       if (real_value > 0.0) { /* keep indices and values */
1639674ae819SStefano Zampini         temp_constraints++;
1640674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
1641674ae819SStefano Zampini         total_counts++;
1642674ae819SStefano Zampini       }
1643674ae819SStefano Zampini     }
1644674ae819SStefano Zampini     ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
164545a1bb75SStefano Zampini     valid_constraints = temp_constraints;
1646eb97c9d2SStefano Zampini     /* perform SVD on the constraints if use_nnsp_true has not be requested by the user and there are non-null constraints on the cc */
1647eb97c9d2SStefano Zampini     if (!pcbddc->use_nnsp_true && temp_constraints) {
1648984c4197SStefano Zampini       PetscReal tol = 1.0e-8; /* tolerance for retaining eigenmodes */
1649674ae819SStefano Zampini 
1650674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1651984c4197SStefano Zampini       /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
1652984c4197SStefano Zampini          POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
1653984c4197SStefano Zampini          -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
1654984c4197SStefano Zampini             the constraints basis will differ (by a complex factor with absolute value equal to 1)
1655984c4197SStefano Zampini             from that computed using LAPACKgesvd
1656984c4197SStefano Zampini          -> This is due to a different computation of eigenvectors in LAPACKheev
1657984c4197SStefano Zampini          -> The quality of the POD-computed basis will be the same */
1658984c4197SStefano Zampini       ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
1659674ae819SStefano Zampini       /* Store upper triangular part of correlation matrix */
1660e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1661984c4197SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1662674ae819SStefano Zampini       for (j=0;j<temp_constraints;j++) {
1663674ae819SStefano Zampini         for (k=0;k<j+1;k++) {
1664e310c8b4SStefano Zampini           PetscStackCallBLAS("BLASdot",correlation_mat[j*temp_constraints+k]=BLASdot_(&Blas_N,&temp_quadrature_constraint[temp_indices[temp_start_ptr+k]],&Blas_one,&temp_quadrature_constraint[temp_indices[temp_start_ptr+j]],&Blas_one_2));
1665674ae819SStefano Zampini         }
1666674ae819SStefano Zampini       }
1667e310c8b4SStefano Zampini       /* compute eigenvalues and eigenvectors of correlation matrix */
1668e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1669e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
1670674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1671c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
1672674ae819SStefano Zampini #else
1673c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
1674674ae819SStefano Zampini #endif
1675674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1676984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
1677984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
1678674ae819SStefano Zampini       j=0;
1679984c4197SStefano Zampini       while (j < temp_constraints && singular_vals[j] < tol) j++;
1680674ae819SStefano Zampini       total_counts=total_counts-j;
168145a1bb75SStefano Zampini       valid_constraints = temp_constraints-j;
1682e310c8b4SStefano Zampini       /* scale and copy POD basis into used quadrature memory */
1683c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1684c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1685c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
1686c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1687c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
1688c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1689674ae819SStefano Zampini       if (j<temp_constraints) {
1690984c4197SStefano Zampini         PetscInt ii;
1691984c4197SStefano Zampini         for (k=j;k<temp_constraints;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]);
1692674ae819SStefano Zampini         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1693c4303822SStefano Zampini         PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&Blas_M,&Blas_N,&Blas_K,&one,&temp_quadrature_constraint[temp_indices[temp_start_ptr]],&Blas_LDA,correlation_mat,&Blas_LDB,&zero,temp_basis,&Blas_LDC));
1694674ae819SStefano Zampini         ierr = PetscFPTrapPop();CHKERRQ(ierr);
1695984c4197SStefano Zampini         for (k=0;k<temp_constraints-j;k++) {
1696674ae819SStefano Zampini           for (ii=0;ii<size_of_constraint;ii++) {
1697984c4197SStefano 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];
1698674ae819SStefano Zampini           }
1699674ae819SStefano Zampini         }
1700674ae819SStefano Zampini       }
1701674ae819SStefano Zampini #else  /* on missing GESVD */
1702e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1703e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1704b7d8b9f8SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1705674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1706674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1707e310c8b4SStefano Zampini       PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,&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));
1708674ae819SStefano Zampini #else
1709e310c8b4SStefano Zampini       PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,&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));
1710674ae819SStefano Zampini #endif
1711984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
1712674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1713984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
1714e310c8b4SStefano Zampini       k = temp_constraints;
1715e310c8b4SStefano Zampini       if (k > size_of_constraint) k = size_of_constraint;
1716674ae819SStefano Zampini       j = 0;
1717e310c8b4SStefano Zampini       while (j < k && singular_vals[k-j-1] < tol) j++;
1718e310c8b4SStefano Zampini       total_counts = total_counts-temp_constraints+k-j;
171945a1bb75SStefano Zampini       valid_constraints = k-j;
1720984c4197SStefano Zampini #endif /* on missing GESVD */
1721674ae819SStefano Zampini     }
172245a1bb75SStefano Zampini     /* setting change_of_basis flag is safe now */
172345a1bb75SStefano Zampini     if (boolforchange) {
172445a1bb75SStefano Zampini       for (j=0;j<valid_constraints;j++) {
172545a1bb75SStefano Zampini         PetscBTSet(change_basis,total_counts-j-1);
172645a1bb75SStefano Zampini       }
172745a1bb75SStefano Zampini     }
1728674ae819SStefano Zampini   }
1729674ae819SStefano Zampini   /* free index sets of faces, edges and vertices */
1730674ae819SStefano Zampini   for (i=0;i<n_ISForFaces;i++) {
1731674ae819SStefano Zampini     ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
1732674ae819SStefano Zampini   }
1733674ae819SStefano Zampini   ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
1734674ae819SStefano Zampini   for (i=0;i<n_ISForEdges;i++) {
1735674ae819SStefano Zampini     ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
1736674ae819SStefano Zampini   }
1737674ae819SStefano Zampini   ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
1738674ae819SStefano Zampini   ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
173939e2fb2aSStefano Zampini   /* map temp_indices_to_constraint in boundary numbering */
174039e2fb2aSStefano Zampini   ierr = ISGlobalToLocalMappingApply(pcbddc->BtoNmap,IS_GTOLM_DROP,temp_indices[total_counts],temp_indices_to_constraint,&i,temp_indices_to_constraint_B);CHKERRQ(ierr);
174139e2fb2aSStefano Zampini   if (i != temp_indices[total_counts]) {
174239e2fb2aSStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for constraints indices %d != %d\n",temp_indices[total_counts],i);
174339e2fb2aSStefano Zampini   }
1744674ae819SStefano Zampini 
1745984c4197SStefano Zampini   /* free workspace */
1746242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1747984c4197SStefano Zampini     ierr = PetscFree(work);CHKERRQ(ierr);
1748984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1749984c4197SStefano Zampini     ierr = PetscFree(rwork);CHKERRQ(ierr);
1750984c4197SStefano Zampini #endif
1751984c4197SStefano Zampini     ierr = PetscFree(singular_vals);CHKERRQ(ierr);
1752984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1753984c4197SStefano Zampini     ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
1754984c4197SStefano Zampini     ierr = PetscFree(temp_basis);CHKERRQ(ierr);
1755984c4197SStefano Zampini #endif
1756984c4197SStefano Zampini   }
1757984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1758984c4197SStefano Zampini     ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
1759984c4197SStefano Zampini   }
1760984c4197SStefano Zampini   ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
1761984c4197SStefano Zampini 
1762727cdba6SStefano Zampini   /* set quantities in pcbddc data structure and store previous primal size */
1763984c4197SStefano Zampini   /* n_vertices defines the number of subdomain corners in the primal space */
1764674ae819SStefano Zampini   /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */
1765727cdba6SStefano Zampini   olocal_primal_size = pcbddc->local_primal_size;
1766984c4197SStefano Zampini   pcbddc->local_primal_size = total_counts;
1767674ae819SStefano Zampini   pcbddc->n_vertices = n_vertices;
1768984c4197SStefano Zampini   pcbddc->n_constraints = pcbddc->local_primal_size-pcbddc->n_vertices;
1769674ae819SStefano Zampini 
1770674ae819SStefano Zampini   /* Create constraint matrix */
1771674ae819SStefano Zampini   /* The constraint matrix is used to compute the l2g map of primal dofs */
1772674ae819SStefano Zampini   /* so we need to set it up properly either with or without change of basis */
1773674ae819SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1774674ae819SStefano Zampini   ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr);
1775984c4197SStefano Zampini   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
1776984c4197SStefano Zampini   /* array to compute a local numbering of constraints : vertices first then constraints */
1777984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_numbering);CHKERRQ(ierr);
1778984c4197SStefano Zampini   /* array to select the proper local node (of minimum index with respect to global ordering) when changing the basis */
1779984c4197SStefano 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 */
1780984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_minloc);CHKERRQ(ierr);
1781984c4197SStefano Zampini   /* auxiliary stuff for basis change */
1782984c4197SStefano Zampini   ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&global_indices);CHKERRQ(ierr);
17834641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n_B,&touched);CHKERRQ(ierr);
1784984c4197SStefano Zampini 
1785984c4197SStefano Zampini   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
1786984c4197SStefano Zampini   total_primal_vertices=0;
1787984c4197SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
1788674ae819SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
1789984c4197SStefano Zampini     if (size_of_constraint == 1) {
17904641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]]);CHKERRQ(ierr);
1791984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]];
1792984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=0;
1793984c4197SStefano Zampini       total_primal_vertices++;
17944641a718SStefano Zampini     } else if (PetscBTLookup(change_basis,i)) { /* Same procedure used in PCBDDCGetPrimalConstraintsLocalIdx */
1795984c4197SStefano Zampini       PetscInt min_loc,min_index;
1796984c4197SStefano Zampini       ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],global_indices);CHKERRQ(ierr);
1797984c4197SStefano Zampini       /* find first untouched local node */
1798674ae819SStefano Zampini       k = 0;
17994641a718SStefano Zampini       while (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) k++;
1800984c4197SStefano Zampini       min_index = global_indices[k];
1801984c4197SStefano Zampini       min_loc = k;
1802984c4197SStefano Zampini       /* search the minimum among global nodes already untouched on the cc */
1803984c4197SStefano Zampini       for (k=1;k<size_of_constraint;k++) {
1804984c4197SStefano Zampini         /* there can be more than one constraint on a single connected component */
18054641a718SStefano Zampini         if (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k]) && min_index > global_indices[k]) {
1806984c4197SStefano Zampini           min_index = global_indices[k];
1807984c4197SStefano Zampini           min_loc = k;
1808674ae819SStefano Zampini         }
1809674ae819SStefano Zampini       }
18104641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]+min_loc]);CHKERRQ(ierr);
1811984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]+min_loc];
1812984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=min_loc;
1813984c4197SStefano Zampini       total_primal_vertices++;
1814984c4197SStefano Zampini     }
1815984c4197SStefano Zampini   }
1816a717540cSStefano Zampini   /* determine if a QR strategy is needed for change of basis */
1817a717540cSStefano Zampini   qr_needed = PETSC_FALSE;
1818a717540cSStefano Zampini   ierr = PetscBTCreate(pcbddc->local_primal_size,&qr_needed_idx);CHKERRQ(ierr);
1819a717540cSStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1820a717540cSStefano Zampini     if (PetscBTLookup(change_basis,i)) {
1821a717540cSStefano Zampini       size_of_constraint = temp_indices[i+1]-temp_indices[i];
1822a717540cSStefano Zampini       j = 0;
1823a717540cSStefano Zampini       for (k=0;k<size_of_constraint;k++) {
1824a717540cSStefano Zampini         if (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) {
1825a717540cSStefano Zampini           j++;
1826a717540cSStefano Zampini         }
1827a717540cSStefano Zampini       }
1828a717540cSStefano Zampini       /* found more than one primal dof on the cc */
1829a717540cSStefano Zampini       if (j > 1) {
1830a717540cSStefano Zampini         PetscBTSet(qr_needed_idx,i);
1831a717540cSStefano Zampini         qr_needed = PETSC_TRUE;
1832a717540cSStefano Zampini       }
1833a717540cSStefano Zampini     }
1834a717540cSStefano Zampini   }
1835984c4197SStefano Zampini   /* free workspace */
1836984c4197SStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
183745a1bb75SStefano Zampini 
1838674ae819SStefano Zampini   /* permute indices in order to have a sorted set of vertices */
1839a717540cSStefano Zampini   ierr = PetscSortInt(total_primal_vertices,aux_primal_numbering);CHKERRQ(ierr);
1840984c4197SStefano Zampini 
1841984c4197SStefano Zampini   /* nonzero structure of constraint matrix */
1842984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1843984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) nnz[i]=1;
1844984c4197SStefano Zampini   j=total_primal_vertices;
1845984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
18464641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1847674ae819SStefano Zampini       nnz[j]=temp_indices[i+1]-temp_indices[i];
1848674ae819SStefano Zampini       j++;
1849674ae819SStefano Zampini     }
1850674ae819SStefano Zampini   }
1851674ae819SStefano Zampini   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
1852674ae819SStefano Zampini   ierr = PetscFree(nnz);CHKERRQ(ierr);
1853674ae819SStefano Zampini   /* set values in constraint matrix */
1854984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) {
1855984c4197SStefano Zampini     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,aux_primal_numbering[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
1856674ae819SStefano Zampini   }
1857984c4197SStefano Zampini   total_counts = total_primal_vertices;
1858984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
18594641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1860674ae819SStefano Zampini       size_of_constraint=temp_indices[i+1]-temp_indices[i];
1861674ae819SStefano 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);
1862674ae819SStefano Zampini       total_counts++;
1863674ae819SStefano Zampini     }
1864674ae819SStefano Zampini   }
1865674ae819SStefano Zampini   /* assembling */
1866674ae819SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1867674ae819SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1868984c4197SStefano Zampini   /*
186945a1bb75SStefano Zampini   ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
1870984c4197SStefano Zampini   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
1871984c4197SStefano Zampini   */
1872674ae819SStefano Zampini   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
1873674ae819SStefano Zampini   if (pcbddc->use_change_of_basis) {
1874026de310SStefano Zampini     /* dual and primal dofs on a single cc */
1875984c4197SStefano Zampini     PetscInt     dual_dofs,primal_dofs;
1876026de310SStefano Zampini     /* iterator on aux_primal_minloc (ordered as read from nearnullspace: vertices, edges and then constraints) */
1877026de310SStefano Zampini     PetscInt     primal_counter;
1878984c4197SStefano Zampini     /* working stuff for GEQRF */
1879984c4197SStefano Zampini     PetscScalar  *qr_basis,*qr_tau,*qr_work,lqr_work_t;
1880984c4197SStefano Zampini     PetscBLASInt lqr_work;
1881984c4197SStefano Zampini     /* working stuff for UNGQR */
1882984c4197SStefano Zampini     PetscScalar  *gqr_work,lgqr_work_t;
1883984c4197SStefano Zampini     PetscBLASInt lgqr_work;
1884984c4197SStefano Zampini     /* working stuff for TRTRS */
1885984c4197SStefano Zampini     PetscScalar  *trs_rhs;
18863f08241aSStefano Zampini     PetscBLASInt Blas_NRHS;
1887984c4197SStefano Zampini     /* pointers for values insertion into change of basis matrix */
1888984c4197SStefano Zampini     PetscInt     *start_rows,*start_cols;
1889984c4197SStefano Zampini     PetscScalar  *start_vals;
1890984c4197SStefano Zampini     /* working stuff for values insertion */
18914641a718SStefano Zampini     PetscBT      is_primal;
1892984c4197SStefano Zampini 
1893a717540cSStefano Zampini     /* change of basis acts on local interfaces -> dimension is n_B x n_B */
1894a717540cSStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
1895a717540cSStefano Zampini     ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr);
1896a717540cSStefano Zampini     ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr);
1897a717540cSStefano Zampini     /* work arrays */
1898a717540cSStefano Zampini     ierr = PetscMalloc(pcis->n_B*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1899a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) nnz[i]=1;
1900a717540cSStefano Zampini     /* nonzeros per row */
1901a717540cSStefano Zampini     for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1902a717540cSStefano Zampini       if (PetscBTLookup(change_basis,i)) {
1903a717540cSStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
1904a717540cSStefano Zampini         if (PetscBTLookup(qr_needed_idx,i)) {
1905a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1906a717540cSStefano Zampini         } else {
1907a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = 2;
1908a717540cSStefano Zampini           /* get local primal index on the cc */
1909a717540cSStefano Zampini           j = 0;
1910a717540cSStefano Zampini           while (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+j])) j++;
1911a717540cSStefano Zampini           nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1912a717540cSStefano Zampini         }
1913a717540cSStefano Zampini       }
1914a717540cSStefano Zampini     }
1915a717540cSStefano Zampini     ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
1916a717540cSStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
1917a717540cSStefano Zampini     /* Set initial identity in the matrix */
1918a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) {
1919a717540cSStefano Zampini       ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
1920a717540cSStefano Zampini     }
1921a717540cSStefano Zampini 
1922a717540cSStefano Zampini     if (pcbddc->dbg_flag) {
1923a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1924a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
1925a717540cSStefano Zampini     }
1926a717540cSStefano Zampini 
1927a717540cSStefano Zampini 
1928a717540cSStefano Zampini     /* Now we loop on the constraints which need a change of basis */
1929a717540cSStefano Zampini     /*
1930a717540cSStefano Zampini        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
1931a717540cSStefano Zampini        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
1932a717540cSStefano Zampini 
1933a717540cSStefano Zampini        Basic blocks of change of basis matrix T computed
1934a717540cSStefano Zampini 
1935a717540cSStefano Zampini           - Using the following block transformation if there is only a primal dof on the cc
1936a717540cSStefano Zampini             (in the example, primal dof is the last one of the edge in LOCAL ordering
1937a717540cSStefano Zampini              in this code, primal dof is the first one of the edge in GLOBAL ordering)
1938a717540cSStefano Zampini             | 1        0   ...        0     1 |
1939a717540cSStefano Zampini             | 0        1   ...        0     1 |
1940a717540cSStefano Zampini             |              ...                |
1941a717540cSStefano Zampini             | 0        ...            1     1 |
1942a717540cSStefano Zampini             | -s_1/s_n ...    -s_{n-1}/-s_n 1 |
1943a717540cSStefano Zampini 
1944a717540cSStefano Zampini           - via QR decomposition of constraints otherwise
1945a717540cSStefano Zampini     */
1946a717540cSStefano Zampini     if (qr_needed) {
1947984c4197SStefano Zampini       /* space to store Q */
1948984c4197SStefano Zampini       ierr = PetscMalloc((max_size_of_constraint)*(max_size_of_constraint)*sizeof(PetscScalar),&qr_basis);CHKERRQ(ierr);
1949984c4197SStefano Zampini       /* first we issue queries for optimal work */
19503f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
19513f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
19523f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1953984c4197SStefano Zampini       lqr_work = -1;
19543f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
1955984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
1956984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
1957984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lqr_work_t)*sizeof(*qr_work),&qr_work);CHKERRQ(ierr);
1958984c4197SStefano Zampini       lgqr_work = -1;
19593f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
19603f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
19613f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
19623f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
19633f08241aSStefano Zampini       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
19643f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
1965984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
1966984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
1967984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lgqr_work_t)*sizeof(*gqr_work),&gqr_work);CHKERRQ(ierr);
1968984c4197SStefano Zampini       /* array to store scaling factors for reflectors */
1969984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*sizeof(*qr_tau),&qr_tau);CHKERRQ(ierr);
1970984c4197SStefano Zampini       /* array to store rhs and solution of triangular solver */
1971984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*max_constraints*sizeof(*trs_rhs),&trs_rhs);CHKERRQ(ierr);
1972a717540cSStefano Zampini       /* allocating workspace for check */
1973a717540cSStefano Zampini       if (pcbddc->dbg_flag) {
1974a717540cSStefano Zampini         ierr = PetscMalloc(max_size_of_constraint*(max_constraints+max_size_of_constraint)*sizeof(*work),&work);CHKERRQ(ierr);
1975a717540cSStefano Zampini       }
1976a717540cSStefano Zampini     }
1977984c4197SStefano Zampini     /* array to store whether a node is primal or not */
19784641a718SStefano Zampini     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
197939e2fb2aSStefano Zampini     ierr = PetscMalloc(total_primal_vertices*sizeof(PetscInt),&aux_primal_numbering_B);CHKERRQ(ierr);
198039e2fb2aSStefano Zampini     ierr = ISGlobalToLocalMappingApply(pcbddc->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,aux_primal_numbering,&i,aux_primal_numbering_B);CHKERRQ(ierr);
198139e2fb2aSStefano Zampini     if (i != total_primal_vertices) {
198239e2fb2aSStefano Zampini       SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %d != %d\n",total_primal_vertices,i);
19834641a718SStefano Zampini     }
198439e2fb2aSStefano Zampini     for (i=0;i<total_primal_vertices;i++) {
198539e2fb2aSStefano Zampini       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
198639e2fb2aSStefano Zampini     }
198739e2fb2aSStefano Zampini     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
1988984c4197SStefano Zampini 
1989a717540cSStefano Zampini     /* loop on constraints and see whether or not they need a change of basis and compute it */
1990026de310SStefano Zampini     /* -> using implicit ordering contained in temp_indices data */
1991026de310SStefano Zampini     total_counts = pcbddc->n_vertices;
1992026de310SStefano Zampini     primal_counter = total_counts;
1993026de310SStefano Zampini     while (total_counts<pcbddc->local_primal_size) {
1994026de310SStefano Zampini       primal_dofs = 1;
19954641a718SStefano Zampini       if (PetscBTLookup(change_basis,total_counts)) {
1996026de310SStefano Zampini         /* get all constraints with same support: if more then one constraint is present on the cc then surely indices are stored contiguosly */
1997026de310SStefano 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]]) {
1998026de310SStefano Zampini           primal_dofs++;
1999674ae819SStefano Zampini         }
2000984c4197SStefano Zampini         /* get constraint info */
2001026de310SStefano Zampini         size_of_constraint = temp_indices[total_counts+1]-temp_indices[total_counts];
2002984c4197SStefano Zampini         dual_dofs = size_of_constraint-primal_dofs;
2003984c4197SStefano Zampini 
2004984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
2005a717540cSStefano Zampini           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraints %d to %d (incl) need a change of basis (size %d)\n",total_counts,total_counts+primal_dofs-1,size_of_constraint);CHKERRQ(ierr);
2006674ae819SStefano Zampini         }
2007984c4197SStefano Zampini 
2008a717540cSStefano Zampini         if (primal_dofs > 1) { /* QR */
2009a717540cSStefano Zampini 
2010a717540cSStefano Zampini           /* copy quadrature constraints for change of basis check */
2011a717540cSStefano Zampini           if (pcbddc->dbg_flag) {
2012a717540cSStefano Zampini             ierr = PetscMemcpy(work,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
2013a717540cSStefano Zampini           }
2014984c4197SStefano Zampini           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
2015026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
2016984c4197SStefano Zampini 
2017984c4197SStefano Zampini           /* compute QR decomposition of constraints */
20183f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
20193f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
20203f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2021674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
20223f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
2023984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
2024674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2025984c4197SStefano Zampini 
2026984c4197SStefano Zampini           /* explictly compute R^-T */
2027984c4197SStefano Zampini           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
2028984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
20293f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
20303f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
20313f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
20323f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
2033984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
20343f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
2035984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
2036984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2037984c4197SStefano Zampini 
2038a717540cSStefano Zampini           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
20393f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
20403f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
20413f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
20423f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2043984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
20443f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
2045984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
2046984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2047984c4197SStefano Zampini 
2048984c4197SStefano Zampini           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
2049984c4197SStefano Zampini              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
2050984c4197SStefano Zampini              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
20513f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
20523f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
20533f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
20543f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
20553f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
20563f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
2057984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2058c4303822SStefano Zampini           PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&Blas_M,&Blas_N,&Blas_K,&one,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&zero,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_LDC));
2059984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2060026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
2061984c4197SStefano Zampini 
2062984c4197SStefano Zampini           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
2063026de310SStefano Zampini           start_rows = &temp_indices_to_constraint_B[temp_indices[total_counts]];
2064984c4197SStefano Zampini           /* insert cols for primal dofs */
2065984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) {
2066984c4197SStefano Zampini             start_vals = &qr_basis[j*size_of_constraint];
2067026de310SStefano Zampini             start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter+j]];
2068984c4197SStefano Zampini             ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
2069984c4197SStefano Zampini           }
2070984c4197SStefano Zampini           /* insert cols for dual dofs */
2071984c4197SStefano Zampini           for (j=0,k=0;j<dual_dofs;k++) {
20724641a718SStefano Zampini             if (!PetscBTLookup(is_primal,temp_indices_to_constraint_B[temp_indices[total_counts]+k])) {
2073984c4197SStefano Zampini               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
2074026de310SStefano Zampini               start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+k];
2075984c4197SStefano Zampini               ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
2076984c4197SStefano Zampini               j++;
2077674ae819SStefano Zampini             }
2078674ae819SStefano Zampini           }
2079984c4197SStefano Zampini 
2080984c4197SStefano Zampini           /* check change of basis */
2081984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
2082984c4197SStefano Zampini             PetscInt   ii,jj;
2083984c4197SStefano Zampini             PetscBool valid_qr=PETSC_TRUE;
2084c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
2085c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2086c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
2087c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2088c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
2089c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
2090984c4197SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2091c4303822SStefano Zampini             PetscStackCallBLAS("BLASgemm",BLASgemm_("T","N",&Blas_M,&Blas_N,&Blas_K,&one,work,&Blas_LDA,qr_basis,&Blas_LDB,&zero,&work[size_of_constraint*primal_dofs],&Blas_LDC));
2092984c4197SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
2093984c4197SStefano Zampini             for (jj=0;jj<size_of_constraint;jj++) {
2094984c4197SStefano Zampini               for (ii=0;ii<primal_dofs;ii++) {
2095984c4197SStefano Zampini                 if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
2096984c4197SStefano Zampini                 if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
2097674ae819SStefano Zampini               }
2098674ae819SStefano Zampini             }
2099984c4197SStefano Zampini             if (!valid_qr) {
210022d5777bSStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
2101984c4197SStefano Zampini               for (jj=0;jj<size_of_constraint;jj++) {
2102984c4197SStefano Zampini                 for (ii=0;ii<primal_dofs;ii++) {
2103984c4197SStefano Zampini                   if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
2104984c4197SStefano 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]));
2105674ae819SStefano Zampini                   }
2106984c4197SStefano Zampini                   if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
2107984c4197SStefano 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]));
2108984c4197SStefano Zampini                   }
2109984c4197SStefano Zampini                 }
2110984c4197SStefano Zampini               }
2111674ae819SStefano Zampini             } else {
211222d5777bSStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
2113674ae819SStefano Zampini             }
2114674ae819SStefano Zampini           }
2115a717540cSStefano Zampini         } else { /* simple transformation block */
2116a717540cSStefano Zampini           PetscInt row,col;
2117a717540cSStefano Zampini           PetscScalar val;
2118a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) {
2119a717540cSStefano Zampini             row = temp_indices_to_constraint_B[temp_indices[total_counts]+j];
2120a717540cSStefano Zampini             if (!PetscBTLookup(is_primal,row)) {
2121a717540cSStefano Zampini               col = temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
2122a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
2123a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,1.0,INSERT_VALUES);CHKERRQ(ierr);
2124a717540cSStefano Zampini             } else {
2125a717540cSStefano Zampini               for (k=0;k<size_of_constraint;k++) {
2126a717540cSStefano Zampini                 col = temp_indices_to_constraint_B[temp_indices[total_counts]+k];
2127a717540cSStefano Zampini                 if (row != col) {
2128a717540cSStefano Zampini                   val = -temp_quadrature_constraint[temp_indices[total_counts]+k]/temp_quadrature_constraint[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
2129a717540cSStefano Zampini                 } else {
2130a717540cSStefano Zampini                   val = 1.0;
2131a717540cSStefano Zampini                 }
2132a717540cSStefano Zampini                 ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
2133a717540cSStefano Zampini               }
2134a717540cSStefano Zampini             }
2135a717540cSStefano Zampini           }
213622d5777bSStefano Zampini           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
2137a717540cSStefano Zampini         }
2138026de310SStefano Zampini         /* increment primal counter */
2139026de310SStefano Zampini         primal_counter += primal_dofs;
2140984c4197SStefano Zampini       } else {
2141984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
2142026de310SStefano 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);
2143674ae819SStefano Zampini         }
2144674ae819SStefano Zampini       }
2145026de310SStefano Zampini       /* increment constraint counter total_counts */
2146026de310SStefano Zampini       total_counts += primal_dofs;
2147674ae819SStefano Zampini     }
2148a717540cSStefano Zampini 
2149a717540cSStefano Zampini     /* free workspace */
2150a717540cSStefano Zampini     if (qr_needed) {
2151984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
2152984c4197SStefano Zampini         ierr = PetscFree(work);CHKERRQ(ierr);
2153984c4197SStefano Zampini       }
2154984c4197SStefano Zampini       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
2155984c4197SStefano Zampini       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
2156984c4197SStefano Zampini       ierr = PetscFree(qr_work);CHKERRQ(ierr);
2157984c4197SStefano Zampini       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
2158984c4197SStefano Zampini       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
2159674ae819SStefano Zampini     }
2160a717540cSStefano Zampini     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
2161674ae819SStefano Zampini     /* assembling */
2162674ae819SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2163674ae819SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2164984c4197SStefano Zampini     /*
216545a1bb75SStefano Zampini     ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
2166984c4197SStefano Zampini     ierr = MatView(pcbddc->ChangeOfBasisMatrix,(PetscViewer)0);CHKERRQ(ierr);
2167984c4197SStefano Zampini     */
2168674ae819SStefano Zampini   }
2169a717540cSStefano Zampini 
2170727cdba6SStefano Zampini   /* get indices in local ordering for vertices and constraints */
2171727cdba6SStefano Zampini   if (olocal_primal_size == pcbddc->local_primal_size) { /* if this is true, I need to check if a new primal space has been introduced */
2172727cdba6SStefano Zampini     ierr = PetscMalloc(olocal_primal_size*sizeof(PetscInt),&oprimal_indices_local_idxs);CHKERRQ(ierr);
2173727cdba6SStefano Zampini     ierr = PetscMemcpy(oprimal_indices_local_idxs,pcbddc->primal_indices_local_idxs,olocal_primal_size*sizeof(PetscInt));CHKERRQ(ierr);
2174727cdba6SStefano Zampini   }
2175727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2176727cdba6SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
2177727cdba6SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&i,&aux_primal_numbering);CHKERRQ(ierr);
2178727cdba6SStefano Zampini   ierr = PetscMemcpy(pcbddc->primal_indices_local_idxs,aux_primal_numbering,i*sizeof(PetscInt));CHKERRQ(ierr);
2179727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2180727cdba6SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&j,&aux_primal_numbering);CHKERRQ(ierr);
2181727cdba6SStefano Zampini   ierr = PetscMemcpy(&pcbddc->primal_indices_local_idxs[i],aux_primal_numbering,j*sizeof(PetscInt));CHKERRQ(ierr);
2182727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2183e9189074SStefano Zampini   /* set quantities in PCBDDC data struct */
2184e9189074SStefano Zampini   pcbddc->n_actual_vertices = i;
2185727cdba6SStefano Zampini   /* check if a new primal space has been introduced */
2186727cdba6SStefano Zampini   pcbddc->new_primal_space_local = PETSC_TRUE;
2187727cdba6SStefano Zampini   if (olocal_primal_size == pcbddc->local_primal_size) {
2188727cdba6SStefano Zampini     ierr = PetscMemcmp(pcbddc->primal_indices_local_idxs,oprimal_indices_local_idxs,olocal_primal_size,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
2189c1c8e736SStefano Zampini     pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
2190727cdba6SStefano Zampini     ierr = PetscFree(oprimal_indices_local_idxs);CHKERRQ(ierr);
2191727cdba6SStefano Zampini   }
2192727cdba6SStefano Zampini   /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
2193727cdba6SStefano Zampini   ierr = MPI_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2194727cdba6SStefano Zampini 
2195a717540cSStefano Zampini   /* flush dbg viewer */
2196b8ffe317SStefano Zampini   if (pcbddc->dbg_flag) {
2197b8ffe317SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2198b8ffe317SStefano Zampini   }
2199a717540cSStefano Zampini 
2200e310c8b4SStefano Zampini   /* free workspace */
2201a717540cSStefano Zampini   ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2202a717540cSStefano Zampini   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
2203984c4197SStefano Zampini   ierr = PetscFree(aux_primal_minloc);CHKERRQ(ierr);
2204674ae819SStefano Zampini   ierr = PetscFree(temp_indices);CHKERRQ(ierr);
22054641a718SStefano Zampini   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
2206674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr);
2207674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
2208674ae819SStefano Zampini   ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr);
2209674ae819SStefano Zampini   PetscFunctionReturn(0);
2210674ae819SStefano Zampini }
2211674ae819SStefano Zampini 
2212674ae819SStefano Zampini #undef __FUNCT__
2213674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
2214674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
2215674ae819SStefano Zampini {
2216674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
2217674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
2218674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
221963602bcaSStefano Zampini   PetscInt    ierr,i,vertex_size;
2220674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
2221674ae819SStefano Zampini 
2222674ae819SStefano Zampini   PetscFunctionBegin;
22238e61c736SStefano Zampini   /* Reset previously computed graph */
22248e61c736SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
2225674ae819SStefano Zampini   /* Init local Graph struct */
2226674ae819SStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr);
2227674ae819SStefano Zampini 
2228575ad6abSStefano Zampini   /* Check validity of the csr graph passed in by the user */
2229575ad6abSStefano Zampini   if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) {
2230575ad6abSStefano Zampini     ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
2231575ad6abSStefano Zampini   }
22329577ea80SStefano Zampini 
2233674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
2234674ae819SStefano Zampini   if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) {
2235674ae819SStefano Zampini     Mat mat_adj;
2236674ae819SStefano Zampini     const PetscInt *xadj,*adjncy;
2237674ae819SStefano Zampini     PetscBool flg_row=PETSC_TRUE;
2238674ae819SStefano Zampini 
2239674ae819SStefano Zampini     ierr = MatConvert(matis->A,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr);
2240674ae819SStefano Zampini     ierr = MatGetRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2241674ae819SStefano Zampini     if (!flg_row) {
2242674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ called in %s\n",__FUNCT__);
2243674ae819SStefano Zampini     }
2244674ae819SStefano Zampini     ierr = PCBDDCSetLocalAdjacencyGraph(pc,i,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
2245674ae819SStefano Zampini     ierr = MatRestoreRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2246674ae819SStefano Zampini     if (!flg_row) {
2247674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__);
2248674ae819SStefano Zampini     }
2249674ae819SStefano Zampini     ierr = MatDestroy(&mat_adj);CHKERRQ(ierr);
2250674ae819SStefano Zampini   }
2251674ae819SStefano Zampini 
225263602bcaSStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting or PCBDDCSetDofsSplittingLocal */
2253674ae819SStefano Zampini   vertex_size = 1;
225463602bcaSStefano Zampini   if (pcbddc->user_provided_isfordofs) {
225563602bcaSStefano Zampini     if (pcbddc->n_ISForDofs) { /* need to convert from global to local and remove references to global dofs splitting */
225663602bcaSStefano Zampini       ierr = PetscMalloc(pcbddc->n_ISForDofs*sizeof(IS),&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
225763602bcaSStefano Zampini       for (i=0;i<pcbddc->n_ISForDofs;i++) {
225863602bcaSStefano Zampini         ierr = PCBDDCGlobalToLocal(pc,matis->ctx,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
225963602bcaSStefano Zampini         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
2260674ae819SStefano Zampini       }
226163602bcaSStefano Zampini       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
226263602bcaSStefano Zampini       pcbddc->n_ISForDofs = 0;
226363602bcaSStefano Zampini       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
2264674ae819SStefano Zampini     }
226563602bcaSStefano Zampini     /* mat block size as vertex size (used for elasticity with rigid body modes as nearnullspace) */
2266674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
226763602bcaSStefano Zampini   } else {
226863602bcaSStefano Zampini     if (!pcbddc->n_ISForDofsLocal) { /* field split not present, create it in local ordering */
226963602bcaSStefano Zampini       ierr = MatGetBlockSize(pc->pmat,&pcbddc->n_ISForDofsLocal);CHKERRQ(ierr);
227063602bcaSStefano Zampini       ierr = PetscMalloc(pcbddc->n_ISForDofsLocal*sizeof(IS),&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
227163602bcaSStefano Zampini       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
227263602bcaSStefano Zampini         ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),pcis->n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
227363602bcaSStefano Zampini       }
227463602bcaSStefano Zampini     }
2275674ae819SStefano Zampini   }
2276674ae819SStefano Zampini 
2277674ae819SStefano Zampini   /* Setup of Graph */
2278785d1243SStefano Zampini   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) { /* need to convert from global to local */
2279e456f2a8SStefano Zampini     ierr = PCBDDCGlobalToLocal(pc,matis->ctx,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
2280785d1243SStefano Zampini   }
2281785d1243SStefano Zampini   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) { /* need to convert from global to local */
2282e456f2a8SStefano Zampini     ierr = PCBDDCGlobalToLocal(pc,matis->ctx,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
2283785d1243SStefano Zampini   }
228463602bcaSStefano Zampini   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices);
2285674ae819SStefano Zampini 
2286674ae819SStefano Zampini   /* Graph's connected components analysis */
2287674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
2288674ae819SStefano Zampini 
2289674ae819SStefano Zampini   /* print some info to stdout */
2290674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
2291e49050b4SStefano Zampini     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer);
2292674ae819SStefano Zampini   }
2293fb180af4SStefano Zampini 
2294fb180af4SStefano Zampini   /* mark topography has done */
2295fb180af4SStefano Zampini   pcbddc->recompute_topography = PETSC_FALSE;
2296674ae819SStefano Zampini   PetscFunctionReturn(0);
2297674ae819SStefano Zampini }
2298674ae819SStefano Zampini 
2299674ae819SStefano Zampini #undef __FUNCT__
2300674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx"
2301f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt **vertices_idx)
2302674ae819SStefano Zampini {
2303674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2304674ae819SStefano Zampini   PetscInt       *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size;
2305674ae819SStefano Zampini   PetscErrorCode ierr;
2306674ae819SStefano Zampini 
2307674ae819SStefano Zampini   PetscFunctionBegin;
2308674ae819SStefano Zampini   n = 0;
2309674ae819SStefano Zampini   vertices = 0;
2310674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2311674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr);
2312b120a5c6SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2313b120a5c6SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2314b120a5c6SStefano Zampini       if (size_of_constraint == 1) n++;
2315b120a5c6SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2316b120a5c6SStefano Zampini     }
2317811e8ca2SStefano Zampini     if (vertices_idx) {
2318b120a5c6SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&vertices);CHKERRQ(ierr);
2319b120a5c6SStefano Zampini       n = 0;
2320674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2321674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2322674ae819SStefano Zampini         if (size_of_constraint == 1) {
2323674ae819SStefano Zampini           vertices[n++]=row_cmat_indices[0];
2324674ae819SStefano Zampini         }
2325674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2326674ae819SStefano Zampini       }
2327674ae819SStefano Zampini     }
2328811e8ca2SStefano Zampini   }
2329674ae819SStefano Zampini   *n_vertices = n;
2330811e8ca2SStefano Zampini   if (vertices_idx) *vertices_idx = vertices;
2331674ae819SStefano Zampini   PetscFunctionReturn(0);
2332674ae819SStefano Zampini }
2333674ae819SStefano Zampini 
2334674ae819SStefano Zampini #undef __FUNCT__
2335674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx"
2336f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt **constraints_idx)
2337674ae819SStefano Zampini {
2338674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2339674ae819SStefano Zampini   PetscInt       *constraints_index,*row_cmat_indices,*row_cmat_global_indices;
2340674ae819SStefano Zampini   PetscInt       n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc;
23414641a718SStefano Zampini   PetscBT        touched;
2342674ae819SStefano Zampini   PetscErrorCode ierr;
2343674ae819SStefano Zampini 
2344f34684f1SStefano Zampini     /* This function assumes that the number of local constraints per connected component
2345f34684f1SStefano Zampini        is not greater than the number of nodes defined for the connected component
2346f34684f1SStefano Zampini        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
2347674ae819SStefano Zampini   PetscFunctionBegin;
2348674ae819SStefano Zampini   n = 0;
2349674ae819SStefano Zampini   constraints_index = 0;
2350674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2351674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr);
2352674ae819SStefano Zampini     max_size_of_constraint = 0;
2353674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2354674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2355674ae819SStefano Zampini       if (size_of_constraint > 1) {
2356674ae819SStefano Zampini         n++;
2357674ae819SStefano Zampini       }
2358674ae819SStefano Zampini       max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint);
2359674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2360674ae819SStefano Zampini     }
2361811e8ca2SStefano Zampini     if (constraints_idx) {
2362674ae819SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&constraints_index);CHKERRQ(ierr);
2363674ae819SStefano Zampini       ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&row_cmat_global_indices);CHKERRQ(ierr);
23644641a718SStefano Zampini       ierr = PetscBTCreate(local_size,&touched);CHKERRQ(ierr);
2365674ae819SStefano Zampini       n = 0;
2366674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2367674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2368674ae819SStefano Zampini         if (size_of_constraint > 1) {
2369674ae819SStefano Zampini           ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr);
237082d3d8afSStefano Zampini           /* find first untouched local node */
237182d3d8afSStefano Zampini           j = 0;
23724641a718SStefano Zampini           while (PetscBTLookup(touched,row_cmat_indices[j])) j++;
237382d3d8afSStefano Zampini           min_index = row_cmat_global_indices[j];
237482d3d8afSStefano Zampini           min_loc = j;
237582d3d8afSStefano Zampini           /* search the minimum among nodes not yet touched on the connected component
237682d3d8afSStefano Zampini              since there can be more than one constraint on a single cc */
2377674ae819SStefano Zampini           for (j=1;j<size_of_constraint;j++) {
23784641a718SStefano Zampini             if (!PetscBTLookup(touched,row_cmat_indices[j]) && min_index > row_cmat_global_indices[j]) {
2379674ae819SStefano Zampini               min_index = row_cmat_global_indices[j];
2380674ae819SStefano Zampini               min_loc = j;
2381674ae819SStefano Zampini             }
2382674ae819SStefano Zampini           }
23834641a718SStefano Zampini           ierr = PetscBTSet(touched,row_cmat_indices[min_loc]);CHKERRQ(ierr);
2384674ae819SStefano Zampini           constraints_index[n++] = row_cmat_indices[min_loc];
2385674ae819SStefano Zampini         }
2386674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2387674ae819SStefano Zampini       }
23884641a718SStefano Zampini       ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2389674ae819SStefano Zampini       ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr);
2390811e8ca2SStefano Zampini     }
2391811e8ca2SStefano Zampini   }
2392674ae819SStefano Zampini   *n_constraints = n;
2393811e8ca2SStefano Zampini   if (constraints_idx) *constraints_idx = constraints_index;
2394674ae819SStefano Zampini   PetscFunctionReturn(0);
2395674ae819SStefano Zampini }
2396674ae819SStefano Zampini 
2397674ae819SStefano Zampini /* the next two functions has been adapted from pcis.c */
2398674ae819SStefano Zampini #undef __FUNCT__
2399674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchur"
2400674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchur(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2401674ae819SStefano Zampini {
2402674ae819SStefano Zampini   PetscErrorCode ierr;
2403674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2404674ae819SStefano Zampini 
2405674ae819SStefano Zampini   PetscFunctionBegin;
2406674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2407674ae819SStefano Zampini   ierr = MatMult(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2408674ae819SStefano Zampini   ierr = MatMult(pcis->A_IB,v,vec1_D);CHKERRQ(ierr);
2409674ae819SStefano Zampini   ierr = KSPSolve(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2410674ae819SStefano Zampini   ierr = MatMult(pcis->A_BI,vec2_D,vec2_B);CHKERRQ(ierr);
2411674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2412674ae819SStefano Zampini   PetscFunctionReturn(0);
2413674ae819SStefano Zampini }
2414674ae819SStefano Zampini 
2415674ae819SStefano Zampini #undef __FUNCT__
2416674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchurTranspose"
2417674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchurTranspose(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2418674ae819SStefano Zampini {
2419674ae819SStefano Zampini   PetscErrorCode ierr;
2420674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2421674ae819SStefano Zampini 
2422674ae819SStefano Zampini   PetscFunctionBegin;
2423674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2424674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2425674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BI,v,vec1_D);CHKERRQ(ierr);
2426674ae819SStefano Zampini   ierr = KSPSolveTranspose(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2427674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_IB,vec2_D,vec2_B);CHKERRQ(ierr);
2428674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2429674ae819SStefano Zampini   PetscFunctionReturn(0);
2430674ae819SStefano Zampini }
2431674ae819SStefano Zampini 
2432674ae819SStefano Zampini #undef __FUNCT__
2433674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
2434674ae819SStefano 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[])
2435674ae819SStefano Zampini {
2436674ae819SStefano Zampini   Vec            local_vec,global_vec;
2437674ae819SStefano Zampini   IS             seqis,paris;
2438674ae819SStefano Zampini   VecScatter     scatter_ctx;
2439674ae819SStefano Zampini   PetscScalar    *array;
2440674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
2441674ae819SStefano Zampini   PetscScalar    globalsum;
2442674ae819SStefano Zampini   PetscInt       i,j,s;
2443674ae819SStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local;
2444674ae819SStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm,max_global;
2445674ae819SStefano Zampini   PetscMPIInt    *dof_sizes,*dof_displs;
2446674ae819SStefano Zampini   PetscBool      first_found;
2447674ae819SStefano Zampini   PetscErrorCode ierr;
2448674ae819SStefano Zampini 
2449674ae819SStefano Zampini   PetscFunctionBegin;
2450674ae819SStefano Zampini   /* mpi buffers */
2451674ae819SStefano Zampini   MPI_Comm_size(comm,&size_prec_comm);
2452674ae819SStefano Zampini   MPI_Comm_rank(comm,&rank_prec_comm);
2453674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
2454674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_sizes),&dof_sizes);CHKERRQ(ierr);
2455674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_displs),&dof_displs);CHKERRQ(ierr);
2456674ae819SStefano Zampini   /* get maximum size of subset */
2457674ae819SStefano Zampini   ierr = PetscMalloc(n_local_dofs*sizeof(PetscInt),&temp_global_dofs);CHKERRQ(ierr);
2458674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
2459674ae819SStefano Zampini   max_local = 0;
2460674ae819SStefano Zampini   if (n_local_dofs) {
2461674ae819SStefano Zampini     max_local = temp_global_dofs[0];
2462674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2463674ae819SStefano Zampini       if (max_local < temp_global_dofs[i] ) {
2464674ae819SStefano Zampini         max_local = temp_global_dofs[i];
2465674ae819SStefano Zampini       }
2466674ae819SStefano Zampini     }
2467674ae819SStefano Zampini   }
2468674ae819SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);
2469674ae819SStefano Zampini   max_global++;
2470674ae819SStefano Zampini   max_local = 0;
2471674ae819SStefano Zampini   if (n_local_dofs) {
2472674ae819SStefano Zampini     max_local = local_dofs[0];
2473674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2474674ae819SStefano Zampini       if (max_local < local_dofs[i] ) {
2475674ae819SStefano Zampini         max_local = local_dofs[i];
2476674ae819SStefano Zampini       }
2477674ae819SStefano Zampini     }
2478674ae819SStefano Zampini   }
2479674ae819SStefano Zampini   max_local++;
2480674ae819SStefano Zampini   /* allocate workspace */
2481674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
2482674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
2483674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
2484674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
2485674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
2486674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
2487674ae819SStefano Zampini   /* create scatter */
2488674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
2489674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
2490674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
2491674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
2492674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
2493674ae819SStefano Zampini   /* init array */
2494674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
2495674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2496674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2497674ae819SStefano Zampini   if (local_dofs_mult) {
2498674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2499674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
2500674ae819SStefano Zampini     }
2501674ae819SStefano Zampini   } else {
2502674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2503674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
2504674ae819SStefano Zampini     }
2505674ae819SStefano Zampini   }
2506674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2507674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
2508674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2509674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2510674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
25115b08dc53SStefano Zampini   *n_global_subset = (PetscInt)PetscRealPart(globalsum);
2512674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
2513674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
2514674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
2515674ae819SStefano Zampini   nlocals = 0;
2516674ae819SStefano Zampini   first_index = -1;
2517674ae819SStefano Zampini   first_found = PETSC_FALSE;
2518674ae819SStefano Zampini   for (i=0;i<s;i++) {
25195b08dc53SStefano Zampini     if (!first_found && PetscRealPart(array[i]) > 0.0) {
2520674ae819SStefano Zampini       first_found = PETSC_TRUE;
2521674ae819SStefano Zampini       first_index = i;
2522674ae819SStefano Zampini     }
25235b08dc53SStefano Zampini     nlocals += (PetscInt)PetscRealPart(array[i]);
2524674ae819SStefano Zampini   }
2525674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2526674ae819SStefano Zampini   if (!rank_prec_comm) {
2527674ae819SStefano Zampini     dof_displs[0]=0;
2528674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
2529674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
2530674ae819SStefano Zampini     }
2531674ae819SStefano Zampini   }
2532674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2533674ae819SStefano Zampini   if (first_found) {
2534674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
2535674ae819SStefano Zampini     old_index = first_index;
2536674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
25375b08dc53SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) {
2538674ae819SStefano Zampini         array[i] += array[old_index];
2539674ae819SStefano Zampini         old_index = i;
2540674ae819SStefano Zampini       }
2541674ae819SStefano Zampini     }
2542674ae819SStefano Zampini   }
2543674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
2544674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2545674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2546674ae819SStefano Zampini   ierr = VecScatterEnd  (scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2547674ae819SStefano Zampini   /* get global ordering of local dofs */
2548674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2549674ae819SStefano Zampini   if (local_dofs_mult) {
2550674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
25515b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i];
2552674ae819SStefano Zampini     }
2553674ae819SStefano Zampini   } else {
2554674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
25555b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1;
2556674ae819SStefano Zampini     }
2557674ae819SStefano Zampini   }
2558674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2559674ae819SStefano Zampini   /* free workspace */
2560674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
2561674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
2562674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
2563674ae819SStefano Zampini   ierr = PetscFree(dof_sizes);CHKERRQ(ierr);
2564674ae819SStefano Zampini   ierr = PetscFree(dof_displs);CHKERRQ(ierr);
2565674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
2566674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
2567674ae819SStefano Zampini   PetscFunctionReturn(0);
2568674ae819SStefano Zampini }
25699a7d3425SStefano Zampini 
25709a7d3425SStefano Zampini #undef __FUNCT__
25719a7d3425SStefano Zampini #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
25729a7d3425SStefano Zampini PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
25739a7d3425SStefano Zampini {
25749a7d3425SStefano Zampini   PetscInt       i,j;
25759a7d3425SStefano Zampini   PetscScalar    *alphas;
25769a7d3425SStefano Zampini   PetscErrorCode ierr;
25779a7d3425SStefano Zampini 
25789a7d3425SStefano Zampini   PetscFunctionBegin;
25799a7d3425SStefano Zampini   /* this implements stabilized Gram-Schmidt */
25809a7d3425SStefano Zampini   ierr = PetscMalloc(n*sizeof(PetscScalar),&alphas);CHKERRQ(ierr);
25819a7d3425SStefano Zampini   for (i=0;i<n;i++) {
25829a7d3425SStefano Zampini     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
25839a7d3425SStefano Zampini     if (i<n) { ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],&alphas[i+1]);CHKERRQ(ierr); }
25849a7d3425SStefano Zampini     for (j=i+1;j<n;j++) { ierr = VecAXPY(vecs[j],PetscConj(-alphas[j]),vecs[i]);CHKERRQ(ierr); }
25859a7d3425SStefano Zampini   }
25869a7d3425SStefano Zampini   ierr = PetscFree(alphas);CHKERRQ(ierr);
25879a7d3425SStefano Zampini   PetscFunctionReturn(0);
25889a7d3425SStefano Zampini }
25899a7d3425SStefano Zampini 
2590fa7f1dd8SStefano Zampini /* TODO
2591fa7f1dd8SStefano Zampini    - now preallocation is done assuming SEQDENSE local matrices
2592fa7f1dd8SStefano Zampini */
2593c8587f34SStefano Zampini #undef __FUNCT__
2594fa7f1dd8SStefano Zampini #define __FUNCT__ "MatISGetMPIXAIJ"
2595fa7f1dd8SStefano Zampini static PetscErrorCode MatISGetMPIXAIJ(Mat mat, MatType Mtype, MatReuse reuse, Mat *M)
2596c8587f34SStefano Zampini {
2597a57a6d2fSStefano Zampini   Mat                    new_mat;
2598a57a6d2fSStefano Zampini   Mat_IS                 *matis = (Mat_IS*)(mat->data);
2599a57a6d2fSStefano Zampini   /* info on mat */
2600fa7f1dd8SStefano Zampini   /* ISLocalToGlobalMapping rmapping,cmapping; */
2601a57a6d2fSStefano Zampini   PetscInt               bs,rows,cols;
2602a57a6d2fSStefano Zampini   PetscInt               lrows,lcols;
2603a57a6d2fSStefano Zampini   PetscInt               local_rows,local_cols;
2604fa7f1dd8SStefano Zampini   PetscBool              isdense;
2605fa7f1dd8SStefano Zampini   /* values insertion */
2606fa7f1dd8SStefano Zampini   PetscScalar            *array;
2607a57a6d2fSStefano Zampini   PetscInt               *local_indices,*global_indices;
2608a57a6d2fSStefano Zampini   /* work */
2609fa7f1dd8SStefano Zampini   PetscInt               i,j,index_row;
2610a57a6d2fSStefano Zampini   PetscErrorCode         ierr;
2611c8587f34SStefano Zampini 
2612a57a6d2fSStefano Zampini   PetscFunctionBegin;
2613fa7f1dd8SStefano Zampini   /* MISSING CHECKS
2614fa7f1dd8SStefano Zampini     - rectangular case not covered (it is not allowed by MATIS)
2615fa7f1dd8SStefano Zampini   */
2616a57a6d2fSStefano Zampini   /* get info from mat */
2617fa7f1dd8SStefano Zampini   /* ierr = MatGetLocalToGlobalMapping(mat,&rmapping,&cmapping);CHKERRQ(ierr); */
2618a57a6d2fSStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
2619a57a6d2fSStefano Zampini   ierr = MatGetBlockSize(mat,&bs);CHKERRQ(ierr);
2620a57a6d2fSStefano Zampini   ierr = MatGetSize(matis->A,&local_rows,&local_cols);CHKERRQ(ierr);
2621a57a6d2fSStefano Zampini 
2622fa7f1dd8SStefano Zampini   /* work */
2623fa7f1dd8SStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*local_indices),&local_indices);CHKERRQ(ierr);
2624fa7f1dd8SStefano Zampini   for (i=0;i<local_rows;i++) local_indices[i]=i;
2625fa7f1dd8SStefano Zampini   /* map indices of local mat to global values */
2626fa7f1dd8SStefano Zampini   ierr = PetscMalloc(PetscMax(local_cols,local_rows)*sizeof(*global_indices),&global_indices);CHKERRQ(ierr);
2627fa7f1dd8SStefano Zampini   /* ierr = ISLocalToGlobalMappingApply(rmapping,local_rows,local_indices,global_indices);CHKERRQ(ierr); */
2628fa7f1dd8SStefano Zampini   ierr = ISLocalToGlobalMappingApply(matis->mapping,local_rows,local_indices,global_indices);CHKERRQ(ierr);
2629fa7f1dd8SStefano Zampini 
2630fa7f1dd8SStefano Zampini   if (reuse==MAT_INITIAL_MATRIX) {
2631fa7f1dd8SStefano Zampini     Vec         vec_dnz,vec_onz;
2632fa7f1dd8SStefano Zampini     PetscScalar *my_dnz,*my_onz;
2633fa7f1dd8SStefano Zampini     PetscInt    *dnz,*onz,*mat_ranges,*row_ownership;
2634fa7f1dd8SStefano Zampini     PetscInt    index_col,owner;
2635fa7f1dd8SStefano Zampini     PetscMPIInt nsubdomains;
2636fa7f1dd8SStefano Zampini 
2637fa7f1dd8SStefano Zampini     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&nsubdomains);CHKERRQ(ierr);
2638a57a6d2fSStefano Zampini     ierr = MatCreate(PetscObjectComm((PetscObject)mat),&new_mat);CHKERRQ(ierr);
2639a57a6d2fSStefano Zampini     ierr = MatSetSizes(new_mat,PETSC_DECIDE,PETSC_DECIDE,rows,cols);CHKERRQ(ierr);
2640a57a6d2fSStefano Zampini     ierr = MatSetBlockSize(new_mat,bs);CHKERRQ(ierr);
2641fa7f1dd8SStefano Zampini     ierr = MatSetType(new_mat,Mtype);CHKERRQ(ierr);
2642a57a6d2fSStefano Zampini     ierr = MatSetUp(new_mat);CHKERRQ(ierr);
2643a57a6d2fSStefano Zampini     ierr = MatGetLocalSize(new_mat,&lrows,&lcols);CHKERRQ(ierr);
2644a57a6d2fSStefano Zampini 
2645a57a6d2fSStefano Zampini     /*
2646a57a6d2fSStefano Zampini       preallocation
2647a57a6d2fSStefano Zampini     */
2648a57a6d2fSStefano Zampini 
2649a57a6d2fSStefano Zampini     ierr = MatPreallocateInitialize(PetscObjectComm((PetscObject)new_mat),lrows,lcols,dnz,onz);CHKERRQ(ierr);
2650a57a6d2fSStefano Zampini     /*
2651a57a6d2fSStefano Zampini        Some vectors are needed to sum up properly on shared interface dofs.
2652fa7f1dd8SStefano Zampini        Preallocation macros cannot do the job.
2653a57a6d2fSStefano Zampini        Note that preallocation is not exact, since it overestimates nonzeros
2654a57a6d2fSStefano Zampini     */
2655a57a6d2fSStefano Zampini     ierr = MatGetVecs(new_mat,NULL,&vec_dnz);CHKERRQ(ierr);
2656fa7f1dd8SStefano Zampini     /* ierr = VecSetLocalToGlobalMapping(vec_dnz,rmapping);CHKERRQ(ierr); */
2657fa7f1dd8SStefano Zampini     ierr = VecSetLocalToGlobalMapping(vec_dnz,matis->mapping);CHKERRQ(ierr);
2658c8587f34SStefano Zampini     ierr = VecDuplicate(vec_dnz,&vec_onz);CHKERRQ(ierr);
2659e7931f94SStefano Zampini     /* All processes need to compute entire row ownership */
2660a57a6d2fSStefano Zampini     ierr = PetscMalloc(rows*sizeof(*row_ownership),&row_ownership);CHKERRQ(ierr);
2661a57a6d2fSStefano Zampini     ierr = MatGetOwnershipRanges(new_mat,(const PetscInt**)&mat_ranges);CHKERRQ(ierr);
2662a57a6d2fSStefano Zampini     for (i=0;i<nsubdomains;i++) {
2663c8587f34SStefano Zampini       for (j=mat_ranges[i];j<mat_ranges[i+1];j++) {
2664c8587f34SStefano Zampini         row_ownership[j]=i;
2665c8587f34SStefano Zampini       }
2666c8587f34SStefano Zampini     }
2667c8587f34SStefano Zampini 
2668e7931f94SStefano Zampini     /*
2669e7931f94SStefano Zampini        my_dnz and my_onz contains exact contribution to preallocation from each local mat
2670e7931f94SStefano Zampini        then, they will be summed up properly. This way, preallocation is always sufficient
2671e7931f94SStefano Zampini     */
2672a57a6d2fSStefano Zampini     ierr = PetscMalloc(local_rows*sizeof(*my_dnz),&my_dnz);CHKERRQ(ierr);
2673a57a6d2fSStefano Zampini     ierr = PetscMalloc(local_rows*sizeof(*my_onz),&my_onz);CHKERRQ(ierr);
2674a57a6d2fSStefano Zampini     ierr = PetscMemzero(my_dnz,local_rows*sizeof(*my_dnz));CHKERRQ(ierr);
2675a57a6d2fSStefano Zampini     ierr = PetscMemzero(my_onz,local_rows*sizeof(*my_onz));CHKERRQ(ierr);
2676a57a6d2fSStefano Zampini     for (i=0;i<local_rows;i++) {
2677a57a6d2fSStefano Zampini       index_row = global_indices[i];
2678a57a6d2fSStefano Zampini       for (j=i;j<local_rows;j++) {
2679a57a6d2fSStefano Zampini         owner = row_ownership[index_row];
2680a57a6d2fSStefano Zampini         index_col = global_indices[j];
2681a57a6d2fSStefano Zampini         if (index_col > mat_ranges[owner]-1 && index_col < mat_ranges[owner+1] ) { /* diag block */
2682c8587f34SStefano Zampini           my_dnz[i] += 1.0;
2683a57a6d2fSStefano Zampini         } else { /* offdiag block */
2684c8587f34SStefano Zampini           my_onz[i] += 1.0;
2685c8587f34SStefano Zampini         }
2686a57a6d2fSStefano Zampini         /* same as before, interchanging rows and cols */
2687c8587f34SStefano Zampini         if (i != j) {
2688a57a6d2fSStefano Zampini           owner = row_ownership[index_col];
2689a57a6d2fSStefano Zampini           if (index_row > mat_ranges[owner]-1 && index_row < mat_ranges[owner+1] ) {
2690c8587f34SStefano Zampini             my_dnz[j] += 1.0;
2691c8587f34SStefano Zampini           } else {
2692c8587f34SStefano Zampini             my_onz[j] += 1.0;
2693c8587f34SStefano Zampini           }
2694c8587f34SStefano Zampini         }
2695c8587f34SStefano Zampini       }
2696c8587f34SStefano Zampini     }
2697c8587f34SStefano Zampini     ierr = VecSet(vec_dnz,0.0);CHKERRQ(ierr);
2698c8587f34SStefano Zampini     ierr = VecSet(vec_onz,0.0);CHKERRQ(ierr);
269920a2ab83SStefano Zampini     if (local_rows) { /* multilevel guard */
2700fa7f1dd8SStefano Zampini       ierr = VecSetValuesLocal(vec_dnz,local_rows,local_indices,my_dnz,ADD_VALUES);CHKERRQ(ierr);
2701fa7f1dd8SStefano Zampini       ierr = VecSetValuesLocal(vec_onz,local_rows,local_indices,my_onz,ADD_VALUES);CHKERRQ(ierr);
2702c8587f34SStefano Zampini     }
2703c8587f34SStefano Zampini     ierr = VecAssemblyBegin(vec_dnz);CHKERRQ(ierr);
2704c8587f34SStefano Zampini     ierr = VecAssemblyBegin(vec_onz);CHKERRQ(ierr);
2705c8587f34SStefano Zampini     ierr = VecAssemblyEnd(vec_dnz);CHKERRQ(ierr);
2706c8587f34SStefano Zampini     ierr = VecAssemblyEnd(vec_onz);CHKERRQ(ierr);
2707c8587f34SStefano Zampini     ierr = PetscFree(my_dnz);CHKERRQ(ierr);
2708c8587f34SStefano Zampini     ierr = PetscFree(my_onz);CHKERRQ(ierr);
2709c8587f34SStefano Zampini     ierr = PetscFree(row_ownership);CHKERRQ(ierr);
2710a57a6d2fSStefano Zampini 
2711a57a6d2fSStefano Zampini     /* set computed preallocation in dnz and onz */
2712a57a6d2fSStefano Zampini     ierr = VecGetArray(vec_dnz,&array);CHKERRQ(ierr);
2713a57a6d2fSStefano Zampini     for (i=0; i<lrows; i++) dnz[i] = (PetscInt)PetscRealPart(array[i]);
2714a57a6d2fSStefano Zampini     ierr = VecRestoreArray(vec_dnz,&array);CHKERRQ(ierr);
2715a57a6d2fSStefano Zampini     ierr = VecGetArray(vec_onz,&array);CHKERRQ(ierr);
2716a57a6d2fSStefano Zampini     for (i=0;i<lrows;i++) onz[i] = (PetscInt)PetscRealPart(array[i]);
2717a57a6d2fSStefano Zampini     ierr = VecRestoreArray(vec_onz,&array);CHKERRQ(ierr);
2718c8587f34SStefano Zampini     ierr = VecDestroy(&vec_dnz);CHKERRQ(ierr);
2719c8587f34SStefano Zampini     ierr = VecDestroy(&vec_onz);CHKERRQ(ierr);
2720c8587f34SStefano Zampini 
2721e7931f94SStefano Zampini     /* Resize preallocation if overestimated */
2722c8587f34SStefano Zampini     for (i=0;i<lrows;i++) {
2723a57a6d2fSStefano Zampini       dnz[i] = PetscMin(dnz[i],lcols);
2724a57a6d2fSStefano Zampini       onz[i] = PetscMin(onz[i],cols-lcols);
2725c8587f34SStefano Zampini     }
2726fa7f1dd8SStefano Zampini     /* set preallocation */
2727a57a6d2fSStefano Zampini     ierr = MatMPIAIJSetPreallocation(new_mat,0,dnz,0,onz);CHKERRQ(ierr);
2728fa7f1dd8SStefano Zampini     for (i=0;i<lrows/bs;i++) {
2729fa7f1dd8SStefano Zampini       dnz[i] = dnz[i*bs]/bs;
2730fa7f1dd8SStefano Zampini       onz[i] = onz[i*bs]/bs;
2731fa7f1dd8SStefano Zampini     }
2732fa7f1dd8SStefano Zampini     ierr = MatMPIBAIJSetPreallocation(new_mat,bs,0,dnz,0,onz);CHKERRQ(ierr);
2733fa7f1dd8SStefano Zampini     for (i=0;i<lrows/bs;i++) {
2734fa7f1dd8SStefano Zampini       dnz[i] = dnz[i]-i;
2735fa7f1dd8SStefano Zampini     }
2736fa7f1dd8SStefano Zampini     ierr = MatMPISBAIJSetPreallocation(new_mat,bs,0,dnz,0,onz);CHKERRQ(ierr);
2737c8587f34SStefano Zampini     ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
2738fa7f1dd8SStefano Zampini     *M = new_mat;
2739fa7f1dd8SStefano Zampini   } else {
2740fa7f1dd8SStefano Zampini     PetscInt mbs,mrows,mcols;
2741fa7f1dd8SStefano Zampini     /* some checks */
2742fa7f1dd8SStefano Zampini     ierr = MatGetBlockSize(*M,&mbs);CHKERRQ(ierr);
2743fa7f1dd8SStefano Zampini     ierr = MatGetSize(*M,&mrows,&mcols);CHKERRQ(ierr);
2744fa7f1dd8SStefano Zampini     if (mrows != rows) {
2745fa7f1dd8SStefano Zampini       SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong number of rows (%d != %d)",rows,mrows);
2746fa7f1dd8SStefano Zampini     }
2747fa7f1dd8SStefano Zampini     if (mrows != rows) {
2748fa7f1dd8SStefano Zampini       SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong number of cols (%d != %d)",cols,mcols);
2749fa7f1dd8SStefano Zampini     }
2750fa7f1dd8SStefano Zampini     if (mbs != bs) {
2751fa7f1dd8SStefano Zampini       SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong block size (%d != %d)",bs,mbs);
2752fa7f1dd8SStefano Zampini     }
2753fa7f1dd8SStefano Zampini     ierr = MatZeroEntries(*M);CHKERRQ(ierr);
2754fa7f1dd8SStefano Zampini   }
2755fa7f1dd8SStefano Zampini   /* set local to global mappings */
2756fa7f1dd8SStefano Zampini   /* ierr = MatSetLocalToGlobalMapping(*M,rmapping,cmapping);CHKERRQ(ierr); */
2757fa7f1dd8SStefano Zampini   /* Set values */
2758fa7f1dd8SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQDENSE,&isdense);CHKERRQ(ierr);
2759fa7f1dd8SStefano Zampini   if (isdense) { /* special case for dense local matrices */
2760fa7f1dd8SStefano Zampini     ierr = MatSetOption(*M,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
2761fa7f1dd8SStefano Zampini     ierr = MatDenseGetArray(matis->A,&array);CHKERRQ(ierr);
2762fa7f1dd8SStefano Zampini     ierr = MatSetValues(*M,local_rows,global_indices,local_cols,global_indices,array,ADD_VALUES);CHKERRQ(ierr);
2763fa7f1dd8SStefano Zampini     ierr = MatDenseRestoreArray(matis->A,&array);CHKERRQ(ierr);
2764fa7f1dd8SStefano Zampini     ierr = PetscFree(local_indices);CHKERRQ(ierr);
2765fa7f1dd8SStefano Zampini     ierr = PetscFree(global_indices);CHKERRQ(ierr);
2766fa7f1dd8SStefano Zampini   } else { /* very basic values insertion for all other matrix types */
2767fa7f1dd8SStefano Zampini     ierr = PetscFree(local_indices);CHKERRQ(ierr);
2768a57a6d2fSStefano Zampini     for (i=0;i<local_rows;i++) {
2769a57a6d2fSStefano Zampini       ierr = MatGetRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2770fa7f1dd8SStefano Zampini       /* ierr = MatSetValuesLocal(*M,1,&i,j,local_indices,array,ADD_VALUES);CHKERRQ(ierr); */
2771a57a6d2fSStefano Zampini       ierr = ISLocalToGlobalMappingApply(matis->mapping,j,local_indices,global_indices);CHKERRQ(ierr);
2772a57a6d2fSStefano Zampini       ierr = ISLocalToGlobalMappingApply(matis->mapping,1,&i,&index_row);CHKERRQ(ierr);
2773fa7f1dd8SStefano Zampini       ierr = MatSetValues(*M,1,&index_row,j,global_indices,array,ADD_VALUES);CHKERRQ(ierr);
2774a57a6d2fSStefano Zampini       ierr = MatRestoreRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2775a57a6d2fSStefano Zampini     }
2776c9f409c0SStefano Zampini     ierr = PetscFree(global_indices);CHKERRQ(ierr);
2777fa7f1dd8SStefano Zampini   }
2778fa7f1dd8SStefano Zampini   ierr = MatAssemblyBegin(*M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2779fa7f1dd8SStefano Zampini   ierr = MatAssemblyEnd(*M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2780fa7f1dd8SStefano Zampini   if (isdense) {
2781fa7f1dd8SStefano Zampini     ierr = MatSetOption(*M,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
2782fa7f1dd8SStefano Zampini   }
2783a57a6d2fSStefano Zampini   PetscFunctionReturn(0);
2784a57a6d2fSStefano Zampini }
2785a57a6d2fSStefano Zampini 
2786e7931f94SStefano Zampini #undef __FUNCT__
278770cf5478SStefano Zampini #define __FUNCT__ "MatISGetSubassemblingPattern"
278828143c3dSStefano Zampini PetscErrorCode MatISGetSubassemblingPattern(Mat mat, PetscInt n_subdomains, PetscBool contiguous, IS* is_sends)
2789e7931f94SStefano Zampini {
2790e7931f94SStefano Zampini   Mat             subdomain_adj;
2791e7931f94SStefano Zampini   IS              new_ranks,ranks_send_to;
2792e7931f94SStefano Zampini   MatPartitioning partitioner;
2793e7931f94SStefano Zampini   Mat_IS          *matis;
2794e7931f94SStefano Zampini   PetscInt        n_neighs,*neighs,*n_shared,**shared;
2795e7931f94SStefano Zampini   PetscInt        prank;
2796e7931f94SStefano Zampini   PetscMPIInt     size,rank,color;
2797e7931f94SStefano Zampini   PetscInt        *xadj,*adjncy,*oldranks;
2798e7931f94SStefano Zampini   PetscInt        *adjncy_wgt,*v_wgt,*is_indices,*ranks_send_to_idx;
279928143c3dSStefano Zampini   PetscInt        i,j,local_size,threshold=0;
2800e7931f94SStefano Zampini   PetscErrorCode  ierr;
28012b510759SStefano Zampini   PetscBool       use_vwgt=PETSC_FALSE,use_square=PETSC_FALSE;
2802e7931f94SStefano Zampini   PetscSubcomm    subcomm;
2803a57a6d2fSStefano Zampini 
2804e7931f94SStefano Zampini   PetscFunctionBegin;
28052b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_square",&use_square,NULL);CHKERRQ(ierr);
28062b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
28072b510759SStefano Zampini   ierr = PetscOptionsGetInt(NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
2808e7931f94SStefano Zampini 
2809e7931f94SStefano Zampini   /* Get info on mapping */
2810e7931f94SStefano Zampini   matis = (Mat_IS*)(mat->data);
2811e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&local_size);CHKERRQ(ierr);
2812e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2813e7931f94SStefano Zampini 
2814e7931f94SStefano Zampini   /* build local CSR graph of subdomains' connectivity */
2815e7931f94SStefano Zampini   ierr = PetscMalloc(2*sizeof(*xadj),&xadj);CHKERRQ(ierr);
2816e7931f94SStefano Zampini   xadj[0] = 0;
2817e7931f94SStefano Zampini   xadj[1] = PetscMax(n_neighs-1,0);
2818e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy),&adjncy);CHKERRQ(ierr);
2819e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy_wgt),&adjncy_wgt);CHKERRQ(ierr);
2820e7931f94SStefano Zampini 
28212b510759SStefano Zampini   if (threshold) {
28222b510759SStefano Zampini     PetscInt* count,min_threshold;
2823e7931f94SStefano Zampini     ierr = PetscMalloc(local_size*sizeof(PetscInt),&count);CHKERRQ(ierr);
2824e7931f94SStefano Zampini     ierr = PetscMemzero(count,local_size*sizeof(PetscInt));CHKERRQ(ierr);
2825e7931f94SStefano Zampini     for (i=1;i<n_neighs;i++) {/* i=1 so I don't count myself -> faces nodes counts to 1 */
2826e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2827e7931f94SStefano Zampini         count[shared[i][j]] += 1;
2828e7931f94SStefano Zampini       }
2829e7931f94SStefano Zampini     }
28302b510759SStefano Zampini     /* adapt threshold since we dont want to lose significant connections */
28312b510759SStefano Zampini     min_threshold = n_neighs;
28322b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
28332b510759SStefano Zampini       for (j=0;j<n_shared[i];j++) {
28342b510759SStefano Zampini         min_threshold = PetscMin(count[shared[i][j]],min_threshold);
28352b510759SStefano Zampini       }
28362b510759SStefano Zampini     }
28372b510759SStefano Zampini     threshold = PetscMax(min_threshold+1,threshold);
2838e7931f94SStefano Zampini     xadj[1] = 0;
28392b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
2840e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2841e7931f94SStefano Zampini         if (count[shared[i][j]] < threshold) {
2842e7931f94SStefano Zampini           adjncy[xadj[1]] = neighs[i];
2843e7931f94SStefano Zampini           adjncy_wgt[xadj[1]] = n_shared[i];
2844e7931f94SStefano Zampini           xadj[1]++;
2845e7931f94SStefano Zampini           break;
2846e7931f94SStefano Zampini         }
2847e7931f94SStefano Zampini       }
2848e7931f94SStefano Zampini     }
2849e7931f94SStefano Zampini     ierr = PetscFree(count);CHKERRQ(ierr);
2850c8587f34SStefano Zampini   } else {
2851e7931f94SStefano Zampini     if (xadj[1]) {
2852e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy,&neighs[1],xadj[1]*sizeof(*adjncy));CHKERRQ(ierr);
2853e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy_wgt,&n_shared[1],xadj[1]*sizeof(*adjncy_wgt));CHKERRQ(ierr);
2854c8587f34SStefano Zampini     }
2855e7931f94SStefano Zampini   }
2856e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingRestoreInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2857e7931f94SStefano Zampini   if (use_square) {
2858e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2859e7931f94SStefano Zampini       adjncy_wgt[i] = adjncy_wgt[i]*adjncy_wgt[i];
2860e7931f94SStefano Zampini     }
2861e7931f94SStefano Zampini   }
2862e7931f94SStefano Zampini   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2863e7931f94SStefano Zampini 
2864e7931f94SStefano Zampini   ierr = PetscMalloc(sizeof(PetscInt),&ranks_send_to_idx);CHKERRQ(ierr);
2865e7931f94SStefano Zampini 
2866e7931f94SStefano Zampini   /*
2867e7931f94SStefano Zampini     Restrict work on active processes only.
2868e7931f94SStefano Zampini   */
2869e7931f94SStefano Zampini   ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&subcomm);CHKERRQ(ierr);
2870e7931f94SStefano Zampini   ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
2871e7931f94SStefano Zampini   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
28722b510759SStefano Zampini   ierr = PetscMPIIntCast(!local_size,&color);CHKERRQ(ierr);
2873d3531aaaSJed Brown   ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
2874e7931f94SStefano Zampini   if (color) {
2875e7931f94SStefano Zampini     ierr = PetscFree(xadj);CHKERRQ(ierr);
2876e7931f94SStefano Zampini     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2877e7931f94SStefano Zampini     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
2878c8587f34SStefano Zampini   } else {
287928143c3dSStefano Zampini     PetscInt coarsening_ratio;
2880e7931f94SStefano Zampini     ierr = MPI_Comm_size(subcomm->comm,&size);CHKERRQ(ierr);
2881e7931f94SStefano Zampini     ierr = PetscMalloc(size*sizeof(*oldranks),&oldranks);CHKERRQ(ierr);
2882e7931f94SStefano Zampini     prank = rank;
2883e7931f94SStefano Zampini     ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm->comm);CHKERRQ(ierr);
28848002ef2cSStefano Zampini     /*
2885e7931f94SStefano Zampini     for (i=0;i<size;i++) {
2886e7931f94SStefano Zampini       PetscPrintf(subcomm->comm,"oldranks[%d] = %d\n",i,oldranks[i]);
2887c8587f34SStefano Zampini     }
28888002ef2cSStefano Zampini     */
2889e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2890e7931f94SStefano Zampini       ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
2891c8587f34SStefano Zampini     }
2892e7931f94SStefano Zampini     ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2893e7931f94SStefano Zampini     ierr = MatCreateMPIAdj(subcomm->comm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
289422b6e8a2SStefano Zampini     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
2895e7931f94SStefano Zampini 
2896e7931f94SStefano Zampini     /* Partition */
2897e7931f94SStefano Zampini     ierr = MatPartitioningCreate(subcomm->comm,&partitioner);CHKERRQ(ierr);
2898e7931f94SStefano Zampini     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
2899e7931f94SStefano Zampini     if (use_vwgt) {
2900e7931f94SStefano Zampini       ierr = PetscMalloc(sizeof(*v_wgt),&v_wgt);CHKERRQ(ierr);
2901e7931f94SStefano Zampini       v_wgt[0] = local_size;
2902e7931f94SStefano Zampini       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
2903c8587f34SStefano Zampini     }
290428143c3dSStefano Zampini     n_subdomains = PetscMin((PetscInt)size,n_subdomains);
290528143c3dSStefano Zampini     coarsening_ratio = size/n_subdomains;
290628143c3dSStefano Zampini     /* Parmetis does not always give back nparts with small graphs! this should be taken into account */
290728143c3dSStefano Zampini     ierr = MatPartitioningSetNParts(partitioner,n_subdomains);CHKERRQ(ierr);
2908e7931f94SStefano Zampini     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
2909e7931f94SStefano Zampini     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
291022b6e8a2SStefano Zampini     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
2911e7931f94SStefano Zampini 
2912e7931f94SStefano Zampini     ierr = ISGetIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
291328143c3dSStefano Zampini     if (contiguous) {
291428143c3dSStefano Zampini       ranks_send_to_idx[0] = oldranks[is_indices[0]]; /* contiguos set of processes */
291528143c3dSStefano Zampini     } else {
291684ba6060SStefano Zampini       ranks_send_to_idx[0] = coarsening_ratio*oldranks[is_indices[0]]; /* scattered set of processes */
291728143c3dSStefano Zampini     }
2918e7931f94SStefano Zampini     ierr = ISRestoreIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2919e7931f94SStefano Zampini     /* clean up */
2920e7931f94SStefano Zampini     ierr = PetscFree(oldranks);CHKERRQ(ierr);
2921e7931f94SStefano Zampini     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
2922e7931f94SStefano Zampini     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
2923e7931f94SStefano Zampini     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
2924e7931f94SStefano Zampini   }
2925e7931f94SStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
2926e7931f94SStefano Zampini 
2927e7931f94SStefano Zampini   /* assemble parallel IS for sends */
2928e7931f94SStefano Zampini   i = 1;
2929e7931f94SStefano Zampini   if (color) i=0;
2930e7931f94SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,&ranks_send_to);CHKERRQ(ierr);
2931e7931f94SStefano Zampini 
2932e7931f94SStefano Zampini   /* get back IS */
2933e7931f94SStefano Zampini   *is_sends = ranks_send_to;
2934e7931f94SStefano Zampini   PetscFunctionReturn(0);
2935e7931f94SStefano Zampini }
2936e7931f94SStefano Zampini 
2937e7931f94SStefano Zampini typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
2938e7931f94SStefano Zampini 
2939e7931f94SStefano Zampini #undef __FUNCT__
2940e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble"
294128143c3dSStefano Zampini PetscErrorCode MatISSubassemble(Mat mat, IS is_sends, PetscInt n_subdomains, PetscBool restrict_comm, MatReuse reuse, Mat *mat_n, PetscInt nis, IS isarray[])
2942e7931f94SStefano Zampini {
294370cf5478SStefano Zampini   Mat                    local_mat;
2944e7931f94SStefano Zampini   Mat_IS                 *matis;
2945e7931f94SStefano Zampini   IS                     is_sends_internal;
2946e7931f94SStefano Zampini   PetscInt               rows,cols;
294728143c3dSStefano Zampini   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals;
294828143c3dSStefano Zampini   PetscBool              ismatis,isdense,destroy_mat;
2949e7931f94SStefano Zampini   ISLocalToGlobalMapping l2gmap;
2950e7931f94SStefano Zampini   PetscInt*              l2gmap_indices;
2951e7931f94SStefano Zampini   const PetscInt*        is_indices;
2952e7931f94SStefano Zampini   MatType                new_local_type;
2953e7931f94SStefano Zampini   /* buffers */
2954e7931f94SStefano Zampini   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
295528143c3dSStefano Zampini   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
2956e7931f94SStefano Zampini   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
2957e7931f94SStefano Zampini   /* MPI */
295828143c3dSStefano Zampini   MPI_Comm               comm,comm_n;
295928143c3dSStefano Zampini   PetscSubcomm           subcomm;
2960e7931f94SStefano Zampini   PetscMPIInt            n_sends,n_recvs,commsize;
296128143c3dSStefano Zampini   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
296228143c3dSStefano Zampini   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
296328143c3dSStefano Zampini   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,source_dest;
296428143c3dSStefano Zampini   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals;
296528143c3dSStefano Zampini   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals;
2966e7931f94SStefano Zampini   PetscErrorCode         ierr;
2967e7931f94SStefano Zampini 
2968e7931f94SStefano Zampini   PetscFunctionBegin;
296928143c3dSStefano Zampini   /* TODO: add missing checks */
297028143c3dSStefano Zampini   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
297128143c3dSStefano Zampini   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
297228143c3dSStefano Zampini   PetscValidLogicalCollectiveEnum(mat,reuse,5);
297328143c3dSStefano Zampini   PetscValidLogicalCollectiveInt(mat,nis,7);
2974e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
297528143c3dSStefano Zampini   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",__FUNCT__);
2976e7931f94SStefano Zampini   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2977e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
2978e7931f94SStefano Zampini   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
2979e7931f94SStefano Zampini   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
2980e7931f94SStefano Zampini   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
298128143c3dSStefano Zampini   if (reuse == MAT_REUSE_MATRIX && *mat_n) {
298270cf5478SStefano Zampini     PetscInt mrows,mcols,mnrows,mncols;
298370cf5478SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
298428143c3dSStefano Zampini     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
298570cf5478SStefano Zampini     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
298670cf5478SStefano Zampini     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
298770cf5478SStefano Zampini     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
298870cf5478SStefano Zampini     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
298970cf5478SStefano Zampini   }
2990e7931f94SStefano Zampini   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
2991e7931f94SStefano Zampini   PetscValidLogicalCollectiveInt(mat,bs,0);
2992e7931f94SStefano Zampini   /* prepare IS for sending if not provided */
2993e7931f94SStefano Zampini   if (!is_sends) {
299428143c3dSStefano Zampini     PetscBool pcontig = PETSC_TRUE;
299528143c3dSStefano Zampini     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
299628143c3dSStefano Zampini     ierr = MatISGetSubassemblingPattern(mat,n_subdomains,pcontig,&is_sends_internal);CHKERRQ(ierr);
2997c8587f34SStefano Zampini   } else {
2998e7931f94SStefano Zampini     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
2999e7931f94SStefano Zampini     is_sends_internal = is_sends;
3000c8587f34SStefano Zampini   }
3001e7931f94SStefano Zampini 
3002e7931f94SStefano Zampini   /* get pointer of MATIS data */
3003e7931f94SStefano Zampini   matis = (Mat_IS*)mat->data;
3004e7931f94SStefano Zampini 
3005e7931f94SStefano Zampini   /* get comm */
3006e7931f94SStefano Zampini   comm = PetscObjectComm((PetscObject)mat);
3007e7931f94SStefano Zampini 
3008e7931f94SStefano Zampini   /* compute number of sends */
3009e7931f94SStefano Zampini   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
3010e7931f94SStefano Zampini   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
3011e7931f94SStefano Zampini 
3012e7931f94SStefano Zampini   /* compute number of receives */
3013e7931f94SStefano Zampini   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
3014e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*iflags),&iflags);CHKERRQ(ierr);
3015e7931f94SStefano Zampini   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
3016e7931f94SStefano Zampini   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
3017e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
3018e7931f94SStefano Zampini   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
3019e7931f94SStefano Zampini   ierr = PetscFree(iflags);CHKERRQ(ierr);
3020e7931f94SStefano Zampini 
302128143c3dSStefano Zampini   /* restrict comm if requested */
302228143c3dSStefano Zampini   subcomm = 0;
302328143c3dSStefano Zampini   destroy_mat = PETSC_FALSE;
302428143c3dSStefano Zampini   if (restrict_comm) {
302528143c3dSStefano Zampini     PetscMPIInt color,rank,subcommsize;
302628143c3dSStefano Zampini     ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
302728143c3dSStefano Zampini     color = 0;
302828143c3dSStefano Zampini     if (n_sends && !n_recvs) color = 1; /* sending only processes will not partecipate in new comm */
302928143c3dSStefano Zampini     ierr = MPI_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
303028143c3dSStefano Zampini     subcommsize = commsize - subcommsize;
303128143c3dSStefano Zampini     /* check if reuse has been requested */
303228143c3dSStefano Zampini     if (reuse == MAT_REUSE_MATRIX) {
303328143c3dSStefano Zampini       if (*mat_n) {
303428143c3dSStefano Zampini         PetscMPIInt subcommsize2;
303528143c3dSStefano Zampini         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
303628143c3dSStefano Zampini         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
303728143c3dSStefano Zampini         comm_n = PetscObjectComm((PetscObject)*mat_n);
303828143c3dSStefano Zampini       } else {
303928143c3dSStefano Zampini         comm_n = PETSC_COMM_SELF;
304028143c3dSStefano Zampini       }
304128143c3dSStefano Zampini     } else { /* MAT_INITIAL_MATRIX */
304228143c3dSStefano Zampini       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
304328143c3dSStefano Zampini       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
304428143c3dSStefano Zampini       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
304528143c3dSStefano Zampini       comm_n = subcomm->comm;
304628143c3dSStefano Zampini     }
304728143c3dSStefano Zampini     /* flag to destroy *mat_n if not significative */
304828143c3dSStefano Zampini     if (color) destroy_mat = PETSC_TRUE;
304928143c3dSStefano Zampini   } else {
305028143c3dSStefano Zampini     comm_n = comm;
305128143c3dSStefano Zampini   }
305228143c3dSStefano Zampini 
3053e7931f94SStefano Zampini   /* prepare send/receive buffers */
3054e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_idxs),&ilengths_idxs);CHKERRQ(ierr);
3055e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
3056e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_vals),&ilengths_vals);CHKERRQ(ierr);
3057e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
305828143c3dSStefano Zampini   if (nis) {
305928143c3dSStefano Zampini     ierr = PetscMalloc(commsize*sizeof(*ilengths_idxs_is),&ilengths_idxs_is);CHKERRQ(ierr);
306028143c3dSStefano Zampini     ierr = PetscMemzero(ilengths_idxs_is,commsize*sizeof(*ilengths_idxs_is));CHKERRQ(ierr);
306128143c3dSStefano Zampini   }
3062e7931f94SStefano Zampini 
306328143c3dSStefano Zampini   /* Get data from local matrices */
3064e7931f94SStefano Zampini   if (!isdense) {
3065e7931f94SStefano Zampini     /* TODO: See below some guidelines on how to prepare the local buffers */
3066e7931f94SStefano Zampini     /*
3067e7931f94SStefano Zampini        send_buffer_vals should contain the raw values of the local matrix
3068e7931f94SStefano Zampini        send_buffer_idxs should contain:
3069e7931f94SStefano Zampini        - MatType_PRIVATE type
3070e7931f94SStefano Zampini        - PetscInt        size_of_l2gmap
3071e7931f94SStefano Zampini        - PetscInt        global_row_indices[size_of_l2gmap]
3072e7931f94SStefano Zampini        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
3073e7931f94SStefano Zampini     */
3074e7931f94SStefano Zampini   } else {
3075e7931f94SStefano Zampini     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
3076e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&i);CHKERRQ(ierr);
3077e7931f94SStefano Zampini     ierr = PetscMalloc((i+2)*sizeof(PetscInt),&send_buffer_idxs);CHKERRQ(ierr);
3078e7931f94SStefano Zampini     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
3079e7931f94SStefano Zampini     send_buffer_idxs[1] = i;
3080e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
3081e7931f94SStefano Zampini     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
3082e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingRestoreIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
3083e7931f94SStefano Zampini     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
3084e7931f94SStefano Zampini     for (i=0;i<n_sends;i++) {
3085e7931f94SStefano Zampini       ilengths_vals[is_indices[i]] = len*len;
3086e7931f94SStefano Zampini       ilengths_idxs[is_indices[i]] = len+2;
3087c8587f34SStefano Zampini     }
3088c8587f34SStefano Zampini   }
3089e7931f94SStefano Zampini   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
309028143c3dSStefano Zampini   /* additional is (if any) */
309128143c3dSStefano Zampini   if (nis) {
309228143c3dSStefano Zampini     PetscMPIInt psum;
309328143c3dSStefano Zampini     PetscInt j;
309428143c3dSStefano Zampini     for (j=0,psum=0;j<nis;j++) {
309528143c3dSStefano Zampini       PetscInt plen;
309628143c3dSStefano Zampini       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
309728143c3dSStefano Zampini       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
309828143c3dSStefano Zampini       psum += len+1; /* indices + lenght */
309928143c3dSStefano Zampini     }
310028143c3dSStefano Zampini     ierr = PetscMalloc(psum*sizeof(PetscInt),&send_buffer_idxs_is);CHKERRQ(ierr);
310128143c3dSStefano Zampini     for (j=0,psum=0;j<nis;j++) {
310228143c3dSStefano Zampini       PetscInt plen;
310328143c3dSStefano Zampini       const PetscInt *is_array_idxs;
310428143c3dSStefano Zampini       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
310528143c3dSStefano Zampini       send_buffer_idxs_is[psum] = plen;
310628143c3dSStefano Zampini       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
310728143c3dSStefano Zampini       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
310828143c3dSStefano Zampini       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
310928143c3dSStefano Zampini       psum += plen+1; /* indices + lenght */
311028143c3dSStefano Zampini     }
311128143c3dSStefano Zampini     for (i=0;i<n_sends;i++) {
311228143c3dSStefano Zampini       ilengths_idxs_is[is_indices[i]] = psum;
311328143c3dSStefano Zampini     }
311428143c3dSStefano Zampini     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
311528143c3dSStefano Zampini   }
311628143c3dSStefano Zampini 
3117e7931f94SStefano Zampini   buf_size_idxs = 0;
3118e7931f94SStefano Zampini   buf_size_vals = 0;
311928143c3dSStefano Zampini   buf_size_idxs_is = 0;
3120e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3121e7931f94SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
3122e7931f94SStefano Zampini     buf_size_vals += (PetscInt)olengths_vals[i];
312328143c3dSStefano Zampini     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
3124e7931f94SStefano Zampini   }
3125e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&recv_buffer_idxs);CHKERRQ(ierr);
3126e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_vals*sizeof(PetscScalar),&recv_buffer_vals);CHKERRQ(ierr);
312728143c3dSStefano Zampini   ierr = PetscMalloc(buf_size_idxs_is*sizeof(PetscInt),&recv_buffer_idxs_is);CHKERRQ(ierr);
3128e7931f94SStefano Zampini 
3129e7931f94SStefano Zampini   /* get new tags for clean communications */
3130e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
3131e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
313228143c3dSStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
3133e7931f94SStefano Zampini 
3134e7931f94SStefano Zampini   /* allocate for requests */
3135e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_idxs);CHKERRQ(ierr);
3136e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_vals);CHKERRQ(ierr);
313728143c3dSStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_idxs_is);CHKERRQ(ierr);
3138e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_idxs);CHKERRQ(ierr);
3139e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_vals);CHKERRQ(ierr);
314028143c3dSStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_idxs_is);CHKERRQ(ierr);
3141e7931f94SStefano Zampini 
3142e7931f94SStefano Zampini   /* communications */
3143e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
3144e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
314528143c3dSStefano Zampini   ptr_idxs_is = recv_buffer_idxs_is;
3146e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3147e7931f94SStefano Zampini     source_dest = onodes[i];
3148e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
3149e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
3150e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3151e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
315228143c3dSStefano Zampini     if (nis) {
315328143c3dSStefano Zampini       ierr = MPI_Irecv(ptr_idxs_is,olengths_idxs_is[i],MPIU_INT,source_dest,tag_idxs_is,comm,&recv_req_idxs_is[i]);CHKERRQ(ierr);
315428143c3dSStefano Zampini       ptr_idxs_is += olengths_idxs_is[i];
315528143c3dSStefano Zampini     }
3156e7931f94SStefano Zampini   }
3157e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) {
3158e7931f94SStefano Zampini     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
3159e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
3160e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
316128143c3dSStefano Zampini     if (nis) {
316228143c3dSStefano Zampini       ierr = MPI_Isend(send_buffer_idxs_is,ilengths_idxs_is[source_dest],MPIU_INT,source_dest,tag_idxs_is,comm,&send_req_idxs_is[i]);CHKERRQ(ierr);
316328143c3dSStefano Zampini     }
3164e7931f94SStefano Zampini   }
3165e7931f94SStefano Zampini   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
3166e7931f94SStefano Zampini   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
3167e7931f94SStefano Zampini 
3168e7931f94SStefano Zampini   /* assemble new l2g map */
3169e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3170e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
3171e7931f94SStefano Zampini   buf_size_idxs = 0;
3172e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3173e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
3174e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3175e7931f94SStefano Zampini   }
3176e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&l2gmap_indices);CHKERRQ(ierr);
3177e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
3178e7931f94SStefano Zampini   buf_size_idxs = 0;
3179e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3180e7931f94SStefano Zampini     ierr = PetscMemcpy(&l2gmap_indices[buf_size_idxs],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
3181e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
3182e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3183e7931f94SStefano Zampini   }
3184e7931f94SStefano Zampini   ierr = PetscSortRemoveDupsInt(&buf_size_idxs,l2gmap_indices);CHKERRQ(ierr);
318528143c3dSStefano Zampini   ierr = ISLocalToGlobalMappingCreate(comm_n,buf_size_idxs,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
3186e7931f94SStefano Zampini   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
3187e7931f94SStefano Zampini 
3188e7931f94SStefano Zampini   /* infer new local matrix type from received local matrices type */
3189e7931f94SStefano Zampini   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
3190e7931f94SStefano Zampini   /* it also assumes that if the block size is set, than it is the same among all local matrices (see checks at the beginning of the function) */
3191e7931f94SStefano Zampini   if (n_recvs) {
319228143c3dSStefano Zampini     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
3193e7931f94SStefano Zampini     ptr_idxs = recv_buffer_idxs;
3194e7931f94SStefano Zampini     for (i=0;i<n_recvs;i++) {
3195e7931f94SStefano Zampini       if ((PetscInt)new_local_type_private != *ptr_idxs) {
3196e7931f94SStefano Zampini         new_local_type_private = MATAIJ_PRIVATE;
3197e7931f94SStefano Zampini         break;
3198e7931f94SStefano Zampini       }
3199e7931f94SStefano Zampini       ptr_idxs += olengths_idxs[i];
3200e7931f94SStefano Zampini     }
3201e7931f94SStefano Zampini     switch (new_local_type_private) {
320228143c3dSStefano Zampini       case MATDENSE_PRIVATE:
320328143c3dSStefano Zampini         if (n_recvs>1) { /* subassembling of dense matrices does not give a dense matrix! */
3204e7931f94SStefano Zampini           new_local_type = MATSEQAIJ;
3205e7931f94SStefano Zampini           bs = 1;
320628143c3dSStefano Zampini         } else { /* if I receive only 1 dense matrix */
320728143c3dSStefano Zampini           new_local_type = MATSEQDENSE;
320828143c3dSStefano Zampini           bs = 1;
320928143c3dSStefano Zampini         }
3210e7931f94SStefano Zampini         break;
3211e7931f94SStefano Zampini       case MATAIJ_PRIVATE:
3212e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
3213e7931f94SStefano Zampini         bs = 1;
3214e7931f94SStefano Zampini         break;
3215e7931f94SStefano Zampini       case MATBAIJ_PRIVATE:
3216e7931f94SStefano Zampini         new_local_type = MATSEQBAIJ;
3217e7931f94SStefano Zampini         break;
3218e7931f94SStefano Zampini       case MATSBAIJ_PRIVATE:
3219e7931f94SStefano Zampini         new_local_type = MATSEQSBAIJ;
3220e7931f94SStefano Zampini         break;
3221e7931f94SStefano Zampini       default:
322228143c3dSStefano Zampini         SETERRQ2(comm,PETSC_ERR_PLIB,"Unkwown private type %d in %s",new_local_type_private,__FUNCT__);
3223e7931f94SStefano Zampini         break;
3224e7931f94SStefano Zampini     }
322528143c3dSStefano Zampini   } else { /* by default, new_local_type is seqdense */
322628143c3dSStefano Zampini     new_local_type = MATSEQDENSE;
322728143c3dSStefano Zampini     bs = 1;
3228e7931f94SStefano Zampini   }
3229e7931f94SStefano Zampini 
323070cf5478SStefano Zampini   /* create MATIS object if needed */
323170cf5478SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
3232e7931f94SStefano Zampini     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
323328143c3dSStefano Zampini     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,mat_n);CHKERRQ(ierr);
323470cf5478SStefano Zampini   } else {
323570cf5478SStefano Zampini     /* it also destroys the local matrices */
323670cf5478SStefano Zampini     ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
323770cf5478SStefano Zampini   }
3238e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
323970cf5478SStefano Zampini   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
3240e7931f94SStefano Zampini   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
3241e7931f94SStefano Zampini   ierr = MatSetUp(local_mat);CHKERRQ(ierr); /* WARNING -> no preallocation yet */
3242e7931f94SStefano Zampini 
3243e7931f94SStefano Zampini   /* set values */
3244e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3245e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
3246e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
3247e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3248e7931f94SStefano Zampini     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
3249e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
325070cf5478SStefano Zampini       ierr = MatSetValues(*mat_n,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
3251e7931f94SStefano Zampini       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3252e7931f94SStefano Zampini       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3253e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
325428143c3dSStefano Zampini     } else {
325528143c3dSStefano Zampini       /* TODO */
3256e7931f94SStefano Zampini     }
3257e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3258e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
3259e7931f94SStefano Zampini   }
3260e7931f94SStefano Zampini   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3261e7931f94SStefano Zampini   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
326270cf5478SStefano Zampini   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
326370cf5478SStefano Zampini   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3264e7931f94SStefano Zampini 
326528143c3dSStefano Zampini #if 1
326628143c3dSStefano Zampini   if (!restrict_comm) { /* check */
3267e7931f94SStefano Zampini     Vec       lvec,rvec;
3268e7931f94SStefano Zampini     PetscReal infty_error;
3269e7931f94SStefano Zampini 
3270e7931f94SStefano Zampini     ierr = MatGetVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
3271e7931f94SStefano Zampini     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
3272e7931f94SStefano Zampini     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
3273e7931f94SStefano Zampini     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
327470cf5478SStefano Zampini     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
3275e7931f94SStefano Zampini     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3276e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
3277e7931f94SStefano Zampini     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
3278e7931f94SStefano Zampini     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
3279e7931f94SStefano Zampini   }
328028143c3dSStefano Zampini #endif
3281e7931f94SStefano Zampini 
328228143c3dSStefano Zampini   /* assemble new additional is (if any) */
328328143c3dSStefano Zampini   if (nis) {
328428143c3dSStefano Zampini     PetscInt **temp_idxs,*count_is,j,psum;
328528143c3dSStefano Zampini 
328628143c3dSStefano Zampini     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
328728143c3dSStefano Zampini     ierr = PetscMalloc(nis*sizeof(PetscInt),&count_is);CHKERRQ(ierr);
328828143c3dSStefano Zampini     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
328928143c3dSStefano Zampini     ptr_idxs = recv_buffer_idxs_is;
329028143c3dSStefano Zampini     psum = 0;
329128143c3dSStefano Zampini     for (i=0;i<n_recvs;i++) {
329228143c3dSStefano Zampini       for (j=0;j<nis;j++) {
329328143c3dSStefano Zampini         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
329428143c3dSStefano Zampini         count_is[j] += plen; /* increment counting of buffer for j-th IS */
329528143c3dSStefano Zampini         psum += plen;
329628143c3dSStefano Zampini         ptr_idxs += plen+1; /* shift pointer to received data */
329728143c3dSStefano Zampini       }
329828143c3dSStefano Zampini     }
329928143c3dSStefano Zampini     ierr = PetscMalloc(nis*sizeof(PetscInt*),&temp_idxs);CHKERRQ(ierr);
330028143c3dSStefano Zampini     ierr = PetscMalloc(psum*sizeof(PetscInt),&temp_idxs[0]);CHKERRQ(ierr);
330128143c3dSStefano Zampini     for (i=1;i<nis;i++) {
330228143c3dSStefano Zampini       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
330328143c3dSStefano Zampini     }
330428143c3dSStefano Zampini     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
330528143c3dSStefano Zampini     ptr_idxs = recv_buffer_idxs_is;
330628143c3dSStefano Zampini     for (i=0;i<n_recvs;i++) {
330728143c3dSStefano Zampini       for (j=0;j<nis;j++) {
330828143c3dSStefano Zampini         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
330928143c3dSStefano Zampini         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
331028143c3dSStefano Zampini         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
331128143c3dSStefano Zampini         ptr_idxs += plen+1; /* shift pointer to received data */
331228143c3dSStefano Zampini       }
331328143c3dSStefano Zampini     }
331428143c3dSStefano Zampini     for (i=0;i<nis;i++) {
331528143c3dSStefano Zampini       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
331628143c3dSStefano Zampini       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
331728143c3dSStefano Zampini       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
331828143c3dSStefano Zampini     }
331928143c3dSStefano Zampini     ierr = PetscFree(count_is);CHKERRQ(ierr);
332028143c3dSStefano Zampini     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
332128143c3dSStefano Zampini     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
332228143c3dSStefano Zampini   }
3323e7931f94SStefano Zampini   /* free workspace */
3324e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
3325e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
332628143c3dSStefano Zampini   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
3327e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3328e7931f94SStefano Zampini   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
3329e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3330e7931f94SStefano Zampini   if (isdense) {
3331e7931f94SStefano Zampini     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
3332e7931f94SStefano Zampini     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
3333e7931f94SStefano Zampini   } else {
3334e7931f94SStefano Zampini     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
3335e7931f94SStefano Zampini   }
333628143c3dSStefano Zampini   if (nis) {
333728143c3dSStefano Zampini     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
333828143c3dSStefano Zampini     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
333928143c3dSStefano Zampini   }
3340e7931f94SStefano Zampini   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
3341e7931f94SStefano Zampini   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
334228143c3dSStefano Zampini   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
3343e7931f94SStefano Zampini   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
3344e7931f94SStefano Zampini   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
334528143c3dSStefano Zampini   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
3346e7931f94SStefano Zampini   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
3347e7931f94SStefano Zampini   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
3348e7931f94SStefano Zampini   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
3349e7931f94SStefano Zampini   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
3350e7931f94SStefano Zampini   ierr = PetscFree(onodes);CHKERRQ(ierr);
335128143c3dSStefano Zampini   if (nis) {
335228143c3dSStefano Zampini     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
335328143c3dSStefano Zampini     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
335428143c3dSStefano Zampini     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
335528143c3dSStefano Zampini   }
335628143c3dSStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
335728143c3dSStefano Zampini   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
335828143c3dSStefano Zampini     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
335928143c3dSStefano Zampini     for (i=0;i<nis;i++) {
336028143c3dSStefano Zampini       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
336128143c3dSStefano Zampini     }
336228143c3dSStefano Zampini   }
3363e7931f94SStefano Zampini   PetscFunctionReturn(0);
3364e7931f94SStefano Zampini }
3365a57a6d2fSStefano Zampini 
3366*12edc857SStefano Zampini /* temporary hack into ksp private data structure */
3367*12edc857SStefano Zampini #include <petsc-private/kspimpl.h>
3368*12edc857SStefano Zampini 
3369c8587f34SStefano Zampini #undef __FUNCT__
3370c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
3371c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
3372c8587f34SStefano Zampini {
3373c8587f34SStefano Zampini   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
3374c8587f34SStefano Zampini   PC_IS                  *pcis = (PC_IS*)pc->data;
337520a2ab83SStefano Zampini   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
33769881197aSStefano Zampini   MatNullSpace           CoarseNullSpace=NULL;
337720a2ab83SStefano Zampini   ISLocalToGlobalMapping coarse_islg;
337820a2ab83SStefano Zampini   IS                     coarse_is;
3379f4ddd8eeSStefano Zampini   PetscInt               max_it;
3380f9eb5b7dSStefano Zampini   PetscInt               im_active=-1,active_procs=-1;
3381f9eb5b7dSStefano Zampini   PC                     pc_temp;
3382c8587f34SStefano Zampini   PCType                 coarse_pc_type;
3383c8587f34SStefano Zampini   KSPType                coarse_ksp_type;
3384f9eb5b7dSStefano Zampini   PetscBool              multilevel_requested,multilevel_allowed;
3385cbcc2c2aSStefano Zampini   PetscBool              setsym,issym,isherm,ispreonly,isbddc,isnn,coarse_reuse;
3386f9eb5b7dSStefano Zampini   MatStructure           matstruct;
33879881197aSStefano Zampini   PetscErrorCode         ierr;
3388fdc09c96SStefano Zampini 
3389c8587f34SStefano Zampini   PetscFunctionBegin;
3390c8587f34SStefano Zampini   /* Assign global numbering to coarse dofs */
3391fa7f1dd8SStefano Zampini   if (pcbddc->new_primal_space) { /* a new primal space is present, so recompute global numbering */
3392fa7f1dd8SStefano Zampini     PetscInt ocoarse_size;
3393fa7f1dd8SStefano Zampini     ocoarse_size = pcbddc->coarse_size;
3394f4ddd8eeSStefano Zampini     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3395f4ddd8eeSStefano Zampini     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
3396f4ddd8eeSStefano Zampini     /* see if we can avoid some work */
3397fa7f1dd8SStefano Zampini     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
3398fa7f1dd8SStefano Zampini       if (ocoarse_size != pcbddc->coarse_size) { /* ...but with different size, so reset it and set reuse flag to false */
3399727cdba6SStefano Zampini         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3400fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_FALSE;
3401fa7f1dd8SStefano Zampini       } else { /* we can safely reuse already computed coarse matrix */
3402fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_TRUE;
3403f4ddd8eeSStefano Zampini       }
3404fa7f1dd8SStefano Zampini     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
3405fa7f1dd8SStefano Zampini       coarse_reuse = PETSC_FALSE;
3406f4ddd8eeSStefano Zampini     }
340770cf5478SStefano Zampini     /* reset any subassembling information */
340870cf5478SStefano Zampini     ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3409fa7f1dd8SStefano Zampini   } else { /* primal space has not been changed, so we can reuse coarse matrix */
3410fa7f1dd8SStefano Zampini     coarse_reuse = PETSC_TRUE;
3411f4ddd8eeSStefano Zampini   }
3412c8587f34SStefano Zampini 
3413cbcc2c2aSStefano Zampini   /* test if we can go multilevel */
3414f9eb5b7dSStefano Zampini   multilevel_allowed = PETSC_FALSE;
3415f9eb5b7dSStefano Zampini   multilevel_requested = PETSC_FALSE;
3416f9eb5b7dSStefano Zampini   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
3417f9eb5b7dSStefano Zampini   if (multilevel_requested) {
34182b510759SStefano Zampini     /* count "active processes" */
34192b510759SStefano Zampini     im_active = !!(pcis->n);
34202b510759SStefano Zampini     ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
34212b510759SStefano Zampini     if (active_procs/pcbddc->coarsening_ratio < 2) {
3422f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_FALSE;
34232b510759SStefano Zampini     } else {
3424f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_TRUE;
3425c8587f34SStefano Zampini     }
3426c8587f34SStefano Zampini   }
3427e7931f94SStefano Zampini 
3428abbbba34SStefano Zampini   /* creates temporary l2gmap and IS for coarse indexes */
3429abbbba34SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
3430abbbba34SStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
3431abbbba34SStefano Zampini 
3432abbbba34SStefano Zampini   /* creates temporary MATIS object for coarse matrix */
3433abbbba34SStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
3434abbbba34SStefano Zampini   ierr = MatCreateIS(PetscObjectComm((PetscObject)pc),1,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size,coarse_islg,&coarse_mat_is);CHKERRQ(ierr);
3435abbbba34SStefano Zampini   ierr = MatISSetLocalMat(coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
3436abbbba34SStefano Zampini   ierr = MatAssemblyBegin(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3437abbbba34SStefano Zampini   ierr = MatAssemblyEnd(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3438abbbba34SStefano Zampini   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
3439abbbba34SStefano Zampini 
3440f9eb5b7dSStefano Zampini   /* set defaults for coarse KSP and PC */
3441f9eb5b7dSStefano Zampini   if (multilevel_allowed) {
3442f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPRICHARDSON;
3443f9eb5b7dSStefano Zampini     coarse_pc_type = PCBDDC;
3444f9eb5b7dSStefano Zampini   } else {
3445f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPPREONLY;
3446f9eb5b7dSStefano Zampini     coarse_pc_type = PCREDUNDANT;
3447c8587f34SStefano Zampini   }
3448c8587f34SStefano Zampini 
3449f9eb5b7dSStefano Zampini   /* create the coarse KSP object only once with defaults */
3450abbbba34SStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
3451f9eb5b7dSStefano Zampini   if (!pcbddc->coarse_ksp) {
3452312be037SStefano Zampini     char prefix[256],str_level[16];
3453e604994aSStefano Zampini     size_t len;
3454f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_ksp);CHKERRQ(ierr);
3455c8587f34SStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
3456f9eb5b7dSStefano Zampini     ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
3457abbbba34SStefano Zampini     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat_is,coarse_mat_is,matstruct);CHKERRQ(ierr);
3458c8587f34SStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
3459c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3460c8587f34SStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
3461e604994aSStefano Zampini     /* prefix */
3462e604994aSStefano Zampini     ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
3463e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
3464e604994aSStefano Zampini     if (!pcbddc->current_level) {
3465e604994aSStefano Zampini       ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
3466e604994aSStefano Zampini       ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
3467c8587f34SStefano Zampini     } else {
3468e604994aSStefano Zampini       ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
3469312be037SStefano Zampini       if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
3470312be037SStefano Zampini       if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
3471e604994aSStefano Zampini       ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
3472e604994aSStefano Zampini       *(prefix+len)='\0';
3473312be037SStefano Zampini       sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
3474e604994aSStefano Zampini       ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
3475e604994aSStefano Zampini     }
3476e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
3477f9eb5b7dSStefano Zampini     /* allow user customization */
3478f9eb5b7dSStefano Zampini     ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
3479312be037SStefano Zampini   }
3480f9eb5b7dSStefano Zampini 
3481f9eb5b7dSStefano Zampini   /* get some info after set from options */
3482f9eb5b7dSStefano Zampini   ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3483f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
3484f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
3485f9eb5b7dSStefano Zampini   if (isbddc && !multilevel_allowed) { /* prevent from infinite loop if user as requested bddc pc for coarse solver */
3486f9eb5b7dSStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
3487f9eb5b7dSStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
3488f9eb5b7dSStefano Zampini     isbddc = PETSC_FALSE;
3489f9eb5b7dSStefano Zampini   }
3490f9eb5b7dSStefano Zampini 
3491f9eb5b7dSStefano Zampini   /* propagate BDDC info to the next level */
3492f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
3493f9eb5b7dSStefano Zampini   ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
3494f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
34951035eff8SStefano Zampini   if (isbddc) { /* protects from unneded computations */
34961035eff8SStefano Zampini     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
34971035eff8SStefano Zampini     const PetscInt         *idxs;
34981035eff8SStefano Zampini     IS                     *c_isfordofs,c_isneumann;
34991035eff8SStefano Zampini     ISLocalToGlobalMapping tmap;
35001035eff8SStefano Zampini 
35011035eff8SStefano Zampini     /* create map between primal indices (in local representative ordering) and local subdomain numbering */
35021035eff8SStefano Zampini     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
35031035eff8SStefano Zampini     /* allocate space for temporary storage */
35041035eff8SStefano Zampini     ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&tidxs);CHKERRQ(ierr);
35051035eff8SStefano Zampini     ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&tidxs2);CHKERRQ(ierr);
35061035eff8SStefano Zampini     /* dofs splitting */
35071035eff8SStefano Zampini     ierr = PetscMalloc(pcbddc->n_ISForDofsLocal*sizeof(IS),&c_isfordofs);CHKERRQ(ierr);
35081035eff8SStefano Zampini     for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
35098002ef2cSStefano Zampini       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
35101035eff8SStefano Zampini       ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
35111035eff8SStefano Zampini       ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
35121035eff8SStefano Zampini       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
35131035eff8SStefano Zampini       ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
35141035eff8SStefano Zampini       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
35151035eff8SStefano Zampini       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pcbddc->ISForDofsLocal[i]),nout,tidxs2,PETSC_COPY_VALUES,&c_isfordofs[i]);CHKERRQ(ierr);
35168002ef2cSStefano Zampini       /* ierr = ISView(c_isfordofs[i],0);CHKERRQ(ierr); */
35171035eff8SStefano Zampini     }
35181035eff8SStefano Zampini     ierr = PCBDDCSetDofsSplitting(pc_temp,pcbddc->n_ISForDofsLocal,c_isfordofs);CHKERRQ(ierr);
35191035eff8SStefano Zampini     for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
35201035eff8SStefano Zampini       ierr = ISDestroy(&c_isfordofs[i]);CHKERRQ(ierr);
35211035eff8SStefano Zampini     }
35221035eff8SStefano Zampini     ierr = PetscFree(c_isfordofs);CHKERRQ(ierr);
35231035eff8SStefano Zampini     /* neumann boundaries */
35241035eff8SStefano Zampini     if (pcbddc->NeumannBoundariesLocal) {
35258002ef2cSStefano Zampini       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
35261035eff8SStefano Zampini       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
35271035eff8SStefano Zampini       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
35281035eff8SStefano Zampini       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
35291035eff8SStefano Zampini       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
35301035eff8SStefano Zampini       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
35311035eff8SStefano Zampini       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pcbddc->NeumannBoundariesLocal),nout,tidxs2,PETSC_COPY_VALUES,&c_isneumann);CHKERRQ(ierr);
35328002ef2cSStefano Zampini       /* ierr = ISView(c_isneumann,0);CHKERRQ(ierr); */
35331035eff8SStefano Zampini       ierr = PCBDDCSetNeumannBoundaries(pc_temp,c_isneumann);CHKERRQ(ierr);
35341035eff8SStefano Zampini     }
35351035eff8SStefano Zampini     ierr = ISDestroy(&c_isneumann);CHKERRQ(ierr);
35361035eff8SStefano Zampini     ierr = PetscFree(tidxs);CHKERRQ(ierr);
35371035eff8SStefano Zampini     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
35381035eff8SStefano Zampini     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
35391035eff8SStefano Zampini   }
3540f9eb5b7dSStefano Zampini 
3541abbbba34SStefano Zampini   /* destroy no longer needed map */
354220a2ab83SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
3543fdc09c96SStefano Zampini 
3544f9eb5b7dSStefano Zampini   /* assemble coarse matrix */
3545f9eb5b7dSStefano Zampini   if (isbddc || isnn) {
354670cf5478SStefano Zampini     if (!pcbddc->coarse_subassembling) { /* subassembling info is not present */
354728143c3dSStefano Zampini       ierr = MatISGetSubassemblingPattern(coarse_mat_is,active_procs/pcbddc->coarsening_ratio,PETSC_TRUE,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
354822b6e8a2SStefano Zampini       if (pcbddc->dbg_flag) {
354922b6e8a2SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
355022b6e8a2SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Subassembling pattern\n");CHKERRQ(ierr);
355122b6e8a2SStefano Zampini         ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
355222b6e8a2SStefano Zampini       }
355370cf5478SStefano Zampini     }
355470cf5478SStefano Zampini     if (coarse_reuse) {
355570cf5478SStefano Zampini       ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL,NULL);CHKERRQ(ierr);
355670cf5478SStefano Zampini       ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
355728143c3dSStefano Zampini       ierr = MatISSubassemble(coarse_mat_is,pcbddc->coarse_subassembling,0,PETSC_FALSE,MAT_REUSE_MATRIX,&coarse_mat,0,NULL);CHKERRQ(ierr);
355870cf5478SStefano Zampini     } else {
355928143c3dSStefano Zampini       ierr = MatISSubassemble(coarse_mat_is,pcbddc->coarse_subassembling,0,PETSC_FALSE,MAT_INITIAL_MATRIX,&coarse_mat,0,NULL);CHKERRQ(ierr);
356070cf5478SStefano Zampini     }
3561fa7f1dd8SStefano Zampini   } else {
3562fa7f1dd8SStefano Zampini     if (coarse_reuse) {
3563fa7f1dd8SStefano Zampini       ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL,NULL);CHKERRQ(ierr);
3564fa7f1dd8SStefano Zampini       ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
3565fa7f1dd8SStefano Zampini       ierr = MatISGetMPIXAIJ(coarse_mat_is,MATMPIAIJ,MAT_REUSE_MATRIX,&coarse_mat);CHKERRQ(ierr);
3566fa7f1dd8SStefano Zampini     } else {
3567fa7f1dd8SStefano Zampini       ierr = MatISGetMPIXAIJ(coarse_mat_is,MATMPIAIJ,MAT_INITIAL_MATRIX,&coarse_mat);CHKERRQ(ierr);
3568fa7f1dd8SStefano Zampini     }
3569c8587f34SStefano Zampini   }
35702b510759SStefano Zampini   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
35719881197aSStefano Zampini 
3572f9eb5b7dSStefano Zampini   /* create local to global scatters for coarse problem */
3573f4ddd8eeSStefano Zampini   if (pcbddc->new_primal_space) {
3574f4ddd8eeSStefano Zampini     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3575f4ddd8eeSStefano Zampini     ierr = VecDestroy(&pcbddc->coarse_rhs);CHKERRQ(ierr);
3576f4ddd8eeSStefano Zampini     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3577f9eb5b7dSStefano Zampini     ierr = MatGetVecs(coarse_mat,&pcbddc->coarse_vec,&pcbddc->coarse_rhs);CHKERRQ(ierr);
3578f9eb5b7dSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3579f4ddd8eeSStefano Zampini   }
3580f9eb5b7dSStefano Zampini   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
3581f9eb5b7dSStefano Zampini 
3582f9eb5b7dSStefano Zampini   /* propagate symmetry info to coarse matrix */
3583cbcc2c2aSStefano Zampini   issym = PETSC_FALSE;
3584cbcc2c2aSStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
3585f9eb5b7dSStefano Zampini   ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,issym);CHKERRQ(ierr);
3586cbcc2c2aSStefano Zampini   isherm = PETSC_FALSE;
3587cbcc2c2aSStefano Zampini   ierr = MatIsHermitianKnown(pc->pmat,&setsym,&isherm);CHKERRQ(ierr);
35885a16e3a0SStefano Zampini   ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
3589f9eb5b7dSStefano Zampini 
3590*12edc857SStefano Zampini /* temporary disabled code */
3591*12edc857SStefano Zampini #if 0
3592b8ffe317SStefano Zampini   /* Compute coarse null space (special handling by BDDC only) */
3593b8ffe317SStefano Zampini   if (pcbddc->NullSpace) {
3594b8ffe317SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCoarse(pc,coarse_mat,&CoarseNullSpace);CHKERRQ(ierr);
3595b8ffe317SStefano Zampini     if (isbddc) {
3596b8ffe317SStefano Zampini       ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
3597b8ffe317SStefano Zampini     } else {
3598c8587f34SStefano Zampini       ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
3599c8587f34SStefano Zampini     }
3600c8587f34SStefano Zampini   }
3601*12edc857SStefano Zampini #endif
3602c8587f34SStefano Zampini 
3603f9eb5b7dSStefano Zampini   /* set operators */
3604f9eb5b7dSStefano Zampini   ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat,matstruct);CHKERRQ(ierr);
3605f9eb5b7dSStefano Zampini 
3606f9eb5b7dSStefano Zampini   /* additional KSP customization */
3607f9eb5b7dSStefano Zampini   ierr = KSPGetTolerances(pcbddc->coarse_ksp,NULL,NULL,NULL,&max_it);CHKERRQ(ierr);
3608f9eb5b7dSStefano Zampini   if (max_it < 5) {
3609c8587f34SStefano Zampini     ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
3610f9eb5b7dSStefano Zampini   }
3611f9eb5b7dSStefano Zampini 
3612f9eb5b7dSStefano Zampini   /* print some info if requested */
3613f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
3614f9eb5b7dSStefano Zampini     ierr = KSPGetType(pcbddc->coarse_ksp,&coarse_ksp_type);CHKERRQ(ierr);
3615f9eb5b7dSStefano Zampini     ierr = PCGetType(pc_temp,&coarse_pc_type);CHKERRQ(ierr);
3616f9eb5b7dSStefano Zampini     if (!multilevel_allowed) {
3617f9eb5b7dSStefano Zampini       if (multilevel_requested) {
3618f9eb5b7dSStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Not enough active processes on level %d (active processes %d, coarsening ratio %d)\n",pcbddc->current_level,active_procs,pcbddc->coarsening_ratio);CHKERRQ(ierr);
3619f9eb5b7dSStefano Zampini       } else if (pcbddc->max_levels) {
3620f9eb5b7dSStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
3621c8587f34SStefano Zampini       }
3622c8587f34SStefano Zampini     }
3623e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Calling %s/%s setup at level %d for coarse solver (%s)\n",coarse_ksp_type,coarse_pc_type,pcbddc->current_level,((PetscObject)pcbddc->coarse_ksp)->prefix);CHKERRQ(ierr);
3624f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3625c8587f34SStefano Zampini   }
3626f9eb5b7dSStefano Zampini 
3627f9eb5b7dSStefano Zampini   /* setup coarse ksp */
3628f9eb5b7dSStefano Zampini   ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
3629*12edc857SStefano Zampini   /* hack -> use a DM on coarse_ksp to remove this hack */
3630*12edc857SStefano Zampini   ierr = MatGetVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_rhs),&((pcbddc->coarse_ksp)->vec_sol));CHKERRQ(ierr);
3631f9eb5b7dSStefano Zampini 
3632cbcc2c2aSStefano Zampini   /* Check coarse problem if in debug mode or if solving with an iterative method */
3633cbcc2c2aSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
3634cbcc2c2aSStefano Zampini   if (pcbddc->dbg_flag || !ispreonly) {
3635c8587f34SStefano Zampini     KSP       check_ksp;
36362b510759SStefano Zampini     KSPType   check_ksp_type;
3637c8587f34SStefano Zampini     PC        check_pc;
3638c8587f34SStefano Zampini     Vec       check_vec;
3639c8587f34SStefano Zampini     PetscReal abs_infty_error,infty_error,lambda_min,lambda_max;
36402b510759SStefano Zampini     PetscInt  its;
3641cbcc2c2aSStefano Zampini     PetscBool compute;
3642c8587f34SStefano Zampini 
36432b510759SStefano Zampini     /* Create ksp object suitable for estimation of extreme eigenvalues */
3644f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&check_ksp);CHKERRQ(ierr);
3645fdc635d7SStefano Zampini     ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
3646f4ddd8eeSStefano Zampini     ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
36472b510759SStefano Zampini     if (ispreonly) {
36482b510759SStefano Zampini       check_ksp_type = KSPPREONLY;
3649f9eb5b7dSStefano Zampini       compute = PETSC_FALSE;
36502b510759SStefano Zampini     } else {
3651cbcc2c2aSStefano Zampini       check_ksp_type = KSPGMRES;
3652f9eb5b7dSStefano Zampini       compute = PETSC_TRUE;
3653c8587f34SStefano Zampini     }
3654c8587f34SStefano Zampini     ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
3655f9eb5b7dSStefano Zampini     ierr = KSPSetComputeSingularValues(check_ksp,compute);CHKERRQ(ierr);
3656c8587f34SStefano Zampini     ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
3657c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
3658c8587f34SStefano Zampini     ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
3659c8587f34SStefano Zampini     /* create random vec */
3660c8587f34SStefano Zampini     ierr = VecDuplicate(pcbddc->coarse_vec,&check_vec);CHKERRQ(ierr);
3661c8587f34SStefano Zampini     ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
3662c8587f34SStefano Zampini     if (CoarseNullSpace) {
3663c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec);CHKERRQ(ierr);
3664c8587f34SStefano Zampini     }
3665fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3666c8587f34SStefano Zampini     /* solve coarse problem */
3667c8587f34SStefano Zampini     ierr = KSPSolve(check_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
3668c8587f34SStefano Zampini     if (CoarseNullSpace) {
3669c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,pcbddc->coarse_vec);CHKERRQ(ierr);
3670c8587f34SStefano Zampini     }
3671cbcc2c2aSStefano Zampini     /* set eigenvalue estimation if preonly has not been requested */
3672cbcc2c2aSStefano Zampini     if (!ispreonly) {
3673cbcc2c2aSStefano Zampini       ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
36748002ef2cSStefano Zampini       /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Coarse problem eigenvalues: %1.6e %1.6e\n",lambda_min,lambda_max);CHKERRQ(ierr); */
3675cbcc2c2aSStefano Zampini       ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max,lambda_min);CHKERRQ(ierr);
3676cbcc2c2aSStefano Zampini       ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
3677cbcc2c2aSStefano Zampini     }
3678c8587f34SStefano Zampini     /* check coarse problem residual error */
3679cbcc2c2aSStefano Zampini     if (pcbddc->dbg_flag) {
3680c8587f34SStefano Zampini       ierr = VecAXPY(check_vec,-1.0,pcbddc->coarse_vec);CHKERRQ(ierr);
3681c8587f34SStefano Zampini       ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3682fdc635d7SStefano Zampini       ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3683c8587f34SStefano Zampini       ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
3684c8587f34SStefano Zampini       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
3685e604994aSStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem (%s) details\n",((PetscObject)(pcbddc->coarse_ksp))->prefix);CHKERRQ(ierr);
3686e604994aSStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
3687e604994aSStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
36882b510759SStefano Zampini       if (!ispreonly) {
368920a2ab83SStefano Zampini         ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
3690f9eb5b7dSStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem eigenvalues (estimated with %d iterations of %s): %1.6e %1.6e\n",its,check_ksp_type,lambda_min,lambda_max);CHKERRQ(ierr);
3691c8587f34SStefano Zampini       }
36922b510759SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3693cbcc2c2aSStefano Zampini     }
3694c8587f34SStefano Zampini     ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
3695c8587f34SStefano Zampini   }
3696cbcc2c2aSStefano Zampini 
3697cbcc2c2aSStefano Zampini   /* print additional info */
3698cbcc2c2aSStefano Zampini   if (pcbddc->dbg_flag) {
3699cbcc2c2aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
3700cbcc2c2aSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3701cbcc2c2aSStefano Zampini     ierr = KSPView(pcbddc->coarse_ksp,pcbddc->dbg_viewer);CHKERRQ(ierr);
3702cbcc2c2aSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3703cbcc2c2aSStefano Zampini   }
3704cbcc2c2aSStefano Zampini 
37052b510759SStefano Zampini   /* free memory */
3706c8587f34SStefano Zampini   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
3707fdc635d7SStefano Zampini   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
3708c8587f34SStefano Zampini   PetscFunctionReturn(0);
3709c8587f34SStefano Zampini }
3710674ae819SStefano Zampini 
3711f34684f1SStefano Zampini #undef __FUNCT__
3712f34684f1SStefano Zampini #define __FUNCT__ "PCBDDCComputePrimalNumbering"
3713f34684f1SStefano Zampini PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
3714f34684f1SStefano Zampini {
3715f34684f1SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3716f34684f1SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
3717f34684f1SStefano Zampini   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
3718727cdba6SStefano Zampini   PetscInt       i,coarse_size;
3719727cdba6SStefano Zampini   PetscInt       *local_primal_indices;
3720f34684f1SStefano Zampini   PetscErrorCode ierr;
3721f34684f1SStefano Zampini 
3722f34684f1SStefano Zampini   PetscFunctionBegin;
3723f34684f1SStefano Zampini   /* Compute global number of coarse dofs */
372489c96988SStefano Zampini   if (!pcbddc->primal_indices_local_idxs && pcbddc->local_primal_size) {
372589c96988SStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Local primal indices have not been created");
3726727cdba6SStefano Zampini   }
3727727cdba6SStefano Zampini   ierr = PCBDDCSubsetNumbering(PetscObjectComm((PetscObject)(pc->pmat)),matis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,NULL,&coarse_size,&local_primal_indices);CHKERRQ(ierr);
3728f34684f1SStefano Zampini 
3729f34684f1SStefano Zampini   /* check numbering */
3730f34684f1SStefano Zampini   if (pcbddc->dbg_flag) {
3731f34684f1SStefano Zampini     PetscScalar coarsesum,*array;
3732f34684f1SStefano Zampini 
3733f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3734f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3735f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
37360fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
3737f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
3738f34684f1SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
3739727cdba6SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
3740f34684f1SStefano Zampini     }
3741f34684f1SStefano Zampini     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
3742f34684f1SStefano Zampini     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
3743f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3744f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3745f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3746f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3747f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3748f34684f1SStefano Zampini     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3749f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3750f34684f1SStefano Zampini       if (array[i] == 1.0) {
3751f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %d owned by a single process!\n",PetscGlobalRank,i);CHKERRQ(ierr);
3752f34684f1SStefano Zampini       }
3753f34684f1SStefano Zampini     }
3754f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3755f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3756f34684f1SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
3757f34684f1SStefano Zampini     }
3758f34684f1SStefano Zampini     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3759f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3760f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3761f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3762f34684f1SStefano Zampini     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
3763f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
3764f34684f1SStefano Zampini     if (pcbddc->dbg_flag > 1) {
3765f34684f1SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
3766f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3767f34684f1SStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
3768f34684f1SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
3769727cdba6SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_primal_indices[%d]=%d (%d)\n",i,local_primal_indices[i],pcbddc->primal_indices_local_idxs[i]);
3770f34684f1SStefano Zampini       }
3771f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3772f34684f1SStefano Zampini     }
3773f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3774f34684f1SStefano Zampini   }
3775f34684f1SStefano Zampini   /* get back data */
3776f34684f1SStefano Zampini   *coarse_size_n = coarse_size;
3777f34684f1SStefano Zampini   *local_primal_indices_n = local_primal_indices;
3778674ae819SStefano Zampini   PetscFunctionReturn(0);
3779674ae819SStefano Zampini }
3780674ae819SStefano Zampini 
3781e456f2a8SStefano Zampini #undef __FUNCT__
3782e456f2a8SStefano Zampini #define __FUNCT__ "PCBDDCGlobalToLocal"
3783e456f2a8SStefano Zampini PetscErrorCode PCBDDCGlobalToLocal(PC pc,VecScatter ctx,IS globalis,IS* localis)
3784e456f2a8SStefano Zampini {
3785e456f2a8SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
3786e456f2a8SStefano Zampini   IS             localis_t;
3787e456f2a8SStefano Zampini   PetscInt       i,lsize,*idxs;
3788e456f2a8SStefano Zampini   PetscScalar    *vals;
3789e456f2a8SStefano Zampini   PetscErrorCode ierr;
3790e456f2a8SStefano Zampini 
3791e456f2a8SStefano Zampini   PetscFunctionBegin;
3792e456f2a8SStefano Zampini   /* get dirichlet indices in local ordering exploiting local to global map */
3793e456f2a8SStefano Zampini   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
3794e456f2a8SStefano Zampini   ierr = PetscMalloc(lsize*sizeof(PetscScalar),&vals);CHKERRQ(ierr);
3795e456f2a8SStefano Zampini   for (i=0;i<lsize;i++) vals[i] = 1.0;
3796e456f2a8SStefano Zampini   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
3797e456f2a8SStefano Zampini   ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
37981035eff8SStefano Zampini   if (idxs) { /* multilevel guard */
3799e456f2a8SStefano Zampini     ierr = VecSetValues(pcis->vec1_global,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
38001035eff8SStefano Zampini   }
3801e456f2a8SStefano Zampini   ierr = VecAssemblyBegin(pcis->vec1_global);CHKERRQ(ierr);
3802e456f2a8SStefano Zampini   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
3803e456f2a8SStefano Zampini   ierr = PetscFree(vals);CHKERRQ(ierr);
3804e456f2a8SStefano Zampini   ierr = VecAssemblyEnd(pcis->vec1_global);CHKERRQ(ierr);
3805e456f2a8SStefano Zampini   /* now compute dirichlet set in local ordering */
3806e456f2a8SStefano Zampini   ierr = VecScatterBegin(ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3807e456f2a8SStefano Zampini   ierr = VecScatterEnd(ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3808e456f2a8SStefano Zampini   ierr = VecGetArrayRead(pcis->vec1_N,(const PetscScalar**)&vals);CHKERRQ(ierr);
3809e456f2a8SStefano Zampini   for (i=0,lsize=0;i<pcis->n;i++) {
3810e456f2a8SStefano Zampini     if (vals[i] == 1.0) {
3811e456f2a8SStefano Zampini       lsize++;
3812e456f2a8SStefano Zampini     }
3813e456f2a8SStefano Zampini   }
3814e456f2a8SStefano Zampini   ierr = PetscMalloc(lsize*sizeof(PetscInt),&idxs);CHKERRQ(ierr);
3815e456f2a8SStefano Zampini   for (i=0,lsize=0;i<pcis->n;i++) {
3816e456f2a8SStefano Zampini     if (vals[i] == 1.0) {
3817e456f2a8SStefano Zampini       idxs[lsize++] = i;
3818e456f2a8SStefano Zampini     }
3819e456f2a8SStefano Zampini   }
3820e456f2a8SStefano Zampini   ierr = VecRestoreArrayRead(pcis->vec1_N,(const PetscScalar**)&vals);CHKERRQ(ierr);
3821e456f2a8SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
3822e456f2a8SStefano Zampini   *localis = localis_t;
3823e456f2a8SStefano Zampini   PetscFunctionReturn(0);
3824e456f2a8SStefano Zampini }
3825