xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 70cf5478945a9d09b9da66ef3d9730962f546e98)
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);
110*70cf5478SStefano 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;
19388ebb749SStefano Zampini   PetscBool              setsym=PETSC_FALSE,issym=PETSC_FALSE;
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) {
22188ebb749SStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"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     }
62188ebb749SStefano Zampini   }
62288ebb749SStefano Zampini   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
62388ebb749SStefano Zampini   /* Checking coarse_sub_mat and coarse basis functios */
62488ebb749SStefano Zampini   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
62588ebb749SStefano Zampini   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
62625084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
62788ebb749SStefano Zampini     Mat         coarse_sub_mat;
62825084f0cSStefano Zampini     Mat         AUXMAT,TM1,TM2,TM3,TM4;
62988ebb749SStefano Zampini     Mat         coarse_phi_D,coarse_phi_B;
63088ebb749SStefano Zampini     Mat         coarse_psi_D,coarse_psi_B;
63188ebb749SStefano Zampini     Mat         A_II,A_BB,A_IB,A_BI;
63288ebb749SStefano Zampini     MatType     checkmattype=MATSEQAIJ;
63388ebb749SStefano Zampini     PetscReal   real_value;
63488ebb749SStefano Zampini 
63588ebb749SStefano Zampini     ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
63688ebb749SStefano Zampini     ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
63788ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
63888ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
63988ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
64088ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
64188ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
64288ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
64388ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
64488ebb749SStefano Zampini     }
64588ebb749SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
64688ebb749SStefano Zampini 
64725084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
64825084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat and local basis functions\n");CHKERRQ(ierr);
64925084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
65088ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
65188ebb749SStefano Zampini       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
65288ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
65388ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
65488ebb749SStefano Zampini       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
65588ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
65688ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
65788ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
65888ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
65988ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
66088ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
66188ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
66288ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
66388ebb749SStefano Zampini     } else {
66488ebb749SStefano Zampini       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
66588ebb749SStefano Zampini       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
66688ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
66788ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_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_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
67188ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
67288ebb749SStefano Zampini     }
67388ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
67488ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
67588ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
67688ebb749SStefano Zampini     ierr = MatConvert(TM1,MATSEQDENSE,MAT_REUSE_MATRIX,&TM1);CHKERRQ(ierr);
67788ebb749SStefano Zampini     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
67888ebb749SStefano Zampini     ierr = MatNorm(TM1,NORM_INFINITY,&real_value);CHKERRQ(ierr);
6790fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
68025084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"----------------------------------\n");CHKERRQ(ierr);
68125084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d \n",PetscGlobalRank);CHKERRQ(ierr);
68225084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"matrix error = % 1.14e\n",real_value);CHKERRQ(ierr);
68325084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (phi) errors\n");CHKERRQ(ierr);
68488ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
68525084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,coarsefunctions_errors[i]);CHKERRQ(ierr);
68688ebb749SStefano Zampini     }
68725084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (phi) errors\n");CHKERRQ(ierr);
68888ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
68925084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,constraints_errors[i]);CHKERRQ(ierr);
69088ebb749SStefano Zampini     }
69188ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
69225084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (psi) errors\n");CHKERRQ(ierr);
69388ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
69425084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,coarsefunctions_errors[i]);CHKERRQ(ierr);
69588ebb749SStefano Zampini       }
69625084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (psi) errors\n");CHKERRQ(ierr);
69788ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
69825084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,constraints_errors[i]);CHKERRQ(ierr);
69988ebb749SStefano Zampini       }
70088ebb749SStefano Zampini     }
70125084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
70288ebb749SStefano Zampini     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
70388ebb749SStefano Zampini     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
70488ebb749SStefano Zampini     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
70588ebb749SStefano Zampini     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
70688ebb749SStefano Zampini     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
70788ebb749SStefano Zampini     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
70888ebb749SStefano Zampini     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
70988ebb749SStefano Zampini     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
71088ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
71188ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
71288ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
71388ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
71488ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
71588ebb749SStefano Zampini     }
71688ebb749SStefano Zampini     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
7178ce42a96SStefano Zampini     ierr = ISRestoreIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
71888ebb749SStefano Zampini     ierr = PetscFree(coarsefunctions_errors);CHKERRQ(ierr);
71988ebb749SStefano Zampini     ierr = PetscFree(constraints_errors);CHKERRQ(ierr);
72088ebb749SStefano Zampini   }
72188ebb749SStefano Zampini   /* free memory */
72288ebb749SStefano Zampini   if (n_vertices) {
72388ebb749SStefano Zampini     ierr = VecDestroy(&vec1_V);CHKERRQ(ierr);
72488ebb749SStefano Zampini     ierr = VecDestroy(&vec2_V);CHKERRQ(ierr);
72588ebb749SStefano Zampini     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
72688ebb749SStefano Zampini     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
72788ebb749SStefano Zampini     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
72888ebb749SStefano Zampini   }
72988ebb749SStefano Zampini   if (n_constraints) {
73088ebb749SStefano Zampini     ierr = VecDestroy(&vec1_C);CHKERRQ(ierr);
73188ebb749SStefano Zampini     ierr = VecDestroy(&vec2_C);CHKERRQ(ierr);
73288ebb749SStefano Zampini     ierr = MatDestroy(&M1);CHKERRQ(ierr);
73388ebb749SStefano Zampini     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
73488ebb749SStefano Zampini   }
73588ebb749SStefano Zampini   ierr = PetscFree(auxindices);CHKERRQ(ierr);
7368629588bSStefano Zampini   /* get back data */
7378629588bSStefano Zampini   *coarse_submat_vals_n = coarse_submat_vals;
73888ebb749SStefano Zampini   PetscFunctionReturn(0);
73988ebb749SStefano Zampini }
74088ebb749SStefano Zampini 
74188ebb749SStefano Zampini #undef __FUNCT__
742aa0d41d4SStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalMatrices"
743aa0d41d4SStefano Zampini PetscErrorCode PCBDDCSetUpLocalMatrices(PC pc)
744aa0d41d4SStefano Zampini {
745aa0d41d4SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
746aa0d41d4SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
747aa0d41d4SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
7489577ea80SStefano Zampini   PetscBool         issbaij,isbaij;
749aa0d41d4SStefano Zampini   /* manage repeated solves */
750aa0d41d4SStefano Zampini   MatReuse          reuse;
751aa0d41d4SStefano Zampini   MatStructure      matstruct;
752aa0d41d4SStefano Zampini   PetscErrorCode    ierr;
753aa0d41d4SStefano Zampini 
754aa0d41d4SStefano Zampini   PetscFunctionBegin;
755f4ddd8eeSStefano Zampini   if (pcbddc->use_change_of_basis && !pcbddc->ChangeOfBasisMatrix) {
756f4ddd8eeSStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Change of basis matrix has not been created");
757f4ddd8eeSStefano Zampini   }
758aa0d41d4SStefano Zampini   /* get mat flags */
759aa0d41d4SStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
760aa0d41d4SStefano Zampini   reuse = MAT_INITIAL_MATRIX;
761aa0d41d4SStefano Zampini   if (pc->setupcalled) {
762aa0d41d4SStefano Zampini     /* when matstruct is SAME_PRECONDITIONER, we shouldn't be here */
763aa0d41d4SStefano Zampini     if (matstruct == SAME_PRECONDITIONER) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen");
764aa0d41d4SStefano Zampini     if (matstruct == SAME_NONZERO_PATTERN) {
765aa0d41d4SStefano Zampini       reuse = MAT_REUSE_MATRIX;
766aa0d41d4SStefano Zampini     } else {
767aa0d41d4SStefano Zampini       reuse = MAT_INITIAL_MATRIX;
768aa0d41d4SStefano Zampini     }
769aa0d41d4SStefano Zampini   }
770aa0d41d4SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
771aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
772aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
773aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
774aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BB);CHKERRQ(ierr);
775aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
776aa0d41d4SStefano Zampini   }
777aa0d41d4SStefano Zampini 
778aa0d41d4SStefano Zampini   /* transform local matrices if needed */
779aa0d41d4SStefano Zampini   if (pcbddc->use_change_of_basis) {
780aa0d41d4SStefano Zampini     Mat         change_mat_all;
781aa0d41d4SStefano Zampini     PetscScalar *row_cmat_values;
782aa0d41d4SStefano Zampini     PetscInt    *row_cmat_indices;
783aa0d41d4SStefano Zampini     PetscInt    *nnz,*is_indices,*temp_indices;
784aa0d41d4SStefano Zampini     PetscInt    i,j,k,n_D,n_B;
785aa0d41d4SStefano Zampini 
786aa0d41d4SStefano Zampini     /* Get Non-overlapping dimensions */
787aa0d41d4SStefano Zampini     n_B = pcis->n_B;
788aa0d41d4SStefano Zampini     n_D = pcis->n-n_B;
789aa0d41d4SStefano Zampini 
790aa0d41d4SStefano Zampini     /* compute nonzero structure of change of basis on all local nodes */
791aa0d41d4SStefano Zampini     ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
792aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
793aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) nnz[is_indices[i]] = 1;
794aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
795aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
796aa0d41d4SStefano Zampini     k=1;
797aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
798aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
799aa0d41d4SStefano Zampini       nnz[is_indices[i]]=j;
800aa0d41d4SStefano Zampini       if (k < j) k = j;
801aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
802aa0d41d4SStefano Zampini     }
803aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
804aa0d41d4SStefano Zampini     /* assemble change of basis matrix on the whole set of local dofs */
805aa0d41d4SStefano Zampini     ierr = PetscMalloc(k*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
806aa0d41d4SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&change_mat_all);CHKERRQ(ierr);
807aa0d41d4SStefano Zampini     ierr = MatSetSizes(change_mat_all,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
808aa0d41d4SStefano Zampini     ierr = MatSetType(change_mat_all,MATSEQAIJ);CHKERRQ(ierr);
809aa0d41d4SStefano Zampini     ierr = MatSeqAIJSetPreallocation(change_mat_all,0,nnz);CHKERRQ(ierr);
810aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
811aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) {
812aa0d41d4SStefano Zampini       ierr = MatSetValue(change_mat_all,is_indices[i],is_indices[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
813aa0d41d4SStefano Zampini     }
814aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
815aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
816aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
817aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
818aa0d41d4SStefano Zampini       for (k=0; k<j; k++) temp_indices[k]=is_indices[row_cmat_indices[k]];
819aa0d41d4SStefano Zampini       ierr = MatSetValues(change_mat_all,1,&is_indices[i],j,temp_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
820aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
821aa0d41d4SStefano Zampini     }
822aa0d41d4SStefano Zampini     ierr = MatAssemblyBegin(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
823aa0d41d4SStefano Zampini     ierr = MatAssemblyEnd(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8249577ea80SStefano Zampini     /* TODO: HOW TO WORK WITH BAIJ and SBAIJ? PtAP not provided */
8259577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
8269577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQBAIJ,&isbaij);CHKERRQ(ierr);
8279577ea80SStefano Zampini     if (!issbaij && !isbaij) {
828aa0d41d4SStefano Zampini       ierr = MatPtAP(matis->A,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
829aa0d41d4SStefano Zampini     } else {
830aa0d41d4SStefano Zampini       Mat work_mat;
831aa0d41d4SStefano Zampini       ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
832aa0d41d4SStefano Zampini       ierr = MatPtAP(work_mat,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
833aa0d41d4SStefano Zampini       ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
834aa0d41d4SStefano Zampini     }
83545a1bb75SStefano Zampini     /*
83645a1bb75SStefano Zampini     ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
83745a1bb75SStefano Zampini     ierr = MatView(change_mat_all,(PetscViewer)0);CHKERRQ(ierr);
83845a1bb75SStefano Zampini     */
839aa0d41d4SStefano Zampini     ierr = MatDestroy(&change_mat_all);CHKERRQ(ierr);
840aa0d41d4SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
841aa0d41d4SStefano Zampini     ierr = PetscFree(temp_indices);CHKERRQ(ierr);
842aa0d41d4SStefano Zampini   } else {
843aa0d41d4SStefano Zampini     /* without change of basis, the local matrix is unchanged */
844aa0d41d4SStefano Zampini     if (!pcbddc->local_mat) {
845aa0d41d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)matis->A);CHKERRQ(ierr);
846aa0d41d4SStefano Zampini       pcbddc->local_mat = matis->A;
847aa0d41d4SStefano Zampini     }
848aa0d41d4SStefano Zampini   }
849aa0d41d4SStefano Zampini 
850aa0d41d4SStefano Zampini   /* get submatrices */
851aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_I_local,reuse,&pcis->A_II);CHKERRQ(ierr);
8529577ea80SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_B_local,reuse,&pcis->A_BB);CHKERRQ(ierr);
8539577ea80SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
8549577ea80SStefano Zampini   if (!issbaij) {
855aa0d41d4SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
856aa0d41d4SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
8579577ea80SStefano Zampini   } else {
8589577ea80SStefano Zampini     Mat newmat;
8599577ea80SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
8609577ea80SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
8619577ea80SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
8629577ea80SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
8639577ea80SStefano Zampini   }
864aa0d41d4SStefano Zampini   PetscFunctionReturn(0);
865aa0d41d4SStefano Zampini }
866aa0d41d4SStefano Zampini 
867aa0d41d4SStefano Zampini #undef __FUNCT__
868a64d13efSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalScatters"
8698ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
870a64d13efSStefano Zampini {
871a64d13efSStefano Zampini   PC_IS*         pcis = (PC_IS*)(pc->data);
872a64d13efSStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8738ce42a96SStefano Zampini   IS             is_aux1,is_aux2;
874e9189074SStefano Zampini   PetscInt       *aux_array1,*aux_array2,*is_indices,*idx_R_local;
8753a50541eSStefano Zampini   PetscInt       n_vertices,i,j,n_R,n_D,n_B;
8763a50541eSStefano Zampini   PetscInt       vbs,bs;
8774641a718SStefano Zampini   PetscBT        bitmask;
878a64d13efSStefano Zampini   PetscErrorCode ierr;
879a64d13efSStefano Zampini 
880a64d13efSStefano Zampini   PetscFunctionBegin;
881f4ddd8eeSStefano Zampini   /* No need to setup local scatters if primal space is unchanged */
882*70cf5478SStefano Zampini   if (!pcbddc->new_primal_space_local && !pcbddc->dbg_flag) {
883f4ddd8eeSStefano Zampini     PetscFunctionReturn(0);
884f4ddd8eeSStefano Zampini   }
885f4ddd8eeSStefano Zampini   /* destroy old objects */
886f4ddd8eeSStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
887f4ddd8eeSStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
888f4ddd8eeSStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
889a64d13efSStefano Zampini   /* Set Non-overlapping dimensions */
890a64d13efSStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
891e9189074SStefano Zampini   n_vertices = pcbddc->n_actual_vertices;
8924641a718SStefano Zampini   /* create auxiliary bitmask */
8934641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
8944641a718SStefano Zampini   for (i=0;i<n_vertices;i++) {
895e9189074SStefano Zampini     ierr = PetscBTSet(bitmask,pcbddc->primal_indices_local_idxs[i]);CHKERRQ(ierr);
8964641a718SStefano Zampini   }
8973a50541eSStefano Zampini 
898a64d13efSStefano Zampini   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
899a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n-n_vertices)*sizeof(PetscInt),&idx_R_local);CHKERRQ(ierr);
900a64d13efSStefano Zampini   for (i=0, n_R=0; i<pcis->n; i++) {
9014641a718SStefano Zampini     if (!PetscBTLookup(bitmask,i)) {
902a64d13efSStefano Zampini       idx_R_local[n_R] = i;
903a64d13efSStefano Zampini       n_R++;
904a64d13efSStefano Zampini     }
905a64d13efSStefano Zampini   }
9063a50541eSStefano Zampini 
9073a50541eSStefano Zampini   /* Block code */
9083a50541eSStefano Zampini   vbs = 1;
9093a50541eSStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
9103a50541eSStefano Zampini   if (bs>1 && !(n_vertices%bs)) {
9113a50541eSStefano Zampini     PetscBool is_blocked = PETSC_TRUE;
9123a50541eSStefano Zampini     PetscInt  *vary;
9133a50541eSStefano Zampini     /* Verify if the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
9143a50541eSStefano Zampini     ierr = PetscMalloc(pcis->n/bs*sizeof(PetscInt),&vary);CHKERRQ(ierr);
9153a50541eSStefano Zampini     ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
916e9189074SStefano Zampini     for (i=0; i<n_vertices; i++) vary[pcbddc->primal_indices_local_idxs[i]/bs]++;
9173a50541eSStefano Zampini     for (i=0; i<n_vertices; i++) {
9183a50541eSStefano Zampini       if (vary[i]!=0 && vary[i]!=bs) {
9193a50541eSStefano Zampini         is_blocked = PETSC_FALSE;
9203a50541eSStefano Zampini         break;
9213a50541eSStefano Zampini       }
9223a50541eSStefano Zampini     }
9233a50541eSStefano Zampini     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
9243a50541eSStefano Zampini       vbs = bs;
9253a50541eSStefano Zampini       for (i=0;i<n_R/vbs;i++) {
9263a50541eSStefano Zampini         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
9273a50541eSStefano Zampini       }
9283a50541eSStefano Zampini     }
9293a50541eSStefano Zampini     ierr = PetscFree(vary);CHKERRQ(ierr);
9303a50541eSStefano Zampini   }
9313a50541eSStefano Zampini   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
9323a50541eSStefano Zampini   ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
933a64d13efSStefano Zampini 
934a64d13efSStefano Zampini   /* print some info if requested */
935a64d13efSStefano Zampini   if (pcbddc->dbg_flag) {
936a64d13efSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
937a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
9380fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
939a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
940a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
9413a50541eSStefano 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);
942a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr);
943a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
944a64d13efSStefano Zampini   }
945a64d13efSStefano Zampini 
946a64d13efSStefano Zampini   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
9473a50541eSStefano Zampini   ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
948a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
949a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array2);CHKERRQ(ierr);
950a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
9514641a718SStefano Zampini   for (i=0; i<n_D; i++) {
9524641a718SStefano Zampini     ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
9534641a718SStefano Zampini   }
954a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
955a64d13efSStefano Zampini   for (i=0, j=0; i<n_R; i++) {
9564641a718SStefano Zampini     if (!PetscBTLookup(bitmask,idx_R_local[i])) {
9574641a718SStefano Zampini       aux_array1[j++] = i;
958a64d13efSStefano Zampini     }
959a64d13efSStefano Zampini   }
960a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
961a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
962a64d13efSStefano Zampini   for (i=0, j=0; i<n_B; i++) {
9634641a718SStefano Zampini     if (!PetscBTLookup(bitmask,is_indices[i])) {
9644641a718SStefano Zampini       aux_array2[j++] = i;
965a64d13efSStefano Zampini     }
966a64d13efSStefano Zampini   }
967a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
968a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
969a64d13efSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
970a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
971a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
972a64d13efSStefano Zampini 
9738eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
974a64d13efSStefano Zampini     ierr = PetscMalloc(n_D*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
975a64d13efSStefano Zampini     for (i=0, j=0; i<n_R; i++) {
9764641a718SStefano Zampini       if (PetscBTLookup(bitmask,idx_R_local[i])) {
9774641a718SStefano Zampini         aux_array1[j++] = i;
978a64d13efSStefano Zampini       }
979a64d13efSStefano Zampini     }
980a64d13efSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
981a64d13efSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
982a64d13efSStefano Zampini     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
983a64d13efSStefano Zampini   }
9844641a718SStefano Zampini   ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
9853a50541eSStefano Zampini   ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
986a64d13efSStefano Zampini   PetscFunctionReturn(0);
987a64d13efSStefano Zampini }
988a64d13efSStefano Zampini 
989304d26faSStefano Zampini 
990304d26faSStefano Zampini #undef __FUNCT__
991304d26faSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
9928ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc)
993304d26faSStefano Zampini {
994304d26faSStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
995304d26faSStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
996304d26faSStefano Zampini   PC             pc_temp;
997304d26faSStefano Zampini   Mat            A_RR;
998304d26faSStefano Zampini   MatStructure   matstruct;
999f4ddd8eeSStefano Zampini   MatReuse       reuse;
1000304d26faSStefano Zampini   PetscScalar    m_one = -1.0;
1001304d26faSStefano Zampini   PetscReal      value;
1002af732b37SStefano Zampini   PetscInt       n_D,n_R,ibs,mbs;
10039577ea80SStefano Zampini   PetscBool      use_exact,use_exact_reduced,issbaij;
1004304d26faSStefano Zampini   PetscErrorCode ierr;
1005e604994aSStefano Zampini   /* prefixes stuff */
1006e604994aSStefano Zampini   char           dir_prefix[256],neu_prefix[256],str_level[3];
1007e604994aSStefano Zampini   size_t         len;
1008304d26faSStefano Zampini 
1009304d26faSStefano Zampini   PetscFunctionBegin;
1010304d26faSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
1011304d26faSStefano Zampini 
1012e604994aSStefano Zampini   /* compute prefixes */
1013e604994aSStefano Zampini   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
1014e604994aSStefano Zampini   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
1015e604994aSStefano Zampini   if (!pcbddc->current_level) {
1016e604994aSStefano Zampini     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
1017e604994aSStefano Zampini     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
1018e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
1019e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
1020e604994aSStefano Zampini   } else {
1021e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
1022e604994aSStefano Zampini     sprintf(str_level,"%d_",(int)(pcbddc->current_level));
1023e604994aSStefano Zampini     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
1024e604994aSStefano Zampini     len -= 15; /* remove "pc_bddc_coarse_" */
1025e604994aSStefano Zampini     if (pcbddc->current_level>1) len -= 2; /* remove "X_" with X level number (works with 9 levels max) */
1026e604994aSStefano Zampini     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
1027e604994aSStefano Zampini     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
1028e604994aSStefano Zampini     *(dir_prefix+len)='\0';
1029e604994aSStefano Zampini     *(neu_prefix+len)='\0';
1030e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
1031e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
1032e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
1033e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
1034e604994aSStefano Zampini   }
1035e604994aSStefano Zampini 
1036304d26faSStefano Zampini   /* DIRICHLET PROBLEM */
1037ac78edfcSStefano Zampini   /* Matrix for Dirichlet problem is pcis->A_II */
10388ce42a96SStefano Zampini   ierr = ISGetSize(pcis->is_I_local,&n_D);CHKERRQ(ierr);
1039304d26faSStefano Zampini   if (!pcbddc->ksp_D) { /* create object if not yet build */
1040304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
1041304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
1042304d26faSStefano Zampini     /* default */
1043304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
1044e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
10459577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
1046304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
10479577ea80SStefano Zampini     if (issbaij) {
10489577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
10499577ea80SStefano Zampini     } else {
1050304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
10519577ea80SStefano Zampini     }
1052304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1053304d26faSStefano Zampini   }
1054304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II,matstruct);CHKERRQ(ierr);
1055304d26faSStefano Zampini   /* Allow user's customization */
1056304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
1057304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1058304d26faSStefano Zampini   if (!n_D) {
1059304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
1060304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1061304d26faSStefano Zampini   }
1062304d26faSStefano Zampini   /* Set Up KSP for Dirichlet problem of BDDC */
1063304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
1064304d26faSStefano Zampini   /* set ksp_D into pcis data */
1065304d26faSStefano Zampini   ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
1066304d26faSStefano Zampini   ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
1067304d26faSStefano Zampini   pcis->ksp_D = pcbddc->ksp_D;
1068304d26faSStefano Zampini 
1069304d26faSStefano Zampini   /* NEUMANN PROBLEM */
1070f4ddd8eeSStefano Zampini   /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
10718ce42a96SStefano Zampini   ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
1072f4ddd8eeSStefano Zampini   if (pcbddc->ksp_R) { /* already created ksp */
1073f4ddd8eeSStefano Zampini     PetscInt nn_R;
1074f4ddd8eeSStefano Zampini     ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR,NULL);CHKERRQ(ierr);
1075f4ddd8eeSStefano Zampini     ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
1076f4ddd8eeSStefano Zampini     ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
1077f4ddd8eeSStefano Zampini     if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
1078f4ddd8eeSStefano Zampini       ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
1079f4ddd8eeSStefano Zampini       ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1080f4ddd8eeSStefano Zampini       reuse = MAT_INITIAL_MATRIX;
1081f4ddd8eeSStefano Zampini     } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
1082727cdba6SStefano Zampini       if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
1083f4ddd8eeSStefano Zampini         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1084f4ddd8eeSStefano Zampini         reuse = MAT_INITIAL_MATRIX;
1085f4ddd8eeSStefano Zampini       } else { /* safe to reuse the matrix */
1086f4ddd8eeSStefano Zampini         reuse = MAT_REUSE_MATRIX;
1087f4ddd8eeSStefano Zampini       }
1088f4ddd8eeSStefano Zampini     }
1089f4ddd8eeSStefano Zampini     /* last check */
1090f4ddd8eeSStefano Zampini     if (matstruct == DIFFERENT_NONZERO_PATTERN) {
1091f4ddd8eeSStefano Zampini       ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1092f4ddd8eeSStefano Zampini       reuse = MAT_INITIAL_MATRIX;
1093f4ddd8eeSStefano Zampini     }
1094f4ddd8eeSStefano Zampini   } else { /* first time, so we need to create the matrix */
1095f4ddd8eeSStefano Zampini     reuse = MAT_INITIAL_MATRIX;
1096f4ddd8eeSStefano Zampini   }
1097f4ddd8eeSStefano Zampini   /* extract A_RR */
1098af732b37SStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
1099af732b37SStefano Zampini   ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
11003a50541eSStefano Zampini   if (ibs != mbs) {
1101af732b37SStefano Zampini     Mat newmat;
1102af732b37SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
1103f4ddd8eeSStefano Zampini     ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
1104af732b37SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
1105af732b37SStefano Zampini   } else {
1106f4ddd8eeSStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
1107af732b37SStefano Zampini   }
1108f4ddd8eeSStefano Zampini   if (!pcbddc->ksp_R) { /* create object if not present */
1109304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
1110304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
1111304d26faSStefano Zampini     /* default */
1112304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
1113e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
1114304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
11159577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
11169577ea80SStefano Zampini     if (issbaij) {
11179577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
11189577ea80SStefano Zampini     } else {
1119304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
11209577ea80SStefano Zampini     }
1121304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1122304d26faSStefano Zampini   }
1123304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR,matstruct);CHKERRQ(ierr);
1124304d26faSStefano Zampini   /* Allow user's customization */
1125304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
1126304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1127304d26faSStefano Zampini   if (!n_R) {
1128304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
1129304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1130304d26faSStefano Zampini   }
1131304d26faSStefano Zampini   /* Set Up KSP for Neumann problem of BDDC */
1132304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
1133304d26faSStefano Zampini 
1134304d26faSStefano Zampini   /* check Dirichlet and Neumann solvers and adapt them if a nullspace correction is needed */
11350fccc4e9SStefano Zampini   if (pcbddc->NullSpace || pcbddc->dbg_flag) {
1136304d26faSStefano Zampini     /* Dirichlet */
11370fccc4e9SStefano Zampini     ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
11380fccc4e9SStefano Zampini     ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
11390fccc4e9SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
11400fccc4e9SStefano Zampini     ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
11410fccc4e9SStefano Zampini     ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
1142304d26faSStefano Zampini     /* need to be adapted? */
1143b8ffe317SStefano Zampini     use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1144b8ffe317SStefano Zampini     ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1145b8ffe317SStefano Zampini     ierr = PCBDDCSetUseExactDirichlet(pc,use_exact_reduced);CHKERRQ(ierr);
1146304d26faSStefano Zampini     /* print info */
1147304d26faSStefano Zampini     if (pcbddc->dbg_flag) {
1148304d26faSStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
11490fccc4e9SStefano Zampini       ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
1150304d26faSStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
1151304d26faSStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Checking solution of Dirichlet and Neumann problems\n");CHKERRQ(ierr);
1152e604994aSStefano 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);
1153304d26faSStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1154304d26faSStefano Zampini     }
1155b8ffe317SStefano Zampini     if (pcbddc->NullSpace && !use_exact_reduced && !pcbddc->switch_static) {
11568ce42a96SStefano Zampini       ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcis->is_I_local);CHKERRQ(ierr);
1157304d26faSStefano Zampini     }
1158304d26faSStefano Zampini 
1159304d26faSStefano Zampini     /* Neumann */
11600fccc4e9SStefano Zampini     ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
11610fccc4e9SStefano Zampini     ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
11620fccc4e9SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
11630fccc4e9SStefano Zampini     ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
11640fccc4e9SStefano Zampini     ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
1165304d26faSStefano Zampini     /* need to be adapted? */
1166b8ffe317SStefano Zampini     use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1167b8ffe317SStefano Zampini     ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1168304d26faSStefano Zampini     /* print info */
1169304d26faSStefano Zampini     if (pcbddc->dbg_flag) {
1170e604994aSStefano 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);
1171304d26faSStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1172304d26faSStefano Zampini     }
1173b8ffe317SStefano Zampini     if (pcbddc->NullSpace && !use_exact_reduced) { /* is it the right logic? */
11748ce42a96SStefano Zampini       ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcbddc->is_R_local);CHKERRQ(ierr);
1175304d26faSStefano Zampini     }
11760fccc4e9SStefano Zampini   }
1177304d26faSStefano Zampini   /* free Neumann problem's matrix */
1178304d26faSStefano Zampini   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1179304d26faSStefano Zampini   PetscFunctionReturn(0);
1180304d26faSStefano Zampini }
1181304d26faSStefano Zampini 
1182304d26faSStefano Zampini #undef __FUNCT__
1183674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSolveSaddlePoint"
1184674ae819SStefano Zampini static PetscErrorCode  PCBDDCSolveSaddlePoint(PC pc)
1185674ae819SStefano Zampini {
1186674ae819SStefano Zampini   PetscErrorCode ierr;
1187674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1188674ae819SStefano Zampini 
1189674ae819SStefano Zampini   PetscFunctionBegin;
1190674ae819SStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
1191674ae819SStefano Zampini   if (pcbddc->local_auxmat1) {
1192674ae819SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec2_R,pcbddc->vec1_C);CHKERRQ(ierr);
1193674ae819SStefano Zampini     ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
1194674ae819SStefano Zampini   }
1195674ae819SStefano Zampini   PetscFunctionReturn(0);
1196674ae819SStefano Zampini }
1197674ae819SStefano Zampini 
1198674ae819SStefano Zampini #undef __FUNCT__
1199674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
1200674ae819SStefano Zampini PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc)
1201674ae819SStefano Zampini {
1202674ae819SStefano Zampini   PetscErrorCode ierr;
1203674ae819SStefano Zampini   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
1204674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)  (pc->data);
1205674ae819SStefano Zampini   const PetscScalar zero = 0.0;
1206674ae819SStefano Zampini 
1207674ae819SStefano Zampini   PetscFunctionBegin;
120815aaf578SStefano Zampini   /* Application of PHI^T (or PSI^T)  */
120915aaf578SStefano Zampini   if (pcbddc->coarse_psi_B) {
121015aaf578SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
12118eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
121215aaf578SStefano Zampini   } else {
1213674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
12148eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
121515aaf578SStefano Zampini   }
1216674ae819SStefano Zampini   /* Scatter data of coarse_rhs */
1217674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { ierr = VecSet(pcbddc->coarse_rhs,zero);CHKERRQ(ierr); }
1218674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1219674ae819SStefano Zampini 
1220674ae819SStefano Zampini   /* Local solution on R nodes */
1221674ae819SStefano Zampini   ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
1222674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1223674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
12248eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1225674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1226674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1227674ae819SStefano Zampini   }
1228674ae819SStefano Zampini   ierr = PCBDDCSolveSaddlePoint(pc);CHKERRQ(ierr);
1229674ae819SStefano Zampini   ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1230674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1231674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
12328eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1233674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1234674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1235674ae819SStefano Zampini   }
1236674ae819SStefano Zampini 
1237674ae819SStefano Zampini   /* Coarse solution */
1238674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1239674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { /* TODO remove null space when doing multilevel */
1240674ae819SStefano Zampini     ierr = KSPSolve(pcbddc->coarse_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
1241674ae819SStefano Zampini   }
1242674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1243674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd  (pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1244674ae819SStefano Zampini 
1245674ae819SStefano Zampini   /* Sum contributions from two levels */
1246674ae819SStefano Zampini   ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
12478eeda7d8SStefano Zampini   if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1248674ae819SStefano Zampini   PetscFunctionReturn(0);
1249674ae819SStefano Zampini }
1250674ae819SStefano Zampini 
1251674ae819SStefano Zampini #undef __FUNCT__
1252674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
1253674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1254674ae819SStefano Zampini {
1255674ae819SStefano Zampini   PetscErrorCode ierr;
1256674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1257674ae819SStefano Zampini 
1258674ae819SStefano Zampini   PetscFunctionBegin;
1259674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1260674ae819SStefano Zampini   PetscFunctionReturn(0);
1261674ae819SStefano Zampini }
1262674ae819SStefano Zampini 
1263674ae819SStefano Zampini #undef __FUNCT__
1264674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
1265674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1266674ae819SStefano Zampini {
1267674ae819SStefano Zampini   PetscErrorCode ierr;
1268674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1269674ae819SStefano Zampini 
1270674ae819SStefano Zampini   PetscFunctionBegin;
1271674ae819SStefano Zampini   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1272674ae819SStefano Zampini   PetscFunctionReturn(0);
1273674ae819SStefano Zampini }
1274674ae819SStefano Zampini 
1275984c4197SStefano Zampini /* uncomment for testing purposes */
1276984c4197SStefano Zampini /* #define PETSC_MISSING_LAPACK_GESVD 1 */
1277674ae819SStefano Zampini #undef __FUNCT__
1278674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp"
1279674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
1280674ae819SStefano Zampini {
1281674ae819SStefano Zampini   PetscErrorCode    ierr;
1282674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
1283674ae819SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
1284674ae819SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
1285984c4197SStefano Zampini   /* constraint and (optionally) change of basis matrix implemented as SeqAIJ */
1286674ae819SStefano Zampini   MatType           impMatType=MATSEQAIJ;
1287984c4197SStefano Zampini   /* one and zero */
1288984c4197SStefano Zampini   PetscScalar       one=1.0,zero=0.0;
1289984c4197SStefano Zampini   /* space to store constraints and their local indices */
1290984c4197SStefano Zampini   PetscScalar       *temp_quadrature_constraint;
1291984c4197SStefano Zampini   PetscInt          *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B;
1292984c4197SStefano Zampini   /* iterators */
1293984c4197SStefano Zampini   PetscInt          i,j,k,total_counts,temp_start_ptr;
1294984c4197SStefano Zampini   /* stuff to store connected components stored in pcbddc->mat_graph */
1295984c4197SStefano Zampini   IS                ISForVertices,*ISForFaces,*ISForEdges,*used_IS;
1296984c4197SStefano Zampini   PetscInt          n_ISForFaces,n_ISForEdges;
1297984c4197SStefano Zampini   /* near null space stuff */
1298674ae819SStefano Zampini   MatNullSpace      nearnullsp;
1299674ae819SStefano Zampini   const Vec         *nearnullvecs;
1300674ae819SStefano Zampini   Vec               *localnearnullsp;
1301984c4197SStefano Zampini   PetscBool         nnsp_has_cnst;
1302984c4197SStefano Zampini   PetscInt          nnsp_size;
1303984c4197SStefano Zampini   PetscScalar       *array;
1304984c4197SStefano Zampini   /* BLAS integers */
1305e310c8b4SStefano Zampini   PetscBLASInt      lwork,lierr;
1306e310c8b4SStefano Zampini   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
1307c4303822SStefano Zampini   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
1308984c4197SStefano Zampini   /* LAPACK working arrays for SVD or POD */
1309242a89d7SStefano Zampini   PetscBool         skip_lapack;
1310984c4197SStefano Zampini   PetscScalar       *work;
1311984c4197SStefano Zampini   PetscReal         *singular_vals;
1312984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1313984c4197SStefano Zampini   PetscReal         *rwork;
1314674ae819SStefano Zampini #endif
1315984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1316e310c8b4SStefano Zampini   PetscBLASInt      Blas_one_2=1;
1317984c4197SStefano Zampini   PetscScalar       *temp_basis,*correlation_mat;
1318b7d8b9f8SStefano Zampini #else
1319b7d8b9f8SStefano Zampini   PetscBLASInt      dummy_int_1=1,dummy_int_2=1;
1320b7d8b9f8SStefano Zampini   PetscScalar       dummy_scalar_1=0.0,dummy_scalar_2=0.0;
1321984c4197SStefano Zampini #endif
1322727cdba6SStefano Zampini   /* reuse */
1323727cdba6SStefano Zampini   PetscInt          olocal_primal_size;
1324727cdba6SStefano Zampini   PetscInt          *oprimal_indices_local_idxs;
1325984c4197SStefano Zampini   /* change of basis */
1326984c4197SStefano Zampini   PetscInt          *aux_primal_numbering,*aux_primal_minloc,*global_indices;
1327a717540cSStefano Zampini   PetscBool         boolforchange,qr_needed;
1328a717540cSStefano Zampini   PetscBT           touched,change_basis,qr_needed_idx;
1329984c4197SStefano Zampini   /* auxiliary stuff */
133039e2fb2aSStefano Zampini   PetscInt          *nnz,*is_indices,*aux_primal_numbering_B;
1331984c4197SStefano Zampini   /* some quantities */
133245a1bb75SStefano Zampini   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
1333984c4197SStefano Zampini   PetscInt          size_of_constraint,max_size_of_constraint,max_constraints,temp_constraints;
1334984c4197SStefano Zampini 
1335674ae819SStefano Zampini 
1336674ae819SStefano Zampini   PetscFunctionBegin;
13378e61c736SStefano Zampini   /* Destroy Mat objects computed previously */
13388e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
13398e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1340674ae819SStefano Zampini   /* Get index sets for faces, edges and vertices from graph */
13418eeda7d8SStefano Zampini   if (!pcbddc->use_faces && !pcbddc->use_edges && !pcbddc->use_vertices) {
13428eeda7d8SStefano Zampini     pcbddc->use_vertices = PETSC_TRUE;
1343674ae819SStefano Zampini   }
13448eeda7d8SStefano Zampini   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,pcbddc->use_faces,pcbddc->use_edges,pcbddc->use_vertices,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);
1345b8ffe317SStefano Zampini   /* HACK: provide functions to set change of basis */
1346b8ffe317SStefano Zampini   if (!ISForVertices && pcbddc->NullSpace) {
1347b8ffe317SStefano Zampini     pcbddc->use_change_of_basis = PETSC_TRUE;
1348b8ffe317SStefano Zampini     pcbddc->use_change_on_faces = PETSC_FALSE;
1349b8ffe317SStefano Zampini   }
1350984c4197SStefano Zampini   /* print some info */
1351674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
13520fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
1353674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1354674ae819SStefano Zampini     i = 0;
1355674ae819SStefano Zampini     if (ISForVertices) {
1356674ae819SStefano Zampini       ierr = ISGetSize(ISForVertices,&i);CHKERRQ(ierr);
1357674ae819SStefano Zampini     }
1358674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices\n",PetscGlobalRank,i);CHKERRQ(ierr);
1359674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges\n",PetscGlobalRank,n_ISForEdges);CHKERRQ(ierr);
136015aaf578SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces\n",PetscGlobalRank,n_ISForFaces);CHKERRQ(ierr);
1361674ae819SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1362674ae819SStefano Zampini   }
1363674ae819SStefano Zampini   /* check if near null space is attached to global mat */
1364674ae819SStefano Zampini   ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
1365674ae819SStefano Zampini   if (nearnullsp) {
1366674ae819SStefano Zampini     ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
1367f4ddd8eeSStefano Zampini     /* remove any stored info */
1368f4ddd8eeSStefano Zampini     ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
1369f4ddd8eeSStefano Zampini     ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1370f4ddd8eeSStefano Zampini     /* store information for BDDC solver reuse */
1371f4ddd8eeSStefano Zampini     ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
1372f4ddd8eeSStefano Zampini     pcbddc->onearnullspace = nearnullsp;
1373f4ddd8eeSStefano Zampini     ierr = PetscMalloc(nnsp_size*sizeof(PetscObjectState),&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1374f4ddd8eeSStefano Zampini     for (i=0;i<nnsp_size;i++) {
1375f4ddd8eeSStefano Zampini       ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
1376f4ddd8eeSStefano Zampini     }
1377984c4197SStefano Zampini   } else { /* if near null space is not provided BDDC uses constants by default */
1378984c4197SStefano Zampini     nnsp_size = 0;
1379674ae819SStefano Zampini     nnsp_has_cnst = PETSC_TRUE;
1380674ae819SStefano Zampini   }
1381984c4197SStefano Zampini   /* get max number of constraints on a single cc */
1382984c4197SStefano Zampini   max_constraints = nnsp_size;
1383984c4197SStefano Zampini   if (nnsp_has_cnst) max_constraints++;
1384984c4197SStefano Zampini 
1385674ae819SStefano Zampini   /*
1386674ae819SStefano Zampini        Evaluate maximum storage size needed by the procedure
1387674ae819SStefano Zampini        - temp_indices will contain start index of each constraint stored as follows
1388674ae819SStefano 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
1389674ae819SStefano 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
1390674ae819SStefano Zampini        - temp_quadrature_constraint  [temp_indices[i],...,temp[indices[i+1]-1] will contain the scalars representing the constraint itself
1391674ae819SStefano Zampini                                                                                                                                                          */
1392674ae819SStefano Zampini   total_counts = n_ISForFaces+n_ISForEdges;
1393984c4197SStefano Zampini   total_counts *= max_constraints;
1394674ae819SStefano Zampini   n_vertices = 0;
1395674ae819SStefano Zampini   if (ISForVertices) {
1396674ae819SStefano Zampini     ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
1397674ae819SStefano Zampini   }
1398674ae819SStefano Zampini   total_counts += n_vertices;
1399674ae819SStefano Zampini   ierr = PetscMalloc((total_counts+1)*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
14004641a718SStefano Zampini   ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
1401674ae819SStefano Zampini   total_counts = 0;
1402674ae819SStefano Zampini   max_size_of_constraint = 0;
1403674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1404674ae819SStefano Zampini     if (i<n_ISForEdges) {
1405674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1406674ae819SStefano Zampini     } else {
1407674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1408674ae819SStefano Zampini     }
1409674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
1410674ae819SStefano Zampini     total_counts += j;
1411674ae819SStefano Zampini     max_size_of_constraint = PetscMax(j,max_size_of_constraint);
1412674ae819SStefano Zampini   }
1413984c4197SStefano Zampini   total_counts *= max_constraints;
1414674ae819SStefano Zampini   total_counts += n_vertices;
1415674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&temp_quadrature_constraint);CHKERRQ(ierr);
1416674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint);CHKERRQ(ierr);
1417674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint_B);CHKERRQ(ierr);
1418984c4197SStefano Zampini   /* get local part of global near null space vectors */
1419984c4197SStefano Zampini   ierr = PetscMalloc(nnsp_size*sizeof(Vec),&localnearnullsp);CHKERRQ(ierr);
1420984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1421984c4197SStefano Zampini     ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
1422984c4197SStefano Zampini     ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1423984c4197SStefano Zampini     ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1424984c4197SStefano Zampini   }
1425674ae819SStefano Zampini 
1426242a89d7SStefano Zampini   /* whether or not to skip lapack calls */
1427242a89d7SStefano Zampini   skip_lapack = PETSC_TRUE;
1428242a89d7SStefano Zampini   if (n_ISForFaces+n_ISForEdges) skip_lapack = PETSC_FALSE;
1429242a89d7SStefano Zampini 
1430984c4197SStefano Zampini   /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
1431242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1432674ae819SStefano Zampini     PetscScalar temp_work;
1433674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1434984c4197SStefano Zampini     /* Proper Orthogonal Decomposition (POD) using the snapshot method */
1435984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*max_constraints*sizeof(PetscScalar),&correlation_mat);CHKERRQ(ierr);
1436984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1437984c4197SStefano Zampini     ierr = PetscMalloc(max_size_of_constraint*max_constraints*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr);
1438674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1439984c4197SStefano Zampini     ierr = PetscMalloc(3*max_constraints*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1440674ae819SStefano Zampini #endif
1441674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1442c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
1443c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
1444674ae819SStefano Zampini     lwork = -1;
1445674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1446674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1447c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
1448674ae819SStefano Zampini #else
1449c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
1450674ae819SStefano Zampini #endif
1451674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1452984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
1453674ae819SStefano Zampini #else /* on missing GESVD */
1454674ae819SStefano Zampini     /* SVD */
1455674ae819SStefano Zampini     PetscInt max_n,min_n;
1456674ae819SStefano Zampini     max_n = max_size_of_constraint;
1457984c4197SStefano Zampini     min_n = max_constraints;
1458984c4197SStefano Zampini     if (max_size_of_constraint < max_constraints) {
1459674ae819SStefano Zampini       min_n = max_size_of_constraint;
1460984c4197SStefano Zampini       max_n = max_constraints;
1461674ae819SStefano Zampini     }
1462674ae819SStefano Zampini     ierr = PetscMalloc(min_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1463674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1464674ae819SStefano Zampini     ierr = PetscMalloc(5*min_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1465674ae819SStefano Zampini #endif
1466674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1467674ae819SStefano Zampini     lwork = -1;
1468e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
1469e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
1470b7d8b9f8SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
1471674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1472674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1473e310c8b4SStefano 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));
1474674ae819SStefano Zampini #else
1475e310c8b4SStefano 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));
1476674ae819SStefano Zampini #endif
1477674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1478984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
1479984c4197SStefano Zampini #endif /* on missing GESVD */
1480674ae819SStefano Zampini     /* Allocate optimal workspace */
1481674ae819SStefano Zampini     ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
1482984c4197SStefano Zampini     ierr = PetscMalloc((PetscInt)lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
1483674ae819SStefano Zampini   }
1484674ae819SStefano Zampini   /* Now we can loop on constraining sets */
1485674ae819SStefano Zampini   total_counts = 0;
1486674ae819SStefano Zampini   temp_indices[0] = 0;
1487674ae819SStefano Zampini   /* vertices */
1488674ae819SStefano Zampini   if (ISForVertices) {
1489674ae819SStefano Zampini     ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1490674ae819SStefano Zampini     if (nnsp_has_cnst) { /* consider all vertices */
149139e2fb2aSStefano Zampini       ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
1492674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1493674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1494674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1495674ae819SStefano Zampini         total_counts++;
1496674ae819SStefano Zampini       }
1497674ae819SStefano Zampini     } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
1498984c4197SStefano Zampini       PetscBool used_vertex;
1499674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1500674ae819SStefano Zampini         used_vertex = PETSC_FALSE;
1501674ae819SStefano Zampini         k = 0;
1502674ae819SStefano Zampini         while (!used_vertex && k<nnsp_size) {
1503984c4197SStefano Zampini           ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1504984c4197SStefano Zampini           if (PetscAbsScalar(array[is_indices[i]])>0.0) {
1505674ae819SStefano Zampini             temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1506674ae819SStefano Zampini             temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1507674ae819SStefano Zampini             temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1508674ae819SStefano Zampini             total_counts++;
1509674ae819SStefano Zampini             used_vertex = PETSC_TRUE;
1510674ae819SStefano Zampini           }
1511984c4197SStefano Zampini           ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1512674ae819SStefano Zampini           k++;
1513674ae819SStefano Zampini         }
1514674ae819SStefano Zampini       }
1515674ae819SStefano Zampini     }
1516674ae819SStefano Zampini     ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1517674ae819SStefano Zampini     n_vertices = total_counts;
1518674ae819SStefano Zampini   }
1519984c4197SStefano Zampini 
1520674ae819SStefano Zampini   /* edges and faces */
1521674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1522674ae819SStefano Zampini     if (i<n_ISForEdges) {
1523674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1524984c4197SStefano Zampini       boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
1525674ae819SStefano Zampini     } else {
1526674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1527984c4197SStefano Zampini       boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
1528674ae819SStefano Zampini     }
1529674ae819SStefano Zampini     temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
1530674ae819SStefano Zampini     temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
1531674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
1532674ae819SStefano Zampini     ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1533984c4197SStefano Zampini     /* change of basis should not be performed on local periodic nodes */
1534984c4197SStefano Zampini     if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
1535674ae819SStefano Zampini     if (nnsp_has_cnst) {
15365b08dc53SStefano Zampini       PetscScalar quad_value;
1537674ae819SStefano Zampini       temp_constraints++;
1538674ae819SStefano Zampini       quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
153939e2fb2aSStefano Zampini       ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
1540674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1541674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
1542674ae819SStefano Zampini       }
1543674ae819SStefano Zampini       temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
1544674ae819SStefano Zampini       total_counts++;
1545674ae819SStefano Zampini     }
1546674ae819SStefano Zampini     for (k=0;k<nnsp_size;k++) {
1547984c4197SStefano Zampini       PetscReal real_value;
1548984c4197SStefano Zampini       ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
154939e2fb2aSStefano Zampini       ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
1550674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1551984c4197SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=array[is_indices[j]];
1552674ae819SStefano Zampini       }
1553984c4197SStefano Zampini       ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1554984c4197SStefano Zampini       /* check if array is null on the connected component */
1555e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1556e310c8b4SStefano Zampini       PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_one));
15575b08dc53SStefano Zampini       if (real_value > 0.0) { /* keep indices and values */
1558674ae819SStefano Zampini         temp_constraints++;
1559674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
1560674ae819SStefano Zampini         total_counts++;
1561674ae819SStefano Zampini       }
1562674ae819SStefano Zampini     }
1563674ae819SStefano Zampini     ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
156445a1bb75SStefano Zampini     valid_constraints = temp_constraints;
1565eb97c9d2SStefano 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 */
1566eb97c9d2SStefano Zampini     if (!pcbddc->use_nnsp_true && temp_constraints) {
1567984c4197SStefano Zampini       PetscReal tol = 1.0e-8; /* tolerance for retaining eigenmodes */
1568674ae819SStefano Zampini 
1569674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1570984c4197SStefano Zampini       /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
1571984c4197SStefano Zampini          POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
1572984c4197SStefano Zampini          -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
1573984c4197SStefano Zampini             the constraints basis will differ (by a complex factor with absolute value equal to 1)
1574984c4197SStefano Zampini             from that computed using LAPACKgesvd
1575984c4197SStefano Zampini          -> This is due to a different computation of eigenvectors in LAPACKheev
1576984c4197SStefano Zampini          -> The quality of the POD-computed basis will be the same */
1577984c4197SStefano Zampini       ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
1578674ae819SStefano Zampini       /* Store upper triangular part of correlation matrix */
1579e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1580984c4197SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1581674ae819SStefano Zampini       for (j=0;j<temp_constraints;j++) {
1582674ae819SStefano Zampini         for (k=0;k<j+1;k++) {
1583e310c8b4SStefano 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));
1584674ae819SStefano Zampini         }
1585674ae819SStefano Zampini       }
1586e310c8b4SStefano Zampini       /* compute eigenvalues and eigenvectors of correlation matrix */
1587e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1588e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
1589674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1590c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
1591674ae819SStefano Zampini #else
1592c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
1593674ae819SStefano Zampini #endif
1594674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1595984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
1596984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
1597674ae819SStefano Zampini       j=0;
1598984c4197SStefano Zampini       while (j < temp_constraints && singular_vals[j] < tol) j++;
1599674ae819SStefano Zampini       total_counts=total_counts-j;
160045a1bb75SStefano Zampini       valid_constraints = temp_constraints-j;
1601e310c8b4SStefano Zampini       /* scale and copy POD basis into used quadrature memory */
1602c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1603c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1604c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
1605c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1606c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
1607c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1608674ae819SStefano Zampini       if (j<temp_constraints) {
1609984c4197SStefano Zampini         PetscInt ii;
1610984c4197SStefano Zampini         for (k=j;k<temp_constraints;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]);
1611674ae819SStefano Zampini         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1612c4303822SStefano 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));
1613674ae819SStefano Zampini         ierr = PetscFPTrapPop();CHKERRQ(ierr);
1614984c4197SStefano Zampini         for (k=0;k<temp_constraints-j;k++) {
1615674ae819SStefano Zampini           for (ii=0;ii<size_of_constraint;ii++) {
1616984c4197SStefano 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];
1617674ae819SStefano Zampini           }
1618674ae819SStefano Zampini         }
1619674ae819SStefano Zampini       }
1620674ae819SStefano Zampini #else  /* on missing GESVD */
1621e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1622e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1623b7d8b9f8SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1624674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1625674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1626e310c8b4SStefano 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));
1627674ae819SStefano Zampini #else
1628e310c8b4SStefano 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));
1629674ae819SStefano Zampini #endif
1630984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
1631674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1632984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
1633e310c8b4SStefano Zampini       k = temp_constraints;
1634e310c8b4SStefano Zampini       if (k > size_of_constraint) k = size_of_constraint;
1635674ae819SStefano Zampini       j = 0;
1636e310c8b4SStefano Zampini       while (j < k && singular_vals[k-j-1] < tol) j++;
1637e310c8b4SStefano Zampini       total_counts = total_counts-temp_constraints+k-j;
163845a1bb75SStefano Zampini       valid_constraints = k-j;
1639984c4197SStefano Zampini #endif /* on missing GESVD */
1640674ae819SStefano Zampini     }
164145a1bb75SStefano Zampini     /* setting change_of_basis flag is safe now */
164245a1bb75SStefano Zampini     if (boolforchange) {
164345a1bb75SStefano Zampini       for (j=0;j<valid_constraints;j++) {
164445a1bb75SStefano Zampini         PetscBTSet(change_basis,total_counts-j-1);
164545a1bb75SStefano Zampini       }
164645a1bb75SStefano Zampini     }
1647674ae819SStefano Zampini   }
1648674ae819SStefano Zampini   /* free index sets of faces, edges and vertices */
1649674ae819SStefano Zampini   for (i=0;i<n_ISForFaces;i++) {
1650674ae819SStefano Zampini     ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
1651674ae819SStefano Zampini   }
1652674ae819SStefano Zampini   ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
1653674ae819SStefano Zampini   for (i=0;i<n_ISForEdges;i++) {
1654674ae819SStefano Zampini     ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
1655674ae819SStefano Zampini   }
1656674ae819SStefano Zampini   ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
1657674ae819SStefano Zampini   ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
165839e2fb2aSStefano Zampini   /* map temp_indices_to_constraint in boundary numbering */
165939e2fb2aSStefano Zampini   ierr = ISGlobalToLocalMappingApply(pcbddc->BtoNmap,IS_GTOLM_DROP,temp_indices[total_counts],temp_indices_to_constraint,&i,temp_indices_to_constraint_B);CHKERRQ(ierr);
166039e2fb2aSStefano Zampini   if (i != temp_indices[total_counts]) {
166139e2fb2aSStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for constraints indices %d != %d\n",temp_indices[total_counts],i);
166239e2fb2aSStefano Zampini   }
1663674ae819SStefano Zampini 
1664984c4197SStefano Zampini   /* free workspace */
1665242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1666984c4197SStefano Zampini     ierr = PetscFree(work);CHKERRQ(ierr);
1667984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1668984c4197SStefano Zampini     ierr = PetscFree(rwork);CHKERRQ(ierr);
1669984c4197SStefano Zampini #endif
1670984c4197SStefano Zampini     ierr = PetscFree(singular_vals);CHKERRQ(ierr);
1671984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1672984c4197SStefano Zampini     ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
1673984c4197SStefano Zampini     ierr = PetscFree(temp_basis);CHKERRQ(ierr);
1674984c4197SStefano Zampini #endif
1675984c4197SStefano Zampini   }
1676984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1677984c4197SStefano Zampini     ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
1678984c4197SStefano Zampini   }
1679984c4197SStefano Zampini   ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
1680984c4197SStefano Zampini 
1681727cdba6SStefano Zampini   /* set quantities in pcbddc data structure and store previous primal size */
1682984c4197SStefano Zampini   /* n_vertices defines the number of subdomain corners in the primal space */
1683674ae819SStefano Zampini   /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */
1684727cdba6SStefano Zampini   olocal_primal_size = pcbddc->local_primal_size;
1685984c4197SStefano Zampini   pcbddc->local_primal_size = total_counts;
1686674ae819SStefano Zampini   pcbddc->n_vertices = n_vertices;
1687984c4197SStefano Zampini   pcbddc->n_constraints = pcbddc->local_primal_size-pcbddc->n_vertices;
1688674ae819SStefano Zampini 
1689674ae819SStefano Zampini   /* Create constraint matrix */
1690674ae819SStefano Zampini   /* The constraint matrix is used to compute the l2g map of primal dofs */
1691674ae819SStefano Zampini   /* so we need to set it up properly either with or without change of basis */
1692674ae819SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1693674ae819SStefano Zampini   ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr);
1694984c4197SStefano Zampini   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
1695984c4197SStefano Zampini   /* array to compute a local numbering of constraints : vertices first then constraints */
1696984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_numbering);CHKERRQ(ierr);
1697984c4197SStefano Zampini   /* array to select the proper local node (of minimum index with respect to global ordering) when changing the basis */
1698984c4197SStefano 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 */
1699984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_minloc);CHKERRQ(ierr);
1700984c4197SStefano Zampini   /* auxiliary stuff for basis change */
1701984c4197SStefano Zampini   ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&global_indices);CHKERRQ(ierr);
17024641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n_B,&touched);CHKERRQ(ierr);
1703984c4197SStefano Zampini 
1704984c4197SStefano Zampini   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
1705984c4197SStefano Zampini   total_primal_vertices=0;
1706984c4197SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
1707674ae819SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
1708984c4197SStefano Zampini     if (size_of_constraint == 1) {
17094641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]]);CHKERRQ(ierr);
1710984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]];
1711984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=0;
1712984c4197SStefano Zampini       total_primal_vertices++;
17134641a718SStefano Zampini     } else if (PetscBTLookup(change_basis,i)) { /* Same procedure used in PCBDDCGetPrimalConstraintsLocalIdx */
1714984c4197SStefano Zampini       PetscInt min_loc,min_index;
1715984c4197SStefano Zampini       ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],global_indices);CHKERRQ(ierr);
1716984c4197SStefano Zampini       /* find first untouched local node */
1717674ae819SStefano Zampini       k = 0;
17184641a718SStefano Zampini       while (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) k++;
1719984c4197SStefano Zampini       min_index = global_indices[k];
1720984c4197SStefano Zampini       min_loc = k;
1721984c4197SStefano Zampini       /* search the minimum among global nodes already untouched on the cc */
1722984c4197SStefano Zampini       for (k=1;k<size_of_constraint;k++) {
1723984c4197SStefano Zampini         /* there can be more than one constraint on a single connected component */
17244641a718SStefano Zampini         if (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k]) && min_index > global_indices[k]) {
1725984c4197SStefano Zampini           min_index = global_indices[k];
1726984c4197SStefano Zampini           min_loc = k;
1727674ae819SStefano Zampini         }
1728674ae819SStefano Zampini       }
17294641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]+min_loc]);CHKERRQ(ierr);
1730984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]+min_loc];
1731984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=min_loc;
1732984c4197SStefano Zampini       total_primal_vertices++;
1733984c4197SStefano Zampini     }
1734984c4197SStefano Zampini   }
1735a717540cSStefano Zampini   /* determine if a QR strategy is needed for change of basis */
1736a717540cSStefano Zampini   qr_needed = PETSC_FALSE;
1737a717540cSStefano Zampini   ierr = PetscBTCreate(pcbddc->local_primal_size,&qr_needed_idx);CHKERRQ(ierr);
1738a717540cSStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1739a717540cSStefano Zampini     if (PetscBTLookup(change_basis,i)) {
1740a717540cSStefano Zampini       size_of_constraint = temp_indices[i+1]-temp_indices[i];
1741a717540cSStefano Zampini       j = 0;
1742a717540cSStefano Zampini       for (k=0;k<size_of_constraint;k++) {
1743a717540cSStefano Zampini         if (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) {
1744a717540cSStefano Zampini           j++;
1745a717540cSStefano Zampini         }
1746a717540cSStefano Zampini       }
1747a717540cSStefano Zampini       /* found more than one primal dof on the cc */
1748a717540cSStefano Zampini       if (j > 1) {
1749a717540cSStefano Zampini         PetscBTSet(qr_needed_idx,i);
1750a717540cSStefano Zampini         qr_needed = PETSC_TRUE;
1751a717540cSStefano Zampini       }
1752a717540cSStefano Zampini     }
1753a717540cSStefano Zampini   }
1754984c4197SStefano Zampini   /* free workspace */
1755984c4197SStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
175645a1bb75SStefano Zampini 
1757674ae819SStefano Zampini   /* permute indices in order to have a sorted set of vertices */
1758a717540cSStefano Zampini   ierr = PetscSortInt(total_primal_vertices,aux_primal_numbering);CHKERRQ(ierr);
1759984c4197SStefano Zampini 
1760984c4197SStefano Zampini   /* nonzero structure of constraint matrix */
1761984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1762984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) nnz[i]=1;
1763984c4197SStefano Zampini   j=total_primal_vertices;
1764984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
17654641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1766674ae819SStefano Zampini       nnz[j]=temp_indices[i+1]-temp_indices[i];
1767674ae819SStefano Zampini       j++;
1768674ae819SStefano Zampini     }
1769674ae819SStefano Zampini   }
1770674ae819SStefano Zampini   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
1771674ae819SStefano Zampini   ierr = PetscFree(nnz);CHKERRQ(ierr);
1772674ae819SStefano Zampini   /* set values in constraint matrix */
1773984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) {
1774984c4197SStefano Zampini     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,aux_primal_numbering[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
1775674ae819SStefano Zampini   }
1776984c4197SStefano Zampini   total_counts = total_primal_vertices;
1777984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
17784641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1779674ae819SStefano Zampini       size_of_constraint=temp_indices[i+1]-temp_indices[i];
1780674ae819SStefano 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);
1781674ae819SStefano Zampini       total_counts++;
1782674ae819SStefano Zampini     }
1783674ae819SStefano Zampini   }
1784674ae819SStefano Zampini   /* assembling */
1785674ae819SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1786674ae819SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1787984c4197SStefano Zampini   /*
178845a1bb75SStefano Zampini   ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
1789984c4197SStefano Zampini   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
1790984c4197SStefano Zampini   */
1791674ae819SStefano Zampini   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
1792674ae819SStefano Zampini   if (pcbddc->use_change_of_basis) {
1793026de310SStefano Zampini     /* dual and primal dofs on a single cc */
1794984c4197SStefano Zampini     PetscInt     dual_dofs,primal_dofs;
1795026de310SStefano Zampini     /* iterator on aux_primal_minloc (ordered as read from nearnullspace: vertices, edges and then constraints) */
1796026de310SStefano Zampini     PetscInt     primal_counter;
1797984c4197SStefano Zampini     /* working stuff for GEQRF */
1798984c4197SStefano Zampini     PetscScalar  *qr_basis,*qr_tau,*qr_work,lqr_work_t;
1799984c4197SStefano Zampini     PetscBLASInt lqr_work;
1800984c4197SStefano Zampini     /* working stuff for UNGQR */
1801984c4197SStefano Zampini     PetscScalar  *gqr_work,lgqr_work_t;
1802984c4197SStefano Zampini     PetscBLASInt lgqr_work;
1803984c4197SStefano Zampini     /* working stuff for TRTRS */
1804984c4197SStefano Zampini     PetscScalar  *trs_rhs;
18053f08241aSStefano Zampini     PetscBLASInt Blas_NRHS;
1806984c4197SStefano Zampini     /* pointers for values insertion into change of basis matrix */
1807984c4197SStefano Zampini     PetscInt     *start_rows,*start_cols;
1808984c4197SStefano Zampini     PetscScalar  *start_vals;
1809984c4197SStefano Zampini     /* working stuff for values insertion */
18104641a718SStefano Zampini     PetscBT      is_primal;
1811984c4197SStefano Zampini 
1812a717540cSStefano Zampini     /* change of basis acts on local interfaces -> dimension is n_B x n_B */
1813a717540cSStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
1814a717540cSStefano Zampini     ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr);
1815a717540cSStefano Zampini     ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr);
1816a717540cSStefano Zampini     /* work arrays */
1817a717540cSStefano Zampini     ierr = PetscMalloc(pcis->n_B*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1818a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) nnz[i]=1;
1819a717540cSStefano Zampini     /* nonzeros per row */
1820a717540cSStefano Zampini     for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1821a717540cSStefano Zampini       if (PetscBTLookup(change_basis,i)) {
1822a717540cSStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
1823a717540cSStefano Zampini         if (PetscBTLookup(qr_needed_idx,i)) {
1824a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1825a717540cSStefano Zampini         } else {
1826a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = 2;
1827a717540cSStefano Zampini           /* get local primal index on the cc */
1828a717540cSStefano Zampini           j = 0;
1829a717540cSStefano Zampini           while (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+j])) j++;
1830a717540cSStefano Zampini           nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1831a717540cSStefano Zampini         }
1832a717540cSStefano Zampini       }
1833a717540cSStefano Zampini     }
1834a717540cSStefano Zampini     ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
1835a717540cSStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
1836a717540cSStefano Zampini     /* Set initial identity in the matrix */
1837a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) {
1838a717540cSStefano Zampini       ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
1839a717540cSStefano Zampini     }
1840a717540cSStefano Zampini 
1841a717540cSStefano Zampini     if (pcbddc->dbg_flag) {
1842a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1843a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
1844a717540cSStefano Zampini     }
1845a717540cSStefano Zampini 
1846a717540cSStefano Zampini 
1847a717540cSStefano Zampini     /* Now we loop on the constraints which need a change of basis */
1848a717540cSStefano Zampini     /*
1849a717540cSStefano Zampini        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
1850a717540cSStefano Zampini        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
1851a717540cSStefano Zampini 
1852a717540cSStefano Zampini        Basic blocks of change of basis matrix T computed
1853a717540cSStefano Zampini 
1854a717540cSStefano Zampini           - Using the following block transformation if there is only a primal dof on the cc
1855a717540cSStefano Zampini             (in the example, primal dof is the last one of the edge in LOCAL ordering
1856a717540cSStefano Zampini              in this code, primal dof is the first one of the edge in GLOBAL ordering)
1857a717540cSStefano Zampini             | 1        0   ...        0     1 |
1858a717540cSStefano Zampini             | 0        1   ...        0     1 |
1859a717540cSStefano Zampini             |              ...                |
1860a717540cSStefano Zampini             | 0        ...            1     1 |
1861a717540cSStefano Zampini             | -s_1/s_n ...    -s_{n-1}/-s_n 1 |
1862a717540cSStefano Zampini 
1863a717540cSStefano Zampini           - via QR decomposition of constraints otherwise
1864a717540cSStefano Zampini     */
1865a717540cSStefano Zampini     if (qr_needed) {
1866984c4197SStefano Zampini       /* space to store Q */
1867984c4197SStefano Zampini       ierr = PetscMalloc((max_size_of_constraint)*(max_size_of_constraint)*sizeof(PetscScalar),&qr_basis);CHKERRQ(ierr);
1868984c4197SStefano Zampini       /* first we issue queries for optimal work */
18693f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
18703f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
18713f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1872984c4197SStefano Zampini       lqr_work = -1;
18733f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
1874984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
1875984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
1876984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lqr_work_t)*sizeof(*qr_work),&qr_work);CHKERRQ(ierr);
1877984c4197SStefano Zampini       lgqr_work = -1;
18783f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
18793f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
18803f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
18813f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
18823f08241aSStefano Zampini       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
18833f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
1884984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
1885984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
1886984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lgqr_work_t)*sizeof(*gqr_work),&gqr_work);CHKERRQ(ierr);
1887984c4197SStefano Zampini       /* array to store scaling factors for reflectors */
1888984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*sizeof(*qr_tau),&qr_tau);CHKERRQ(ierr);
1889984c4197SStefano Zampini       /* array to store rhs and solution of triangular solver */
1890984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*max_constraints*sizeof(*trs_rhs),&trs_rhs);CHKERRQ(ierr);
1891a717540cSStefano Zampini       /* allocating workspace for check */
1892a717540cSStefano Zampini       if (pcbddc->dbg_flag) {
1893a717540cSStefano Zampini         ierr = PetscMalloc(max_size_of_constraint*(max_constraints+max_size_of_constraint)*sizeof(*work),&work);CHKERRQ(ierr);
1894a717540cSStefano Zampini       }
1895a717540cSStefano Zampini     }
1896984c4197SStefano Zampini     /* array to store whether a node is primal or not */
18974641a718SStefano Zampini     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
189839e2fb2aSStefano Zampini     ierr = PetscMalloc(total_primal_vertices*sizeof(PetscInt),&aux_primal_numbering_B);CHKERRQ(ierr);
189939e2fb2aSStefano Zampini     ierr = ISGlobalToLocalMappingApply(pcbddc->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,aux_primal_numbering,&i,aux_primal_numbering_B);CHKERRQ(ierr);
190039e2fb2aSStefano Zampini     if (i != total_primal_vertices) {
190139e2fb2aSStefano Zampini       SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %d != %d\n",total_primal_vertices,i);
19024641a718SStefano Zampini     }
190339e2fb2aSStefano Zampini     for (i=0;i<total_primal_vertices;i++) {
190439e2fb2aSStefano Zampini       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
190539e2fb2aSStefano Zampini     }
190639e2fb2aSStefano Zampini     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
1907984c4197SStefano Zampini 
1908a717540cSStefano Zampini     /* loop on constraints and see whether or not they need a change of basis and compute it */
1909026de310SStefano Zampini     /* -> using implicit ordering contained in temp_indices data */
1910026de310SStefano Zampini     total_counts = pcbddc->n_vertices;
1911026de310SStefano Zampini     primal_counter = total_counts;
1912026de310SStefano Zampini     while (total_counts<pcbddc->local_primal_size) {
1913026de310SStefano Zampini       primal_dofs = 1;
19144641a718SStefano Zampini       if (PetscBTLookup(change_basis,total_counts)) {
1915026de310SStefano Zampini         /* get all constraints with same support: if more then one constraint is present on the cc then surely indices are stored contiguosly */
1916026de310SStefano 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]]) {
1917026de310SStefano Zampini           primal_dofs++;
1918674ae819SStefano Zampini         }
1919984c4197SStefano Zampini         /* get constraint info */
1920026de310SStefano Zampini         size_of_constraint = temp_indices[total_counts+1]-temp_indices[total_counts];
1921984c4197SStefano Zampini         dual_dofs = size_of_constraint-primal_dofs;
1922984c4197SStefano Zampini 
1923984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
1924a717540cSStefano 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);
1925674ae819SStefano Zampini         }
1926984c4197SStefano Zampini 
1927a717540cSStefano Zampini         if (primal_dofs > 1) { /* QR */
1928a717540cSStefano Zampini 
1929a717540cSStefano Zampini           /* copy quadrature constraints for change of basis check */
1930a717540cSStefano Zampini           if (pcbddc->dbg_flag) {
1931a717540cSStefano Zampini             ierr = PetscMemcpy(work,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1932a717540cSStefano Zampini           }
1933984c4197SStefano Zampini           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
1934026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1935984c4197SStefano Zampini 
1936984c4197SStefano Zampini           /* compute QR decomposition of constraints */
19373f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
19383f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
19393f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1940674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
19413f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
1942984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
1943674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1944984c4197SStefano Zampini 
1945984c4197SStefano Zampini           /* explictly compute R^-T */
1946984c4197SStefano Zampini           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
1947984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
19483f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
19493f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
19503f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
19513f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
1952984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
19533f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
1954984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
1955984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1956984c4197SStefano Zampini 
1957a717540cSStefano Zampini           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
19583f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
19593f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
19603f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
19613f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1962984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
19633f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
1964984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
1965984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1966984c4197SStefano Zampini 
1967984c4197SStefano Zampini           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
1968984c4197SStefano Zampini              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
1969984c4197SStefano Zampini              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
19703f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
19713f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
19723f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
19733f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
19743f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
19753f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1976984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1977c4303822SStefano 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));
1978984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1979026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1980984c4197SStefano Zampini 
1981984c4197SStefano Zampini           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
1982026de310SStefano Zampini           start_rows = &temp_indices_to_constraint_B[temp_indices[total_counts]];
1983984c4197SStefano Zampini           /* insert cols for primal dofs */
1984984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) {
1985984c4197SStefano Zampini             start_vals = &qr_basis[j*size_of_constraint];
1986026de310SStefano Zampini             start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter+j]];
1987984c4197SStefano Zampini             ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1988984c4197SStefano Zampini           }
1989984c4197SStefano Zampini           /* insert cols for dual dofs */
1990984c4197SStefano Zampini           for (j=0,k=0;j<dual_dofs;k++) {
19914641a718SStefano Zampini             if (!PetscBTLookup(is_primal,temp_indices_to_constraint_B[temp_indices[total_counts]+k])) {
1992984c4197SStefano Zampini               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
1993026de310SStefano Zampini               start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+k];
1994984c4197SStefano Zampini               ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1995984c4197SStefano Zampini               j++;
1996674ae819SStefano Zampini             }
1997674ae819SStefano Zampini           }
1998984c4197SStefano Zampini 
1999984c4197SStefano Zampini           /* check change of basis */
2000984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
2001984c4197SStefano Zampini             PetscInt   ii,jj;
2002984c4197SStefano Zampini             PetscBool valid_qr=PETSC_TRUE;
2003c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
2004c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2005c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
2006c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2007c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
2008c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
2009984c4197SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2010c4303822SStefano 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));
2011984c4197SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
2012984c4197SStefano Zampini             for (jj=0;jj<size_of_constraint;jj++) {
2013984c4197SStefano Zampini               for (ii=0;ii<primal_dofs;ii++) {
2014984c4197SStefano Zampini                 if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
2015984c4197SStefano Zampini                 if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
2016674ae819SStefano Zampini               }
2017674ae819SStefano Zampini             }
2018984c4197SStefano Zampini             if (!valid_qr) {
2019984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
2020984c4197SStefano Zampini               for (jj=0;jj<size_of_constraint;jj++) {
2021984c4197SStefano Zampini                 for (ii=0;ii<primal_dofs;ii++) {
2022984c4197SStefano Zampini                   if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
2023984c4197SStefano 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]));
2024674ae819SStefano Zampini                   }
2025984c4197SStefano Zampini                   if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
2026984c4197SStefano 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]));
2027984c4197SStefano Zampini                   }
2028984c4197SStefano Zampini                 }
2029984c4197SStefano Zampini               }
2030674ae819SStefano Zampini             } else {
2031984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
2032674ae819SStefano Zampini             }
2033674ae819SStefano Zampini           }
2034a717540cSStefano Zampini         } else { /* simple transformation block */
2035a717540cSStefano Zampini           PetscInt row,col;
2036a717540cSStefano Zampini           PetscScalar val;
2037a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) {
2038a717540cSStefano Zampini             row = temp_indices_to_constraint_B[temp_indices[total_counts]+j];
2039a717540cSStefano Zampini             if (!PetscBTLookup(is_primal,row)) {
2040a717540cSStefano Zampini               col = temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
2041a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
2042a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,1.0,INSERT_VALUES);CHKERRQ(ierr);
2043a717540cSStefano Zampini             } else {
2044a717540cSStefano Zampini               for (k=0;k<size_of_constraint;k++) {
2045a717540cSStefano Zampini                 col = temp_indices_to_constraint_B[temp_indices[total_counts]+k];
2046a717540cSStefano Zampini                 if (row != col) {
2047a717540cSStefano Zampini                   val = -temp_quadrature_constraint[temp_indices[total_counts]+k]/temp_quadrature_constraint[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
2048a717540cSStefano Zampini                 } else {
2049a717540cSStefano Zampini                   val = 1.0;
2050a717540cSStefano Zampini                 }
2051a717540cSStefano Zampini                 ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
2052a717540cSStefano Zampini               }
2053a717540cSStefano Zampini             }
2054a717540cSStefano Zampini           }
2055a717540cSStefano Zampini         }
2056026de310SStefano Zampini         /* increment primal counter */
2057026de310SStefano Zampini         primal_counter += primal_dofs;
2058984c4197SStefano Zampini       } else {
2059984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
2060026de310SStefano 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);
2061674ae819SStefano Zampini         }
2062674ae819SStefano Zampini       }
2063026de310SStefano Zampini       /* increment constraint counter total_counts */
2064026de310SStefano Zampini       total_counts += primal_dofs;
2065674ae819SStefano Zampini     }
2066a717540cSStefano Zampini 
2067a717540cSStefano Zampini     /* free workspace */
2068a717540cSStefano Zampini     if (qr_needed) {
2069984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
2070984c4197SStefano Zampini         ierr = PetscFree(work);CHKERRQ(ierr);
2071984c4197SStefano Zampini       }
2072984c4197SStefano Zampini       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
2073984c4197SStefano Zampini       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
2074984c4197SStefano Zampini       ierr = PetscFree(qr_work);CHKERRQ(ierr);
2075984c4197SStefano Zampini       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
2076984c4197SStefano Zampini       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
2077674ae819SStefano Zampini     }
2078a717540cSStefano Zampini     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
2079674ae819SStefano Zampini     /* assembling */
2080674ae819SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2081674ae819SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2082984c4197SStefano Zampini     /*
208345a1bb75SStefano Zampini     ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
2084984c4197SStefano Zampini     ierr = MatView(pcbddc->ChangeOfBasisMatrix,(PetscViewer)0);CHKERRQ(ierr);
2085984c4197SStefano Zampini     */
2086674ae819SStefano Zampini   }
2087a717540cSStefano Zampini 
2088727cdba6SStefano Zampini   /* get indices in local ordering for vertices and constraints */
2089727cdba6SStefano 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 */
2090727cdba6SStefano Zampini     ierr = PetscMalloc(olocal_primal_size*sizeof(PetscInt),&oprimal_indices_local_idxs);CHKERRQ(ierr);
2091727cdba6SStefano Zampini     ierr = PetscMemcpy(oprimal_indices_local_idxs,pcbddc->primal_indices_local_idxs,olocal_primal_size*sizeof(PetscInt));CHKERRQ(ierr);
2092727cdba6SStefano Zampini   }
2093727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2094727cdba6SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
2095727cdba6SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&i,&aux_primal_numbering);CHKERRQ(ierr);
2096727cdba6SStefano Zampini   ierr = PetscMemcpy(pcbddc->primal_indices_local_idxs,aux_primal_numbering,i*sizeof(PetscInt));CHKERRQ(ierr);
2097727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2098727cdba6SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&j,&aux_primal_numbering);CHKERRQ(ierr);
2099727cdba6SStefano Zampini   ierr = PetscMemcpy(&pcbddc->primal_indices_local_idxs[i],aux_primal_numbering,j*sizeof(PetscInt));CHKERRQ(ierr);
2100727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2101e9189074SStefano Zampini   /* set quantities in PCBDDC data struct */
2102e9189074SStefano Zampini   pcbddc->n_actual_vertices = i;
2103727cdba6SStefano Zampini   /* check if a new primal space has been introduced */
2104727cdba6SStefano Zampini   pcbddc->new_primal_space_local = PETSC_TRUE;
2105727cdba6SStefano Zampini   if (olocal_primal_size == pcbddc->local_primal_size) {
2106727cdba6SStefano Zampini     ierr = PetscMemcmp(pcbddc->primal_indices_local_idxs,oprimal_indices_local_idxs,olocal_primal_size,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
2107c1c8e736SStefano Zampini     pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
2108727cdba6SStefano Zampini     ierr = PetscFree(oprimal_indices_local_idxs);CHKERRQ(ierr);
2109727cdba6SStefano Zampini   }
211089c96988SStefano Zampini   /* need to set pcbddc->new_primal_space_local to true when the local primal space is empty, otherwise pcbddc->is_R_local will not be created */
211189c96988SStefano Zampini   if (!pcbddc->local_primal_size) pcbddc->new_primal_space_local = PETSC_TRUE;
2112727cdba6SStefano Zampini   /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
2113727cdba6SStefano Zampini   ierr = MPI_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2114727cdba6SStefano Zampini 
2115a717540cSStefano Zampini   /* flush dbg viewer */
2116b8ffe317SStefano Zampini   if (pcbddc->dbg_flag) {
2117b8ffe317SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2118b8ffe317SStefano Zampini   }
2119a717540cSStefano Zampini 
2120e310c8b4SStefano Zampini   /* free workspace */
2121a717540cSStefano Zampini   ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2122a717540cSStefano Zampini   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
2123984c4197SStefano Zampini   ierr = PetscFree(aux_primal_minloc);CHKERRQ(ierr);
2124674ae819SStefano Zampini   ierr = PetscFree(temp_indices);CHKERRQ(ierr);
21254641a718SStefano Zampini   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
2126674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr);
2127674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
2128674ae819SStefano Zampini   ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr);
2129674ae819SStefano Zampini   PetscFunctionReturn(0);
2130674ae819SStefano Zampini }
2131674ae819SStefano Zampini 
2132674ae819SStefano Zampini #undef __FUNCT__
2133674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
2134674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
2135674ae819SStefano Zampini {
2136674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
2137674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
2138674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
213963602bcaSStefano Zampini   PetscInt    ierr,i,vertex_size;
2140674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
2141674ae819SStefano Zampini 
2142674ae819SStefano Zampini   PetscFunctionBegin;
21438e61c736SStefano Zampini   /* Reset previously computed graph */
21448e61c736SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
2145674ae819SStefano Zampini   /* Init local Graph struct */
2146674ae819SStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr);
2147674ae819SStefano Zampini 
2148575ad6abSStefano Zampini   /* Check validity of the csr graph passed in by the user */
2149575ad6abSStefano Zampini   if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) {
2150575ad6abSStefano Zampini     ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
2151575ad6abSStefano Zampini   }
21529577ea80SStefano Zampini 
2153674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
2154674ae819SStefano Zampini   if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) {
2155674ae819SStefano Zampini     Mat mat_adj;
2156674ae819SStefano Zampini     const PetscInt *xadj,*adjncy;
2157674ae819SStefano Zampini     PetscBool flg_row=PETSC_TRUE;
2158674ae819SStefano Zampini 
2159674ae819SStefano Zampini     ierr = MatConvert(matis->A,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr);
2160674ae819SStefano Zampini     ierr = MatGetRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2161674ae819SStefano Zampini     if (!flg_row) {
2162674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ called in %s\n",__FUNCT__);
2163674ae819SStefano Zampini     }
2164674ae819SStefano Zampini     ierr = PCBDDCSetLocalAdjacencyGraph(pc,i,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
2165674ae819SStefano Zampini     ierr = MatRestoreRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2166674ae819SStefano Zampini     if (!flg_row) {
2167674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__);
2168674ae819SStefano Zampini     }
2169674ae819SStefano Zampini     ierr = MatDestroy(&mat_adj);CHKERRQ(ierr);
2170674ae819SStefano Zampini   }
2171674ae819SStefano Zampini 
217263602bcaSStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting or PCBDDCSetDofsSplittingLocal */
2173674ae819SStefano Zampini   vertex_size = 1;
217463602bcaSStefano Zampini   if (pcbddc->user_provided_isfordofs) {
217563602bcaSStefano Zampini     if (pcbddc->n_ISForDofs) { /* need to convert from global to local and remove references to global dofs splitting */
217663602bcaSStefano Zampini       ierr = PetscMalloc(pcbddc->n_ISForDofs*sizeof(IS),&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
217763602bcaSStefano Zampini       for (i=0;i<pcbddc->n_ISForDofs;i++) {
217863602bcaSStefano Zampini         ierr = PCBDDCGlobalToLocal(pc,matis->ctx,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
217963602bcaSStefano Zampini         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
2180674ae819SStefano Zampini       }
218163602bcaSStefano Zampini       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
218263602bcaSStefano Zampini       pcbddc->n_ISForDofs = 0;
218363602bcaSStefano Zampini       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
2184674ae819SStefano Zampini     }
218563602bcaSStefano Zampini     /* mat block size as vertex size (used for elasticity with rigid body modes as nearnullspace) */
2186674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
218763602bcaSStefano Zampini   } else {
218863602bcaSStefano Zampini     if (!pcbddc->n_ISForDofsLocal) { /* field split not present, create it in local ordering */
218963602bcaSStefano Zampini       ierr = MatGetBlockSize(pc->pmat,&pcbddc->n_ISForDofsLocal);CHKERRQ(ierr);
219063602bcaSStefano Zampini       ierr = PetscMalloc(pcbddc->n_ISForDofsLocal*sizeof(IS),&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
219163602bcaSStefano Zampini       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
219263602bcaSStefano Zampini         ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),pcis->n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
219363602bcaSStefano Zampini       }
219463602bcaSStefano Zampini     }
2195674ae819SStefano Zampini   }
2196674ae819SStefano Zampini 
2197674ae819SStefano Zampini   /* Setup of Graph */
2198785d1243SStefano Zampini   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) { /* need to convert from global to local */
2199e456f2a8SStefano Zampini     ierr = PCBDDCGlobalToLocal(pc,matis->ctx,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
2200785d1243SStefano Zampini   }
2201785d1243SStefano Zampini   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) { /* need to convert from global to local */
2202e456f2a8SStefano Zampini     ierr = PCBDDCGlobalToLocal(pc,matis->ctx,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
2203785d1243SStefano Zampini   }
220463602bcaSStefano Zampini   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices);
2205674ae819SStefano Zampini 
2206674ae819SStefano Zampini   /* Graph's connected components analysis */
2207674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
2208674ae819SStefano Zampini 
2209674ae819SStefano Zampini   /* print some info to stdout */
2210674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
2211e49050b4SStefano Zampini     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer);
2212674ae819SStefano Zampini   }
2213fb180af4SStefano Zampini 
2214fb180af4SStefano Zampini   /* mark topography has done */
2215fb180af4SStefano Zampini   pcbddc->recompute_topography = PETSC_FALSE;
2216674ae819SStefano Zampini   PetscFunctionReturn(0);
2217674ae819SStefano Zampini }
2218674ae819SStefano Zampini 
2219674ae819SStefano Zampini #undef __FUNCT__
2220674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx"
2221f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt **vertices_idx)
2222674ae819SStefano Zampini {
2223674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2224674ae819SStefano Zampini   PetscInt       *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size;
2225674ae819SStefano Zampini   PetscErrorCode ierr;
2226674ae819SStefano Zampini 
2227674ae819SStefano Zampini   PetscFunctionBegin;
2228674ae819SStefano Zampini   n = 0;
2229674ae819SStefano Zampini   vertices = 0;
2230674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2231674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr);
2232b120a5c6SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2233b120a5c6SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2234b120a5c6SStefano Zampini       if (size_of_constraint == 1) n++;
2235b120a5c6SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2236b120a5c6SStefano Zampini     }
2237811e8ca2SStefano Zampini     if (vertices_idx) {
2238b120a5c6SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&vertices);CHKERRQ(ierr);
2239b120a5c6SStefano Zampini       n = 0;
2240674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2241674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2242674ae819SStefano Zampini         if (size_of_constraint == 1) {
2243674ae819SStefano Zampini           vertices[n++]=row_cmat_indices[0];
2244674ae819SStefano Zampini         }
2245674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2246674ae819SStefano Zampini       }
2247674ae819SStefano Zampini     }
2248811e8ca2SStefano Zampini   }
2249674ae819SStefano Zampini   *n_vertices = n;
2250811e8ca2SStefano Zampini   if (vertices_idx) *vertices_idx = vertices;
2251674ae819SStefano Zampini   PetscFunctionReturn(0);
2252674ae819SStefano Zampini }
2253674ae819SStefano Zampini 
2254674ae819SStefano Zampini #undef __FUNCT__
2255674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx"
2256f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt **constraints_idx)
2257674ae819SStefano Zampini {
2258674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2259674ae819SStefano Zampini   PetscInt       *constraints_index,*row_cmat_indices,*row_cmat_global_indices;
2260674ae819SStefano Zampini   PetscInt       n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc;
22614641a718SStefano Zampini   PetscBT        touched;
2262674ae819SStefano Zampini   PetscErrorCode ierr;
2263674ae819SStefano Zampini 
2264f34684f1SStefano Zampini     /* This function assumes that the number of local constraints per connected component
2265f34684f1SStefano Zampini        is not greater than the number of nodes defined for the connected component
2266f34684f1SStefano Zampini        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
2267674ae819SStefano Zampini   PetscFunctionBegin;
2268674ae819SStefano Zampini   n = 0;
2269674ae819SStefano Zampini   constraints_index = 0;
2270674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2271674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr);
2272674ae819SStefano Zampini     max_size_of_constraint = 0;
2273674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2274674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2275674ae819SStefano Zampini       if (size_of_constraint > 1) {
2276674ae819SStefano Zampini         n++;
2277674ae819SStefano Zampini       }
2278674ae819SStefano Zampini       max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint);
2279674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2280674ae819SStefano Zampini     }
2281811e8ca2SStefano Zampini     if (constraints_idx) {
2282674ae819SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&constraints_index);CHKERRQ(ierr);
2283674ae819SStefano Zampini       ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&row_cmat_global_indices);CHKERRQ(ierr);
22844641a718SStefano Zampini       ierr = PetscBTCreate(local_size,&touched);CHKERRQ(ierr);
2285674ae819SStefano Zampini       n = 0;
2286674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2287674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2288674ae819SStefano Zampini         if (size_of_constraint > 1) {
2289674ae819SStefano Zampini           ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr);
229082d3d8afSStefano Zampini           /* find first untouched local node */
229182d3d8afSStefano Zampini           j = 0;
22924641a718SStefano Zampini           while (PetscBTLookup(touched,row_cmat_indices[j])) j++;
229382d3d8afSStefano Zampini           min_index = row_cmat_global_indices[j];
229482d3d8afSStefano Zampini           min_loc = j;
229582d3d8afSStefano Zampini           /* search the minimum among nodes not yet touched on the connected component
229682d3d8afSStefano Zampini              since there can be more than one constraint on a single cc */
2297674ae819SStefano Zampini           for (j=1;j<size_of_constraint;j++) {
22984641a718SStefano Zampini             if (!PetscBTLookup(touched,row_cmat_indices[j]) && min_index > row_cmat_global_indices[j]) {
2299674ae819SStefano Zampini               min_index = row_cmat_global_indices[j];
2300674ae819SStefano Zampini               min_loc = j;
2301674ae819SStefano Zampini             }
2302674ae819SStefano Zampini           }
23034641a718SStefano Zampini           ierr = PetscBTSet(touched,row_cmat_indices[min_loc]);CHKERRQ(ierr);
2304674ae819SStefano Zampini           constraints_index[n++] = row_cmat_indices[min_loc];
2305674ae819SStefano Zampini         }
2306674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2307674ae819SStefano Zampini       }
23084641a718SStefano Zampini       ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2309674ae819SStefano Zampini       ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr);
2310811e8ca2SStefano Zampini     }
2311811e8ca2SStefano Zampini   }
2312674ae819SStefano Zampini   *n_constraints = n;
2313811e8ca2SStefano Zampini   if (constraints_idx) *constraints_idx = constraints_index;
2314674ae819SStefano Zampini   PetscFunctionReturn(0);
2315674ae819SStefano Zampini }
2316674ae819SStefano Zampini 
2317674ae819SStefano Zampini /* the next two functions has been adapted from pcis.c */
2318674ae819SStefano Zampini #undef __FUNCT__
2319674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchur"
2320674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchur(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2321674ae819SStefano Zampini {
2322674ae819SStefano Zampini   PetscErrorCode ierr;
2323674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2324674ae819SStefano Zampini 
2325674ae819SStefano Zampini   PetscFunctionBegin;
2326674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2327674ae819SStefano Zampini   ierr = MatMult(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2328674ae819SStefano Zampini   ierr = MatMult(pcis->A_IB,v,vec1_D);CHKERRQ(ierr);
2329674ae819SStefano Zampini   ierr = KSPSolve(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2330674ae819SStefano Zampini   ierr = MatMult(pcis->A_BI,vec2_D,vec2_B);CHKERRQ(ierr);
2331674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2332674ae819SStefano Zampini   PetscFunctionReturn(0);
2333674ae819SStefano Zampini }
2334674ae819SStefano Zampini 
2335674ae819SStefano Zampini #undef __FUNCT__
2336674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchurTranspose"
2337674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchurTranspose(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2338674ae819SStefano Zampini {
2339674ae819SStefano Zampini   PetscErrorCode ierr;
2340674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2341674ae819SStefano Zampini 
2342674ae819SStefano Zampini   PetscFunctionBegin;
2343674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2344674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2345674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BI,v,vec1_D);CHKERRQ(ierr);
2346674ae819SStefano Zampini   ierr = KSPSolveTranspose(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2347674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_IB,vec2_D,vec2_B);CHKERRQ(ierr);
2348674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2349674ae819SStefano Zampini   PetscFunctionReturn(0);
2350674ae819SStefano Zampini }
2351674ae819SStefano Zampini 
2352674ae819SStefano Zampini #undef __FUNCT__
2353674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
2354674ae819SStefano 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[])
2355674ae819SStefano Zampini {
2356674ae819SStefano Zampini   Vec            local_vec,global_vec;
2357674ae819SStefano Zampini   IS             seqis,paris;
2358674ae819SStefano Zampini   VecScatter     scatter_ctx;
2359674ae819SStefano Zampini   PetscScalar    *array;
2360674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
2361674ae819SStefano Zampini   PetscScalar    globalsum;
2362674ae819SStefano Zampini   PetscInt       i,j,s;
2363674ae819SStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local;
2364674ae819SStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm,max_global;
2365674ae819SStefano Zampini   PetscMPIInt    *dof_sizes,*dof_displs;
2366674ae819SStefano Zampini   PetscBool      first_found;
2367674ae819SStefano Zampini   PetscErrorCode ierr;
2368674ae819SStefano Zampini 
2369674ae819SStefano Zampini   PetscFunctionBegin;
2370674ae819SStefano Zampini   /* mpi buffers */
2371674ae819SStefano Zampini   MPI_Comm_size(comm,&size_prec_comm);
2372674ae819SStefano Zampini   MPI_Comm_rank(comm,&rank_prec_comm);
2373674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
2374674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_sizes),&dof_sizes);CHKERRQ(ierr);
2375674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_displs),&dof_displs);CHKERRQ(ierr);
2376674ae819SStefano Zampini   /* get maximum size of subset */
2377674ae819SStefano Zampini   ierr = PetscMalloc(n_local_dofs*sizeof(PetscInt),&temp_global_dofs);CHKERRQ(ierr);
2378674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
2379674ae819SStefano Zampini   max_local = 0;
2380674ae819SStefano Zampini   if (n_local_dofs) {
2381674ae819SStefano Zampini     max_local = temp_global_dofs[0];
2382674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2383674ae819SStefano Zampini       if (max_local < temp_global_dofs[i] ) {
2384674ae819SStefano Zampini         max_local = temp_global_dofs[i];
2385674ae819SStefano Zampini       }
2386674ae819SStefano Zampini     }
2387674ae819SStefano Zampini   }
2388674ae819SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);
2389674ae819SStefano Zampini   max_global++;
2390674ae819SStefano Zampini   max_local = 0;
2391674ae819SStefano Zampini   if (n_local_dofs) {
2392674ae819SStefano Zampini     max_local = local_dofs[0];
2393674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2394674ae819SStefano Zampini       if (max_local < local_dofs[i] ) {
2395674ae819SStefano Zampini         max_local = local_dofs[i];
2396674ae819SStefano Zampini       }
2397674ae819SStefano Zampini     }
2398674ae819SStefano Zampini   }
2399674ae819SStefano Zampini   max_local++;
2400674ae819SStefano Zampini   /* allocate workspace */
2401674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
2402674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
2403674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
2404674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
2405674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
2406674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
2407674ae819SStefano Zampini   /* create scatter */
2408674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
2409674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
2410674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
2411674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
2412674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
2413674ae819SStefano Zampini   /* init array */
2414674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
2415674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2416674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2417674ae819SStefano Zampini   if (local_dofs_mult) {
2418674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2419674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
2420674ae819SStefano Zampini     }
2421674ae819SStefano Zampini   } else {
2422674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2423674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
2424674ae819SStefano Zampini     }
2425674ae819SStefano Zampini   }
2426674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2427674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
2428674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2429674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2430674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
24315b08dc53SStefano Zampini   *n_global_subset = (PetscInt)PetscRealPart(globalsum);
2432674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
2433674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
2434674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
2435674ae819SStefano Zampini   nlocals = 0;
2436674ae819SStefano Zampini   first_index = -1;
2437674ae819SStefano Zampini   first_found = PETSC_FALSE;
2438674ae819SStefano Zampini   for (i=0;i<s;i++) {
24395b08dc53SStefano Zampini     if (!first_found && PetscRealPart(array[i]) > 0.0) {
2440674ae819SStefano Zampini       first_found = PETSC_TRUE;
2441674ae819SStefano Zampini       first_index = i;
2442674ae819SStefano Zampini     }
24435b08dc53SStefano Zampini     nlocals += (PetscInt)PetscRealPart(array[i]);
2444674ae819SStefano Zampini   }
2445674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2446674ae819SStefano Zampini   if (!rank_prec_comm) {
2447674ae819SStefano Zampini     dof_displs[0]=0;
2448674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
2449674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
2450674ae819SStefano Zampini     }
2451674ae819SStefano Zampini   }
2452674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2453674ae819SStefano Zampini   if (first_found) {
2454674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
2455674ae819SStefano Zampini     old_index = first_index;
2456674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
24575b08dc53SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) {
2458674ae819SStefano Zampini         array[i] += array[old_index];
2459674ae819SStefano Zampini         old_index = i;
2460674ae819SStefano Zampini       }
2461674ae819SStefano Zampini     }
2462674ae819SStefano Zampini   }
2463674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
2464674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2465674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2466674ae819SStefano Zampini   ierr = VecScatterEnd  (scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2467674ae819SStefano Zampini   /* get global ordering of local dofs */
2468674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2469674ae819SStefano Zampini   if (local_dofs_mult) {
2470674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
24715b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i];
2472674ae819SStefano Zampini     }
2473674ae819SStefano Zampini   } else {
2474674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
24755b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1;
2476674ae819SStefano Zampini     }
2477674ae819SStefano Zampini   }
2478674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2479674ae819SStefano Zampini   /* free workspace */
2480674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
2481674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
2482674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
2483674ae819SStefano Zampini   ierr = PetscFree(dof_sizes);CHKERRQ(ierr);
2484674ae819SStefano Zampini   ierr = PetscFree(dof_displs);CHKERRQ(ierr);
2485674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
2486674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
2487674ae819SStefano Zampini   PetscFunctionReturn(0);
2488674ae819SStefano Zampini }
24899a7d3425SStefano Zampini 
24909a7d3425SStefano Zampini #undef __FUNCT__
24919a7d3425SStefano Zampini #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
24929a7d3425SStefano Zampini PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
24939a7d3425SStefano Zampini {
24949a7d3425SStefano Zampini   PetscInt       i,j;
24959a7d3425SStefano Zampini   PetscScalar    *alphas;
24969a7d3425SStefano Zampini   PetscErrorCode ierr;
24979a7d3425SStefano Zampini 
24989a7d3425SStefano Zampini   PetscFunctionBegin;
24999a7d3425SStefano Zampini   /* this implements stabilized Gram-Schmidt */
25009a7d3425SStefano Zampini   ierr = PetscMalloc(n*sizeof(PetscScalar),&alphas);CHKERRQ(ierr);
25019a7d3425SStefano Zampini   for (i=0;i<n;i++) {
25029a7d3425SStefano Zampini     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
25039a7d3425SStefano Zampini     if (i<n) { ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],&alphas[i+1]);CHKERRQ(ierr); }
25049a7d3425SStefano Zampini     for (j=i+1;j<n;j++) { ierr = VecAXPY(vecs[j],PetscConj(-alphas[j]),vecs[i]);CHKERRQ(ierr); }
25059a7d3425SStefano Zampini   }
25069a7d3425SStefano Zampini   ierr = PetscFree(alphas);CHKERRQ(ierr);
25079a7d3425SStefano Zampini   PetscFunctionReturn(0);
25089a7d3425SStefano Zampini }
25099a7d3425SStefano Zampini 
2510fa7f1dd8SStefano Zampini /* TODO
2511fa7f1dd8SStefano Zampini    - now preallocation is done assuming SEQDENSE local matrices
2512fa7f1dd8SStefano Zampini */
2513c8587f34SStefano Zampini #undef __FUNCT__
2514fa7f1dd8SStefano Zampini #define __FUNCT__ "MatISGetMPIXAIJ"
2515fa7f1dd8SStefano Zampini static PetscErrorCode MatISGetMPIXAIJ(Mat mat, MatType Mtype, MatReuse reuse, Mat *M)
2516c8587f34SStefano Zampini {
2517a57a6d2fSStefano Zampini   Mat                    new_mat;
2518a57a6d2fSStefano Zampini   Mat_IS                 *matis = (Mat_IS*)(mat->data);
2519a57a6d2fSStefano Zampini   /* info on mat */
2520fa7f1dd8SStefano Zampini   /* ISLocalToGlobalMapping rmapping,cmapping; */
2521a57a6d2fSStefano Zampini   PetscInt               bs,rows,cols;
2522a57a6d2fSStefano Zampini   PetscInt               lrows,lcols;
2523a57a6d2fSStefano Zampini   PetscInt               local_rows,local_cols;
2524fa7f1dd8SStefano Zampini   PetscBool              isdense;
2525fa7f1dd8SStefano Zampini   /* values insertion */
2526fa7f1dd8SStefano Zampini   PetscScalar            *array;
2527a57a6d2fSStefano Zampini   PetscInt               *local_indices,*global_indices;
2528a57a6d2fSStefano Zampini   /* work */
2529fa7f1dd8SStefano Zampini   PetscInt               i,j,index_row;
2530a57a6d2fSStefano Zampini   PetscErrorCode         ierr;
2531c8587f34SStefano Zampini 
2532a57a6d2fSStefano Zampini   PetscFunctionBegin;
2533fa7f1dd8SStefano Zampini   /* MISSING CHECKS
2534fa7f1dd8SStefano Zampini     - rectangular case not covered (it is not allowed by MATIS)
2535fa7f1dd8SStefano Zampini   */
2536a57a6d2fSStefano Zampini   /* get info from mat */
2537fa7f1dd8SStefano Zampini   /* ierr = MatGetLocalToGlobalMapping(mat,&rmapping,&cmapping);CHKERRQ(ierr); */
2538a57a6d2fSStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
2539a57a6d2fSStefano Zampini   ierr = MatGetBlockSize(mat,&bs);CHKERRQ(ierr);
2540a57a6d2fSStefano Zampini   ierr = MatGetSize(matis->A,&local_rows,&local_cols);CHKERRQ(ierr);
2541a57a6d2fSStefano Zampini 
2542fa7f1dd8SStefano Zampini   /* work */
2543fa7f1dd8SStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*local_indices),&local_indices);CHKERRQ(ierr);
2544fa7f1dd8SStefano Zampini   for (i=0;i<local_rows;i++) local_indices[i]=i;
2545fa7f1dd8SStefano Zampini   /* map indices of local mat to global values */
2546fa7f1dd8SStefano Zampini   ierr = PetscMalloc(PetscMax(local_cols,local_rows)*sizeof(*global_indices),&global_indices);CHKERRQ(ierr);
2547fa7f1dd8SStefano Zampini   /* ierr = ISLocalToGlobalMappingApply(rmapping,local_rows,local_indices,global_indices);CHKERRQ(ierr); */
2548fa7f1dd8SStefano Zampini   ierr = ISLocalToGlobalMappingApply(matis->mapping,local_rows,local_indices,global_indices);CHKERRQ(ierr);
2549fa7f1dd8SStefano Zampini 
2550fa7f1dd8SStefano Zampini   if (reuse==MAT_INITIAL_MATRIX) {
2551fa7f1dd8SStefano Zampini     Vec         vec_dnz,vec_onz;
2552fa7f1dd8SStefano Zampini     PetscScalar *my_dnz,*my_onz;
2553fa7f1dd8SStefano Zampini     PetscInt    *dnz,*onz,*mat_ranges,*row_ownership;
2554fa7f1dd8SStefano Zampini     PetscInt    index_col,owner;
2555fa7f1dd8SStefano Zampini     PetscMPIInt nsubdomains;
2556fa7f1dd8SStefano Zampini 
2557fa7f1dd8SStefano Zampini     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&nsubdomains);CHKERRQ(ierr);
2558a57a6d2fSStefano Zampini     ierr = MatCreate(PetscObjectComm((PetscObject)mat),&new_mat);CHKERRQ(ierr);
2559a57a6d2fSStefano Zampini     ierr = MatSetSizes(new_mat,PETSC_DECIDE,PETSC_DECIDE,rows,cols);CHKERRQ(ierr);
2560a57a6d2fSStefano Zampini     ierr = MatSetBlockSize(new_mat,bs);CHKERRQ(ierr);
2561fa7f1dd8SStefano Zampini     ierr = MatSetType(new_mat,Mtype);CHKERRQ(ierr);
2562a57a6d2fSStefano Zampini     ierr = MatSetUp(new_mat);CHKERRQ(ierr);
2563a57a6d2fSStefano Zampini     ierr = MatGetLocalSize(new_mat,&lrows,&lcols);CHKERRQ(ierr);
2564a57a6d2fSStefano Zampini 
2565a57a6d2fSStefano Zampini     /*
2566a57a6d2fSStefano Zampini       preallocation
2567a57a6d2fSStefano Zampini     */
2568a57a6d2fSStefano Zampini 
2569a57a6d2fSStefano Zampini     ierr = MatPreallocateInitialize(PetscObjectComm((PetscObject)new_mat),lrows,lcols,dnz,onz);CHKERRQ(ierr);
2570a57a6d2fSStefano Zampini     /*
2571a57a6d2fSStefano Zampini        Some vectors are needed to sum up properly on shared interface dofs.
2572fa7f1dd8SStefano Zampini        Preallocation macros cannot do the job.
2573a57a6d2fSStefano Zampini        Note that preallocation is not exact, since it overestimates nonzeros
2574a57a6d2fSStefano Zampini     */
2575a57a6d2fSStefano Zampini     ierr = MatGetVecs(new_mat,NULL,&vec_dnz);CHKERRQ(ierr);
2576fa7f1dd8SStefano Zampini     /* ierr = VecSetLocalToGlobalMapping(vec_dnz,rmapping);CHKERRQ(ierr); */
2577fa7f1dd8SStefano Zampini     ierr = VecSetLocalToGlobalMapping(vec_dnz,matis->mapping);CHKERRQ(ierr);
2578c8587f34SStefano Zampini     ierr = VecDuplicate(vec_dnz,&vec_onz);CHKERRQ(ierr);
2579e7931f94SStefano Zampini     /* All processes need to compute entire row ownership */
2580a57a6d2fSStefano Zampini     ierr = PetscMalloc(rows*sizeof(*row_ownership),&row_ownership);CHKERRQ(ierr);
2581a57a6d2fSStefano Zampini     ierr = MatGetOwnershipRanges(new_mat,(const PetscInt**)&mat_ranges);CHKERRQ(ierr);
2582a57a6d2fSStefano Zampini     for (i=0;i<nsubdomains;i++) {
2583c8587f34SStefano Zampini       for (j=mat_ranges[i];j<mat_ranges[i+1];j++) {
2584c8587f34SStefano Zampini         row_ownership[j]=i;
2585c8587f34SStefano Zampini       }
2586c8587f34SStefano Zampini     }
2587c8587f34SStefano Zampini 
2588e7931f94SStefano Zampini     /*
2589e7931f94SStefano Zampini        my_dnz and my_onz contains exact contribution to preallocation from each local mat
2590e7931f94SStefano Zampini        then, they will be summed up properly. This way, preallocation is always sufficient
2591e7931f94SStefano Zampini     */
2592a57a6d2fSStefano Zampini     ierr = PetscMalloc(local_rows*sizeof(*my_dnz),&my_dnz);CHKERRQ(ierr);
2593a57a6d2fSStefano Zampini     ierr = PetscMalloc(local_rows*sizeof(*my_onz),&my_onz);CHKERRQ(ierr);
2594a57a6d2fSStefano Zampini     ierr = PetscMemzero(my_dnz,local_rows*sizeof(*my_dnz));CHKERRQ(ierr);
2595a57a6d2fSStefano Zampini     ierr = PetscMemzero(my_onz,local_rows*sizeof(*my_onz));CHKERRQ(ierr);
2596a57a6d2fSStefano Zampini     for (i=0;i<local_rows;i++) {
2597a57a6d2fSStefano Zampini       index_row = global_indices[i];
2598a57a6d2fSStefano Zampini       for (j=i;j<local_rows;j++) {
2599a57a6d2fSStefano Zampini         owner = row_ownership[index_row];
2600a57a6d2fSStefano Zampini         index_col = global_indices[j];
2601a57a6d2fSStefano Zampini         if (index_col > mat_ranges[owner]-1 && index_col < mat_ranges[owner+1] ) { /* diag block */
2602c8587f34SStefano Zampini           my_dnz[i] += 1.0;
2603a57a6d2fSStefano Zampini         } else { /* offdiag block */
2604c8587f34SStefano Zampini           my_onz[i] += 1.0;
2605c8587f34SStefano Zampini         }
2606a57a6d2fSStefano Zampini         /* same as before, interchanging rows and cols */
2607c8587f34SStefano Zampini         if (i != j) {
2608a57a6d2fSStefano Zampini           owner = row_ownership[index_col];
2609a57a6d2fSStefano Zampini           if (index_row > mat_ranges[owner]-1 && index_row < mat_ranges[owner+1] ) {
2610c8587f34SStefano Zampini             my_dnz[j] += 1.0;
2611c8587f34SStefano Zampini           } else {
2612c8587f34SStefano Zampini             my_onz[j] += 1.0;
2613c8587f34SStefano Zampini           }
2614c8587f34SStefano Zampini         }
2615c8587f34SStefano Zampini       }
2616c8587f34SStefano Zampini     }
2617c8587f34SStefano Zampini     ierr = VecSet(vec_dnz,0.0);CHKERRQ(ierr);
2618c8587f34SStefano Zampini     ierr = VecSet(vec_onz,0.0);CHKERRQ(ierr);
261920a2ab83SStefano Zampini     if (local_rows) { /* multilevel guard */
2620fa7f1dd8SStefano Zampini       ierr = VecSetValuesLocal(vec_dnz,local_rows,local_indices,my_dnz,ADD_VALUES);CHKERRQ(ierr);
2621fa7f1dd8SStefano Zampini       ierr = VecSetValuesLocal(vec_onz,local_rows,local_indices,my_onz,ADD_VALUES);CHKERRQ(ierr);
2622c8587f34SStefano Zampini     }
2623c8587f34SStefano Zampini     ierr = VecAssemblyBegin(vec_dnz);CHKERRQ(ierr);
2624c8587f34SStefano Zampini     ierr = VecAssemblyBegin(vec_onz);CHKERRQ(ierr);
2625c8587f34SStefano Zampini     ierr = VecAssemblyEnd(vec_dnz);CHKERRQ(ierr);
2626c8587f34SStefano Zampini     ierr = VecAssemblyEnd(vec_onz);CHKERRQ(ierr);
2627c8587f34SStefano Zampini     ierr = PetscFree(my_dnz);CHKERRQ(ierr);
2628c8587f34SStefano Zampini     ierr = PetscFree(my_onz);CHKERRQ(ierr);
2629c8587f34SStefano Zampini     ierr = PetscFree(row_ownership);CHKERRQ(ierr);
2630a57a6d2fSStefano Zampini 
2631a57a6d2fSStefano Zampini     /* set computed preallocation in dnz and onz */
2632a57a6d2fSStefano Zampini     ierr = VecGetArray(vec_dnz,&array);CHKERRQ(ierr);
2633a57a6d2fSStefano Zampini     for (i=0; i<lrows; i++) dnz[i] = (PetscInt)PetscRealPart(array[i]);
2634a57a6d2fSStefano Zampini     ierr = VecRestoreArray(vec_dnz,&array);CHKERRQ(ierr);
2635a57a6d2fSStefano Zampini     ierr = VecGetArray(vec_onz,&array);CHKERRQ(ierr);
2636a57a6d2fSStefano Zampini     for (i=0;i<lrows;i++) onz[i] = (PetscInt)PetscRealPart(array[i]);
2637a57a6d2fSStefano Zampini     ierr = VecRestoreArray(vec_onz,&array);CHKERRQ(ierr);
2638c8587f34SStefano Zampini     ierr = VecDestroy(&vec_dnz);CHKERRQ(ierr);
2639c8587f34SStefano Zampini     ierr = VecDestroy(&vec_onz);CHKERRQ(ierr);
2640c8587f34SStefano Zampini 
2641e7931f94SStefano Zampini     /* Resize preallocation if overestimated */
2642c8587f34SStefano Zampini     for (i=0;i<lrows;i++) {
2643a57a6d2fSStefano Zampini       dnz[i] = PetscMin(dnz[i],lcols);
2644a57a6d2fSStefano Zampini       onz[i] = PetscMin(onz[i],cols-lcols);
2645c8587f34SStefano Zampini     }
2646fa7f1dd8SStefano Zampini     /* set preallocation */
2647a57a6d2fSStefano Zampini     ierr = MatMPIAIJSetPreallocation(new_mat,0,dnz,0,onz);CHKERRQ(ierr);
2648fa7f1dd8SStefano Zampini     for (i=0;i<lrows/bs;i++) {
2649fa7f1dd8SStefano Zampini       dnz[i] = dnz[i*bs]/bs;
2650fa7f1dd8SStefano Zampini       onz[i] = onz[i*bs]/bs;
2651fa7f1dd8SStefano Zampini     }
2652fa7f1dd8SStefano Zampini     ierr = MatMPIBAIJSetPreallocation(new_mat,bs,0,dnz,0,onz);CHKERRQ(ierr);
2653fa7f1dd8SStefano Zampini     for (i=0;i<lrows/bs;i++) {
2654fa7f1dd8SStefano Zampini       dnz[i] = dnz[i]-i;
2655fa7f1dd8SStefano Zampini     }
2656fa7f1dd8SStefano Zampini     ierr = MatMPISBAIJSetPreallocation(new_mat,bs,0,dnz,0,onz);CHKERRQ(ierr);
2657c8587f34SStefano Zampini     ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
2658fa7f1dd8SStefano Zampini     *M = new_mat;
2659fa7f1dd8SStefano Zampini   } else {
2660fa7f1dd8SStefano Zampini     PetscInt mbs,mrows,mcols;
2661fa7f1dd8SStefano Zampini     /* some checks */
2662fa7f1dd8SStefano Zampini     ierr = MatGetBlockSize(*M,&mbs);CHKERRQ(ierr);
2663fa7f1dd8SStefano Zampini     ierr = MatGetSize(*M,&mrows,&mcols);CHKERRQ(ierr);
2664fa7f1dd8SStefano Zampini     if (mrows != rows) {
2665fa7f1dd8SStefano Zampini       SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong number of rows (%d != %d)",rows,mrows);
2666fa7f1dd8SStefano Zampini     }
2667fa7f1dd8SStefano Zampini     if (mrows != rows) {
2668fa7f1dd8SStefano Zampini       SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong number of cols (%d != %d)",cols,mcols);
2669fa7f1dd8SStefano Zampini     }
2670fa7f1dd8SStefano Zampini     if (mbs != bs) {
2671fa7f1dd8SStefano Zampini       SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong block size (%d != %d)",bs,mbs);
2672fa7f1dd8SStefano Zampini     }
2673fa7f1dd8SStefano Zampini     ierr = MatZeroEntries(*M);CHKERRQ(ierr);
2674fa7f1dd8SStefano Zampini   }
2675fa7f1dd8SStefano Zampini   /* set local to global mappings */
2676fa7f1dd8SStefano Zampini   /* ierr = MatSetLocalToGlobalMapping(*M,rmapping,cmapping);CHKERRQ(ierr); */
2677fa7f1dd8SStefano Zampini   /* Set values */
2678fa7f1dd8SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQDENSE,&isdense);CHKERRQ(ierr);
2679fa7f1dd8SStefano Zampini   if (isdense) { /* special case for dense local matrices */
2680fa7f1dd8SStefano Zampini     ierr = MatSetOption(*M,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
2681fa7f1dd8SStefano Zampini     ierr = MatDenseGetArray(matis->A,&array);CHKERRQ(ierr);
2682fa7f1dd8SStefano Zampini     ierr = MatSetValues(*M,local_rows,global_indices,local_cols,global_indices,array,ADD_VALUES);CHKERRQ(ierr);
2683fa7f1dd8SStefano Zampini     ierr = MatDenseRestoreArray(matis->A,&array);CHKERRQ(ierr);
2684fa7f1dd8SStefano Zampini     ierr = PetscFree(local_indices);CHKERRQ(ierr);
2685fa7f1dd8SStefano Zampini     ierr = PetscFree(global_indices);CHKERRQ(ierr);
2686fa7f1dd8SStefano Zampini   } else { /* very basic values insertion for all other matrix types */
2687fa7f1dd8SStefano Zampini     ierr = PetscFree(local_indices);CHKERRQ(ierr);
2688fa7f1dd8SStefano Zampini     ierr = PetscFree(global_indices);CHKERRQ(ierr);
2689a57a6d2fSStefano Zampini     for (i=0;i<local_rows;i++) {
2690a57a6d2fSStefano Zampini       ierr = MatGetRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2691fa7f1dd8SStefano Zampini       /* ierr = MatSetValuesLocal(*M,1,&i,j,local_indices,array,ADD_VALUES);CHKERRQ(ierr); */
2692a57a6d2fSStefano Zampini       ierr = ISLocalToGlobalMappingApply(matis->mapping,j,local_indices,global_indices);CHKERRQ(ierr);
2693a57a6d2fSStefano Zampini       ierr = ISLocalToGlobalMappingApply(matis->mapping,1,&i,&index_row);CHKERRQ(ierr);
2694fa7f1dd8SStefano Zampini       ierr = MatSetValues(*M,1,&index_row,j,global_indices,array,ADD_VALUES);CHKERRQ(ierr);
2695a57a6d2fSStefano Zampini       ierr = MatRestoreRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2696a57a6d2fSStefano Zampini     }
2697fa7f1dd8SStefano Zampini   }
2698fa7f1dd8SStefano Zampini   ierr = MatAssemblyBegin(*M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2699fa7f1dd8SStefano Zampini   ierr = MatAssemblyEnd(*M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2700fa7f1dd8SStefano Zampini   if (isdense) {
2701fa7f1dd8SStefano Zampini     ierr = MatSetOption(*M,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
2702fa7f1dd8SStefano Zampini   }
2703a57a6d2fSStefano Zampini   PetscFunctionReturn(0);
2704a57a6d2fSStefano Zampini }
2705a57a6d2fSStefano Zampini 
2706e7931f94SStefano Zampini #undef __FUNCT__
2707*70cf5478SStefano Zampini #define __FUNCT__ "MatISGetSubassemblingPattern"
2708*70cf5478SStefano Zampini PetscErrorCode MatISGetSubassemblingPattern(Mat mat, PetscInt coarsening_ratio, IS* is_sends)
2709e7931f94SStefano Zampini {
2710e7931f94SStefano Zampini   Mat             subdomain_adj;
2711e7931f94SStefano Zampini   IS              new_ranks,ranks_send_to;
2712e7931f94SStefano Zampini   MatPartitioning partitioner;
2713e7931f94SStefano Zampini   Mat_IS          *matis;
2714e7931f94SStefano Zampini   PetscInt        n_neighs,*neighs,*n_shared,**shared;
2715e7931f94SStefano Zampini   PetscInt        prank;
2716e7931f94SStefano Zampini   PetscMPIInt     size,rank,color;
2717e7931f94SStefano Zampini   PetscInt        *xadj,*adjncy,*oldranks;
2718e7931f94SStefano Zampini   PetscInt        *adjncy_wgt,*v_wgt,*is_indices,*ranks_send_to_idx;
2719e7931f94SStefano Zampini   PetscInt        i,j,n_subdomains,local_size,threshold=0;
2720e7931f94SStefano Zampini   PetscErrorCode  ierr;
27212b510759SStefano Zampini   PetscBool       use_vwgt=PETSC_FALSE,use_square=PETSC_FALSE;
2722e7931f94SStefano Zampini   PetscSubcomm    subcomm;
2723a57a6d2fSStefano Zampini 
2724e7931f94SStefano Zampini   PetscFunctionBegin;
27252b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_square",&use_square,NULL);CHKERRQ(ierr);
27262b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
27272b510759SStefano Zampini   ierr = PetscOptionsGetInt(NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
2728e7931f94SStefano Zampini 
2729e7931f94SStefano Zampini   /* Get info on mapping */
2730e7931f94SStefano Zampini   matis = (Mat_IS*)(mat->data);
2731e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&local_size);CHKERRQ(ierr);
2732e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2733e7931f94SStefano Zampini 
2734e7931f94SStefano Zampini   /* build local CSR graph of subdomains' connectivity */
2735e7931f94SStefano Zampini   ierr = PetscMalloc(2*sizeof(*xadj),&xadj);CHKERRQ(ierr);
2736e7931f94SStefano Zampini   xadj[0] = 0;
2737e7931f94SStefano Zampini   xadj[1] = PetscMax(n_neighs-1,0);
2738e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy),&adjncy);CHKERRQ(ierr);
2739e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy_wgt),&adjncy_wgt);CHKERRQ(ierr);
2740e7931f94SStefano Zampini 
27412b510759SStefano Zampini   if (threshold) {
27422b510759SStefano Zampini     PetscInt* count,min_threshold;
2743e7931f94SStefano Zampini     ierr = PetscMalloc(local_size*sizeof(PetscInt),&count);CHKERRQ(ierr);
2744e7931f94SStefano Zampini     ierr = PetscMemzero(count,local_size*sizeof(PetscInt));CHKERRQ(ierr);
2745e7931f94SStefano Zampini     for (i=1;i<n_neighs;i++) {/* i=1 so I don't count myself -> faces nodes counts to 1 */
2746e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2747e7931f94SStefano Zampini         count[shared[i][j]] += 1;
2748e7931f94SStefano Zampini       }
2749e7931f94SStefano Zampini     }
27502b510759SStefano Zampini     /* adapt threshold since we dont want to lose significant connections */
27512b510759SStefano Zampini     min_threshold = n_neighs;
27522b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
27532b510759SStefano Zampini       for (j=0;j<n_shared[i];j++) {
27542b510759SStefano Zampini         min_threshold = PetscMin(count[shared[i][j]],min_threshold);
27552b510759SStefano Zampini       }
27562b510759SStefano Zampini     }
27572b510759SStefano Zampini     threshold = PetscMax(min_threshold+1,threshold);
2758e7931f94SStefano Zampini     xadj[1] = 0;
27592b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
2760e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2761e7931f94SStefano Zampini         if (count[shared[i][j]] < threshold) {
2762e7931f94SStefano Zampini           adjncy[xadj[1]] = neighs[i];
2763e7931f94SStefano Zampini           adjncy_wgt[xadj[1]] = n_shared[i];
2764e7931f94SStefano Zampini           xadj[1]++;
2765e7931f94SStefano Zampini           break;
2766e7931f94SStefano Zampini         }
2767e7931f94SStefano Zampini       }
2768e7931f94SStefano Zampini     }
2769e7931f94SStefano Zampini     ierr = PetscFree(count);CHKERRQ(ierr);
2770c8587f34SStefano Zampini   } else {
2771e7931f94SStefano Zampini     if (xadj[1]) {
2772e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy,&neighs[1],xadj[1]*sizeof(*adjncy));CHKERRQ(ierr);
2773e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy_wgt,&n_shared[1],xadj[1]*sizeof(*adjncy_wgt));CHKERRQ(ierr);
2774c8587f34SStefano Zampini     }
2775e7931f94SStefano Zampini   }
2776e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingRestoreInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2777e7931f94SStefano Zampini   if (use_square) {
2778e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2779e7931f94SStefano Zampini       adjncy_wgt[i] = adjncy_wgt[i]*adjncy_wgt[i];
2780e7931f94SStefano Zampini     }
2781e7931f94SStefano Zampini   }
2782e7931f94SStefano Zampini   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2783e7931f94SStefano Zampini 
2784e7931f94SStefano Zampini   ierr = PetscMalloc(sizeof(PetscInt),&ranks_send_to_idx);CHKERRQ(ierr);
2785e7931f94SStefano Zampini 
2786e7931f94SStefano Zampini   /*
2787e7931f94SStefano Zampini     Restrict work on active processes only.
2788e7931f94SStefano Zampini   */
2789e7931f94SStefano Zampini   ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&subcomm);CHKERRQ(ierr);
2790e7931f94SStefano Zampini   ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
2791e7931f94SStefano Zampini   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
27922b510759SStefano Zampini   ierr = PetscMPIIntCast(!local_size,&color);CHKERRQ(ierr);
2793d3531aaaSJed Brown   ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
2794e7931f94SStefano Zampini   if (color) {
2795e7931f94SStefano Zampini     ierr = PetscFree(xadj);CHKERRQ(ierr);
2796e7931f94SStefano Zampini     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2797e7931f94SStefano Zampini     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
2798c8587f34SStefano Zampini   } else {
2799e7931f94SStefano Zampini     ierr = MPI_Comm_size(subcomm->comm,&size);CHKERRQ(ierr);
2800e7931f94SStefano Zampini     ierr = PetscMalloc(size*sizeof(*oldranks),&oldranks);CHKERRQ(ierr);
2801e7931f94SStefano Zampini     prank = rank;
2802e7931f94SStefano Zampini     ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm->comm);CHKERRQ(ierr);
28038002ef2cSStefano Zampini     /*
2804e7931f94SStefano Zampini     for (i=0;i<size;i++) {
2805e7931f94SStefano Zampini       PetscPrintf(subcomm->comm,"oldranks[%d] = %d\n",i,oldranks[i]);
2806c8587f34SStefano Zampini     }
28078002ef2cSStefano Zampini     */
2808e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2809e7931f94SStefano Zampini       ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
2810c8587f34SStefano Zampini     }
2811e7931f94SStefano Zampini     ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2812e7931f94SStefano Zampini     ierr = MatCreateMPIAdj(subcomm->comm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
2813e7931f94SStefano Zampini     n_subdomains = (PetscInt)size;
2814e7931f94SStefano Zampini     ierr = MatView(subdomain_adj,0);CHKERRQ(ierr);
2815e7931f94SStefano Zampini 
2816e7931f94SStefano Zampini     /* Partition */
2817e7931f94SStefano Zampini     ierr = MatPartitioningCreate(subcomm->comm,&partitioner);CHKERRQ(ierr);
2818e7931f94SStefano Zampini     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
2819e7931f94SStefano Zampini     if (use_vwgt) {
2820e7931f94SStefano Zampini       ierr = PetscMalloc(sizeof(*v_wgt),&v_wgt);CHKERRQ(ierr);
2821e7931f94SStefano Zampini       v_wgt[0] = local_size;
2822e7931f94SStefano Zampini       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
2823c8587f34SStefano Zampini     }
28248002ef2cSStefano Zampini     /* ierr = PetscPrintf(PetscObjectComm((PetscObject)partitioner),"NPARTS %d\n",n_subdomains/coarsening_ratio);CHKERRQ(ierr); */
2825e7931f94SStefano Zampini     ierr = MatPartitioningSetNParts(partitioner,n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2826e7931f94SStefano Zampini     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
2827e7931f94SStefano Zampini     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
2828e7931f94SStefano Zampini     ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr);
2829e7931f94SStefano Zampini 
2830e7931f94SStefano Zampini     ierr = ISGetIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
283184ba6060SStefano Zampini     /* ranks_send_to_idx[0] = oldranks[is_indices[0]]; */ /* contiguos set of processes */
283284ba6060SStefano Zampini     ranks_send_to_idx[0] = coarsening_ratio*oldranks[is_indices[0]]; /* scattered set of processes */
2833e7931f94SStefano Zampini     ierr = ISRestoreIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2834e7931f94SStefano Zampini     /* clean up */
2835e7931f94SStefano Zampini     ierr = PetscFree(oldranks);CHKERRQ(ierr);
2836e7931f94SStefano Zampini     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
2837e7931f94SStefano Zampini     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
2838e7931f94SStefano Zampini     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
2839e7931f94SStefano Zampini   }
2840e7931f94SStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
2841e7931f94SStefano Zampini 
2842e7931f94SStefano Zampini   /* assemble parallel IS for sends */
2843e7931f94SStefano Zampini   i = 1;
2844e7931f94SStefano Zampini   if (color) i=0;
2845e7931f94SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,&ranks_send_to);CHKERRQ(ierr);
2846e7931f94SStefano Zampini   ierr = ISView(ranks_send_to,0);CHKERRQ(ierr);
2847e7931f94SStefano Zampini 
2848e7931f94SStefano Zampini   /* get back IS */
2849e7931f94SStefano Zampini   *is_sends = ranks_send_to;
2850e7931f94SStefano Zampini   PetscFunctionReturn(0);
2851e7931f94SStefano Zampini }
2852e7931f94SStefano Zampini 
2853e7931f94SStefano Zampini typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
2854e7931f94SStefano Zampini 
2855e7931f94SStefano Zampini #undef __FUNCT__
2856e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble"
2857*70cf5478SStefano Zampini PetscErrorCode MatISSubassemble(Mat mat, IS is_sends, PetscInt coarsening_ratio, MatReuse reuse, Mat *mat_n)
2858e7931f94SStefano Zampini {
2859*70cf5478SStefano Zampini   Mat                    local_mat;
2860e7931f94SStefano Zampini   Mat_IS                 *matis;
2861e7931f94SStefano Zampini   IS                     is_sends_internal;
2862e7931f94SStefano Zampini   PetscInt               rows,cols;
2863e7931f94SStefano Zampini   PetscInt               i,bs,buf_size_idxs,buf_size_vals;
2864e7931f94SStefano Zampini   PetscBool              ismatis,isdense;
2865e7931f94SStefano Zampini   ISLocalToGlobalMapping l2gmap;
2866e7931f94SStefano Zampini   PetscInt*              l2gmap_indices;
2867e7931f94SStefano Zampini   const PetscInt*        is_indices;
2868e7931f94SStefano Zampini   MatType                new_local_type;
2869e7931f94SStefano Zampini   MatTypePrivate         new_local_type_private;
2870e7931f94SStefano Zampini   /* buffers */
2871e7931f94SStefano Zampini   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
2872e7931f94SStefano Zampini   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
2873e7931f94SStefano Zampini   /* MPI */
2874e7931f94SStefano Zampini   MPI_Comm               comm;
2875e7931f94SStefano Zampini   PetscMPIInt            n_sends,n_recvs,commsize;
2876e7931f94SStefano Zampini   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals;
2877e7931f94SStefano Zampini   PetscMPIInt            *onodes,*olengths_idxs,*olengths_vals;
2878e7931f94SStefano Zampini   PetscMPIInt            len,tag_idxs,tag_vals,source_dest;
2879e7931f94SStefano Zampini   MPI_Request            *send_req_idxs,*send_req_vals,*recv_req_idxs,*recv_req_vals;
2880e7931f94SStefano Zampini   PetscErrorCode         ierr;
2881e7931f94SStefano Zampini 
2882e7931f94SStefano Zampini   PetscFunctionBegin;
2883e7931f94SStefano Zampini   /* checks */
2884e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
2885e7931f94SStefano Zampini   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on an matrix object which is not of type MATIS",__FUNCT__);
2886e7931f94SStefano Zampini   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2887e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
2888e7931f94SStefano Zampini   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
2889e7931f94SStefano Zampini   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
2890e7931f94SStefano Zampini   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
2891*70cf5478SStefano Zampini   if (reuse == MAT_REUSE_MATRIX) {
2892*70cf5478SStefano Zampini     PetscInt mrows,mcols,mnrows,mncols;
2893*70cf5478SStefano Zampini     PetscBool ismatis;
2894*70cf5478SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
2895*70cf5478SStefano Zampini     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
2896*70cf5478SStefano Zampini     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
2897*70cf5478SStefano Zampini     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
2898*70cf5478SStefano Zampini     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
2899*70cf5478SStefano Zampini     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
2900*70cf5478SStefano Zampini   }
2901e7931f94SStefano Zampini   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
2902e7931f94SStefano Zampini   PetscValidLogicalCollectiveInt(mat,bs,0);
2903e7931f94SStefano Zampini   /* prepare IS for sending if not provided */
2904e7931f94SStefano Zampini   if (!is_sends) {
2905e7931f94SStefano Zampini     if (!coarsening_ratio) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a coarsening ratio");
2906*70cf5478SStefano Zampini     ierr = MatISGetSubassemblingPattern(mat,coarsening_ratio,&is_sends_internal);CHKERRQ(ierr);
2907c8587f34SStefano Zampini   } else {
2908e7931f94SStefano Zampini     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
2909e7931f94SStefano Zampini     is_sends_internal = is_sends;
2910c8587f34SStefano Zampini   }
2911e7931f94SStefano Zampini 
2912e7931f94SStefano Zampini   /* get pointer of MATIS data */
2913e7931f94SStefano Zampini   matis = (Mat_IS*)mat->data;
2914e7931f94SStefano Zampini 
2915e7931f94SStefano Zampini   /* get comm */
2916e7931f94SStefano Zampini   comm = PetscObjectComm((PetscObject)mat);
2917e7931f94SStefano Zampini 
2918e7931f94SStefano Zampini   /* compute number of sends */
2919e7931f94SStefano Zampini   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
2920e7931f94SStefano Zampini   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
2921e7931f94SStefano Zampini 
2922e7931f94SStefano Zampini   /* compute number of receives */
2923e7931f94SStefano Zampini   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
2924e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*iflags),&iflags);CHKERRQ(ierr);
2925e7931f94SStefano Zampini   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
2926e7931f94SStefano Zampini   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2927e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
2928e7931f94SStefano Zampini   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
2929e7931f94SStefano Zampini   ierr = PetscFree(iflags);CHKERRQ(ierr);
2930e7931f94SStefano Zampini 
2931e7931f94SStefano Zampini   /* prepare send/receive buffers */
2932e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_idxs),&ilengths_idxs);CHKERRQ(ierr);
2933e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
2934e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_vals),&ilengths_vals);CHKERRQ(ierr);
2935e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
2936e7931f94SStefano Zampini 
2937e7931f94SStefano Zampini   /* Get data from local mat */
2938e7931f94SStefano Zampini   if (!isdense) {
2939e7931f94SStefano Zampini     /* TODO: See below some guidelines on how to prepare the local buffers */
2940e7931f94SStefano Zampini     /*
2941e7931f94SStefano Zampini        send_buffer_vals should contain the raw values of the local matrix
2942e7931f94SStefano Zampini        send_buffer_idxs should contain:
2943e7931f94SStefano Zampini        - MatType_PRIVATE type
2944e7931f94SStefano Zampini        - PetscInt        size_of_l2gmap
2945e7931f94SStefano Zampini        - PetscInt        global_row_indices[size_of_l2gmap]
2946e7931f94SStefano Zampini        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
2947e7931f94SStefano Zampini     */
2948e7931f94SStefano Zampini   } else {
2949e7931f94SStefano Zampini     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
2950e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&i);CHKERRQ(ierr);
2951e7931f94SStefano Zampini     ierr = PetscMalloc((i+2)*sizeof(PetscInt),&send_buffer_idxs);CHKERRQ(ierr);
2952e7931f94SStefano Zampini     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
2953e7931f94SStefano Zampini     send_buffer_idxs[1] = i;
2954e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2955e7931f94SStefano Zampini     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
2956e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingRestoreIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2957e7931f94SStefano Zampini     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
2958e7931f94SStefano Zampini     for (i=0;i<n_sends;i++) {
2959e7931f94SStefano Zampini       ilengths_vals[is_indices[i]] = len*len;
2960e7931f94SStefano Zampini       ilengths_idxs[is_indices[i]] = len+2;
2961c8587f34SStefano Zampini     }
2962c8587f34SStefano Zampini   }
2963e7931f94SStefano Zampini   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
2964e7931f94SStefano Zampini   buf_size_idxs = 0;
2965e7931f94SStefano Zampini   buf_size_vals = 0;
2966e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2967e7931f94SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
2968e7931f94SStefano Zampini     buf_size_vals += (PetscInt)olengths_vals[i];
2969e7931f94SStefano Zampini   }
2970e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&recv_buffer_idxs);CHKERRQ(ierr);
2971e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_vals*sizeof(PetscScalar),&recv_buffer_vals);CHKERRQ(ierr);
2972e7931f94SStefano Zampini 
2973e7931f94SStefano Zampini   /* get new tags for clean communications */
2974e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
2975e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
2976e7931f94SStefano Zampini 
2977e7931f94SStefano Zampini   /* allocate for requests */
2978e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_idxs);CHKERRQ(ierr);
2979e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_vals);CHKERRQ(ierr);
2980e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_idxs);CHKERRQ(ierr);
2981e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_vals);CHKERRQ(ierr);
2982e7931f94SStefano Zampini 
2983e7931f94SStefano Zampini   /* communications */
2984e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2985e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
2986e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2987e7931f94SStefano Zampini     source_dest = onodes[i];
2988e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
2989e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
2990e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2991e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
2992e7931f94SStefano Zampini   }
2993e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) {
2994e7931f94SStefano Zampini     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
2995e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
2996e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
2997e7931f94SStefano Zampini   }
2998e7931f94SStefano Zampini   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2999e7931f94SStefano Zampini   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
3000e7931f94SStefano Zampini 
3001e7931f94SStefano Zampini   /* assemble new l2g map */
3002e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3003e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
3004e7931f94SStefano Zampini   buf_size_idxs = 0;
3005e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3006e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
3007e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3008e7931f94SStefano Zampini   }
3009e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&l2gmap_indices);CHKERRQ(ierr);
3010e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
3011e7931f94SStefano Zampini   buf_size_idxs = 0;
3012e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3013e7931f94SStefano Zampini     ierr = PetscMemcpy(&l2gmap_indices[buf_size_idxs],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
3014e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
3015e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3016e7931f94SStefano Zampini   }
3017e7931f94SStefano Zampini   ierr = PetscSortRemoveDupsInt(&buf_size_idxs,l2gmap_indices);CHKERRQ(ierr);
3018e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingCreate(comm,buf_size_idxs,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
3019e7931f94SStefano Zampini   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
3020e7931f94SStefano Zampini 
3021e7931f94SStefano Zampini   /* infer new local matrix type from received local matrices type */
3022e7931f94SStefano Zampini   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
3023e7931f94SStefano 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) */
3024e7931f94SStefano Zampini   new_local_type_private = MATAIJ_PRIVATE;
3025e7931f94SStefano Zampini   new_local_type = MATSEQAIJ;
3026e7931f94SStefano Zampini   if (n_recvs) {
3027be4bc593SStefano Zampini     new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
3028e7931f94SStefano Zampini     ptr_idxs = recv_buffer_idxs;
3029e7931f94SStefano Zampini     for (i=0;i<n_recvs;i++) {
3030e7931f94SStefano Zampini       if ((PetscInt)new_local_type_private != *ptr_idxs) {
3031e7931f94SStefano Zampini         new_local_type_private = MATAIJ_PRIVATE;
3032e7931f94SStefano Zampini         break;
3033e7931f94SStefano Zampini       }
3034e7931f94SStefano Zampini       ptr_idxs += olengths_idxs[i];
3035e7931f94SStefano Zampini     }
3036e7931f94SStefano Zampini     switch (new_local_type_private) {
3037e7931f94SStefano Zampini       case MATDENSE_PRIVATE: /* subassembling of dense matrices does not give a dense matrix! */
3038e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
3039e7931f94SStefano Zampini         bs = 1;
3040e7931f94SStefano Zampini         break;
3041e7931f94SStefano Zampini       case MATAIJ_PRIVATE:
3042e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
3043e7931f94SStefano Zampini         bs = 1;
3044e7931f94SStefano Zampini         break;
3045e7931f94SStefano Zampini       case MATBAIJ_PRIVATE:
3046e7931f94SStefano Zampini         new_local_type = MATSEQBAIJ;
3047e7931f94SStefano Zampini         break;
3048e7931f94SStefano Zampini       case MATSBAIJ_PRIVATE:
3049e7931f94SStefano Zampini         new_local_type = MATSEQSBAIJ;
3050e7931f94SStefano Zampini         break;
3051e7931f94SStefano Zampini       default:
3052e7931f94SStefano Zampini         SETERRQ2(comm,PETSC_ERR_LIB,"Unkwown private type %d in %s",new_local_type_private,__FUNCT__);
3053e7931f94SStefano Zampini         break;
3054e7931f94SStefano Zampini     }
3055e7931f94SStefano Zampini   }
3056e7931f94SStefano Zampini 
3057*70cf5478SStefano Zampini   /* create MATIS object if needed */
3058*70cf5478SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
3059e7931f94SStefano Zampini     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
3060*70cf5478SStefano Zampini     ierr = MatCreateIS(comm,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,mat_n);CHKERRQ(ierr);
3061*70cf5478SStefano Zampini   } else {
3062*70cf5478SStefano Zampini     /* it also destroys the local matrices */
3063*70cf5478SStefano Zampini     ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
3064*70cf5478SStefano Zampini   }
3065e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
3066*70cf5478SStefano Zampini   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
3067e7931f94SStefano Zampini   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
3068e7931f94SStefano Zampini   ierr = MatSetUp(local_mat);CHKERRQ(ierr); /* WARNING -> no preallocation yet */
3069e7931f94SStefano Zampini 
3070e7931f94SStefano Zampini   /* set values */
3071e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3072e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
3073e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
3074e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3075e7931f94SStefano Zampini     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
3076e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
3077*70cf5478SStefano Zampini       ierr = MatSetValues(*mat_n,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
3078e7931f94SStefano Zampini       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3079e7931f94SStefano Zampini       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3080e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
3081e7931f94SStefano Zampini     }
3082e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3083e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
3084e7931f94SStefano Zampini   }
3085e7931f94SStefano Zampini   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3086e7931f94SStefano Zampini   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3087*70cf5478SStefano Zampini   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3088*70cf5478SStefano Zampini   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3089e7931f94SStefano Zampini 
3090e7931f94SStefano Zampini   { /* check */
3091e7931f94SStefano Zampini     Vec       lvec,rvec;
3092e7931f94SStefano Zampini     PetscReal infty_error;
3093e7931f94SStefano Zampini 
3094e7931f94SStefano Zampini     ierr = MatGetVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
3095e7931f94SStefano Zampini     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
3096e7931f94SStefano Zampini     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
3097e7931f94SStefano Zampini     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
3098*70cf5478SStefano Zampini     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
3099e7931f94SStefano Zampini     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3100e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
3101e7931f94SStefano Zampini     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
3102e7931f94SStefano Zampini     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
3103e7931f94SStefano Zampini   }
3104e7931f94SStefano Zampini 
3105e7931f94SStefano Zampini   /* free workspace */
3106e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
3107e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
3108e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3109e7931f94SStefano Zampini   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
3110e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3111e7931f94SStefano Zampini   if (isdense) {
3112e7931f94SStefano Zampini     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
3113e7931f94SStefano Zampini     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
3114e7931f94SStefano Zampini   } else {
3115e7931f94SStefano Zampini     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
3116e7931f94SStefano Zampini   }
3117e7931f94SStefano Zampini   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
3118e7931f94SStefano Zampini   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
3119e7931f94SStefano Zampini   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
3120e7931f94SStefano Zampini   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
3121e7931f94SStefano Zampini   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
3122e7931f94SStefano Zampini   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
3123e7931f94SStefano Zampini   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
3124e7931f94SStefano Zampini   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
3125e7931f94SStefano Zampini   ierr = PetscFree(onodes);CHKERRQ(ierr);
3126e7931f94SStefano Zampini   PetscFunctionReturn(0);
3127e7931f94SStefano Zampini }
3128a57a6d2fSStefano Zampini 
3129c8587f34SStefano Zampini #undef __FUNCT__
3130c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
3131c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
3132c8587f34SStefano Zampini {
3133c8587f34SStefano Zampini   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
3134c8587f34SStefano Zampini   PC_IS                  *pcis = (PC_IS*)pc->data;
313520a2ab83SStefano Zampini   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
31369881197aSStefano Zampini   MatNullSpace           CoarseNullSpace=NULL;
313720a2ab83SStefano Zampini   ISLocalToGlobalMapping coarse_islg;
313820a2ab83SStefano Zampini   IS                     coarse_is;
3139f4ddd8eeSStefano Zampini   PetscInt               max_it;
3140f9eb5b7dSStefano Zampini   PetscInt               im_active=-1,active_procs=-1;
3141f9eb5b7dSStefano Zampini   PC                     pc_temp;
3142c8587f34SStefano Zampini   PCType                 coarse_pc_type;
3143c8587f34SStefano Zampini   KSPType                coarse_ksp_type;
3144f9eb5b7dSStefano Zampini   PetscBool              multilevel_requested,multilevel_allowed;
3145cbcc2c2aSStefano Zampini   PetscBool              setsym,issym,isherm,ispreonly,isbddc,isnn,coarse_reuse;
3146f9eb5b7dSStefano Zampini   MatStructure           matstruct;
31479881197aSStefano Zampini   PetscErrorCode         ierr;
3148fdc09c96SStefano Zampini 
3149c8587f34SStefano Zampini   PetscFunctionBegin;
3150c8587f34SStefano Zampini   /* Assign global numbering to coarse dofs */
3151fa7f1dd8SStefano Zampini   if (pcbddc->new_primal_space) { /* a new primal space is present, so recompute global numbering */
3152fa7f1dd8SStefano Zampini     PetscInt ocoarse_size;
3153fa7f1dd8SStefano Zampini     ocoarse_size = pcbddc->coarse_size;
3154f4ddd8eeSStefano Zampini     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3155f4ddd8eeSStefano Zampini     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
3156f4ddd8eeSStefano Zampini     /* see if we can avoid some work */
3157fa7f1dd8SStefano Zampini     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
3158fa7f1dd8SStefano Zampini       if (ocoarse_size != pcbddc->coarse_size) { /* ...but with different size, so reset it and set reuse flag to false */
3159727cdba6SStefano Zampini         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3160fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_FALSE;
3161fa7f1dd8SStefano Zampini       } else { /* we can safely reuse already computed coarse matrix */
3162fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_TRUE;
3163f4ddd8eeSStefano Zampini       }
3164fa7f1dd8SStefano Zampini     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
3165fa7f1dd8SStefano Zampini       coarse_reuse = PETSC_FALSE;
3166f4ddd8eeSStefano Zampini     }
3167*70cf5478SStefano Zampini     /* reset any subassembling information */
3168*70cf5478SStefano Zampini     ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3169fa7f1dd8SStefano Zampini   } else { /* primal space has not been changed, so we can reuse coarse matrix */
3170fa7f1dd8SStefano Zampini     coarse_reuse = PETSC_TRUE;
3171f4ddd8eeSStefano Zampini   }
3172c8587f34SStefano Zampini 
3173cbcc2c2aSStefano Zampini   /* test if we can go multilevel */
3174f9eb5b7dSStefano Zampini   multilevel_allowed = PETSC_FALSE;
3175f9eb5b7dSStefano Zampini   multilevel_requested = PETSC_FALSE;
3176f9eb5b7dSStefano Zampini   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
3177f9eb5b7dSStefano Zampini   if (multilevel_requested) {
31782b510759SStefano Zampini     /* count "active processes" */
31792b510759SStefano Zampini     im_active = !!(pcis->n);
31802b510759SStefano Zampini     ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
31812b510759SStefano Zampini     if (active_procs/pcbddc->coarsening_ratio < 2) {
3182f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_FALSE;
31832b510759SStefano Zampini     } else {
3184f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_TRUE;
3185c8587f34SStefano Zampini     }
3186c8587f34SStefano Zampini   }
3187e7931f94SStefano Zampini 
3188f9eb5b7dSStefano Zampini   /* set defaults for coarse KSP and PC */
3189f9eb5b7dSStefano Zampini   if (multilevel_allowed) {
3190f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPRICHARDSON;
3191f9eb5b7dSStefano Zampini     coarse_pc_type = PCBDDC;
3192f9eb5b7dSStefano Zampini   } else {
3193f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPPREONLY;
3194f9eb5b7dSStefano Zampini     coarse_pc_type = PCREDUNDANT;
3195c8587f34SStefano Zampini   }
3196c8587f34SStefano Zampini 
3197f9eb5b7dSStefano Zampini   /* create the coarse KSP object only once with defaults */
3198f9eb5b7dSStefano Zampini   if (!pcbddc->coarse_ksp) {
3199e604994aSStefano Zampini     char prefix[256],str_level[3];
3200e604994aSStefano Zampini     size_t len;
3201f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_ksp);CHKERRQ(ierr);
3202c8587f34SStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
3203f9eb5b7dSStefano Zampini     ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
3204c8587f34SStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
3205c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3206c8587f34SStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
3207e604994aSStefano Zampini     /* prefix */
3208e604994aSStefano Zampini     ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
3209e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
3210e604994aSStefano Zampini     if (!pcbddc->current_level) {
3211e604994aSStefano Zampini       ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
3212e604994aSStefano Zampini       ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
3213c8587f34SStefano Zampini     } else {
3214e604994aSStefano Zampini       ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
3215e604994aSStefano Zampini       if (pcbddc->current_level>1) len -= 2;
3216e604994aSStefano Zampini       ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
3217e604994aSStefano Zampini       *(prefix+len)='\0';
3218e604994aSStefano Zampini       sprintf(str_level,"%d_",(int)(pcbddc->current_level));
3219e604994aSStefano Zampini       ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
3220e604994aSStefano Zampini     }
3221e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
3222f9eb5b7dSStefano Zampini   }
3223f9eb5b7dSStefano Zampini   /* allow user customization */
322485c4d303SStefano Zampini   /* ierr = PetscPrintf(PETSC_COMM_WORLD,"Type of %s before setting from options %s\n",((PetscObject)pcbddc->coarse_ksp)->prefix,((PetscObject)pcbddc->coarse_ksp)->type_name);CHKERRQ(ierr); */
3225f9eb5b7dSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
322685c4d303SStefano Zampini   /* ierr = PetscPrintf(PETSC_COMM_WORLD,"Type of %s after setting from options %s\n",((PetscObject)pcbddc->coarse_ksp)->prefix,((PetscObject)pcbddc->coarse_ksp)->type_name);CHKERRQ(ierr); */
3227f9eb5b7dSStefano Zampini 
3228f9eb5b7dSStefano Zampini   /* get some info after set from options */
3229f9eb5b7dSStefano Zampini   ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3230f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
3231f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
3232f9eb5b7dSStefano Zampini   if (isbddc && !multilevel_allowed) { /* prevent from infinite loop if user as requested bddc pc for coarse solver */
3233f9eb5b7dSStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
3234f9eb5b7dSStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
3235f9eb5b7dSStefano Zampini     isbddc = PETSC_FALSE;
3236f9eb5b7dSStefano Zampini   }
3237f9eb5b7dSStefano Zampini 
32381035eff8SStefano Zampini   /* creates temporary l2gmap and IS for coarse indexes */
32391035eff8SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
32401035eff8SStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
32411035eff8SStefano Zampini 
3242f9eb5b7dSStefano Zampini   /* propagate BDDC info to the next level */
3243f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
3244f9eb5b7dSStefano Zampini   ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
3245f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
32461035eff8SStefano Zampini   if (isbddc) { /* protects from unneded computations */
32471035eff8SStefano Zampini     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
32481035eff8SStefano Zampini     const PetscInt         *idxs;
32491035eff8SStefano Zampini     IS                     *c_isfordofs,c_isneumann;
32501035eff8SStefano Zampini     ISLocalToGlobalMapping tmap;
32511035eff8SStefano Zampini 
32521035eff8SStefano Zampini     /* create map between primal indices (in local representative ordering) and local subdomain numbering */
32531035eff8SStefano Zampini     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
32541035eff8SStefano Zampini     /* allocate space for temporary storage */
32551035eff8SStefano Zampini     ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&tidxs);CHKERRQ(ierr);
32561035eff8SStefano Zampini     ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&tidxs2);CHKERRQ(ierr);
32571035eff8SStefano Zampini     /* dofs splitting */
32581035eff8SStefano Zampini     ierr = PetscMalloc(pcbddc->n_ISForDofsLocal*sizeof(IS),&c_isfordofs);CHKERRQ(ierr);
32591035eff8SStefano Zampini     for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
32608002ef2cSStefano Zampini       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
32611035eff8SStefano Zampini       ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
32621035eff8SStefano Zampini       ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
32631035eff8SStefano Zampini       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
32641035eff8SStefano Zampini       ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
32651035eff8SStefano Zampini       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
32661035eff8SStefano Zampini       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pcbddc->ISForDofsLocal[i]),nout,tidxs2,PETSC_COPY_VALUES,&c_isfordofs[i]);CHKERRQ(ierr);
32678002ef2cSStefano Zampini       /* ierr = ISView(c_isfordofs[i],0);CHKERRQ(ierr); */
32681035eff8SStefano Zampini     }
32691035eff8SStefano Zampini     ierr = PCBDDCSetDofsSplitting(pc_temp,pcbddc->n_ISForDofsLocal,c_isfordofs);CHKERRQ(ierr);
32701035eff8SStefano Zampini     for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
32711035eff8SStefano Zampini       ierr = ISDestroy(&c_isfordofs[i]);CHKERRQ(ierr);
32721035eff8SStefano Zampini     }
32731035eff8SStefano Zampini     ierr = PetscFree(c_isfordofs);CHKERRQ(ierr);
32741035eff8SStefano Zampini     /* neumann boundaries */
32751035eff8SStefano Zampini     if (pcbddc->NeumannBoundariesLocal) {
32768002ef2cSStefano Zampini       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
32771035eff8SStefano Zampini       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
32781035eff8SStefano Zampini       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
32791035eff8SStefano Zampini       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
32801035eff8SStefano Zampini       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
32811035eff8SStefano Zampini       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
32821035eff8SStefano Zampini       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pcbddc->NeumannBoundariesLocal),nout,tidxs2,PETSC_COPY_VALUES,&c_isneumann);CHKERRQ(ierr);
32838002ef2cSStefano Zampini       /* ierr = ISView(c_isneumann,0);CHKERRQ(ierr); */
32841035eff8SStefano Zampini       ierr = PCBDDCSetNeumannBoundaries(pc_temp,c_isneumann);CHKERRQ(ierr);
32851035eff8SStefano Zampini     }
32861035eff8SStefano Zampini     ierr = ISDestroy(&c_isneumann);CHKERRQ(ierr);
32871035eff8SStefano Zampini     ierr = PetscFree(tidxs);CHKERRQ(ierr);
32881035eff8SStefano Zampini     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
32891035eff8SStefano Zampini     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
32901035eff8SStefano Zampini   }
3291f9eb5b7dSStefano Zampini 
3292f9eb5b7dSStefano Zampini   /* creates temporary MATIS object for coarse matrix */
3293a57a6d2fSStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
3294f4ddd8eeSStefano Zampini   ierr = MatCreateIS(PetscObjectComm((PetscObject)pc),1,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size,coarse_islg,&coarse_mat_is);CHKERRQ(ierr);
3295a57a6d2fSStefano Zampini   ierr = MatISSetLocalMat(coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
3296e7931f94SStefano Zampini   ierr = MatAssemblyBegin(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3297e7931f94SStefano Zampini   ierr = MatAssemblyEnd(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
329820a2ab83SStefano Zampini   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
329920a2ab83SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
3300fdc09c96SStefano Zampini 
3301f9eb5b7dSStefano Zampini   /* assemble coarse matrix */
3302f9eb5b7dSStefano Zampini   if (isbddc || isnn) {
3303*70cf5478SStefano Zampini     if (!pcbddc->coarse_subassembling) { /* subassembling info is not present */
3304*70cf5478SStefano Zampini       ierr = MatISGetSubassemblingPattern(coarse_mat_is,pcbddc->coarsening_ratio,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3305*70cf5478SStefano Zampini     }
3306*70cf5478SStefano Zampini     if (coarse_reuse) {
3307*70cf5478SStefano Zampini       ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL,NULL);CHKERRQ(ierr);
3308*70cf5478SStefano Zampini       ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
3309*70cf5478SStefano Zampini       ierr = MatISSubassemble(coarse_mat_is,pcbddc->coarse_subassembling,pcbddc->coarsening_ratio,MAT_REUSE_MATRIX,&coarse_mat);CHKERRQ(ierr);
3310*70cf5478SStefano Zampini     } else {
3311*70cf5478SStefano Zampini       ierr = MatISSubassemble(coarse_mat_is,pcbddc->coarse_subassembling,pcbddc->coarsening_ratio,MAT_INITIAL_MATRIX,&coarse_mat);CHKERRQ(ierr);
3312*70cf5478SStefano Zampini     }
3313fa7f1dd8SStefano Zampini   } else {
3314fa7f1dd8SStefano Zampini     if (coarse_reuse) {
3315fa7f1dd8SStefano Zampini       ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL,NULL);CHKERRQ(ierr);
3316fa7f1dd8SStefano Zampini       ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
3317fa7f1dd8SStefano Zampini       ierr = MatISGetMPIXAIJ(coarse_mat_is,MATMPIAIJ,MAT_REUSE_MATRIX,&coarse_mat);CHKERRQ(ierr);
3318fa7f1dd8SStefano Zampini     } else {
3319fa7f1dd8SStefano Zampini       ierr = MatISGetMPIXAIJ(coarse_mat_is,MATMPIAIJ,MAT_INITIAL_MATRIX,&coarse_mat);CHKERRQ(ierr);
3320fa7f1dd8SStefano Zampini     }
3321c8587f34SStefano Zampini   }
33222b510759SStefano Zampini   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
33239881197aSStefano Zampini 
3324f9eb5b7dSStefano Zampini   /* create local to global scatters for coarse problem */
3325f4ddd8eeSStefano Zampini   if (pcbddc->new_primal_space) {
3326f4ddd8eeSStefano Zampini     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3327f4ddd8eeSStefano Zampini     ierr = VecDestroy(&pcbddc->coarse_rhs);CHKERRQ(ierr);
3328f4ddd8eeSStefano Zampini     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3329f9eb5b7dSStefano Zampini     ierr = MatGetVecs(coarse_mat,&pcbddc->coarse_vec,&pcbddc->coarse_rhs);CHKERRQ(ierr);
3330f9eb5b7dSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3331f4ddd8eeSStefano Zampini   }
3332f9eb5b7dSStefano Zampini   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
3333f9eb5b7dSStefano Zampini 
3334f9eb5b7dSStefano Zampini   /* propagate symmetry info to coarse matrix */
3335cbcc2c2aSStefano Zampini   issym = PETSC_FALSE;
3336cbcc2c2aSStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
3337f9eb5b7dSStefano Zampini   ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,issym);CHKERRQ(ierr);
3338cbcc2c2aSStefano Zampini   isherm = PETSC_FALSE;
3339cbcc2c2aSStefano Zampini   ierr = MatIsHermitianKnown(pc->pmat,&setsym,&isherm);CHKERRQ(ierr);
33405a16e3a0SStefano Zampini   ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
3341f9eb5b7dSStefano Zampini 
3342b8ffe317SStefano Zampini   /* Compute coarse null space (special handling by BDDC only) */
3343b8ffe317SStefano Zampini   if (pcbddc->NullSpace) {
3344b8ffe317SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCoarse(pc,coarse_mat,&CoarseNullSpace);CHKERRQ(ierr);
3345b8ffe317SStefano Zampini     if (isbddc) {
3346b8ffe317SStefano Zampini       ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
3347b8ffe317SStefano Zampini     } else {
3348c8587f34SStefano Zampini       ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
3349c8587f34SStefano Zampini     }
3350c8587f34SStefano Zampini   }
3351c8587f34SStefano Zampini 
3352f9eb5b7dSStefano Zampini   /* set operators */
3353f9eb5b7dSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
3354f9eb5b7dSStefano Zampini   ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat,matstruct);CHKERRQ(ierr);
3355f9eb5b7dSStefano Zampini 
3356f9eb5b7dSStefano Zampini   /* additional KSP customization */
3357f9eb5b7dSStefano Zampini   ierr = KSPGetTolerances(pcbddc->coarse_ksp,NULL,NULL,NULL,&max_it);CHKERRQ(ierr);
3358f9eb5b7dSStefano Zampini   if (max_it < 5) {
3359c8587f34SStefano Zampini     ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
3360f9eb5b7dSStefano Zampini   }
3361f9eb5b7dSStefano Zampini 
3362f9eb5b7dSStefano Zampini   /* print some info if requested */
3363f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
3364f9eb5b7dSStefano Zampini     ierr = KSPGetType(pcbddc->coarse_ksp,&coarse_ksp_type);CHKERRQ(ierr);
3365f9eb5b7dSStefano Zampini     ierr = PCGetType(pc_temp,&coarse_pc_type);CHKERRQ(ierr);
3366f9eb5b7dSStefano Zampini     if (!multilevel_allowed) {
3367f9eb5b7dSStefano Zampini       if (multilevel_requested) {
3368f9eb5b7dSStefano 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);
3369f9eb5b7dSStefano Zampini       } else if (pcbddc->max_levels) {
3370f9eb5b7dSStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
3371c8587f34SStefano Zampini       }
3372c8587f34SStefano Zampini     }
3373e604994aSStefano 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);
3374f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3375c8587f34SStefano Zampini   }
3376f9eb5b7dSStefano Zampini 
3377f9eb5b7dSStefano Zampini   /* setup coarse ksp */
3378f9eb5b7dSStefano Zampini   ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
3379f9eb5b7dSStefano Zampini 
3380cbcc2c2aSStefano Zampini   /* Check coarse problem if in debug mode or if solving with an iterative method */
3381cbcc2c2aSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
3382cbcc2c2aSStefano Zampini   if (pcbddc->dbg_flag || !ispreonly) {
3383c8587f34SStefano Zampini     KSP       check_ksp;
33842b510759SStefano Zampini     KSPType   check_ksp_type;
3385c8587f34SStefano Zampini     PC        check_pc;
3386c8587f34SStefano Zampini     Vec       check_vec;
3387c8587f34SStefano Zampini     PetscReal abs_infty_error,infty_error,lambda_min,lambda_max;
33882b510759SStefano Zampini     PetscInt  its;
3389cbcc2c2aSStefano Zampini     PetscBool compute;
3390c8587f34SStefano Zampini 
33912b510759SStefano Zampini     /* Create ksp object suitable for estimation of extreme eigenvalues */
3392f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&check_ksp);CHKERRQ(ierr);
3393fdc635d7SStefano Zampini     ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
3394f4ddd8eeSStefano Zampini     ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
33952b510759SStefano Zampini     if (ispreonly) {
33962b510759SStefano Zampini       check_ksp_type = KSPPREONLY;
3397f9eb5b7dSStefano Zampini       compute = PETSC_FALSE;
33982b510759SStefano Zampini     } else {
3399cbcc2c2aSStefano Zampini       check_ksp_type = KSPGMRES;
3400f9eb5b7dSStefano Zampini       compute = PETSC_TRUE;
3401c8587f34SStefano Zampini     }
3402c8587f34SStefano Zampini     ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
3403f9eb5b7dSStefano Zampini     ierr = KSPSetComputeSingularValues(check_ksp,compute);CHKERRQ(ierr);
3404c8587f34SStefano Zampini     ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
3405c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
3406c8587f34SStefano Zampini     ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
3407c8587f34SStefano Zampini     /* create random vec */
3408c8587f34SStefano Zampini     ierr = VecDuplicate(pcbddc->coarse_vec,&check_vec);CHKERRQ(ierr);
3409c8587f34SStefano Zampini     ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
3410c8587f34SStefano Zampini     if (CoarseNullSpace) {
3411c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec);CHKERRQ(ierr);
3412c8587f34SStefano Zampini     }
3413fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3414c8587f34SStefano Zampini     /* solve coarse problem */
3415c8587f34SStefano Zampini     ierr = KSPSolve(check_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
3416c8587f34SStefano Zampini     if (CoarseNullSpace) {
3417c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,pcbddc->coarse_vec);CHKERRQ(ierr);
3418c8587f34SStefano Zampini     }
3419cbcc2c2aSStefano Zampini     /* set eigenvalue estimation if preonly has not been requested */
3420cbcc2c2aSStefano Zampini     if (!ispreonly) {
3421cbcc2c2aSStefano Zampini       ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
34228002ef2cSStefano Zampini       /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Coarse problem eigenvalues: %1.6e %1.6e\n",lambda_min,lambda_max);CHKERRQ(ierr); */
3423cbcc2c2aSStefano Zampini       ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max,lambda_min);CHKERRQ(ierr);
3424cbcc2c2aSStefano Zampini       ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
3425cbcc2c2aSStefano Zampini     }
3426c8587f34SStefano Zampini     /* check coarse problem residual error */
3427cbcc2c2aSStefano Zampini     if (pcbddc->dbg_flag) {
3428c8587f34SStefano Zampini       ierr = VecAXPY(check_vec,-1.0,pcbddc->coarse_vec);CHKERRQ(ierr);
3429c8587f34SStefano Zampini       ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3430fdc635d7SStefano Zampini       ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3431c8587f34SStefano Zampini       ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
3432c8587f34SStefano Zampini       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
3433e604994aSStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem (%s) details\n",((PetscObject)(pcbddc->coarse_ksp))->prefix);CHKERRQ(ierr);
3434e604994aSStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
3435e604994aSStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
34362b510759SStefano Zampini       if (!ispreonly) {
343720a2ab83SStefano Zampini         ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
3438f9eb5b7dSStefano 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);
3439c8587f34SStefano Zampini       }
34402b510759SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3441cbcc2c2aSStefano Zampini     }
3442c8587f34SStefano Zampini     ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
3443c8587f34SStefano Zampini   }
3444cbcc2c2aSStefano Zampini 
3445cbcc2c2aSStefano Zampini   /* print additional info */
3446cbcc2c2aSStefano Zampini   if (pcbddc->dbg_flag) {
3447cbcc2c2aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
3448cbcc2c2aSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3449cbcc2c2aSStefano Zampini     ierr = KSPView(pcbddc->coarse_ksp,pcbddc->dbg_viewer);CHKERRQ(ierr);
3450cbcc2c2aSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3451cbcc2c2aSStefano Zampini   }
3452cbcc2c2aSStefano Zampini 
34532b510759SStefano Zampini   /* free memory */
3454c8587f34SStefano Zampini   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
3455fdc635d7SStefano Zampini   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
3456c8587f34SStefano Zampini   PetscFunctionReturn(0);
3457c8587f34SStefano Zampini }
3458674ae819SStefano Zampini 
3459f34684f1SStefano Zampini #undef __FUNCT__
3460f34684f1SStefano Zampini #define __FUNCT__ "PCBDDCComputePrimalNumbering"
3461f34684f1SStefano Zampini PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
3462f34684f1SStefano Zampini {
3463f34684f1SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3464f34684f1SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
3465f34684f1SStefano Zampini   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
3466727cdba6SStefano Zampini   PetscInt       i,coarse_size;
3467727cdba6SStefano Zampini   PetscInt       *local_primal_indices;
3468f34684f1SStefano Zampini   PetscErrorCode ierr;
3469f34684f1SStefano Zampini 
3470f34684f1SStefano Zampini   PetscFunctionBegin;
3471f34684f1SStefano Zampini   /* Compute global number of coarse dofs */
347289c96988SStefano Zampini   if (!pcbddc->primal_indices_local_idxs && pcbddc->local_primal_size) {
347389c96988SStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Local primal indices have not been created");
3474727cdba6SStefano Zampini   }
3475727cdba6SStefano 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);
3476f34684f1SStefano Zampini 
3477f34684f1SStefano Zampini   /* check numbering */
3478f34684f1SStefano Zampini   if (pcbddc->dbg_flag) {
3479f34684f1SStefano Zampini     PetscScalar coarsesum,*array;
3480f34684f1SStefano Zampini 
3481f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3482f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3483f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
34840fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
3485f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
3486f34684f1SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
3487727cdba6SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
3488f34684f1SStefano Zampini     }
3489f34684f1SStefano Zampini     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
3490f34684f1SStefano Zampini     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
3491f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3492f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3493f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3494f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3495f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3496f34684f1SStefano Zampini     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3497f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3498f34684f1SStefano Zampini       if (array[i] == 1.0) {
3499f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %d owned by a single process!\n",PetscGlobalRank,i);CHKERRQ(ierr);
3500f34684f1SStefano Zampini       }
3501f34684f1SStefano Zampini     }
3502f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3503f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3504f34684f1SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
3505f34684f1SStefano Zampini     }
3506f34684f1SStefano Zampini     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3507f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3508f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3509f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3510f34684f1SStefano Zampini     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
3511f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
3512f34684f1SStefano Zampini     if (pcbddc->dbg_flag > 1) {
3513f34684f1SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
3514f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3515f34684f1SStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
3516f34684f1SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
3517727cdba6SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_primal_indices[%d]=%d (%d)\n",i,local_primal_indices[i],pcbddc->primal_indices_local_idxs[i]);
3518f34684f1SStefano Zampini       }
3519f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3520f34684f1SStefano Zampini     }
3521f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3522f34684f1SStefano Zampini   }
3523f34684f1SStefano Zampini   /* get back data */
3524f34684f1SStefano Zampini   *coarse_size_n = coarse_size;
3525f34684f1SStefano Zampini   *local_primal_indices_n = local_primal_indices;
3526674ae819SStefano Zampini   PetscFunctionReturn(0);
3527674ae819SStefano Zampini }
3528674ae819SStefano Zampini 
3529e456f2a8SStefano Zampini #undef __FUNCT__
3530e456f2a8SStefano Zampini #define __FUNCT__ "PCBDDCGlobalToLocal"
3531e456f2a8SStefano Zampini PetscErrorCode PCBDDCGlobalToLocal(PC pc,VecScatter ctx,IS globalis,IS* localis)
3532e456f2a8SStefano Zampini {
3533e456f2a8SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
3534e456f2a8SStefano Zampini   IS             localis_t;
3535e456f2a8SStefano Zampini   PetscInt       i,lsize,*idxs;
3536e456f2a8SStefano Zampini   PetscScalar    *vals;
3537e456f2a8SStefano Zampini   PetscErrorCode ierr;
3538e456f2a8SStefano Zampini 
3539e456f2a8SStefano Zampini   PetscFunctionBegin;
3540e456f2a8SStefano Zampini   /* get dirichlet indices in local ordering exploiting local to global map */
3541e456f2a8SStefano Zampini   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
3542e456f2a8SStefano Zampini   ierr = PetscMalloc(lsize*sizeof(PetscScalar),&vals);CHKERRQ(ierr);
3543e456f2a8SStefano Zampini   for (i=0;i<lsize;i++) vals[i] = 1.0;
3544e456f2a8SStefano Zampini   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
3545e456f2a8SStefano Zampini   ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
35461035eff8SStefano Zampini   if (idxs) { /* multilevel guard */
3547e456f2a8SStefano Zampini     ierr = VecSetValues(pcis->vec1_global,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
35481035eff8SStefano Zampini   }
3549e456f2a8SStefano Zampini   ierr = VecAssemblyBegin(pcis->vec1_global);CHKERRQ(ierr);
3550e456f2a8SStefano Zampini   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
3551e456f2a8SStefano Zampini   ierr = PetscFree(vals);CHKERRQ(ierr);
3552e456f2a8SStefano Zampini   ierr = VecAssemblyEnd(pcis->vec1_global);CHKERRQ(ierr);
3553e456f2a8SStefano Zampini   /* now compute dirichlet set in local ordering */
3554e456f2a8SStefano Zampini   ierr = VecScatterBegin(ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3555e456f2a8SStefano Zampini   ierr = VecScatterEnd(ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3556e456f2a8SStefano Zampini   ierr = VecGetArrayRead(pcis->vec1_N,(const PetscScalar**)&vals);CHKERRQ(ierr);
3557e456f2a8SStefano Zampini   for (i=0,lsize=0;i<pcis->n;i++) {
3558e456f2a8SStefano Zampini     if (vals[i] == 1.0) {
3559e456f2a8SStefano Zampini       lsize++;
3560e456f2a8SStefano Zampini     }
3561e456f2a8SStefano Zampini   }
3562e456f2a8SStefano Zampini   ierr = PetscMalloc(lsize*sizeof(PetscInt),&idxs);CHKERRQ(ierr);
3563e456f2a8SStefano Zampini   for (i=0,lsize=0;i<pcis->n;i++) {
3564e456f2a8SStefano Zampini     if (vals[i] == 1.0) {
3565e456f2a8SStefano Zampini       idxs[lsize++] = i;
3566e456f2a8SStefano Zampini     }
3567e456f2a8SStefano Zampini   }
3568e456f2a8SStefano Zampini   ierr = VecRestoreArrayRead(pcis->vec1_N,(const PetscScalar**)&vals);CHKERRQ(ierr);
3569e456f2a8SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
3570e456f2a8SStefano Zampini   *localis = localis_t;
3571e456f2a8SStefano Zampini   PetscFunctionReturn(0);
3572e456f2a8SStefano Zampini }
3573