xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 95ecbf38f54bf907855fa510dba2b327f79c8484)
1ab5c6b0cSJed Brown #include <../src/ksp/pc/impls/bddc/bddc.h>
2ab5c6b0cSJed Brown #include <../src/ksp/pc/impls/bddc/bddcprivate.h>
3674ae819SStefano Zampini #include <petscblaslapack.h>
4674ae819SStefano Zampini 
5674ae819SStefano Zampini #undef __FUNCT__
6c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpSolvers"
7c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpSolvers(PC pc)
8c8587f34SStefano Zampini {
9c8587f34SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
108629588bSStefano Zampini   PetscScalar    *coarse_submat_vals;
11c8587f34SStefano Zampini   PetscErrorCode ierr;
12c8587f34SStefano Zampini 
13c8587f34SStefano Zampini   PetscFunctionBegin;
14c8587f34SStefano Zampini   /* Compute matrix after change of basis and extract local submatrices */
15c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalMatrices(pc);CHKERRQ(ierr);
16c8587f34SStefano Zampini 
17f4ddd8eeSStefano Zampini   /* Setup local scatters R_to_B and (optionally) R_to_D */
18f4ddd8eeSStefano Zampini   /* PCBDDCSetUpLocalWorkVectors and PCBDDCSetUpLocalMatrices should be called first! */
19c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
20c8587f34SStefano Zampini 
21c8587f34SStefano Zampini   /* Setup local solvers ksp_D and ksp_R */
220fccc4e9SStefano Zampini   /* PCBDDCSetUpLocalScatters should be called first! */
23c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalSolvers(pc);CHKERRQ(ierr);
24c8587f34SStefano Zampini 
25c8587f34SStefano Zampini   /* Change global null space passed in by the user if change of basis has been requested */
26c8587f34SStefano Zampini   if (pcbddc->NullSpace && pcbddc->use_change_of_basis) {
27c8587f34SStefano Zampini     ierr = PCBDDCNullSpaceAdaptGlobal(pc);CHKERRQ(ierr);
28c8587f34SStefano Zampini   }
29c8587f34SStefano Zampini 
308629588bSStefano Zampini   /*
318629588bSStefano Zampini      Setup local correction and local part of coarse basis.
328629588bSStefano Zampini      Gives back the dense local part of the coarse matrix in column major ordering
338629588bSStefano Zampini   */
3447f4ddc3SStefano Zampini   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
358629588bSStefano Zampini 
368629588bSStefano Zampini   /* Compute total number of coarse nodes and setup coarse solver */
378629588bSStefano Zampini   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
388629588bSStefano Zampini 
398629588bSStefano Zampini   /* free */
408629588bSStefano Zampini   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
41c8587f34SStefano Zampini   PetscFunctionReturn(0);
42c8587f34SStefano Zampini }
43c8587f34SStefano Zampini 
44c8587f34SStefano Zampini #undef __FUNCT__
45674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetCustomization"
46674ae819SStefano Zampini PetscErrorCode PCBDDCResetCustomization(PC pc)
47674ae819SStefano Zampini {
48674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
49674ae819SStefano Zampini   PetscErrorCode ierr;
50674ae819SStefano Zampini 
51674ae819SStefano Zampini   PetscFunctionBegin;
52674ae819SStefano Zampini   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
53674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
54674ae819SStefano Zampini   ierr = MatNullSpaceDestroy(&pcbddc->NullSpace);CHKERRQ(ierr);
55674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
56785d1243SStefano Zampini   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
57674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
58f4ddd8eeSStefano Zampini   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
59f4ddd8eeSStefano Zampini   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
60785d1243SStefano Zampini   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
6163602bcaSStefano Zampini   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
6263602bcaSStefano Zampini   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
63674ae819SStefano Zampini   PetscFunctionReturn(0);
64674ae819SStefano Zampini }
65674ae819SStefano Zampini 
66674ae819SStefano Zampini #undef __FUNCT__
67674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetTopography"
68674ae819SStefano Zampini PetscErrorCode PCBDDCResetTopography(PC pc)
69674ae819SStefano Zampini {
70674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
71674ae819SStefano Zampini   PetscErrorCode ierr;
72674ae819SStefano Zampini 
73674ae819SStefano Zampini   PetscFunctionBegin;
74674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
75674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
76674ae819SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
77674ae819SStefano Zampini   PetscFunctionReturn(0);
78674ae819SStefano Zampini }
79674ae819SStefano Zampini 
80674ae819SStefano Zampini #undef __FUNCT__
81674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetSolvers"
82674ae819SStefano Zampini PetscErrorCode PCBDDCResetSolvers(PC pc)
83674ae819SStefano Zampini {
84674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
85674ae819SStefano Zampini   PetscErrorCode ierr;
86674ae819SStefano Zampini 
87674ae819SStefano Zampini   PetscFunctionBegin;
88674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
89674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_rhs);CHKERRQ(ierr);
90674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
91674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
9215aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
9315aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
94674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
95674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
96674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
97674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
98674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
99674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
1008ce42a96SStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
101674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
102674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
103674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
104f4ddd8eeSStefano Zampini   ierr = KSPDestroy(&pcbddc->ksp_D);CHKERRQ(ierr);
105f4ddd8eeSStefano Zampini   ierr = KSPDestroy(&pcbddc->ksp_R);CHKERRQ(ierr);
106f4ddd8eeSStefano Zampini   ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
107f4ddd8eeSStefano Zampini   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
108727cdba6SStefano Zampini   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
109f4ddd8eeSStefano Zampini   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
11070cf5478SStefano Zampini   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
1116e683305SStefano Zampini   ierr = ISDestroy(&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
112674ae819SStefano Zampini   PetscFunctionReturn(0);
113674ae819SStefano Zampini }
114674ae819SStefano Zampini 
115674ae819SStefano Zampini #undef __FUNCT__
116f4ddd8eeSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalWorkVectors"
117f4ddd8eeSStefano Zampini PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
1186bfb1811SStefano Zampini {
1196bfb1811SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1206bfb1811SStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
1216bfb1811SStefano Zampini   VecType        impVecType;
122e9189074SStefano Zampini   PetscInt       n_constraints,n_R,old_size;
1236bfb1811SStefano Zampini   PetscErrorCode ierr;
1246bfb1811SStefano Zampini 
1256bfb1811SStefano Zampini   PetscFunctionBegin;
126f4ddd8eeSStefano Zampini   if (!pcbddc->ConstraintMatrix) {
127f4ddd8eeSStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Constraint matrix has not been created");
128f4ddd8eeSStefano Zampini   }
129e7b262bdSStefano Zampini   /* get sizes */
130e9189074SStefano Zampini   n_constraints = pcbddc->local_primal_size - pcbddc->n_actual_vertices;
131e9189074SStefano Zampini   n_R = pcis->n-pcbddc->n_actual_vertices;
1326bfb1811SStefano Zampini   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
133e7b262bdSStefano Zampini   /* local work vectors (try to avoid unneeded work)*/
134e7b262bdSStefano Zampini   /* R nodes */
135e7b262bdSStefano Zampini   old_size = -1;
136e7b262bdSStefano Zampini   if (pcbddc->vec1_R) {
137e7b262bdSStefano Zampini     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
138e7b262bdSStefano Zampini   }
139e7b262bdSStefano Zampini   if (n_R != old_size) {
140e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
141e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
1426bfb1811SStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
1436bfb1811SStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
1446bfb1811SStefano Zampini     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
1456bfb1811SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
146e7b262bdSStefano Zampini   }
147e7b262bdSStefano Zampini   /* local primal dofs */
148e7b262bdSStefano Zampini   old_size = -1;
149e7b262bdSStefano Zampini   if (pcbddc->vec1_P) {
150e7b262bdSStefano Zampini     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
151e7b262bdSStefano Zampini   }
152e9189074SStefano Zampini   if (pcbddc->local_primal_size != old_size) {
153e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
15483b7ccabSStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
155e9189074SStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
1566bfb1811SStefano Zampini     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
157e7b262bdSStefano Zampini   }
158e7b262bdSStefano Zampini   /* local explicit constraints */
159e7b262bdSStefano Zampini   old_size = -1;
160e7b262bdSStefano Zampini   if (pcbddc->vec1_C) {
161e7b262bdSStefano Zampini     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
162e7b262bdSStefano Zampini   }
163e7b262bdSStefano Zampini   if (n_constraints && n_constraints != old_size) {
164e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
16583b7ccabSStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
16683b7ccabSStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
16783b7ccabSStefano Zampini     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
16883b7ccabSStefano Zampini   }
1696bfb1811SStefano Zampini   PetscFunctionReturn(0);
1706bfb1811SStefano Zampini }
1716bfb1811SStefano Zampini 
1726bfb1811SStefano Zampini #undef __FUNCT__
17347f4ddc3SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCorrection"
17447f4ddc3SStefano Zampini PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
17588ebb749SStefano Zampini {
17625084f0cSStefano Zampini   PetscErrorCode         ierr;
17725084f0cSStefano Zampini   /* pointers to pcis and pcbddc */
17888ebb749SStefano Zampini   PC_IS*                 pcis = (PC_IS*)pc->data;
17988ebb749SStefano Zampini   PC_BDDC*               pcbddc = (PC_BDDC*)pc->data;
18025084f0cSStefano Zampini   /* submatrices of local problem */
18188ebb749SStefano Zampini   Mat                    A_RV,A_VR,A_VV;
18225084f0cSStefano Zampini   /* working matrices */
18325084f0cSStefano Zampini   Mat                    M1,M2,M3,C_CR;
18425084f0cSStefano Zampini   /* working vectors */
18525084f0cSStefano Zampini   Vec                    vec1_C,vec2_C,vec1_V,vec2_V;
18625084f0cSStefano Zampini   /* additional working stuff */
18725084f0cSStefano Zampini   IS                     is_aux;
18825084f0cSStefano Zampini   PetscScalar            *coarse_submat_vals; /* TODO: use a PETSc matrix */
18925084f0cSStefano Zampini   const PetscScalar      *array,*row_cmat_values;
19025084f0cSStefano Zampini   const PetscInt         *row_cmat_indices,*idx_R_local;
191e9189074SStefano Zampini   PetscInt               *idx_V_B,*auxindices;
19225084f0cSStefano Zampini   PetscInt               n_vertices,n_constraints,size_of_constraint;
19325084f0cSStefano Zampini   PetscInt               i,j,n_R,n_D,n_B;
194c0553b1fSStefano Zampini   PetscBool              setsym=PETSC_FALSE,issym=PETSC_FALSE,unsymmetric_check;
19545a1bb75SStefano Zampini   /* matrix type (vector type propagated downstream from vec1_C and local matrix type) */
19688ebb749SStefano Zampini   MatType                impMatType;
19725084f0cSStefano Zampini   /* some shortcuts to scalars */
19825084f0cSStefano Zampini   PetscScalar            zero=0.0,one=1.0,m_one=-1.0;
19925084f0cSStefano Zampini   /* for debugging purposes */
20088ebb749SStefano Zampini   PetscReal              *coarsefunctions_errors,*constraints_errors;
20188ebb749SStefano Zampini 
20288ebb749SStefano Zampini   PetscFunctionBegin;
203e9189074SStefano Zampini   /* get number of vertices (corners plus constraints with change of basis)
204e9189074SStefano Zampini      pcbddc->n_actual_vertices stores the actual number of vertices, pcbddc->n_vertices the number of corners computed */
205e9189074SStefano Zampini   n_vertices = pcbddc->n_actual_vertices;
20688ebb749SStefano Zampini   n_constraints = pcbddc->local_primal_size-n_vertices;
20788ebb749SStefano Zampini   /* Set Non-overlapping dimensions */
20888ebb749SStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
20988ebb749SStefano Zampini   n_R = pcis->n-n_vertices;
21088ebb749SStefano Zampini 
21188ebb749SStefano Zampini   /* Set types for local objects needed by BDDC precondtioner */
21288ebb749SStefano Zampini   impMatType = MATSEQDENSE;
21388ebb749SStefano Zampini 
21488ebb749SStefano Zampini   /* Allocating some extra storage just to be safe */
21588ebb749SStefano Zampini   ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&auxindices);CHKERRQ(ierr);
21688ebb749SStefano Zampini   for (i=0;i<pcis->n;i++) auxindices[i]=i;
21788ebb749SStefano Zampini 
21888ebb749SStefano Zampini   /* vertices in boundary numbering */
219785e854fSJed Brown   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
220e9189074SStefano Zampini   ierr = ISGlobalToLocalMappingApply(pcbddc->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->primal_indices_local_idxs,&i,idx_V_B);CHKERRQ(ierr);
22188ebb749SStefano Zampini   if (i != n_vertices) {
22222d5777bSStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %d != %d\n",n_vertices,i);
22388ebb749SStefano Zampini   }
22488ebb749SStefano Zampini 
22588ebb749SStefano Zampini   /* Precompute stuffs needed for preprocessing and application of BDDC*/
22688ebb749SStefano Zampini   if (n_constraints) {
227f4ddd8eeSStefano Zampini     /* see if we can save some allocations */
228f4ddd8eeSStefano Zampini     if (pcbddc->local_auxmat2) {
229f4ddd8eeSStefano Zampini       PetscInt on_R,on_constraints;
230f4ddd8eeSStefano Zampini       ierr = MatGetSize(pcbddc->local_auxmat2,&on_R,&on_constraints);CHKERRQ(ierr);
231f4ddd8eeSStefano Zampini       if (on_R != n_R || on_constraints != n_constraints) {
232f4ddd8eeSStefano Zampini         ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
233f4ddd8eeSStefano Zampini         ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
234f4ddd8eeSStefano Zampini       }
235f4ddd8eeSStefano Zampini     }
23645a1bb75SStefano Zampini     /* work vectors */
23745a1bb75SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec1_C);CHKERRQ(ierr);
23845a1bb75SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec2_C);CHKERRQ(ierr);
23945a1bb75SStefano Zampini     /* auxiliary matrices */
240f4ddd8eeSStefano Zampini     if (!pcbddc->local_auxmat2) {
24188ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->local_auxmat2);CHKERRQ(ierr);
24225084f0cSStefano Zampini       ierr = MatSetSizes(pcbddc->local_auxmat2,n_R,n_constraints,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
24388ebb749SStefano Zampini       ierr = MatSetType(pcbddc->local_auxmat2,impMatType);CHKERRQ(ierr);
24425084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->local_auxmat2);CHKERRQ(ierr);
245f4ddd8eeSStefano Zampini     }
24688ebb749SStefano Zampini 
24725084f0cSStefano Zampini     /* Extract constraints on R nodes: C_{CR}  */
24825084f0cSStefano Zampini     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
2498ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
25025084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
25188ebb749SStefano Zampini 
25288ebb749SStefano Zampini     /* Assemble local_auxmat2 = - A_{RR}^{-1} C^T_{CR} needed by BDDC application */
25388ebb749SStefano Zampini     for (i=0;i<n_constraints;i++) {
25488ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
25588ebb749SStefano Zampini       /* Get row of constraint matrix in R numbering */
25625084f0cSStefano Zampini       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
25725084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_R,size_of_constraint,row_cmat_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
25825084f0cSStefano Zampini       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
25925084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_R);CHKERRQ(ierr);
26025084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_R);CHKERRQ(ierr);
26188ebb749SStefano Zampini       /* Solve for row of constraint matrix in R numbering */
26288ebb749SStefano Zampini       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
26325084f0cSStefano Zampini       /* Set values in local_auxmat2 */
26425084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
26588ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->local_auxmat2,n_R,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
26625084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
26788ebb749SStefano Zampini     }
26888ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
26988ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
27025084f0cSStefano Zampini     ierr = MatScale(pcbddc->local_auxmat2,m_one);CHKERRQ(ierr);
27188ebb749SStefano Zampini 
27288ebb749SStefano Zampini     /* Assemble explicitly M1 = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1} needed in preproc  */
27325084f0cSStefano Zampini     ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
27425084f0cSStefano Zampini     ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
27588ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&M1);CHKERRQ(ierr);
27688ebb749SStefano Zampini     ierr = MatSetSizes(M1,n_constraints,n_constraints,n_constraints,n_constraints);CHKERRQ(ierr);
27788ebb749SStefano Zampini     ierr = MatSetType(M1,impMatType);CHKERRQ(ierr);
27825084f0cSStefano Zampini     ierr = MatSetUp(M1);CHKERRQ(ierr);
27925084f0cSStefano Zampini     ierr = MatDuplicate(M1,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
28025084f0cSStefano Zampini     ierr = MatZeroEntries(M2);CHKERRQ(ierr);
28125084f0cSStefano Zampini     ierr = VecSet(vec1_C,m_one);CHKERRQ(ierr);
28225084f0cSStefano Zampini     ierr = MatDiagonalSet(M2,vec1_C,INSERT_VALUES);CHKERRQ(ierr);
28325084f0cSStefano Zampini     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
28425084f0cSStefano Zampini     ierr = MatDestroy(&M2);CHKERRQ(ierr);
28525084f0cSStefano Zampini     ierr = MatDestroy(&M3);CHKERRQ(ierr);
28688ebb749SStefano Zampini     /* Assemble local_auxmat1 = M1*C_{CR} needed by BDDC application in KSP and in preproc */
287f4ddd8eeSStefano Zampini     if (!pcbddc->local_auxmat1) {
28888ebb749SStefano Zampini       ierr = MatMatMult(M1,C_CR,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
289f4ddd8eeSStefano Zampini     } else {
290f4ddd8eeSStefano Zampini       ierr = MatMatMult(M1,C_CR,MAT_REUSE_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
291f4ddd8eeSStefano Zampini     }
29288ebb749SStefano Zampini   }
29388ebb749SStefano Zampini 
29488ebb749SStefano Zampini   /* Get submatrices from subdomain matrix */
29588ebb749SStefano Zampini   if (n_vertices) {
2963a50541eSStefano Zampini     PetscInt ibs,mbs;
2973a50541eSStefano Zampini     PetscBool issbaij;
298af732b37SStefano Zampini     Mat newmat;
2993a50541eSStefano Zampini 
3003a50541eSStefano Zampini     ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
3019577ea80SStefano Zampini     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
3029577ea80SStefano Zampini     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
3033a50541eSStefano Zampini     if (ibs != mbs) { /* need to convert to SEQAIJ */
3049577ea80SStefano Zampini       ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
3059577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3069577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3079577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3089577ea80SStefano Zampini       ierr = MatDestroy(&newmat);CHKERRQ(ierr);
3099577ea80SStefano Zampini     } else {
3103a50541eSStefano Zampini       /* this is safe */
3119577ea80SStefano Zampini       ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3123a50541eSStefano Zampini       ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
3133a50541eSStefano Zampini       if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
3143a50541eSStefano Zampini         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
31545a1bb75SStefano Zampini         /* which of the two approaches is faster? */
3163a50541eSStefano Zampini         /* ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3173a50541eSStefano Zampini         ierr = MatCreateTranspose(A_RV,&A_VR);CHKERRQ(ierr);*/
3183a50541eSStefano Zampini         ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3193a50541eSStefano Zampini         ierr = MatCreateTranspose(A_VR,&A_RV);CHKERRQ(ierr);
3203a50541eSStefano Zampini         ierr = MatDestroy(&newmat);CHKERRQ(ierr);
3213a50541eSStefano Zampini       } else {
3229577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3239577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3249577ea80SStefano Zampini       }
3253a50541eSStefano Zampini     }
32645a1bb75SStefano Zampini     ierr = MatGetVecs(A_RV,&vec1_V,NULL);CHKERRQ(ierr);
32745a1bb75SStefano Zampini     ierr = VecDuplicate(vec1_V,&vec2_V);CHKERRQ(ierr);
32825084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
32988ebb749SStefano Zampini   }
33088ebb749SStefano Zampini 
33188ebb749SStefano Zampini   /* Matrix of coarse basis functions (local) */
332f4ddd8eeSStefano Zampini   if (pcbddc->coarse_phi_B) {
333f4ddd8eeSStefano Zampini     PetscInt on_B,on_primal;
334f4ddd8eeSStefano Zampini     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
335f4ddd8eeSStefano Zampini     if (on_B != n_B || on_primal != pcbddc->local_primal_size) {
336f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
337f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
338f4ddd8eeSStefano Zampini     }
339f4ddd8eeSStefano Zampini   }
340f4ddd8eeSStefano Zampini   if (pcbddc->coarse_phi_D) {
341f4ddd8eeSStefano Zampini     PetscInt on_D,on_primal;
342f4ddd8eeSStefano Zampini     ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,&on_primal);CHKERRQ(ierr);
343f4ddd8eeSStefano Zampini     if (on_D != n_D || on_primal != pcbddc->local_primal_size) {
344f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
345f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
346f4ddd8eeSStefano Zampini     }
347f4ddd8eeSStefano Zampini   }
348f4ddd8eeSStefano Zampini   if (!pcbddc->coarse_phi_B) {
34988ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
35088ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_phi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
35188ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_phi_B,impMatType);CHKERRQ(ierr);
35225084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_phi_B);CHKERRQ(ierr);
353f4ddd8eeSStefano Zampini   }
354f4ddd8eeSStefano Zampini   if ( (pcbddc->switch_static || pcbddc->dbg_flag) && !pcbddc->coarse_phi_D ) {
35588ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
35688ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_phi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
35788ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_phi_D,impMatType);CHKERRQ(ierr);
35825084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_phi_D);CHKERRQ(ierr);
35988ebb749SStefano Zampini   }
36088ebb749SStefano Zampini 
36125084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
3628ce42a96SStefano Zampini     ierr = ISGetIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
363785e854fSJed Brown     ierr = PetscMalloc1(2*pcbddc->local_primal_size,&coarsefunctions_errors);CHKERRQ(ierr);
364785e854fSJed Brown     ierr = PetscMalloc1(2*pcbddc->local_primal_size,&constraints_errors);CHKERRQ(ierr);
36588ebb749SStefano Zampini   }
36688ebb749SStefano Zampini   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
367785e854fSJed Brown   ierr = PetscMalloc1((pcbddc->local_primal_size)*(pcbddc->local_primal_size),&coarse_submat_vals);CHKERRQ(ierr);
36888ebb749SStefano Zampini 
36988ebb749SStefano Zampini   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
37025084f0cSStefano Zampini 
37125084f0cSStefano Zampini   /* vertices */
37288ebb749SStefano Zampini   for (i=0;i<n_vertices;i++) {
37345a1bb75SStefano Zampini     /* this should not be needed, but MatMult_BAIJ is broken when using compressed row routines */
374f4ddd8eeSStefano Zampini     ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr); /* TODO: REMOVE IT */
37588ebb749SStefano Zampini     ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
37688ebb749SStefano Zampini     ierr = VecSetValue(vec1_V,i,one,INSERT_VALUES);CHKERRQ(ierr);
37788ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
37888ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
37925084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on constraints multipliers */
38088ebb749SStefano Zampini     ierr = MatMult(A_RV,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
38188ebb749SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
38288ebb749SStefano Zampini     ierr = VecScale(pcbddc->vec1_R,m_one);CHKERRQ(ierr);
38388ebb749SStefano Zampini     if (n_constraints) {
38488ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec1_R,vec1_C);CHKERRQ(ierr);
38588ebb749SStefano Zampini       ierr = MatMultAdd(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
38688ebb749SStefano Zampini       ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
38788ebb749SStefano Zampini     }
38888ebb749SStefano Zampini     ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
38988ebb749SStefano Zampini     ierr = MatMultAdd(A_VV,vec1_V,vec2_V,vec2_V);CHKERRQ(ierr);
39088ebb749SStefano Zampini 
39188ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
39288ebb749SStefano Zampini     /* coarse basis functions */
39388ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
39488ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
39588ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
39625084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
39788ebb749SStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
39825084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
39988ebb749SStefano Zampini     ierr = MatSetValue(pcbddc->coarse_phi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
4008eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
40188ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40288ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40325084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
40488ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
40525084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
40688ebb749SStefano Zampini     }
40725084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
40825084f0cSStefano Zampini     ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
40925084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
41025084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
41188ebb749SStefano Zampini     if (n_constraints) {
41225084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
41325084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
41425084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
41588ebb749SStefano Zampini     }
41688ebb749SStefano Zampini 
41725084f0cSStefano Zampini     /* check */
41825084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
41925084f0cSStefano Zampini       /* assemble subdomain vector on local nodes */
42088ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
42125084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
42225084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
42325084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
424e9189074SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],one,INSERT_VALUES);CHKERRQ(ierr);
42525084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
42625084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
42788ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers (i.e. primal nodes) */
42888ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
42925084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
43025084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
43125084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
43288ebb749SStefano Zampini       if (n_constraints) {
43325084f0cSStefano Zampini         ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
43425084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
43525084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
43688ebb749SStefano Zampini       }
43725084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
43825084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
43988ebb749SStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
44088ebb749SStefano Zampini       /* check saddle point solution */
44188ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
44288ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
44388ebb749SStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i]);CHKERRQ(ierr);
44488ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
44525084f0cSStefano Zampini       /* shift by the identity matrix */
44625084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
44725084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
44825084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
44988ebb749SStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i]);CHKERRQ(ierr);
45088ebb749SStefano Zampini     }
45188ebb749SStefano Zampini   }
45288ebb749SStefano Zampini 
45325084f0cSStefano Zampini   /* constraints */
45488ebb749SStefano Zampini   for (i=0;i<n_constraints;i++) {
45588ebb749SStefano Zampini     ierr = VecSet(vec2_C,zero);CHKERRQ(ierr);
45688ebb749SStefano Zampini     ierr = VecSetValue(vec2_C,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
45788ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec2_C);CHKERRQ(ierr);
45888ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec2_C);CHKERRQ(ierr);
45925084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on vertices multipliers */
46088ebb749SStefano Zampini     ierr = MatMult(M1,vec2_C,vec1_C);CHKERRQ(ierr);
46188ebb749SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
46288ebb749SStefano Zampini     ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
46325084f0cSStefano Zampini     if (n_vertices) {
46425084f0cSStefano Zampini       ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
46525084f0cSStefano Zampini     }
46688ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
46788ebb749SStefano Zampini     /* coarse basis functions */
46825084f0cSStefano Zampini     j = i+n_vertices; /* don't touch this! */
46988ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
47088ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
47188ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
47225084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
47325084f0cSStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
47425084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
4758eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
47688ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
47788ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
47825084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
47925084f0cSStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
48025084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
48188ebb749SStefano Zampini     }
48225084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
48388ebb749SStefano Zampini     if (n_vertices) {
48425084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
48525084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
48625084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
48788ebb749SStefano Zampini     }
48825084f0cSStefano Zampini     ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
48925084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
49025084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
49188ebb749SStefano Zampini 
49225084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
49388ebb749SStefano Zampini       /* assemble subdomain vector on nodes */
49488ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
49525084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
49625084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
49725084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
49825084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
49925084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
50088ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers */
50188ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
50288ebb749SStefano Zampini       if (n_vertices) {
50325084f0cSStefano Zampini         ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
50425084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
50525084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
50688ebb749SStefano Zampini       }
50725084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
50825084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
50925084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
51025084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
51125084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
51225084f0cSStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
51388ebb749SStefano Zampini       /* check saddle point solution */
51488ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
51588ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
51625084f0cSStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[j]);CHKERRQ(ierr);
51788ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
51825084f0cSStefano Zampini       /* shift by the identity matrix */
51925084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,j,m_one,ADD_VALUES);CHKERRQ(ierr);
52025084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
52125084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
52225084f0cSStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[j]);CHKERRQ(ierr);
52388ebb749SStefano Zampini     }
52488ebb749SStefano Zampini   }
52525084f0cSStefano Zampini   /* call assembling routines for local coarse basis */
52688ebb749SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
52788ebb749SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5288eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
52988ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
53088ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
53188ebb749SStefano Zampini   }
53225084f0cSStefano Zampini 
53388ebb749SStefano Zampini   /* compute other basis functions for non-symmetric problems */
53488ebb749SStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
53588ebb749SStefano Zampini   if (!setsym || (setsym && !issym)) {
536f4ddd8eeSStefano Zampini     if (!pcbddc->coarse_psi_B) {
53788ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
53888ebb749SStefano Zampini       ierr = MatSetSizes(pcbddc->coarse_psi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
53988ebb749SStefano Zampini       ierr = MatSetType(pcbddc->coarse_psi_B,impMatType);CHKERRQ(ierr);
54025084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->coarse_psi_B);CHKERRQ(ierr);
541f4ddd8eeSStefano Zampini     }
542f4ddd8eeSStefano Zampini     if ( (pcbddc->switch_static || pcbddc->dbg_flag) && !pcbddc->coarse_psi_D) {
54388ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
54488ebb749SStefano Zampini       ierr = MatSetSizes(pcbddc->coarse_psi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
54588ebb749SStefano Zampini       ierr = MatSetType(pcbddc->coarse_psi_D,impMatType);CHKERRQ(ierr);
54625084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->coarse_psi_D);CHKERRQ(ierr);
54788ebb749SStefano Zampini     }
54888ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
54988ebb749SStefano Zampini       if (n_constraints) {
55088ebb749SStefano Zampini         ierr = VecSet(vec1_C,zero);CHKERRQ(ierr);
55188ebb749SStefano Zampini         for (j=0;j<n_constraints;j++) {
55225084f0cSStefano Zampini           ierr = VecSetValue(vec1_C,j,coarse_submat_vals[(j+n_vertices)*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
55388ebb749SStefano Zampini         }
55425084f0cSStefano Zampini         ierr = VecAssemblyBegin(vec1_C);CHKERRQ(ierr);
55525084f0cSStefano Zampini         ierr = VecAssemblyEnd(vec1_C);CHKERRQ(ierr);
55688ebb749SStefano Zampini       }
55788ebb749SStefano Zampini       if (i<n_vertices) {
55888ebb749SStefano Zampini         ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
55988ebb749SStefano Zampini         ierr = VecSetValue(vec1_V,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
56088ebb749SStefano Zampini         ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
56188ebb749SStefano Zampini         ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
56288ebb749SStefano Zampini         ierr = MatMultTranspose(A_VR,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
56388ebb749SStefano Zampini         if (n_constraints) {
56488ebb749SStefano Zampini           ierr = MatMultTransposeAdd(C_CR,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
56588ebb749SStefano Zampini         }
56688ebb749SStefano Zampini       } else {
56788ebb749SStefano Zampini         ierr = MatMultTranspose(C_CR,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
56888ebb749SStefano Zampini       }
56988ebb749SStefano Zampini       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
57088ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
57188ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
57288ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
57325084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
57488ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_psi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
57525084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
57688ebb749SStefano Zampini       if (i<n_vertices) {
57788ebb749SStefano Zampini         ierr = MatSetValue(pcbddc->coarse_psi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
57888ebb749SStefano Zampini       }
5798eeda7d8SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
58088ebb749SStefano Zampini         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
58188ebb749SStefano Zampini         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
58225084f0cSStefano Zampini         ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
58388ebb749SStefano Zampini         ierr = MatSetValues(pcbddc->coarse_psi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
58425084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
58588ebb749SStefano Zampini       }
58688ebb749SStefano Zampini 
58725084f0cSStefano Zampini       if (pcbddc->dbg_flag) {
58888ebb749SStefano Zampini         /* assemble subdomain vector on nodes */
58988ebb749SStefano Zampini         ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
59025084f0cSStefano Zampini         ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
59125084f0cSStefano Zampini         ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
59225084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
59325084f0cSStefano Zampini         if (i<n_vertices) {
594e9189074SStefano Zampini           ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],one,INSERT_VALUES);CHKERRQ(ierr);
59588ebb749SStefano Zampini         }
59625084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
59725084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
59825084f0cSStefano Zampini         /* assemble subdomain vector of lagrange multipliers */
59925084f0cSStefano Zampini         for (j=0;j<pcbddc->local_primal_size;j++) {
60025084f0cSStefano Zampini           ierr = VecSetValue(pcbddc->vec1_P,j,-coarse_submat_vals[j*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
60125084f0cSStefano Zampini         }
60225084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
60325084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
60488ebb749SStefano Zampini         /* check saddle point solution */
60588ebb749SStefano Zampini         ierr = MatMultTranspose(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
60688ebb749SStefano Zampini         ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
60788ebb749SStefano Zampini         ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
60888ebb749SStefano Zampini         ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
60925084f0cSStefano Zampini         /* shift by the identity matrix */
61025084f0cSStefano Zampini         ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
61125084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
61225084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
61388ebb749SStefano Zampini         ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
61488ebb749SStefano Zampini       }
61588ebb749SStefano Zampini     }
61688ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
61788ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6188eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
61988ebb749SStefano Zampini       ierr = MatAssemblyBegin(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
62088ebb749SStefano Zampini       ierr = MatAssemblyEnd(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
62188ebb749SStefano Zampini     }
622c0553b1fSStefano Zampini     unsymmetric_check = PETSC_TRUE;
623c0553b1fSStefano Zampini   } else { /* take references to already computed coarse basis */
624c0553b1fSStefano Zampini     unsymmetric_check = PETSC_FALSE;
625c0553b1fSStefano Zampini     ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
626c0553b1fSStefano Zampini     pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
627c0553b1fSStefano Zampini     if (pcbddc->coarse_phi_D) {
628c0553b1fSStefano Zampini       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
629c0553b1fSStefano Zampini       pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
630c0553b1fSStefano Zampini     }
63188ebb749SStefano Zampini   }
63288ebb749SStefano Zampini   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
63388ebb749SStefano Zampini   /* Checking coarse_sub_mat and coarse basis functios */
63488ebb749SStefano Zampini   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
63588ebb749SStefano Zampini   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
63625084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
63788ebb749SStefano Zampini     Mat         coarse_sub_mat;
63825084f0cSStefano Zampini     Mat         AUXMAT,TM1,TM2,TM3,TM4;
63988ebb749SStefano Zampini     Mat         coarse_phi_D,coarse_phi_B;
64088ebb749SStefano Zampini     Mat         coarse_psi_D,coarse_psi_B;
64188ebb749SStefano Zampini     Mat         A_II,A_BB,A_IB,A_BI;
64288ebb749SStefano Zampini     MatType     checkmattype=MATSEQAIJ;
64388ebb749SStefano Zampini     PetscReal   real_value;
64488ebb749SStefano Zampini 
64588ebb749SStefano Zampini     ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
64688ebb749SStefano Zampini     ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
64788ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
64888ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
64988ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
65088ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
651c0553b1fSStefano Zampini     if (unsymmetric_check) {
65288ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
65388ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
65488ebb749SStefano Zampini     }
65588ebb749SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
65688ebb749SStefano Zampini 
65725084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
65825084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat and local basis functions\n");CHKERRQ(ierr);
65925084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
660c0553b1fSStefano Zampini     if (unsymmetric_check) {
66188ebb749SStefano Zampini       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
66288ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
66388ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
66488ebb749SStefano Zampini       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
66588ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
66688ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
66788ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
66888ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
66988ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
67088ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
67188ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
67288ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
67388ebb749SStefano Zampini     } else {
67488ebb749SStefano Zampini       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
67588ebb749SStefano Zampini       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
67688ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
67788ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
67888ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
67988ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
68088ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
68188ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
68288ebb749SStefano Zampini     }
68388ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
68488ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
68588ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
68688ebb749SStefano Zampini     ierr = MatConvert(TM1,MATSEQDENSE,MAT_REUSE_MATRIX,&TM1);CHKERRQ(ierr);
68781d9aea3SBarry Smith     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
68888ebb749SStefano Zampini     ierr = MatNorm(TM1,NORM_INFINITY,&real_value);CHKERRQ(ierr);
6890fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
69025084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"----------------------------------\n");CHKERRQ(ierr);
69125084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d \n",PetscGlobalRank);CHKERRQ(ierr);
69225084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"matrix error = % 1.14e\n",real_value);CHKERRQ(ierr);
69325084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (phi) errors\n");CHKERRQ(ierr);
69488ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
69525084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,coarsefunctions_errors[i]);CHKERRQ(ierr);
69688ebb749SStefano Zampini     }
69725084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (phi) errors\n");CHKERRQ(ierr);
69888ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
69925084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,constraints_errors[i]);CHKERRQ(ierr);
70088ebb749SStefano Zampini     }
701c0553b1fSStefano Zampini     if (unsymmetric_check) {
70225084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (psi) errors\n");CHKERRQ(ierr);
70388ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
70425084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,coarsefunctions_errors[i]);CHKERRQ(ierr);
70588ebb749SStefano Zampini       }
70625084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (psi) errors\n");CHKERRQ(ierr);
70788ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
70825084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,constraints_errors[i]);CHKERRQ(ierr);
70988ebb749SStefano Zampini       }
71088ebb749SStefano Zampini     }
71125084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
71288ebb749SStefano Zampini     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
71388ebb749SStefano Zampini     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
71488ebb749SStefano Zampini     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
71588ebb749SStefano Zampini     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
71688ebb749SStefano Zampini     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
71788ebb749SStefano Zampini     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
71888ebb749SStefano Zampini     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
71988ebb749SStefano Zampini     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
72088ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
72188ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
722c0553b1fSStefano Zampini     if (unsymmetric_check) {
72388ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
72488ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
72588ebb749SStefano Zampini     }
72688ebb749SStefano Zampini     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
7278ce42a96SStefano Zampini     ierr = ISRestoreIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
72888ebb749SStefano Zampini     ierr = PetscFree(coarsefunctions_errors);CHKERRQ(ierr);
72988ebb749SStefano Zampini     ierr = PetscFree(constraints_errors);CHKERRQ(ierr);
73088ebb749SStefano Zampini   }
73188ebb749SStefano Zampini   /* free memory */
73288ebb749SStefano Zampini   if (n_vertices) {
73388ebb749SStefano Zampini     ierr = VecDestroy(&vec1_V);CHKERRQ(ierr);
73488ebb749SStefano Zampini     ierr = VecDestroy(&vec2_V);CHKERRQ(ierr);
73588ebb749SStefano Zampini     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
73688ebb749SStefano Zampini     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
73788ebb749SStefano Zampini     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
73888ebb749SStefano Zampini   }
73988ebb749SStefano Zampini   if (n_constraints) {
74088ebb749SStefano Zampini     ierr = VecDestroy(&vec1_C);CHKERRQ(ierr);
74188ebb749SStefano Zampini     ierr = VecDestroy(&vec2_C);CHKERRQ(ierr);
74288ebb749SStefano Zampini     ierr = MatDestroy(&M1);CHKERRQ(ierr);
74388ebb749SStefano Zampini     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
74488ebb749SStefano Zampini   }
74588ebb749SStefano Zampini   ierr = PetscFree(auxindices);CHKERRQ(ierr);
7468629588bSStefano Zampini   /* get back data */
7478629588bSStefano Zampini   *coarse_submat_vals_n = coarse_submat_vals;
74888ebb749SStefano Zampini   PetscFunctionReturn(0);
74988ebb749SStefano Zampini }
75088ebb749SStefano Zampini 
75188ebb749SStefano Zampini #undef __FUNCT__
752aa0d41d4SStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalMatrices"
753aa0d41d4SStefano Zampini PetscErrorCode PCBDDCSetUpLocalMatrices(PC pc)
754aa0d41d4SStefano Zampini {
755aa0d41d4SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
756aa0d41d4SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
757aa0d41d4SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
75822d5777bSStefano Zampini   PetscBool         issbaij,isseqaij;
759aa0d41d4SStefano Zampini   /* manage repeated solves */
760aa0d41d4SStefano Zampini   MatReuse          reuse;
761aa0d41d4SStefano Zampini   PetscErrorCode    ierr;
762aa0d41d4SStefano Zampini 
763aa0d41d4SStefano Zampini   PetscFunctionBegin;
764f4ddd8eeSStefano Zampini   if (pcbddc->use_change_of_basis && !pcbddc->ChangeOfBasisMatrix) {
765f4ddd8eeSStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Change of basis matrix has not been created");
766f4ddd8eeSStefano Zampini   }
767aa0d41d4SStefano Zampini   /* get mat flags */
768aa0d41d4SStefano Zampini   reuse = MAT_INITIAL_MATRIX;
769aa0d41d4SStefano Zampini   if (pc->setupcalled) {
770d1e9a80fSBarry Smith     if (pc->flag == SAME_NONZERO_PATTERN) {
771aa0d41d4SStefano Zampini       reuse = MAT_REUSE_MATRIX;
772aa0d41d4SStefano Zampini     } else {
773aa0d41d4SStefano Zampini       reuse = MAT_INITIAL_MATRIX;
774aa0d41d4SStefano Zampini     }
775aa0d41d4SStefano Zampini   }
776aa0d41d4SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
777aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
778aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
779aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
780aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BB);CHKERRQ(ierr);
781aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
782aa0d41d4SStefano Zampini   }
783aa0d41d4SStefano Zampini 
784aa0d41d4SStefano Zampini   /* transform local matrices if needed */
785aa0d41d4SStefano Zampini   if (pcbddc->use_change_of_basis) {
786aa0d41d4SStefano Zampini     Mat         change_mat_all;
787aa0d41d4SStefano Zampini     PetscScalar *row_cmat_values;
788aa0d41d4SStefano Zampini     PetscInt    *row_cmat_indices;
789aa0d41d4SStefano Zampini     PetscInt    *nnz,*is_indices,*temp_indices;
790aa0d41d4SStefano Zampini     PetscInt    i,j,k,n_D,n_B;
791aa0d41d4SStefano Zampini 
792aa0d41d4SStefano Zampini     /* Get Non-overlapping dimensions */
793aa0d41d4SStefano Zampini     n_B = pcis->n_B;
794aa0d41d4SStefano Zampini     n_D = pcis->n-n_B;
795aa0d41d4SStefano Zampini 
796aa0d41d4SStefano Zampini     /* compute nonzero structure of change of basis on all local nodes */
797785e854fSJed Brown     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
798aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
799aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) nnz[is_indices[i]] = 1;
800aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
801aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
802aa0d41d4SStefano Zampini     k=1;
803aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
804aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
805aa0d41d4SStefano Zampini       nnz[is_indices[i]]=j;
806aa0d41d4SStefano Zampini       if (k < j) k = j;
807aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
808aa0d41d4SStefano Zampini     }
809aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
810aa0d41d4SStefano Zampini     /* assemble change of basis matrix on the whole set of local dofs */
811785e854fSJed Brown     ierr = PetscMalloc1(k,&temp_indices);CHKERRQ(ierr);
812aa0d41d4SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&change_mat_all);CHKERRQ(ierr);
813aa0d41d4SStefano Zampini     ierr = MatSetSizes(change_mat_all,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
814aa0d41d4SStefano Zampini     ierr = MatSetType(change_mat_all,MATSEQAIJ);CHKERRQ(ierr);
815aa0d41d4SStefano Zampini     ierr = MatSeqAIJSetPreallocation(change_mat_all,0,nnz);CHKERRQ(ierr);
816aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
817aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) {
818aa0d41d4SStefano Zampini       ierr = MatSetValue(change_mat_all,is_indices[i],is_indices[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
819aa0d41d4SStefano Zampini     }
820aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
821aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
822aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
823aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
824aa0d41d4SStefano Zampini       for (k=0; k<j; k++) temp_indices[k]=is_indices[row_cmat_indices[k]];
825aa0d41d4SStefano Zampini       ierr = MatSetValues(change_mat_all,1,&is_indices[i],j,temp_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
826aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
827aa0d41d4SStefano Zampini     }
828aa0d41d4SStefano Zampini     ierr = MatAssemblyBegin(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
829aa0d41d4SStefano Zampini     ierr = MatAssemblyEnd(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
83022d5777bSStefano Zampini     /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
83122d5777bSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQBAIJ,&isseqaij);CHKERRQ(ierr);
83222d5777bSStefano Zampini     if (isseqaij) {
833aa0d41d4SStefano Zampini       ierr = MatPtAP(matis->A,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
834aa0d41d4SStefano Zampini     } else {
835aa0d41d4SStefano Zampini       Mat work_mat;
836aa0d41d4SStefano Zampini       ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
837aa0d41d4SStefano Zampini       ierr = MatPtAP(work_mat,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
838aa0d41d4SStefano Zampini       ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
839aa0d41d4SStefano Zampini     }
84045a1bb75SStefano Zampini     /*
84145a1bb75SStefano Zampini     ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
84245a1bb75SStefano Zampini     ierr = MatView(change_mat_all,(PetscViewer)0);CHKERRQ(ierr);
84345a1bb75SStefano Zampini     */
844aa0d41d4SStefano Zampini     ierr = MatDestroy(&change_mat_all);CHKERRQ(ierr);
845aa0d41d4SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
846aa0d41d4SStefano Zampini     ierr = PetscFree(temp_indices);CHKERRQ(ierr);
847aa0d41d4SStefano Zampini   } else {
848aa0d41d4SStefano Zampini     /* without change of basis, the local matrix is unchanged */
849aa0d41d4SStefano Zampini     if (!pcbddc->local_mat) {
850aa0d41d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)matis->A);CHKERRQ(ierr);
851aa0d41d4SStefano Zampini       pcbddc->local_mat = matis->A;
852aa0d41d4SStefano Zampini     }
853aa0d41d4SStefano Zampini   }
854aa0d41d4SStefano Zampini 
855aa0d41d4SStefano Zampini   /* get submatrices */
856aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_I_local,reuse,&pcis->A_II);CHKERRQ(ierr);
8579577ea80SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_B_local,reuse,&pcis->A_BB);CHKERRQ(ierr);
8589577ea80SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
8599577ea80SStefano Zampini   if (!issbaij) {
860aa0d41d4SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
861aa0d41d4SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
8629577ea80SStefano Zampini   } else {
8639577ea80SStefano Zampini     Mat newmat;
8649577ea80SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
8659577ea80SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
8669577ea80SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
8679577ea80SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
8689577ea80SStefano Zampini   }
869aa0d41d4SStefano Zampini   PetscFunctionReturn(0);
870aa0d41d4SStefano Zampini }
871aa0d41d4SStefano Zampini 
872aa0d41d4SStefano Zampini #undef __FUNCT__
873a64d13efSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalScatters"
8748ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
875a64d13efSStefano Zampini {
876a64d13efSStefano Zampini   PC_IS*         pcis = (PC_IS*)(pc->data);
877a64d13efSStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8788ce42a96SStefano Zampini   IS             is_aux1,is_aux2;
879e9189074SStefano Zampini   PetscInt       *aux_array1,*aux_array2,*is_indices,*idx_R_local;
8803a50541eSStefano Zampini   PetscInt       n_vertices,i,j,n_R,n_D,n_B;
8813a50541eSStefano Zampini   PetscInt       vbs,bs;
8824641a718SStefano Zampini   PetscBT        bitmask;
883a64d13efSStefano Zampini   PetscErrorCode ierr;
884a64d13efSStefano Zampini 
885a64d13efSStefano Zampini   PetscFunctionBegin;
886b23d619eSStefano Zampini   /*
887b23d619eSStefano Zampini     No need to setup local scatters if
888b23d619eSStefano Zampini       - primal space is unchanged
889b23d619eSStefano Zampini         AND
890b23d619eSStefano Zampini       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
891b23d619eSStefano Zampini         AND
892b23d619eSStefano Zampini       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
893b23d619eSStefano Zampini   */
894b23d619eSStefano Zampini   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
895f4ddd8eeSStefano Zampini     PetscFunctionReturn(0);
896f4ddd8eeSStefano Zampini   }
897f4ddd8eeSStefano Zampini   /* destroy old objects */
898f4ddd8eeSStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
899f4ddd8eeSStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
900f4ddd8eeSStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
901a64d13efSStefano Zampini   /* Set Non-overlapping dimensions */
902a64d13efSStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
903e9189074SStefano Zampini   n_vertices = pcbddc->n_actual_vertices;
9044641a718SStefano Zampini   /* create auxiliary bitmask */
9054641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
9064641a718SStefano Zampini   for (i=0;i<n_vertices;i++) {
907e9189074SStefano Zampini     ierr = PetscBTSet(bitmask,pcbddc->primal_indices_local_idxs[i]);CHKERRQ(ierr);
9084641a718SStefano Zampini   }
9093a50541eSStefano Zampini 
910a64d13efSStefano Zampini   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
911785e854fSJed Brown   ierr = PetscMalloc1((pcis->n-n_vertices),&idx_R_local);CHKERRQ(ierr);
912a64d13efSStefano Zampini   for (i=0, n_R=0; i<pcis->n; i++) {
9134641a718SStefano Zampini     if (!PetscBTLookup(bitmask,i)) {
914a64d13efSStefano Zampini       idx_R_local[n_R] = i;
915a64d13efSStefano Zampini       n_R++;
916a64d13efSStefano Zampini     }
917a64d13efSStefano Zampini   }
9183a50541eSStefano Zampini 
9193a50541eSStefano Zampini   /* Block code */
9203a50541eSStefano Zampini   vbs = 1;
9213a50541eSStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
9223a50541eSStefano Zampini   if (bs>1 && !(n_vertices%bs)) {
9233a50541eSStefano Zampini     PetscBool is_blocked = PETSC_TRUE;
9243a50541eSStefano Zampini     PetscInt  *vary;
9253a50541eSStefano Zampini     /* Verify if the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
926785e854fSJed Brown     ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
9273a50541eSStefano Zampini     ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
928e9189074SStefano Zampini     for (i=0; i<n_vertices; i++) vary[pcbddc->primal_indices_local_idxs[i]/bs]++;
9293a50541eSStefano Zampini     for (i=0; i<n_vertices; i++) {
9303a50541eSStefano Zampini       if (vary[i]!=0 && vary[i]!=bs) {
9313a50541eSStefano Zampini         is_blocked = PETSC_FALSE;
9323a50541eSStefano Zampini         break;
9333a50541eSStefano Zampini       }
9343a50541eSStefano Zampini     }
9353a50541eSStefano Zampini     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
9363a50541eSStefano Zampini       vbs = bs;
9373a50541eSStefano Zampini       for (i=0;i<n_R/vbs;i++) {
9383a50541eSStefano Zampini         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
9393a50541eSStefano Zampini       }
9403a50541eSStefano Zampini     }
9413a50541eSStefano Zampini     ierr = PetscFree(vary);CHKERRQ(ierr);
9423a50541eSStefano Zampini   }
9433a50541eSStefano Zampini   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
9443a50541eSStefano Zampini   ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
945a64d13efSStefano Zampini 
946a64d13efSStefano Zampini   /* print some info if requested */
947a64d13efSStefano Zampini   if (pcbddc->dbg_flag) {
948a64d13efSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
949a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
9500fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
951a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
952a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
9533a50541eSStefano 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);
954a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr);
955a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
956a64d13efSStefano Zampini   }
957a64d13efSStefano Zampini 
958a64d13efSStefano Zampini   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
9593a50541eSStefano Zampini   ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
960785e854fSJed Brown   ierr = PetscMalloc1((pcis->n_B-n_vertices),&aux_array1);CHKERRQ(ierr);
961785e854fSJed Brown   ierr = PetscMalloc1((pcis->n_B-n_vertices),&aux_array2);CHKERRQ(ierr);
962a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
9634641a718SStefano Zampini   for (i=0; i<n_D; i++) {
9644641a718SStefano Zampini     ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
9654641a718SStefano Zampini   }
966a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
967a64d13efSStefano Zampini   for (i=0, j=0; i<n_R; i++) {
9684641a718SStefano Zampini     if (!PetscBTLookup(bitmask,idx_R_local[i])) {
9694641a718SStefano Zampini       aux_array1[j++] = i;
970a64d13efSStefano Zampini     }
971a64d13efSStefano Zampini   }
972a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
973a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
974a64d13efSStefano Zampini   for (i=0, j=0; i<n_B; i++) {
9754641a718SStefano Zampini     if (!PetscBTLookup(bitmask,is_indices[i])) {
9764641a718SStefano Zampini       aux_array2[j++] = i;
977a64d13efSStefano Zampini     }
978a64d13efSStefano Zampini   }
979a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
980a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
981a64d13efSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
982a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
983a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
984a64d13efSStefano Zampini 
9858eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
986785e854fSJed Brown     ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
987a64d13efSStefano Zampini     for (i=0, j=0; i<n_R; i++) {
9884641a718SStefano Zampini       if (PetscBTLookup(bitmask,idx_R_local[i])) {
9894641a718SStefano Zampini         aux_array1[j++] = i;
990a64d13efSStefano Zampini       }
991a64d13efSStefano Zampini     }
992a64d13efSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
993a64d13efSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
994a64d13efSStefano Zampini     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
995a64d13efSStefano Zampini   }
9964641a718SStefano Zampini   ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
9973a50541eSStefano Zampini   ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
998a64d13efSStefano Zampini   PetscFunctionReturn(0);
999a64d13efSStefano Zampini }
1000a64d13efSStefano Zampini 
1001304d26faSStefano Zampini 
1002304d26faSStefano Zampini #undef __FUNCT__
1003304d26faSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
10048ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc)
1005304d26faSStefano Zampini {
1006304d26faSStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1007304d26faSStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
1008304d26faSStefano Zampini   PC             pc_temp;
1009304d26faSStefano Zampini   Mat            A_RR;
1010f4ddd8eeSStefano Zampini   MatReuse       reuse;
1011304d26faSStefano Zampini   PetscScalar    m_one = -1.0;
1012304d26faSStefano Zampini   PetscReal      value;
1013af732b37SStefano Zampini   PetscInt       n_D,n_R,ibs,mbs;
10149577ea80SStefano Zampini   PetscBool      use_exact,use_exact_reduced,issbaij;
1015304d26faSStefano Zampini   PetscErrorCode ierr;
1016e604994aSStefano Zampini   /* prefixes stuff */
1017312be037SStefano Zampini   char           dir_prefix[256],neu_prefix[256],str_level[16];
1018e604994aSStefano Zampini   size_t         len;
1019304d26faSStefano Zampini 
1020304d26faSStefano Zampini   PetscFunctionBegin;
1021304d26faSStefano Zampini 
1022e604994aSStefano Zampini   /* compute prefixes */
1023e604994aSStefano Zampini   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
1024e604994aSStefano Zampini   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
1025e604994aSStefano Zampini   if (!pcbddc->current_level) {
1026e604994aSStefano Zampini     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
1027e604994aSStefano Zampini     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
1028e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
1029e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
1030e604994aSStefano Zampini   } else {
1031e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
1032312be037SStefano Zampini     sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
1033e604994aSStefano Zampini     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
1034e604994aSStefano Zampini     len -= 15; /* remove "pc_bddc_coarse_" */
1035312be037SStefano Zampini     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
1036312be037SStefano Zampini     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
1037e604994aSStefano Zampini     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
1038e604994aSStefano Zampini     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
1039e604994aSStefano Zampini     *(dir_prefix+len)='\0';
1040e604994aSStefano Zampini     *(neu_prefix+len)='\0';
1041e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
1042e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
1043e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
1044e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
1045e604994aSStefano Zampini   }
1046e604994aSStefano Zampini 
1047304d26faSStefano Zampini   /* DIRICHLET PROBLEM */
1048ac78edfcSStefano Zampini   /* Matrix for Dirichlet problem is pcis->A_II */
10498ce42a96SStefano Zampini   ierr = ISGetSize(pcis->is_I_local,&n_D);CHKERRQ(ierr);
1050304d26faSStefano Zampini   if (!pcbddc->ksp_D) { /* create object if not yet build */
1051304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
1052304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
1053304d26faSStefano Zampini     /* default */
1054304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
1055e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
10569577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
1057304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
10589577ea80SStefano Zampini     if (issbaij) {
10599577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
10609577ea80SStefano Zampini     } else {
1061304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
10629577ea80SStefano Zampini     }
1063304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1064304d26faSStefano Zampini     /* Allow user's customization */
1065304d26faSStefano Zampini     ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
1066312be037SStefano Zampini   }
1067*95ecbf38SStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
1068304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1069304d26faSStefano Zampini   if (!n_D) {
1070304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
1071304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1072304d26faSStefano Zampini   }
1073304d26faSStefano Zampini   /* Set Up KSP for Dirichlet problem of BDDC */
1074304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
1075304d26faSStefano Zampini   /* set ksp_D into pcis data */
1076304d26faSStefano Zampini   ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
1077304d26faSStefano Zampini   ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
1078304d26faSStefano Zampini   pcis->ksp_D = pcbddc->ksp_D;
1079304d26faSStefano Zampini 
1080304d26faSStefano Zampini   /* NEUMANN PROBLEM */
1081f4ddd8eeSStefano Zampini   /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
10828ce42a96SStefano Zampini   ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
1083f4ddd8eeSStefano Zampini   if (pcbddc->ksp_R) { /* already created ksp */
1084f4ddd8eeSStefano Zampini     PetscInt nn_R;
108581d9aea3SBarry Smith     ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
1086f4ddd8eeSStefano Zampini     ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
1087f4ddd8eeSStefano Zampini     ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
1088f4ddd8eeSStefano Zampini     if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
1089f4ddd8eeSStefano Zampini       ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
1090f4ddd8eeSStefano Zampini       ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1091f4ddd8eeSStefano Zampini       reuse = MAT_INITIAL_MATRIX;
1092f4ddd8eeSStefano Zampini     } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
1093727cdba6SStefano Zampini       if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
1094f4ddd8eeSStefano Zampini         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1095f4ddd8eeSStefano Zampini         reuse = MAT_INITIAL_MATRIX;
1096f4ddd8eeSStefano Zampini       } else { /* safe to reuse the matrix */
1097f4ddd8eeSStefano Zampini         reuse = MAT_REUSE_MATRIX;
1098f4ddd8eeSStefano Zampini       }
1099f4ddd8eeSStefano Zampini     }
1100f4ddd8eeSStefano Zampini     /* last check */
1101d1e9a80fSBarry Smith     if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
1102f4ddd8eeSStefano Zampini       ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1103f4ddd8eeSStefano Zampini       reuse = MAT_INITIAL_MATRIX;
1104f4ddd8eeSStefano Zampini     }
1105f4ddd8eeSStefano Zampini   } else { /* first time, so we need to create the matrix */
1106f4ddd8eeSStefano Zampini     reuse = MAT_INITIAL_MATRIX;
1107f4ddd8eeSStefano Zampini   }
1108f4ddd8eeSStefano Zampini   /* extract A_RR */
1109af732b37SStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
1110af732b37SStefano Zampini   ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
11113a50541eSStefano Zampini   if (ibs != mbs) {
1112af732b37SStefano Zampini     Mat newmat;
1113af732b37SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
1114f4ddd8eeSStefano Zampini     ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
1115af732b37SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
1116af732b37SStefano Zampini   } else {
1117f4ddd8eeSStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
1118af732b37SStefano Zampini   }
1119f4ddd8eeSStefano Zampini   if (!pcbddc->ksp_R) { /* create object if not present */
1120304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
1121304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
1122304d26faSStefano Zampini     /* default */
1123304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
1124e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
1125304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
11269577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
11279577ea80SStefano Zampini     if (issbaij) {
11289577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
11299577ea80SStefano Zampini     } else {
1130304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
11319577ea80SStefano Zampini     }
1132304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1133304d26faSStefano Zampini     /* Allow user's customization */
1134304d26faSStefano Zampini     ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
1135312be037SStefano Zampini   }
1136*95ecbf38SStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
1137304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1138304d26faSStefano Zampini   if (!n_R) {
1139304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
1140304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1141304d26faSStefano Zampini   }
1142304d26faSStefano Zampini   /* Set Up KSP for Neumann problem of BDDC */
1143304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
1144304d26faSStefano Zampini 
1145304d26faSStefano Zampini   /* check Dirichlet and Neumann solvers and adapt them if a nullspace correction is needed */
11460fccc4e9SStefano Zampini   if (pcbddc->NullSpace || pcbddc->dbg_flag) {
1147304d26faSStefano Zampini     /* Dirichlet */
11480fccc4e9SStefano Zampini     ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
11490fccc4e9SStefano Zampini     ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
11500fccc4e9SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
11510fccc4e9SStefano Zampini     ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
11520fccc4e9SStefano Zampini     ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
1153304d26faSStefano Zampini     /* need to be adapted? */
1154b8ffe317SStefano Zampini     use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1155b8ffe317SStefano Zampini     ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1156b8ffe317SStefano Zampini     ierr = PCBDDCSetUseExactDirichlet(pc,use_exact_reduced);CHKERRQ(ierr);
1157304d26faSStefano Zampini     /* print info */
1158304d26faSStefano Zampini     if (pcbddc->dbg_flag) {
1159304d26faSStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
11600fccc4e9SStefano Zampini       ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
1161304d26faSStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
1162304d26faSStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Checking solution of Dirichlet and Neumann problems\n");CHKERRQ(ierr);
1163e604994aSStefano 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);
1164304d26faSStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1165304d26faSStefano Zampini     }
1166b8ffe317SStefano Zampini     if (pcbddc->NullSpace && !use_exact_reduced && !pcbddc->switch_static) {
11678ce42a96SStefano Zampini       ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcis->is_I_local);CHKERRQ(ierr);
1168304d26faSStefano Zampini     }
1169304d26faSStefano Zampini 
1170304d26faSStefano Zampini     /* Neumann */
11710fccc4e9SStefano Zampini     ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
11720fccc4e9SStefano Zampini     ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
11730fccc4e9SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
11740fccc4e9SStefano Zampini     ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
11750fccc4e9SStefano Zampini     ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
1176304d26faSStefano Zampini     /* need to be adapted? */
1177b8ffe317SStefano Zampini     use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1178b8ffe317SStefano Zampini     ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1179304d26faSStefano Zampini     /* print info */
1180304d26faSStefano Zampini     if (pcbddc->dbg_flag) {
1181e604994aSStefano 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);
1182304d26faSStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1183304d26faSStefano Zampini     }
1184b8ffe317SStefano Zampini     if (pcbddc->NullSpace && !use_exact_reduced) { /* is it the right logic? */
11858ce42a96SStefano Zampini       ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcbddc->is_R_local);CHKERRQ(ierr);
1186304d26faSStefano Zampini     }
11870fccc4e9SStefano Zampini   }
1188304d26faSStefano Zampini   /* free Neumann problem's matrix */
1189304d26faSStefano Zampini   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1190304d26faSStefano Zampini   PetscFunctionReturn(0);
1191304d26faSStefano Zampini }
1192304d26faSStefano Zampini 
1193304d26faSStefano Zampini #undef __FUNCT__
1194ba15a52eSStefano Zampini #define __FUNCT__ "PCBDDCSolveSubstructureCorrection"
119520c7b377SStefano Zampini static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec rhs, Vec sol, Vec work, PetscBool applytranspose)
1196674ae819SStefano Zampini {
1197674ae819SStefano Zampini   PetscErrorCode ierr;
1198674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1199674ae819SStefano Zampini 
1200674ae819SStefano Zampini   PetscFunctionBegin;
120120c7b377SStefano Zampini   if (applytranspose) {
1202674ae819SStefano Zampini     if (pcbddc->local_auxmat1) {
120320c7b377SStefano Zampini       ierr = MatMultTranspose(pcbddc->local_auxmat2,rhs,work);CHKERRQ(ierr);
120420c7b377SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,work,rhs,rhs);CHKERRQ(ierr);
120520c7b377SStefano Zampini     }
120620c7b377SStefano Zampini     ierr = KSPSolveTranspose(pcbddc->ksp_R,rhs,sol);CHKERRQ(ierr);
120720c7b377SStefano Zampini   } else {
120820c7b377SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,rhs,sol);CHKERRQ(ierr);
120920c7b377SStefano Zampini     if (pcbddc->local_auxmat1) {
121020c7b377SStefano Zampini       ierr = MatMult(pcbddc->local_auxmat1,sol,work);CHKERRQ(ierr);
121120c7b377SStefano Zampini       ierr = MatMultAdd(pcbddc->local_auxmat2,work,sol,sol);CHKERRQ(ierr);
121220c7b377SStefano Zampini     }
1213674ae819SStefano Zampini   }
1214674ae819SStefano Zampini   PetscFunctionReturn(0);
1215674ae819SStefano Zampini }
1216674ae819SStefano Zampini 
1217dc359a40SStefano Zampini /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
1218674ae819SStefano Zampini #undef __FUNCT__
1219674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
1220dc359a40SStefano Zampini PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
1221674ae819SStefano Zampini {
1222674ae819SStefano Zampini   PetscErrorCode ierr;
1223674ae819SStefano Zampini   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
1224674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)  (pc->data);
1225674ae819SStefano Zampini   const PetscScalar zero = 0.0;
1226674ae819SStefano Zampini 
1227674ae819SStefano Zampini   PetscFunctionBegin;
1228dc359a40SStefano Zampini   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
1229dc359a40SStefano Zampini   if (applytranspose) {
1230674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
12318eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
1232dc359a40SStefano Zampini   } else {
1233674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
1234674ae819SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
123515aaf578SStefano Zampini   }
123612edc857SStefano Zampini   /* start communications from local primal nodes to rhs of coarse solver */
123712edc857SStefano Zampini   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
123812edc857SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
123912edc857SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
124012edc857SStefano Zampini 
124112edc857SStefano Zampini   /* Coarse solution -> rhs and sol updated in PCBDDCScattarCoarseDataBegin/End */
124212edc857SStefano Zampini   /* TODO remove null space when doing multilevel */
124312edc857SStefano Zampini   if (pcbddc->coarse_ksp) {
124412edc857SStefano Zampini     if (applytranspose) {
124512edc857SStefano Zampini       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,NULL,NULL);CHKERRQ(ierr);
124612edc857SStefano Zampini     } else {
124712edc857SStefano Zampini       ierr = KSPSolve(pcbddc->coarse_ksp,NULL,NULL);CHKERRQ(ierr);
124812edc857SStefano Zampini     }
124912edc857SStefano Zampini   }
125012edc857SStefano Zampini   /* start communications from coarse solver solution to local primal nodes */
125112edc857SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1252674ae819SStefano Zampini 
1253674ae819SStefano Zampini   /* Local solution on R nodes */
1254674ae819SStefano Zampini   ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
1255674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1256674ae819SStefano Zampini   ierr = VecScatterEnd(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
12578eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1258674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1259674ae819SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1260674ae819SStefano Zampini   }
126120c7b377SStefano Zampini   ierr = PCBDDCSolveSubstructureCorrection(pc,pcbddc->vec1_R,pcbddc->vec2_R,pcbddc->vec1_C,applytranspose);CHKERRQ(ierr);
1262674ae819SStefano Zampini   ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1263674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1264674ae819SStefano Zampini   ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
12658eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1266674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1267674ae819SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1268674ae819SStefano Zampini   }
1269674ae819SStefano Zampini 
127012edc857SStefano Zampini   /* complete communications from coarse sol to local primal nodes */
127112edc857SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1272674ae819SStefano Zampini 
1273674ae819SStefano Zampini   /* Sum contributions from two levels */
1274dc359a40SStefano Zampini   if (applytranspose) {
1275dc359a40SStefano Zampini     ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
1276dc359a40SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1277dc359a40SStefano Zampini   } else {
1278674ae819SStefano Zampini     ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
12798eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1280dc359a40SStefano Zampini   }
1281674ae819SStefano Zampini   PetscFunctionReturn(0);
1282674ae819SStefano Zampini }
1283674ae819SStefano Zampini 
128412edc857SStefano Zampini /* TODO: the following two function can be optimized using VecPlaceArray whenever possible and using overlap flag */
1285674ae819SStefano Zampini #undef __FUNCT__
1286674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
128712edc857SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
1288674ae819SStefano Zampini {
1289674ae819SStefano Zampini   PetscErrorCode ierr;
1290674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
129112edc857SStefano Zampini   PetscScalar    *array,*array2;
129212edc857SStefano Zampini   Vec            from,to;
1293674ae819SStefano Zampini 
1294674ae819SStefano Zampini   PetscFunctionBegin;
129512edc857SStefano Zampini   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
129612edc857SStefano Zampini     from = pcbddc->coarse_vec;
129712edc857SStefano Zampini     to = pcbddc->vec1_P;
129812edc857SStefano Zampini     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
129912edc857SStefano Zampini       Vec tvec;
130012edc857SStefano Zampini       PetscInt lsize;
130112edc857SStefano Zampini       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
130212edc857SStefano Zampini       ierr = VecGetLocalSize(tvec,&lsize);CHKERRQ(ierr);
130312edc857SStefano Zampini       ierr = VecGetArrayRead(tvec,(const PetscScalar**)&array);CHKERRQ(ierr);
130412edc857SStefano Zampini       ierr = VecGetArray(from,&array2);CHKERRQ(ierr);
130512edc857SStefano Zampini       ierr = PetscMemcpy(array2,array,lsize*sizeof(PetscScalar));CHKERRQ(ierr);
130612edc857SStefano Zampini       ierr = VecRestoreArrayRead(tvec,(const PetscScalar**)&array);CHKERRQ(ierr);
130712edc857SStefano Zampini       ierr = VecRestoreArray(from,&array2);CHKERRQ(ierr);
130812edc857SStefano Zampini     }
130912edc857SStefano Zampini   } else { /* from local to global -> put data in coarse right hand side */
131012edc857SStefano Zampini     from = pcbddc->vec1_P;
131112edc857SStefano Zampini     to = pcbddc->coarse_vec;
131212edc857SStefano Zampini   }
131312edc857SStefano Zampini   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
1314674ae819SStefano Zampini   PetscFunctionReturn(0);
1315674ae819SStefano Zampini }
1316674ae819SStefano Zampini 
1317674ae819SStefano Zampini #undef __FUNCT__
1318674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
131912edc857SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
1320674ae819SStefano Zampini {
1321674ae819SStefano Zampini   PetscErrorCode ierr;
1322674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
132312edc857SStefano Zampini   PetscScalar    *array,*array2;
132412edc857SStefano Zampini   Vec            from,to;
1325674ae819SStefano Zampini 
1326674ae819SStefano Zampini   PetscFunctionBegin;
132712edc857SStefano Zampini   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
132812edc857SStefano Zampini     from = pcbddc->coarse_vec;
132912edc857SStefano Zampini     to = pcbddc->vec1_P;
133012edc857SStefano Zampini   } else { /* from local to global -> put data in coarse right hand side */
133112edc857SStefano Zampini     from = pcbddc->vec1_P;
133212edc857SStefano Zampini     to = pcbddc->coarse_vec;
133312edc857SStefano Zampini   }
133412edc857SStefano Zampini   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
133512edc857SStefano Zampini   if (smode == SCATTER_FORWARD) {
133612edc857SStefano Zampini     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
133712edc857SStefano Zampini       Vec tvec;
133812edc857SStefano Zampini       PetscInt lsize;
133912edc857SStefano Zampini       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
134012edc857SStefano Zampini       ierr = VecGetLocalSize(tvec,&lsize);CHKERRQ(ierr);
134112edc857SStefano Zampini       ierr = VecGetArrayRead(to,(const PetscScalar**)&array);CHKERRQ(ierr);
134212edc857SStefano Zampini       ierr = VecGetArray(tvec,&array2);CHKERRQ(ierr);
134312edc857SStefano Zampini       ierr = PetscMemcpy(array2,array,lsize*sizeof(PetscScalar));CHKERRQ(ierr);
134412edc857SStefano Zampini       ierr = VecRestoreArrayRead(to,(const PetscScalar**)&array);CHKERRQ(ierr);
134512edc857SStefano Zampini       ierr = VecRestoreArray(tvec,&array2);CHKERRQ(ierr);
134612edc857SStefano Zampini     }
134712edc857SStefano Zampini   }
1348674ae819SStefano Zampini   PetscFunctionReturn(0);
1349674ae819SStefano Zampini }
1350674ae819SStefano Zampini 
1351984c4197SStefano Zampini /* uncomment for testing purposes */
1352984c4197SStefano Zampini /* #define PETSC_MISSING_LAPACK_GESVD 1 */
1353674ae819SStefano Zampini #undef __FUNCT__
1354674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp"
1355674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
1356674ae819SStefano Zampini {
1357674ae819SStefano Zampini   PetscErrorCode    ierr;
1358674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
1359674ae819SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
1360674ae819SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
1361984c4197SStefano Zampini   /* constraint and (optionally) change of basis matrix implemented as SeqAIJ */
1362674ae819SStefano Zampini   MatType           impMatType=MATSEQAIJ;
1363984c4197SStefano Zampini   /* one and zero */
1364984c4197SStefano Zampini   PetscScalar       one=1.0,zero=0.0;
1365984c4197SStefano Zampini   /* space to store constraints and their local indices */
1366984c4197SStefano Zampini   PetscScalar       *temp_quadrature_constraint;
1367984c4197SStefano Zampini   PetscInt          *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B;
1368984c4197SStefano Zampini   /* iterators */
1369984c4197SStefano Zampini   PetscInt          i,j,k,total_counts,temp_start_ptr;
1370984c4197SStefano Zampini   /* stuff to store connected components stored in pcbddc->mat_graph */
1371984c4197SStefano Zampini   IS                ISForVertices,*ISForFaces,*ISForEdges,*used_IS;
1372984c4197SStefano Zampini   PetscInt          n_ISForFaces,n_ISForEdges;
1373984c4197SStefano Zampini   /* near null space stuff */
1374674ae819SStefano Zampini   MatNullSpace      nearnullsp;
1375674ae819SStefano Zampini   const Vec         *nearnullvecs;
1376674ae819SStefano Zampini   Vec               *localnearnullsp;
1377984c4197SStefano Zampini   PetscBool         nnsp_has_cnst;
1378984c4197SStefano Zampini   PetscInt          nnsp_size;
1379984c4197SStefano Zampini   PetscScalar       *array;
1380984c4197SStefano Zampini   /* BLAS integers */
1381e310c8b4SStefano Zampini   PetscBLASInt      lwork,lierr;
1382e310c8b4SStefano Zampini   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
1383c4303822SStefano Zampini   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
1384984c4197SStefano Zampini   /* LAPACK working arrays for SVD or POD */
1385242a89d7SStefano Zampini   PetscBool         skip_lapack;
1386984c4197SStefano Zampini   PetscScalar       *work;
1387984c4197SStefano Zampini   PetscReal         *singular_vals;
1388984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1389984c4197SStefano Zampini   PetscReal         *rwork;
1390674ae819SStefano Zampini #endif
1391984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1392e310c8b4SStefano Zampini   PetscBLASInt      Blas_one_2=1;
1393984c4197SStefano Zampini   PetscScalar       *temp_basis,*correlation_mat;
1394b7d8b9f8SStefano Zampini #else
1395b7d8b9f8SStefano Zampini   PetscBLASInt      dummy_int_1=1,dummy_int_2=1;
1396b7d8b9f8SStefano Zampini   PetscScalar       dummy_scalar_1=0.0,dummy_scalar_2=0.0;
1397984c4197SStefano Zampini #endif
1398727cdba6SStefano Zampini   /* reuse */
1399727cdba6SStefano Zampini   PetscInt          olocal_primal_size;
1400727cdba6SStefano Zampini   PetscInt          *oprimal_indices_local_idxs;
1401984c4197SStefano Zampini   /* change of basis */
1402984c4197SStefano Zampini   PetscInt          *aux_primal_numbering,*aux_primal_minloc,*global_indices;
1403a717540cSStefano Zampini   PetscBool         boolforchange,qr_needed;
1404a717540cSStefano Zampini   PetscBT           touched,change_basis,qr_needed_idx;
1405984c4197SStefano Zampini   /* auxiliary stuff */
140639e2fb2aSStefano Zampini   PetscInt          *nnz,*is_indices,*aux_primal_numbering_B;
1407984c4197SStefano Zampini   /* some quantities */
140845a1bb75SStefano Zampini   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
1409984c4197SStefano Zampini   PetscInt          size_of_constraint,max_size_of_constraint,max_constraints,temp_constraints;
1410984c4197SStefano Zampini 
1411674ae819SStefano Zampini 
1412674ae819SStefano Zampini   PetscFunctionBegin;
14138e61c736SStefano Zampini   /* Destroy Mat objects computed previously */
14148e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
14158e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1416674ae819SStefano Zampini   /* Get index sets for faces, edges and vertices from graph */
14178eeda7d8SStefano Zampini   if (!pcbddc->use_faces && !pcbddc->use_edges && !pcbddc->use_vertices) {
14188eeda7d8SStefano Zampini     pcbddc->use_vertices = PETSC_TRUE;
1419674ae819SStefano Zampini   }
14208eeda7d8SStefano Zampini   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,pcbddc->use_faces,pcbddc->use_edges,pcbddc->use_vertices,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);
142198a51de6SStefano Zampini   /* HACKS (the two following code branches) */
1422b8ffe317SStefano Zampini   if (!ISForVertices && pcbddc->NullSpace) {
1423b8ffe317SStefano Zampini     pcbddc->use_change_of_basis = PETSC_TRUE;
1424b8ffe317SStefano Zampini     pcbddc->use_change_on_faces = PETSC_FALSE;
1425b8ffe317SStefano Zampini   }
142698a51de6SStefano Zampini   if (pcbddc->NullSpace) {
142798a51de6SStefano Zampini     /* use_change_of_basis should be consistent among processors */
142898a51de6SStefano Zampini     PetscBool tbool = pcbddc->use_change_of_basis;
142998a51de6SStefano Zampini     ierr = MPI_Allreduce(&tbool,&(pcbddc->use_change_of_basis),1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
143098a51de6SStefano Zampini   }
1431984c4197SStefano Zampini   /* print some info */
1432674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
14330fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
1434674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1435674ae819SStefano Zampini     i = 0;
1436674ae819SStefano Zampini     if (ISForVertices) {
1437674ae819SStefano Zampini       ierr = ISGetSize(ISForVertices,&i);CHKERRQ(ierr);
1438674ae819SStefano Zampini     }
1439674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices\n",PetscGlobalRank,i);CHKERRQ(ierr);
1440674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges\n",PetscGlobalRank,n_ISForEdges);CHKERRQ(ierr);
144115aaf578SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces\n",PetscGlobalRank,n_ISForFaces);CHKERRQ(ierr);
1442674ae819SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1443674ae819SStefano Zampini   }
1444674ae819SStefano Zampini   /* check if near null space is attached to global mat */
1445674ae819SStefano Zampini   ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
1446674ae819SStefano Zampini   if (nearnullsp) {
1447674ae819SStefano Zampini     ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
1448f4ddd8eeSStefano Zampini     /* remove any stored info */
1449f4ddd8eeSStefano Zampini     ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
1450f4ddd8eeSStefano Zampini     ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1451f4ddd8eeSStefano Zampini     /* store information for BDDC solver reuse */
1452f4ddd8eeSStefano Zampini     ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
1453f4ddd8eeSStefano Zampini     pcbddc->onearnullspace = nearnullsp;
1454473ba861SJed Brown     ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1455f4ddd8eeSStefano Zampini     for (i=0;i<nnsp_size;i++) {
1456f4ddd8eeSStefano Zampini       ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
1457f4ddd8eeSStefano Zampini     }
1458984c4197SStefano Zampini   } else { /* if near null space is not provided BDDC uses constants by default */
1459984c4197SStefano Zampini     nnsp_size = 0;
1460674ae819SStefano Zampini     nnsp_has_cnst = PETSC_TRUE;
1461674ae819SStefano Zampini   }
1462984c4197SStefano Zampini   /* get max number of constraints on a single cc */
1463984c4197SStefano Zampini   max_constraints = nnsp_size;
1464984c4197SStefano Zampini   if (nnsp_has_cnst) max_constraints++;
1465984c4197SStefano Zampini 
1466674ae819SStefano Zampini   /*
1467674ae819SStefano Zampini        Evaluate maximum storage size needed by the procedure
1468674ae819SStefano Zampini        - temp_indices will contain start index of each constraint stored as follows
1469674ae819SStefano Zampini        - temp_indices_to_constraint  [temp_indices[i],...,temp[indices[i+1]-1] will contain the indices (in local numbering) on which the constraint acts
1470674ae819SStefano Zampini        - temp_indices_to_constraint_B[temp_indices[i],...,temp[indices[i+1]-1] will contain the indices (in boundary numbering) on which the constraint acts
1471674ae819SStefano Zampini        - temp_quadrature_constraint  [temp_indices[i],...,temp[indices[i+1]-1] will contain the scalars representing the constraint itself
1472674ae819SStefano Zampini                                                                                                                                                          */
1473674ae819SStefano Zampini   total_counts = n_ISForFaces+n_ISForEdges;
1474984c4197SStefano Zampini   total_counts *= max_constraints;
1475674ae819SStefano Zampini   n_vertices = 0;
1476674ae819SStefano Zampini   if (ISForVertices) {
1477674ae819SStefano Zampini     ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
1478674ae819SStefano Zampini   }
1479674ae819SStefano Zampini   total_counts += n_vertices;
1480785e854fSJed Brown   ierr = PetscMalloc1((total_counts+1),&temp_indices);CHKERRQ(ierr);
14814641a718SStefano Zampini   ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
1482674ae819SStefano Zampini   total_counts = 0;
1483674ae819SStefano Zampini   max_size_of_constraint = 0;
1484674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1485674ae819SStefano Zampini     if (i<n_ISForEdges) {
1486674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1487674ae819SStefano Zampini     } else {
1488674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1489674ae819SStefano Zampini     }
1490674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
1491674ae819SStefano Zampini     total_counts += j;
1492674ae819SStefano Zampini     max_size_of_constraint = PetscMax(j,max_size_of_constraint);
1493674ae819SStefano Zampini   }
1494984c4197SStefano Zampini   total_counts *= max_constraints;
1495674ae819SStefano Zampini   total_counts += n_vertices;
1496785e854fSJed Brown   ierr = PetscMalloc1(total_counts,&temp_quadrature_constraint);CHKERRQ(ierr);
1497785e854fSJed Brown   ierr = PetscMalloc1(total_counts,&temp_indices_to_constraint);CHKERRQ(ierr);
1498785e854fSJed Brown   ierr = PetscMalloc1(total_counts,&temp_indices_to_constraint_B);CHKERRQ(ierr);
1499984c4197SStefano Zampini   /* get local part of global near null space vectors */
1500785e854fSJed Brown   ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
1501984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1502984c4197SStefano Zampini     ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
1503984c4197SStefano Zampini     ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1504984c4197SStefano Zampini     ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1505984c4197SStefano Zampini   }
1506674ae819SStefano Zampini 
1507242a89d7SStefano Zampini   /* whether or not to skip lapack calls */
1508242a89d7SStefano Zampini   skip_lapack = PETSC_TRUE;
1509242a89d7SStefano Zampini   if (n_ISForFaces+n_ISForEdges) skip_lapack = PETSC_FALSE;
1510242a89d7SStefano Zampini 
1511984c4197SStefano Zampini   /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
1512242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1513674ae819SStefano Zampini     PetscScalar temp_work;
1514674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1515984c4197SStefano Zampini     /* Proper Orthogonal Decomposition (POD) using the snapshot method */
1516785e854fSJed Brown     ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
1517785e854fSJed Brown     ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
1518785e854fSJed Brown     ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
1519674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1520785e854fSJed Brown     ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
1521674ae819SStefano Zampini #endif
1522674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1523c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
1524c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
1525674ae819SStefano Zampini     lwork = -1;
1526674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1527674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1528c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
1529674ae819SStefano Zampini #else
1530c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
1531674ae819SStefano Zampini #endif
1532674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1533984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
1534674ae819SStefano Zampini #else /* on missing GESVD */
1535674ae819SStefano Zampini     /* SVD */
1536674ae819SStefano Zampini     PetscInt max_n,min_n;
1537674ae819SStefano Zampini     max_n = max_size_of_constraint;
1538984c4197SStefano Zampini     min_n = max_constraints;
1539984c4197SStefano Zampini     if (max_size_of_constraint < max_constraints) {
1540674ae819SStefano Zampini       min_n = max_size_of_constraint;
1541984c4197SStefano Zampini       max_n = max_constraints;
1542674ae819SStefano Zampini     }
1543785e854fSJed Brown     ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
1544674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1545785e854fSJed Brown     ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
1546674ae819SStefano Zampini #endif
1547674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1548674ae819SStefano Zampini     lwork = -1;
1549e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
1550e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
1551b7d8b9f8SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
1552674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1553674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1554e310c8b4SStefano Zampini     PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,&temp_quadrature_constraint[0],&Blas_LDA,singular_vals,&dummy_scalar_1,&dummy_int_1,&dummy_scalar_2,&dummy_int_2,&temp_work,&lwork,&lierr));
1555674ae819SStefano Zampini #else
1556e310c8b4SStefano Zampini     PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,&temp_quadrature_constraint[0],&Blas_LDA,singular_vals,&dummy_scalar_1,&dummy_int_1,&dummy_scalar_2,&dummy_int_2,&temp_work,&lwork,rwork,&lierr));
1557674ae819SStefano Zampini #endif
1558674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1559984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
1560984c4197SStefano Zampini #endif /* on missing GESVD */
1561674ae819SStefano Zampini     /* Allocate optimal workspace */
1562674ae819SStefano Zampini     ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
1563785e854fSJed Brown     ierr = PetscMalloc1((PetscInt)lwork,&work);CHKERRQ(ierr);
1564674ae819SStefano Zampini   }
1565674ae819SStefano Zampini   /* Now we can loop on constraining sets */
1566674ae819SStefano Zampini   total_counts = 0;
1567674ae819SStefano Zampini   temp_indices[0] = 0;
1568674ae819SStefano Zampini   /* vertices */
1569674ae819SStefano Zampini   if (ISForVertices) {
1570674ae819SStefano Zampini     ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1571674ae819SStefano Zampini     if (nnsp_has_cnst) { /* consider all vertices */
157239e2fb2aSStefano Zampini       ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
1573674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1574674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1575674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1576674ae819SStefano Zampini         total_counts++;
1577674ae819SStefano Zampini       }
1578674ae819SStefano Zampini     } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
1579984c4197SStefano Zampini       PetscBool used_vertex;
1580674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1581674ae819SStefano Zampini         used_vertex = PETSC_FALSE;
1582674ae819SStefano Zampini         k = 0;
1583674ae819SStefano Zampini         while (!used_vertex && k<nnsp_size) {
1584984c4197SStefano Zampini           ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1585984c4197SStefano Zampini           if (PetscAbsScalar(array[is_indices[i]])>0.0) {
1586674ae819SStefano Zampini             temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1587674ae819SStefano Zampini             temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1588674ae819SStefano Zampini             temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1589674ae819SStefano Zampini             total_counts++;
1590674ae819SStefano Zampini             used_vertex = PETSC_TRUE;
1591674ae819SStefano Zampini           }
1592984c4197SStefano Zampini           ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1593674ae819SStefano Zampini           k++;
1594674ae819SStefano Zampini         }
1595674ae819SStefano Zampini       }
1596674ae819SStefano Zampini     }
1597674ae819SStefano Zampini     ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1598674ae819SStefano Zampini     n_vertices = total_counts;
1599674ae819SStefano Zampini   }
1600984c4197SStefano Zampini 
1601674ae819SStefano Zampini   /* edges and faces */
1602674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1603674ae819SStefano Zampini     if (i<n_ISForEdges) {
1604674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1605984c4197SStefano Zampini       boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
1606674ae819SStefano Zampini     } else {
1607674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1608984c4197SStefano Zampini       boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
1609674ae819SStefano Zampini     }
1610674ae819SStefano Zampini     temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
1611674ae819SStefano Zampini     temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
1612674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
1613674ae819SStefano Zampini     ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1614984c4197SStefano Zampini     /* change of basis should not be performed on local periodic nodes */
1615984c4197SStefano Zampini     if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
1616674ae819SStefano Zampini     if (nnsp_has_cnst) {
16175b08dc53SStefano Zampini       PetscScalar quad_value;
1618674ae819SStefano Zampini       temp_constraints++;
1619674ae819SStefano Zampini       quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
162039e2fb2aSStefano Zampini       ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
1621674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1622674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
1623674ae819SStefano Zampini       }
1624674ae819SStefano Zampini       temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
1625674ae819SStefano Zampini       total_counts++;
1626674ae819SStefano Zampini     }
1627674ae819SStefano Zampini     for (k=0;k<nnsp_size;k++) {
1628984c4197SStefano Zampini       PetscReal real_value;
1629984c4197SStefano Zampini       ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
163039e2fb2aSStefano Zampini       ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
1631674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1632984c4197SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=array[is_indices[j]];
1633674ae819SStefano Zampini       }
1634984c4197SStefano Zampini       ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1635984c4197SStefano Zampini       /* check if array is null on the connected component */
1636e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1637e310c8b4SStefano Zampini       PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_one));
16385b08dc53SStefano Zampini       if (real_value > 0.0) { /* keep indices and values */
1639674ae819SStefano Zampini         temp_constraints++;
1640674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
1641674ae819SStefano Zampini         total_counts++;
1642674ae819SStefano Zampini       }
1643674ae819SStefano Zampini     }
1644674ae819SStefano Zampini     ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
164545a1bb75SStefano Zampini     valid_constraints = temp_constraints;
1646eb97c9d2SStefano Zampini     /* perform SVD on the constraints if use_nnsp_true has not be requested by the user and there are non-null constraints on the cc */
1647eb97c9d2SStefano Zampini     if (!pcbddc->use_nnsp_true && temp_constraints) {
1648984c4197SStefano Zampini       PetscReal tol = 1.0e-8; /* tolerance for retaining eigenmodes */
1649674ae819SStefano Zampini 
1650674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1651984c4197SStefano Zampini       /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
1652984c4197SStefano Zampini          POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
1653984c4197SStefano Zampini          -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
1654984c4197SStefano Zampini             the constraints basis will differ (by a complex factor with absolute value equal to 1)
1655984c4197SStefano Zampini             from that computed using LAPACKgesvd
1656984c4197SStefano Zampini          -> This is due to a different computation of eigenvectors in LAPACKheev
1657984c4197SStefano Zampini          -> The quality of the POD-computed basis will be the same */
1658984c4197SStefano Zampini       ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
1659674ae819SStefano Zampini       /* Store upper triangular part of correlation matrix */
1660e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1661984c4197SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1662674ae819SStefano Zampini       for (j=0;j<temp_constraints;j++) {
1663674ae819SStefano Zampini         for (k=0;k<j+1;k++) {
1664e310c8b4SStefano Zampini           PetscStackCallBLAS("BLASdot",correlation_mat[j*temp_constraints+k]=BLASdot_(&Blas_N,&temp_quadrature_constraint[temp_indices[temp_start_ptr+k]],&Blas_one,&temp_quadrature_constraint[temp_indices[temp_start_ptr+j]],&Blas_one_2));
1665674ae819SStefano Zampini         }
1666674ae819SStefano Zampini       }
1667e310c8b4SStefano Zampini       /* compute eigenvalues and eigenvectors of correlation matrix */
1668e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1669e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
1670674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1671c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
1672674ae819SStefano Zampini #else
1673c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
1674674ae819SStefano Zampini #endif
1675674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1676984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
1677984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
1678674ae819SStefano Zampini       j=0;
1679984c4197SStefano Zampini       while (j < temp_constraints && singular_vals[j] < tol) j++;
1680674ae819SStefano Zampini       total_counts=total_counts-j;
168145a1bb75SStefano Zampini       valid_constraints = temp_constraints-j;
1682e310c8b4SStefano Zampini       /* scale and copy POD basis into used quadrature memory */
1683c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1684c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1685c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
1686c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1687c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
1688c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1689674ae819SStefano Zampini       if (j<temp_constraints) {
1690984c4197SStefano Zampini         PetscInt ii;
1691984c4197SStefano Zampini         for (k=j;k<temp_constraints;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]);
1692674ae819SStefano Zampini         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1693c4303822SStefano Zampini         PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&Blas_M,&Blas_N,&Blas_K,&one,&temp_quadrature_constraint[temp_indices[temp_start_ptr]],&Blas_LDA,correlation_mat,&Blas_LDB,&zero,temp_basis,&Blas_LDC));
1694674ae819SStefano Zampini         ierr = PetscFPTrapPop();CHKERRQ(ierr);
1695984c4197SStefano Zampini         for (k=0;k<temp_constraints-j;k++) {
1696674ae819SStefano Zampini           for (ii=0;ii<size_of_constraint;ii++) {
1697984c4197SStefano Zampini             temp_quadrature_constraint[temp_indices[temp_start_ptr+k]+ii]=singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
1698674ae819SStefano Zampini           }
1699674ae819SStefano Zampini         }
1700674ae819SStefano Zampini       }
1701674ae819SStefano Zampini #else  /* on missing GESVD */
1702e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1703e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1704b7d8b9f8SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1705674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1706674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1707e310c8b4SStefano Zampini       PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,&temp_quadrature_constraint[temp_indices[temp_start_ptr]],&Blas_LDA,singular_vals,&dummy_scalar_1,&dummy_int_1,&dummy_scalar_2,&dummy_int_2,work,&lwork,&lierr));
1708674ae819SStefano Zampini #else
1709e310c8b4SStefano Zampini       PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,&temp_quadrature_constraint[temp_indices[temp_start_ptr]],&Blas_LDA,singular_vals,&dummy_scalar_1,&dummy_int_1,&dummy_scalar_2,&dummy_int_2,work,&lwork,rwork,&lierr));
1710674ae819SStefano Zampini #endif
1711984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
1712674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1713984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
1714e310c8b4SStefano Zampini       k = temp_constraints;
1715e310c8b4SStefano Zampini       if (k > size_of_constraint) k = size_of_constraint;
1716674ae819SStefano Zampini       j = 0;
1717e310c8b4SStefano Zampini       while (j < k && singular_vals[k-j-1] < tol) j++;
1718e310c8b4SStefano Zampini       total_counts = total_counts-temp_constraints+k-j;
171945a1bb75SStefano Zampini       valid_constraints = k-j;
1720984c4197SStefano Zampini #endif /* on missing GESVD */
1721674ae819SStefano Zampini     }
172245a1bb75SStefano Zampini     /* setting change_of_basis flag is safe now */
172345a1bb75SStefano Zampini     if (boolforchange) {
172445a1bb75SStefano Zampini       for (j=0;j<valid_constraints;j++) {
172545a1bb75SStefano Zampini         PetscBTSet(change_basis,total_counts-j-1);
172645a1bb75SStefano Zampini       }
172745a1bb75SStefano Zampini     }
1728674ae819SStefano Zampini   }
1729674ae819SStefano Zampini   /* free index sets of faces, edges and vertices */
1730674ae819SStefano Zampini   for (i=0;i<n_ISForFaces;i++) {
1731674ae819SStefano Zampini     ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
1732674ae819SStefano Zampini   }
1733674ae819SStefano Zampini   ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
1734674ae819SStefano Zampini   for (i=0;i<n_ISForEdges;i++) {
1735674ae819SStefano Zampini     ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
1736674ae819SStefano Zampini   }
1737674ae819SStefano Zampini   ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
1738674ae819SStefano Zampini   ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
173939e2fb2aSStefano Zampini   /* map temp_indices_to_constraint in boundary numbering */
174039e2fb2aSStefano Zampini   ierr = ISGlobalToLocalMappingApply(pcbddc->BtoNmap,IS_GTOLM_DROP,temp_indices[total_counts],temp_indices_to_constraint,&i,temp_indices_to_constraint_B);CHKERRQ(ierr);
174139e2fb2aSStefano Zampini   if (i != temp_indices[total_counts]) {
174239e2fb2aSStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for constraints indices %d != %d\n",temp_indices[total_counts],i);
174339e2fb2aSStefano Zampini   }
1744674ae819SStefano Zampini 
1745984c4197SStefano Zampini   /* free workspace */
1746242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1747984c4197SStefano Zampini     ierr = PetscFree(work);CHKERRQ(ierr);
1748984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1749984c4197SStefano Zampini     ierr = PetscFree(rwork);CHKERRQ(ierr);
1750984c4197SStefano Zampini #endif
1751984c4197SStefano Zampini     ierr = PetscFree(singular_vals);CHKERRQ(ierr);
1752984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1753984c4197SStefano Zampini     ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
1754984c4197SStefano Zampini     ierr = PetscFree(temp_basis);CHKERRQ(ierr);
1755984c4197SStefano Zampini #endif
1756984c4197SStefano Zampini   }
1757984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1758984c4197SStefano Zampini     ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
1759984c4197SStefano Zampini   }
1760984c4197SStefano Zampini   ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
1761984c4197SStefano Zampini 
1762727cdba6SStefano Zampini   /* set quantities in pcbddc data structure and store previous primal size */
1763984c4197SStefano Zampini   /* n_vertices defines the number of subdomain corners in the primal space */
1764674ae819SStefano Zampini   /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */
1765727cdba6SStefano Zampini   olocal_primal_size = pcbddc->local_primal_size;
1766984c4197SStefano Zampini   pcbddc->local_primal_size = total_counts;
1767674ae819SStefano Zampini   pcbddc->n_vertices = n_vertices;
1768984c4197SStefano Zampini   pcbddc->n_constraints = pcbddc->local_primal_size-pcbddc->n_vertices;
1769674ae819SStefano Zampini 
1770674ae819SStefano Zampini   /* Create constraint matrix */
1771674ae819SStefano Zampini   /* The constraint matrix is used to compute the l2g map of primal dofs */
1772674ae819SStefano Zampini   /* so we need to set it up properly either with or without change of basis */
1773674ae819SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1774674ae819SStefano Zampini   ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr);
1775984c4197SStefano Zampini   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
1776984c4197SStefano Zampini   /* array to compute a local numbering of constraints : vertices first then constraints */
1777785e854fSJed Brown   ierr = PetscMalloc1(pcbddc->local_primal_size,&aux_primal_numbering);CHKERRQ(ierr);
1778984c4197SStefano Zampini   /* array to select the proper local node (of minimum index with respect to global ordering) when changing the basis */
1779984c4197SStefano Zampini   /* note: it should not be needed since IS for faces and edges are already sorted by global ordering when analyzing the graph but... just in case */
1780785e854fSJed Brown   ierr = PetscMalloc1(pcbddc->local_primal_size,&aux_primal_minloc);CHKERRQ(ierr);
1781984c4197SStefano Zampini   /* auxiliary stuff for basis change */
1782785e854fSJed Brown   ierr = PetscMalloc1(max_size_of_constraint,&global_indices);CHKERRQ(ierr);
17834641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n_B,&touched);CHKERRQ(ierr);
1784984c4197SStefano Zampini 
1785984c4197SStefano Zampini   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
1786984c4197SStefano Zampini   total_primal_vertices=0;
1787984c4197SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
1788674ae819SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
1789984c4197SStefano Zampini     if (size_of_constraint == 1) {
17904641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]]);CHKERRQ(ierr);
1791984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]];
1792984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=0;
1793984c4197SStefano Zampini       total_primal_vertices++;
17944641a718SStefano Zampini     } else if (PetscBTLookup(change_basis,i)) { /* Same procedure used in PCBDDCGetPrimalConstraintsLocalIdx */
1795984c4197SStefano Zampini       PetscInt min_loc,min_index;
1796984c4197SStefano Zampini       ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],global_indices);CHKERRQ(ierr);
1797984c4197SStefano Zampini       /* find first untouched local node */
1798674ae819SStefano Zampini       k = 0;
17994641a718SStefano Zampini       while (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) k++;
1800984c4197SStefano Zampini       min_index = global_indices[k];
1801984c4197SStefano Zampini       min_loc = k;
1802984c4197SStefano Zampini       /* search the minimum among global nodes already untouched on the cc */
1803984c4197SStefano Zampini       for (k=1;k<size_of_constraint;k++) {
1804984c4197SStefano Zampini         /* there can be more than one constraint on a single connected component */
18054641a718SStefano Zampini         if (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k]) && min_index > global_indices[k]) {
1806984c4197SStefano Zampini           min_index = global_indices[k];
1807984c4197SStefano Zampini           min_loc = k;
1808674ae819SStefano Zampini         }
1809674ae819SStefano Zampini       }
18104641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]+min_loc]);CHKERRQ(ierr);
1811984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]+min_loc];
1812984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=min_loc;
1813984c4197SStefano Zampini       total_primal_vertices++;
1814984c4197SStefano Zampini     }
1815984c4197SStefano Zampini   }
1816a717540cSStefano Zampini   /* determine if a QR strategy is needed for change of basis */
1817a717540cSStefano Zampini   qr_needed = PETSC_FALSE;
1818a717540cSStefano Zampini   ierr = PetscBTCreate(pcbddc->local_primal_size,&qr_needed_idx);CHKERRQ(ierr);
1819a717540cSStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1820a717540cSStefano Zampini     if (PetscBTLookup(change_basis,i)) {
1821a717540cSStefano Zampini       size_of_constraint = temp_indices[i+1]-temp_indices[i];
1822a717540cSStefano Zampini       j = 0;
1823a717540cSStefano Zampini       for (k=0;k<size_of_constraint;k++) {
1824a717540cSStefano Zampini         if (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) {
1825a717540cSStefano Zampini           j++;
1826a717540cSStefano Zampini         }
1827a717540cSStefano Zampini       }
1828a717540cSStefano Zampini       /* found more than one primal dof on the cc */
1829a717540cSStefano Zampini       if (j > 1) {
1830a717540cSStefano Zampini         PetscBTSet(qr_needed_idx,i);
1831a717540cSStefano Zampini         qr_needed = PETSC_TRUE;
1832a717540cSStefano Zampini       }
1833a717540cSStefano Zampini     }
1834a717540cSStefano Zampini   }
1835984c4197SStefano Zampini   /* free workspace */
1836984c4197SStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
183745a1bb75SStefano Zampini 
1838674ae819SStefano Zampini   /* permute indices in order to have a sorted set of vertices */
1839a717540cSStefano Zampini   ierr = PetscSortInt(total_primal_vertices,aux_primal_numbering);CHKERRQ(ierr);
1840984c4197SStefano Zampini 
1841984c4197SStefano Zampini   /* nonzero structure of constraint matrix */
1842785e854fSJed Brown   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
1843984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) nnz[i]=1;
1844984c4197SStefano Zampini   j=total_primal_vertices;
1845984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
18464641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1847674ae819SStefano Zampini       nnz[j]=temp_indices[i+1]-temp_indices[i];
1848674ae819SStefano Zampini       j++;
1849674ae819SStefano Zampini     }
1850674ae819SStefano Zampini   }
1851674ae819SStefano Zampini   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
1852674ae819SStefano Zampini   ierr = PetscFree(nnz);CHKERRQ(ierr);
1853674ae819SStefano Zampini   /* set values in constraint matrix */
1854984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) {
1855984c4197SStefano Zampini     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,aux_primal_numbering[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
1856674ae819SStefano Zampini   }
1857984c4197SStefano Zampini   total_counts = total_primal_vertices;
1858984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
18594641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1860674ae819SStefano Zampini       size_of_constraint=temp_indices[i+1]-temp_indices[i];
1861674ae819SStefano Zampini       ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&total_counts,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],&temp_quadrature_constraint[temp_indices[i]],INSERT_VALUES);CHKERRQ(ierr);
1862674ae819SStefano Zampini       total_counts++;
1863674ae819SStefano Zampini     }
1864674ae819SStefano Zampini   }
1865674ae819SStefano Zampini   /* assembling */
1866674ae819SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1867674ae819SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1868984c4197SStefano Zampini   /*
186945a1bb75SStefano Zampini   ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
1870984c4197SStefano Zampini   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
1871984c4197SStefano Zampini   */
1872674ae819SStefano Zampini   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
1873674ae819SStefano Zampini   if (pcbddc->use_change_of_basis) {
1874026de310SStefano Zampini     /* dual and primal dofs on a single cc */
1875984c4197SStefano Zampini     PetscInt     dual_dofs,primal_dofs;
1876026de310SStefano Zampini     /* iterator on aux_primal_minloc (ordered as read from nearnullspace: vertices, edges and then constraints) */
1877026de310SStefano Zampini     PetscInt     primal_counter;
1878984c4197SStefano Zampini     /* working stuff for GEQRF */
187981d9aea3SBarry Smith     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
1880984c4197SStefano Zampini     PetscBLASInt lqr_work;
1881984c4197SStefano Zampini     /* working stuff for UNGQR */
1882984c4197SStefano Zampini     PetscScalar  *gqr_work,lgqr_work_t;
1883984c4197SStefano Zampini     PetscBLASInt lgqr_work;
1884984c4197SStefano Zampini     /* working stuff for TRTRS */
1885984c4197SStefano Zampini     PetscScalar  *trs_rhs;
18863f08241aSStefano Zampini     PetscBLASInt Blas_NRHS;
1887984c4197SStefano Zampini     /* pointers for values insertion into change of basis matrix */
1888984c4197SStefano Zampini     PetscInt     *start_rows,*start_cols;
1889984c4197SStefano Zampini     PetscScalar  *start_vals;
1890984c4197SStefano Zampini     /* working stuff for values insertion */
18914641a718SStefano Zampini     PetscBT      is_primal;
1892984c4197SStefano Zampini 
1893a717540cSStefano Zampini     /* change of basis acts on local interfaces -> dimension is n_B x n_B */
1894a717540cSStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
1895a717540cSStefano Zampini     ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr);
1896a717540cSStefano Zampini     ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr);
1897a717540cSStefano Zampini     /* work arrays */
1898785e854fSJed Brown     ierr = PetscMalloc1(pcis->n_B,&nnz);CHKERRQ(ierr);
1899a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) nnz[i]=1;
1900a717540cSStefano Zampini     /* nonzeros per row */
1901a717540cSStefano Zampini     for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1902a717540cSStefano Zampini       if (PetscBTLookup(change_basis,i)) {
1903a717540cSStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
1904a717540cSStefano Zampini         if (PetscBTLookup(qr_needed_idx,i)) {
1905a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1906a717540cSStefano Zampini         } else {
1907a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = 2;
1908a717540cSStefano Zampini           /* get local primal index on the cc */
1909a717540cSStefano Zampini           j = 0;
1910a717540cSStefano Zampini           while (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+j])) j++;
1911a717540cSStefano Zampini           nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1912a717540cSStefano Zampini         }
1913a717540cSStefano Zampini       }
1914a717540cSStefano Zampini     }
1915a717540cSStefano Zampini     ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
1916a717540cSStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
1917a717540cSStefano Zampini     /* Set initial identity in the matrix */
1918a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) {
1919a717540cSStefano Zampini       ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
1920a717540cSStefano Zampini     }
1921a717540cSStefano Zampini 
1922a717540cSStefano Zampini     if (pcbddc->dbg_flag) {
1923a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1924a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
1925a717540cSStefano Zampini     }
1926a717540cSStefano Zampini 
1927a717540cSStefano Zampini 
1928a717540cSStefano Zampini     /* Now we loop on the constraints which need a change of basis */
1929a717540cSStefano Zampini     /*
1930a717540cSStefano Zampini        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
1931a717540cSStefano Zampini        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
1932a717540cSStefano Zampini 
1933a717540cSStefano Zampini        Basic blocks of change of basis matrix T computed
1934a717540cSStefano Zampini 
1935a717540cSStefano Zampini           - Using the following block transformation if there is only a primal dof on the cc
1936a717540cSStefano Zampini             (in the example, primal dof is the last one of the edge in LOCAL ordering
1937a717540cSStefano Zampini              in this code, primal dof is the first one of the edge in GLOBAL ordering)
1938a717540cSStefano Zampini             | 1        0   ...        0     1 |
1939a717540cSStefano Zampini             | 0        1   ...        0     1 |
1940a717540cSStefano Zampini             |              ...                |
1941a717540cSStefano Zampini             | 0        ...            1     1 |
1942a717540cSStefano Zampini             | -s_1/s_n ...    -s_{n-1}/-s_n 1 |
1943a717540cSStefano Zampini 
1944a717540cSStefano Zampini           - via QR decomposition of constraints otherwise
1945a717540cSStefano Zampini     */
1946a717540cSStefano Zampini     if (qr_needed) {
1947984c4197SStefano Zampini       /* space to store Q */
1948785e854fSJed Brown       ierr = PetscMalloc1((max_size_of_constraint)*(max_size_of_constraint),&qr_basis);CHKERRQ(ierr);
1949984c4197SStefano Zampini       /* first we issue queries for optimal work */
19503f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
19513f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
19523f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1953984c4197SStefano Zampini       lqr_work = -1;
19543f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
1955984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
1956984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
1957785e854fSJed Brown       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
1958984c4197SStefano Zampini       lgqr_work = -1;
19593f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
19603f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
19613f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
19623f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
19633f08241aSStefano Zampini       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
19643f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
1965984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
1966984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
1967785e854fSJed Brown       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
1968984c4197SStefano Zampini       /* array to store scaling factors for reflectors */
1969785e854fSJed Brown       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
1970984c4197SStefano Zampini       /* array to store rhs and solution of triangular solver */
1971785e854fSJed Brown       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
1972a717540cSStefano Zampini       /* allocating workspace for check */
1973a717540cSStefano Zampini       if (pcbddc->dbg_flag) {
1974785e854fSJed Brown         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&work);CHKERRQ(ierr);
1975a717540cSStefano Zampini       }
1976a717540cSStefano Zampini     }
1977984c4197SStefano Zampini     /* array to store whether a node is primal or not */
19784641a718SStefano Zampini     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
1979473ba861SJed Brown     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
198039e2fb2aSStefano Zampini     ierr = ISGlobalToLocalMappingApply(pcbddc->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,aux_primal_numbering,&i,aux_primal_numbering_B);CHKERRQ(ierr);
198139e2fb2aSStefano Zampini     if (i != total_primal_vertices) {
198239e2fb2aSStefano Zampini       SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %d != %d\n",total_primal_vertices,i);
19834641a718SStefano Zampini     }
198439e2fb2aSStefano Zampini     for (i=0;i<total_primal_vertices;i++) {
198539e2fb2aSStefano Zampini       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
198639e2fb2aSStefano Zampini     }
198739e2fb2aSStefano Zampini     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
1988984c4197SStefano Zampini 
1989a717540cSStefano Zampini     /* loop on constraints and see whether or not they need a change of basis and compute it */
1990026de310SStefano Zampini     /* -> using implicit ordering contained in temp_indices data */
1991026de310SStefano Zampini     total_counts = pcbddc->n_vertices;
1992026de310SStefano Zampini     primal_counter = total_counts;
1993026de310SStefano Zampini     while (total_counts<pcbddc->local_primal_size) {
1994026de310SStefano Zampini       primal_dofs = 1;
19954641a718SStefano Zampini       if (PetscBTLookup(change_basis,total_counts)) {
1996026de310SStefano Zampini         /* get all constraints with same support: if more then one constraint is present on the cc then surely indices are stored contiguosly */
1997026de310SStefano Zampini         while (total_counts+primal_dofs < pcbddc->local_primal_size && temp_indices_to_constraint_B[temp_indices[total_counts]] == temp_indices_to_constraint_B[temp_indices[total_counts+primal_dofs]]) {
1998026de310SStefano Zampini           primal_dofs++;
1999674ae819SStefano Zampini         }
2000984c4197SStefano Zampini         /* get constraint info */
2001026de310SStefano Zampini         size_of_constraint = temp_indices[total_counts+1]-temp_indices[total_counts];
2002984c4197SStefano Zampini         dual_dofs = size_of_constraint-primal_dofs;
2003984c4197SStefano Zampini 
2004984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
2005a717540cSStefano Zampini           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraints %d to %d (incl) need a change of basis (size %d)\n",total_counts,total_counts+primal_dofs-1,size_of_constraint);CHKERRQ(ierr);
2006674ae819SStefano Zampini         }
2007984c4197SStefano Zampini 
2008a717540cSStefano Zampini         if (primal_dofs > 1) { /* QR */
2009a717540cSStefano Zampini 
2010a717540cSStefano Zampini           /* copy quadrature constraints for change of basis check */
2011a717540cSStefano Zampini           if (pcbddc->dbg_flag) {
2012a717540cSStefano Zampini             ierr = PetscMemcpy(work,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
2013a717540cSStefano Zampini           }
2014984c4197SStefano Zampini           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
2015026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
2016984c4197SStefano Zampini 
2017984c4197SStefano Zampini           /* compute QR decomposition of constraints */
20183f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
20193f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
20203f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2021674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
20223f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
2023984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
2024674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2025984c4197SStefano Zampini 
2026984c4197SStefano Zampini           /* explictly compute R^-T */
2027984c4197SStefano Zampini           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
2028984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
20293f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
20303f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
20313f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
20323f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
2033984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
20343f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
2035984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
2036984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2037984c4197SStefano Zampini 
2038a717540cSStefano Zampini           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
20393f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
20403f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
20413f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
20423f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2043984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
20443f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
2045984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
2046984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2047984c4197SStefano Zampini 
2048984c4197SStefano Zampini           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
2049984c4197SStefano Zampini              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
2050984c4197SStefano Zampini              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
20513f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
20523f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
20533f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
20543f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
20553f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
20563f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
2057984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2058c4303822SStefano Zampini           PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&Blas_M,&Blas_N,&Blas_K,&one,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&zero,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_LDC));
2059984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2060026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
2061984c4197SStefano Zampini 
2062984c4197SStefano Zampini           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
2063026de310SStefano Zampini           start_rows = &temp_indices_to_constraint_B[temp_indices[total_counts]];
2064984c4197SStefano Zampini           /* insert cols for primal dofs */
2065984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) {
2066984c4197SStefano Zampini             start_vals = &qr_basis[j*size_of_constraint];
2067026de310SStefano Zampini             start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter+j]];
2068984c4197SStefano Zampini             ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
2069984c4197SStefano Zampini           }
2070984c4197SStefano Zampini           /* insert cols for dual dofs */
2071984c4197SStefano Zampini           for (j=0,k=0;j<dual_dofs;k++) {
20724641a718SStefano Zampini             if (!PetscBTLookup(is_primal,temp_indices_to_constraint_B[temp_indices[total_counts]+k])) {
2073984c4197SStefano Zampini               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
2074026de310SStefano Zampini               start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+k];
2075984c4197SStefano Zampini               ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
2076984c4197SStefano Zampini               j++;
2077674ae819SStefano Zampini             }
2078674ae819SStefano Zampini           }
2079984c4197SStefano Zampini 
2080984c4197SStefano Zampini           /* check change of basis */
2081984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
2082984c4197SStefano Zampini             PetscInt   ii,jj;
2083984c4197SStefano Zampini             PetscBool valid_qr=PETSC_TRUE;
2084c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
2085c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2086c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
2087c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2088c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
2089c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
2090984c4197SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2091c4303822SStefano Zampini             PetscStackCallBLAS("BLASgemm",BLASgemm_("T","N",&Blas_M,&Blas_N,&Blas_K,&one,work,&Blas_LDA,qr_basis,&Blas_LDB,&zero,&work[size_of_constraint*primal_dofs],&Blas_LDC));
2092984c4197SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
2093984c4197SStefano Zampini             for (jj=0;jj<size_of_constraint;jj++) {
2094984c4197SStefano Zampini               for (ii=0;ii<primal_dofs;ii++) {
2095984c4197SStefano Zampini                 if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
2096984c4197SStefano Zampini                 if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
2097674ae819SStefano Zampini               }
2098674ae819SStefano Zampini             }
2099984c4197SStefano Zampini             if (!valid_qr) {
210022d5777bSStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
2101984c4197SStefano Zampini               for (jj=0;jj<size_of_constraint;jj++) {
2102984c4197SStefano Zampini                 for (ii=0;ii<primal_dofs;ii++) {
2103984c4197SStefano Zampini                   if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
2104984c4197SStefano Zampini                     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\tQr basis function %d is not orthogonal to constraint %d (%1.14e)!\n",jj,ii,PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]));
2105674ae819SStefano Zampini                   }
2106984c4197SStefano Zampini                   if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
2107984c4197SStefano Zampini                     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\tQr basis function %d is not unitary w.r.t constraint %d (%1.14e)!\n",jj,ii,PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]));
2108984c4197SStefano Zampini                   }
2109984c4197SStefano Zampini                 }
2110984c4197SStefano Zampini               }
2111674ae819SStefano Zampini             } else {
211222d5777bSStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
2113674ae819SStefano Zampini             }
2114674ae819SStefano Zampini           }
2115a717540cSStefano Zampini         } else { /* simple transformation block */
2116a717540cSStefano Zampini           PetscInt row,col;
2117a717540cSStefano Zampini           PetscScalar val;
2118a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) {
2119a717540cSStefano Zampini             row = temp_indices_to_constraint_B[temp_indices[total_counts]+j];
2120a717540cSStefano Zampini             if (!PetscBTLookup(is_primal,row)) {
2121a717540cSStefano Zampini               col = temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
2122a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
2123a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,1.0,INSERT_VALUES);CHKERRQ(ierr);
2124a717540cSStefano Zampini             } else {
2125a717540cSStefano Zampini               for (k=0;k<size_of_constraint;k++) {
2126a717540cSStefano Zampini                 col = temp_indices_to_constraint_B[temp_indices[total_counts]+k];
2127a717540cSStefano Zampini                 if (row != col) {
2128a717540cSStefano Zampini                   val = -temp_quadrature_constraint[temp_indices[total_counts]+k]/temp_quadrature_constraint[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
2129a717540cSStefano Zampini                 } else {
2130a717540cSStefano Zampini                   val = 1.0;
2131a717540cSStefano Zampini                 }
2132a717540cSStefano Zampini                 ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
2133a717540cSStefano Zampini               }
2134a717540cSStefano Zampini             }
2135a717540cSStefano Zampini           }
213698a51de6SStefano Zampini           if (pcbddc->dbg_flag) {
213722d5777bSStefano Zampini             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
2138a717540cSStefano Zampini           }
213998a51de6SStefano Zampini         }
2140026de310SStefano Zampini         /* increment primal counter */
2141026de310SStefano Zampini         primal_counter += primal_dofs;
2142984c4197SStefano Zampini       } else {
2143984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
2144026de310SStefano 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);
2145674ae819SStefano Zampini         }
2146674ae819SStefano Zampini       }
2147026de310SStefano Zampini       /* increment constraint counter total_counts */
2148026de310SStefano Zampini       total_counts += primal_dofs;
2149674ae819SStefano Zampini     }
2150a717540cSStefano Zampini 
2151a717540cSStefano Zampini     /* free workspace */
2152a717540cSStefano Zampini     if (qr_needed) {
2153984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
2154984c4197SStefano Zampini         ierr = PetscFree(work);CHKERRQ(ierr);
2155984c4197SStefano Zampini       }
2156984c4197SStefano Zampini       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
2157984c4197SStefano Zampini       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
2158984c4197SStefano Zampini       ierr = PetscFree(qr_work);CHKERRQ(ierr);
2159984c4197SStefano Zampini       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
2160984c4197SStefano Zampini       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
2161674ae819SStefano Zampini     }
2162a717540cSStefano Zampini     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
2163674ae819SStefano Zampini     /* assembling */
2164674ae819SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2165674ae819SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2166984c4197SStefano Zampini     /*
216745a1bb75SStefano Zampini     ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
2168984c4197SStefano Zampini     ierr = MatView(pcbddc->ChangeOfBasisMatrix,(PetscViewer)0);CHKERRQ(ierr);
2169984c4197SStefano Zampini     */
2170674ae819SStefano Zampini   }
2171a717540cSStefano Zampini 
2172727cdba6SStefano Zampini   /* get indices in local ordering for vertices and constraints */
2173727cdba6SStefano 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 */
2174473ba861SJed Brown     ierr = PetscMalloc1(olocal_primal_size,&oprimal_indices_local_idxs);CHKERRQ(ierr);
2175727cdba6SStefano Zampini     ierr = PetscMemcpy(oprimal_indices_local_idxs,pcbddc->primal_indices_local_idxs,olocal_primal_size*sizeof(PetscInt));CHKERRQ(ierr);
2176727cdba6SStefano Zampini   }
2177727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2178f347579bSStefano Zampini   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
2179473ba861SJed Brown   ierr = PetscMalloc1(pcbddc->local_primal_size,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
2180727cdba6SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&i,&aux_primal_numbering);CHKERRQ(ierr);
2181727cdba6SStefano Zampini   ierr = PetscMemcpy(pcbddc->primal_indices_local_idxs,aux_primal_numbering,i*sizeof(PetscInt));CHKERRQ(ierr);
2182727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2183727cdba6SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&j,&aux_primal_numbering);CHKERRQ(ierr);
2184727cdba6SStefano Zampini   ierr = PetscMemcpy(&pcbddc->primal_indices_local_idxs[i],aux_primal_numbering,j*sizeof(PetscInt));CHKERRQ(ierr);
2185727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2186e9189074SStefano Zampini   /* set quantities in PCBDDC data struct */
2187e9189074SStefano Zampini   pcbddc->n_actual_vertices = i;
2188727cdba6SStefano Zampini   /* check if a new primal space has been introduced */
2189727cdba6SStefano Zampini   pcbddc->new_primal_space_local = PETSC_TRUE;
2190727cdba6SStefano Zampini   if (olocal_primal_size == pcbddc->local_primal_size) {
2191727cdba6SStefano Zampini     ierr = PetscMemcmp(pcbddc->primal_indices_local_idxs,oprimal_indices_local_idxs,olocal_primal_size,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
2192c1c8e736SStefano Zampini     pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
2193727cdba6SStefano Zampini     ierr = PetscFree(oprimal_indices_local_idxs);CHKERRQ(ierr);
2194727cdba6SStefano Zampini   }
2195727cdba6SStefano Zampini   /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
2196727cdba6SStefano Zampini   ierr = MPI_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2197727cdba6SStefano Zampini 
2198a717540cSStefano Zampini   /* flush dbg viewer */
2199b8ffe317SStefano Zampini   if (pcbddc->dbg_flag) {
2200b8ffe317SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2201b8ffe317SStefano Zampini   }
2202a717540cSStefano Zampini 
2203e310c8b4SStefano Zampini   /* free workspace */
2204a717540cSStefano Zampini   ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2205a717540cSStefano Zampini   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
2206984c4197SStefano Zampini   ierr = PetscFree(aux_primal_minloc);CHKERRQ(ierr);
2207674ae819SStefano Zampini   ierr = PetscFree(temp_indices);CHKERRQ(ierr);
22084641a718SStefano Zampini   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
2209674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr);
2210674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
2211674ae819SStefano Zampini   ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr);
2212674ae819SStefano Zampini   PetscFunctionReturn(0);
2213674ae819SStefano Zampini }
2214674ae819SStefano Zampini 
2215674ae819SStefano Zampini #undef __FUNCT__
2216674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
2217674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
2218674ae819SStefano Zampini {
2219674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
2220674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
2221674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
222263602bcaSStefano Zampini   PetscInt    ierr,i,vertex_size;
2223674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
2224674ae819SStefano Zampini 
2225674ae819SStefano Zampini   PetscFunctionBegin;
22268e61c736SStefano Zampini   /* Reset previously computed graph */
22278e61c736SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
2228674ae819SStefano Zampini   /* Init local Graph struct */
2229674ae819SStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr);
2230674ae819SStefano Zampini 
2231575ad6abSStefano Zampini   /* Check validity of the csr graph passed in by the user */
2232575ad6abSStefano Zampini   if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) {
2233575ad6abSStefano Zampini     ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
2234575ad6abSStefano Zampini   }
22359577ea80SStefano Zampini 
2236674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
2237674ae819SStefano Zampini   if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) {
2238674ae819SStefano Zampini     Mat mat_adj;
2239674ae819SStefano Zampini     const PetscInt *xadj,*adjncy;
2240674ae819SStefano Zampini     PetscBool flg_row=PETSC_TRUE;
2241674ae819SStefano Zampini 
2242674ae819SStefano Zampini     ierr = MatConvert(matis->A,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr);
2243674ae819SStefano Zampini     ierr = MatGetRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2244674ae819SStefano Zampini     if (!flg_row) {
2245674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ called in %s\n",__FUNCT__);
2246674ae819SStefano Zampini     }
2247674ae819SStefano Zampini     ierr = PCBDDCSetLocalAdjacencyGraph(pc,i,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
2248674ae819SStefano Zampini     ierr = MatRestoreRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2249674ae819SStefano Zampini     if (!flg_row) {
2250674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__);
2251674ae819SStefano Zampini     }
2252674ae819SStefano Zampini     ierr = MatDestroy(&mat_adj);CHKERRQ(ierr);
2253674ae819SStefano Zampini   }
2254674ae819SStefano Zampini 
225563602bcaSStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting or PCBDDCSetDofsSplittingLocal */
2256674ae819SStefano Zampini   vertex_size = 1;
225763602bcaSStefano Zampini   if (pcbddc->user_provided_isfordofs) {
225863602bcaSStefano Zampini     if (pcbddc->n_ISForDofs) { /* need to convert from global to local and remove references to global dofs splitting */
2259*95ecbf38SStefano Zampini       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
226063602bcaSStefano Zampini       for (i=0;i<pcbddc->n_ISForDofs;i++) {
226163602bcaSStefano Zampini         ierr = PCBDDCGlobalToLocal(pc,matis->ctx,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
226263602bcaSStefano Zampini         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
2263674ae819SStefano Zampini       }
226463602bcaSStefano Zampini       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
226563602bcaSStefano Zampini       pcbddc->n_ISForDofs = 0;
226663602bcaSStefano Zampini       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
2267674ae819SStefano Zampini     }
226863602bcaSStefano Zampini     /* mat block size as vertex size (used for elasticity with rigid body modes as nearnullspace) */
2269674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
227063602bcaSStefano Zampini   } else {
227163602bcaSStefano Zampini     if (!pcbddc->n_ISForDofsLocal) { /* field split not present, create it in local ordering */
227263602bcaSStefano Zampini       ierr = MatGetBlockSize(pc->pmat,&pcbddc->n_ISForDofsLocal);CHKERRQ(ierr);
227363602bcaSStefano Zampini       ierr = PetscMalloc(pcbddc->n_ISForDofsLocal*sizeof(IS),&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
227463602bcaSStefano Zampini       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
227563602bcaSStefano Zampini         ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),pcis->n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
227663602bcaSStefano Zampini       }
227763602bcaSStefano Zampini     }
2278674ae819SStefano Zampini   }
2279674ae819SStefano Zampini 
2280674ae819SStefano Zampini   /* Setup of Graph */
2281785d1243SStefano Zampini   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) { /* need to convert from global to local */
2282e456f2a8SStefano Zampini     ierr = PCBDDCGlobalToLocal(pc,matis->ctx,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
2283785d1243SStefano Zampini   }
2284785d1243SStefano Zampini   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) { /* need to convert from global to local */
2285e456f2a8SStefano Zampini     ierr = PCBDDCGlobalToLocal(pc,matis->ctx,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
2286785d1243SStefano Zampini   }
228763602bcaSStefano Zampini   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices);
2288674ae819SStefano Zampini 
2289674ae819SStefano Zampini   /* Graph's connected components analysis */
2290674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
2291674ae819SStefano Zampini 
2292674ae819SStefano Zampini   /* print some info to stdout */
2293674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
2294e49050b4SStefano Zampini     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer);
2295674ae819SStefano Zampini   }
2296fb180af4SStefano Zampini 
2297fb180af4SStefano Zampini   /* mark topography has done */
2298fb180af4SStefano Zampini   pcbddc->recompute_topography = PETSC_FALSE;
2299674ae819SStefano Zampini   PetscFunctionReturn(0);
2300674ae819SStefano Zampini }
2301674ae819SStefano Zampini 
2302674ae819SStefano Zampini #undef __FUNCT__
2303674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx"
2304f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt **vertices_idx)
2305674ae819SStefano Zampini {
2306674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2307674ae819SStefano Zampini   PetscInt       *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size;
2308674ae819SStefano Zampini   PetscErrorCode ierr;
2309674ae819SStefano Zampini 
2310674ae819SStefano Zampini   PetscFunctionBegin;
2311674ae819SStefano Zampini   n = 0;
2312674ae819SStefano Zampini   vertices = 0;
2313674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2314674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr);
2315b120a5c6SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2316b120a5c6SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2317b120a5c6SStefano Zampini       if (size_of_constraint == 1) n++;
2318b120a5c6SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2319b120a5c6SStefano Zampini     }
2320811e8ca2SStefano Zampini     if (vertices_idx) {
2321785e854fSJed Brown       ierr = PetscMalloc1(n,&vertices);CHKERRQ(ierr);
2322b120a5c6SStefano Zampini       n = 0;
2323674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2324674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2325674ae819SStefano Zampini         if (size_of_constraint == 1) {
2326674ae819SStefano Zampini           vertices[n++]=row_cmat_indices[0];
2327674ae819SStefano Zampini         }
2328674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2329674ae819SStefano Zampini       }
2330674ae819SStefano Zampini     }
2331811e8ca2SStefano Zampini   }
2332674ae819SStefano Zampini   *n_vertices = n;
2333811e8ca2SStefano Zampini   if (vertices_idx) *vertices_idx = vertices;
2334674ae819SStefano Zampini   PetscFunctionReturn(0);
2335674ae819SStefano Zampini }
2336674ae819SStefano Zampini 
2337674ae819SStefano Zampini #undef __FUNCT__
2338674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx"
2339f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt **constraints_idx)
2340674ae819SStefano Zampini {
2341674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2342674ae819SStefano Zampini   PetscInt       *constraints_index,*row_cmat_indices,*row_cmat_global_indices;
2343674ae819SStefano Zampini   PetscInt       n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc;
23444641a718SStefano Zampini   PetscBT        touched;
2345674ae819SStefano Zampini   PetscErrorCode ierr;
2346674ae819SStefano Zampini 
2347f34684f1SStefano Zampini     /* This function assumes that the number of local constraints per connected component
2348f34684f1SStefano Zampini        is not greater than the number of nodes defined for the connected component
2349f34684f1SStefano Zampini        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
2350674ae819SStefano Zampini   PetscFunctionBegin;
2351674ae819SStefano Zampini   n = 0;
2352674ae819SStefano Zampini   constraints_index = 0;
2353674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2354674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr);
2355674ae819SStefano Zampini     max_size_of_constraint = 0;
2356674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2357674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2358674ae819SStefano Zampini       if (size_of_constraint > 1) {
2359674ae819SStefano Zampini         n++;
2360674ae819SStefano Zampini       }
2361674ae819SStefano Zampini       max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint);
2362674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2363674ae819SStefano Zampini     }
2364811e8ca2SStefano Zampini     if (constraints_idx) {
2365785e854fSJed Brown       ierr = PetscMalloc1(n,&constraints_index);CHKERRQ(ierr);
2366785e854fSJed Brown       ierr = PetscMalloc1(max_size_of_constraint,&row_cmat_global_indices);CHKERRQ(ierr);
23674641a718SStefano Zampini       ierr = PetscBTCreate(local_size,&touched);CHKERRQ(ierr);
2368674ae819SStefano Zampini       n = 0;
2369674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2370674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2371674ae819SStefano Zampini         if (size_of_constraint > 1) {
2372674ae819SStefano Zampini           ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr);
237382d3d8afSStefano Zampini           /* find first untouched local node */
237482d3d8afSStefano Zampini           j = 0;
23754641a718SStefano Zampini           while (PetscBTLookup(touched,row_cmat_indices[j])) j++;
237682d3d8afSStefano Zampini           min_index = row_cmat_global_indices[j];
237782d3d8afSStefano Zampini           min_loc = j;
237882d3d8afSStefano Zampini           /* search the minimum among nodes not yet touched on the connected component
237982d3d8afSStefano Zampini              since there can be more than one constraint on a single cc */
2380674ae819SStefano Zampini           for (j=1;j<size_of_constraint;j++) {
23814641a718SStefano Zampini             if (!PetscBTLookup(touched,row_cmat_indices[j]) && min_index > row_cmat_global_indices[j]) {
2382674ae819SStefano Zampini               min_index = row_cmat_global_indices[j];
2383674ae819SStefano Zampini               min_loc = j;
2384674ae819SStefano Zampini             }
2385674ae819SStefano Zampini           }
23864641a718SStefano Zampini           ierr = PetscBTSet(touched,row_cmat_indices[min_loc]);CHKERRQ(ierr);
2387674ae819SStefano Zampini           constraints_index[n++] = row_cmat_indices[min_loc];
2388674ae819SStefano Zampini         }
2389674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2390674ae819SStefano Zampini       }
23914641a718SStefano Zampini       ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2392674ae819SStefano Zampini       ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr);
2393811e8ca2SStefano Zampini     }
2394811e8ca2SStefano Zampini   }
2395674ae819SStefano Zampini   *n_constraints = n;
2396811e8ca2SStefano Zampini   if (constraints_idx) *constraints_idx = constraints_index;
2397674ae819SStefano Zampini   PetscFunctionReturn(0);
2398674ae819SStefano Zampini }
2399674ae819SStefano Zampini 
2400674ae819SStefano Zampini /* the next two functions has been adapted from pcis.c */
2401674ae819SStefano Zampini #undef __FUNCT__
2402674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchur"
2403674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchur(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2404674ae819SStefano Zampini {
2405674ae819SStefano Zampini   PetscErrorCode ierr;
2406674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2407674ae819SStefano Zampini 
2408674ae819SStefano Zampini   PetscFunctionBegin;
2409674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2410674ae819SStefano Zampini   ierr = MatMult(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2411674ae819SStefano Zampini   ierr = MatMult(pcis->A_IB,v,vec1_D);CHKERRQ(ierr);
2412674ae819SStefano Zampini   ierr = KSPSolve(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2413674ae819SStefano Zampini   ierr = MatMult(pcis->A_BI,vec2_D,vec2_B);CHKERRQ(ierr);
2414674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2415674ae819SStefano Zampini   PetscFunctionReturn(0);
2416674ae819SStefano Zampini }
2417674ae819SStefano Zampini 
2418674ae819SStefano Zampini #undef __FUNCT__
2419674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchurTranspose"
2420674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchurTranspose(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2421674ae819SStefano Zampini {
2422674ae819SStefano Zampini   PetscErrorCode ierr;
2423674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2424674ae819SStefano Zampini 
2425674ae819SStefano Zampini   PetscFunctionBegin;
2426674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2427674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2428674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BI,v,vec1_D);CHKERRQ(ierr);
2429674ae819SStefano Zampini   ierr = KSPSolveTranspose(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2430674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_IB,vec2_D,vec2_B);CHKERRQ(ierr);
2431674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2432674ae819SStefano Zampini   PetscFunctionReturn(0);
2433674ae819SStefano Zampini }
2434674ae819SStefano Zampini 
2435674ae819SStefano Zampini #undef __FUNCT__
2436674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
2437674ae819SStefano 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[])
2438674ae819SStefano Zampini {
2439674ae819SStefano Zampini   Vec            local_vec,global_vec;
2440674ae819SStefano Zampini   IS             seqis,paris;
2441674ae819SStefano Zampini   VecScatter     scatter_ctx;
2442674ae819SStefano Zampini   PetscScalar    *array;
2443674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
2444674ae819SStefano Zampini   PetscScalar    globalsum;
2445674ae819SStefano Zampini   PetscInt       i,j,s;
2446674ae819SStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local;
2447674ae819SStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm,max_global;
2448674ae819SStefano Zampini   PetscMPIInt    *dof_sizes,*dof_displs;
2449674ae819SStefano Zampini   PetscBool      first_found;
2450674ae819SStefano Zampini   PetscErrorCode ierr;
2451674ae819SStefano Zampini 
2452674ae819SStefano Zampini   PetscFunctionBegin;
2453674ae819SStefano Zampini   /* mpi buffers */
2454674ae819SStefano Zampini   MPI_Comm_size(comm,&size_prec_comm);
2455674ae819SStefano Zampini   MPI_Comm_rank(comm,&rank_prec_comm);
2456674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
2457785e854fSJed Brown   ierr = PetscMalloc1(j,&dof_sizes);CHKERRQ(ierr);
2458785e854fSJed Brown   ierr = PetscMalloc1(j,&dof_displs);CHKERRQ(ierr);
2459674ae819SStefano Zampini   /* get maximum size of subset */
2460785e854fSJed Brown   ierr = PetscMalloc1(n_local_dofs,&temp_global_dofs);CHKERRQ(ierr);
2461674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
2462674ae819SStefano Zampini   max_local = 0;
2463674ae819SStefano Zampini   if (n_local_dofs) {
2464674ae819SStefano Zampini     max_local = temp_global_dofs[0];
2465674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2466674ae819SStefano Zampini       if (max_local < temp_global_dofs[i] ) {
2467674ae819SStefano Zampini         max_local = temp_global_dofs[i];
2468674ae819SStefano Zampini       }
2469674ae819SStefano Zampini     }
2470674ae819SStefano Zampini   }
2471674ae819SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);
2472674ae819SStefano Zampini   max_global++;
2473674ae819SStefano Zampini   max_local = 0;
2474674ae819SStefano Zampini   if (n_local_dofs) {
2475674ae819SStefano Zampini     max_local = local_dofs[0];
2476674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2477674ae819SStefano Zampini       if (max_local < local_dofs[i] ) {
2478674ae819SStefano Zampini         max_local = local_dofs[i];
2479674ae819SStefano Zampini       }
2480674ae819SStefano Zampini     }
2481674ae819SStefano Zampini   }
2482674ae819SStefano Zampini   max_local++;
2483674ae819SStefano Zampini   /* allocate workspace */
2484674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
2485674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
2486674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
2487674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
2488674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
2489674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
2490674ae819SStefano Zampini   /* create scatter */
2491674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
2492674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
2493674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
2494674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
2495674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
2496674ae819SStefano Zampini   /* init array */
2497674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
2498674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2499674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2500674ae819SStefano Zampini   if (local_dofs_mult) {
2501674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2502674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
2503674ae819SStefano Zampini     }
2504674ae819SStefano Zampini   } else {
2505674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2506674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
2507674ae819SStefano Zampini     }
2508674ae819SStefano Zampini   }
2509674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2510674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
2511674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2512674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2513674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
25145b08dc53SStefano Zampini   *n_global_subset = (PetscInt)PetscRealPart(globalsum);
2515674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
2516674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
2517674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
2518674ae819SStefano Zampini   nlocals = 0;
2519674ae819SStefano Zampini   first_index = -1;
2520674ae819SStefano Zampini   first_found = PETSC_FALSE;
2521674ae819SStefano Zampini   for (i=0;i<s;i++) {
25225b08dc53SStefano Zampini     if (!first_found && PetscRealPart(array[i]) > 0.0) {
2523674ae819SStefano Zampini       first_found = PETSC_TRUE;
2524674ae819SStefano Zampini       first_index = i;
2525674ae819SStefano Zampini     }
25265b08dc53SStefano Zampini     nlocals += (PetscInt)PetscRealPart(array[i]);
2527674ae819SStefano Zampini   }
2528674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2529674ae819SStefano Zampini   if (!rank_prec_comm) {
2530674ae819SStefano Zampini     dof_displs[0]=0;
2531674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
2532674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
2533674ae819SStefano Zampini     }
2534674ae819SStefano Zampini   }
2535674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2536674ae819SStefano Zampini   if (first_found) {
2537674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
2538674ae819SStefano Zampini     old_index = first_index;
2539674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
25405b08dc53SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) {
2541674ae819SStefano Zampini         array[i] += array[old_index];
2542674ae819SStefano Zampini         old_index = i;
2543674ae819SStefano Zampini       }
2544674ae819SStefano Zampini     }
2545674ae819SStefano Zampini   }
2546674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
2547674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2548674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2549674ae819SStefano Zampini   ierr = VecScatterEnd  (scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2550674ae819SStefano Zampini   /* get global ordering of local dofs */
2551674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2552674ae819SStefano Zampini   if (local_dofs_mult) {
2553674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
25545b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i];
2555674ae819SStefano Zampini     }
2556674ae819SStefano Zampini   } else {
2557674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
25585b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1;
2559674ae819SStefano Zampini     }
2560674ae819SStefano Zampini   }
2561674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2562674ae819SStefano Zampini   /* free workspace */
2563674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
2564674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
2565674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
2566674ae819SStefano Zampini   ierr = PetscFree(dof_sizes);CHKERRQ(ierr);
2567674ae819SStefano Zampini   ierr = PetscFree(dof_displs);CHKERRQ(ierr);
2568674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
2569674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
2570674ae819SStefano Zampini   PetscFunctionReturn(0);
2571674ae819SStefano Zampini }
25729a7d3425SStefano Zampini 
25739a7d3425SStefano Zampini #undef __FUNCT__
25749a7d3425SStefano Zampini #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
25759a7d3425SStefano Zampini PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
25769a7d3425SStefano Zampini {
25779a7d3425SStefano Zampini   PetscInt       i,j;
25789a7d3425SStefano Zampini   PetscScalar    *alphas;
25799a7d3425SStefano Zampini   PetscErrorCode ierr;
25809a7d3425SStefano Zampini 
25819a7d3425SStefano Zampini   PetscFunctionBegin;
25829a7d3425SStefano Zampini   /* this implements stabilized Gram-Schmidt */
2583785e854fSJed Brown   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
25849a7d3425SStefano Zampini   for (i=0;i<n;i++) {
25859a7d3425SStefano Zampini     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
25869a7d3425SStefano Zampini     if (i<n) { ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],&alphas[i+1]);CHKERRQ(ierr); }
25879a7d3425SStefano Zampini     for (j=i+1;j<n;j++) { ierr = VecAXPY(vecs[j],PetscConj(-alphas[j]),vecs[i]);CHKERRQ(ierr); }
25889a7d3425SStefano Zampini   }
25899a7d3425SStefano Zampini   ierr = PetscFree(alphas);CHKERRQ(ierr);
25909a7d3425SStefano Zampini   PetscFunctionReturn(0);
25919a7d3425SStefano Zampini }
25929a7d3425SStefano Zampini 
2593fa7f1dd8SStefano Zampini /* TODO
2594fa7f1dd8SStefano Zampini    - now preallocation is done assuming SEQDENSE local matrices
2595fa7f1dd8SStefano Zampini */
2596c8587f34SStefano Zampini #undef __FUNCT__
2597fa7f1dd8SStefano Zampini #define __FUNCT__ "MatISGetMPIXAIJ"
2598fa7f1dd8SStefano Zampini static PetscErrorCode MatISGetMPIXAIJ(Mat mat, MatType Mtype, MatReuse reuse, Mat *M)
2599c8587f34SStefano Zampini {
2600a57a6d2fSStefano Zampini   Mat                    new_mat;
2601a57a6d2fSStefano Zampini   Mat_IS                 *matis = (Mat_IS*)(mat->data);
2602a57a6d2fSStefano Zampini   /* info on mat */
2603fa7f1dd8SStefano Zampini   /* ISLocalToGlobalMapping rmapping,cmapping; */
2604a57a6d2fSStefano Zampini   PetscInt               bs,rows,cols;
2605a57a6d2fSStefano Zampini   PetscInt               lrows,lcols;
2606a57a6d2fSStefano Zampini   PetscInt               local_rows,local_cols;
2607fa7f1dd8SStefano Zampini   PetscBool              isdense;
2608fa7f1dd8SStefano Zampini   /* values insertion */
2609fa7f1dd8SStefano Zampini   PetscScalar            *array;
2610a57a6d2fSStefano Zampini   PetscInt               *local_indices,*global_indices;
2611a57a6d2fSStefano Zampini   /* work */
2612fa7f1dd8SStefano Zampini   PetscInt               i,j,index_row;
2613a57a6d2fSStefano Zampini   PetscErrorCode         ierr;
2614c8587f34SStefano Zampini 
2615a57a6d2fSStefano Zampini   PetscFunctionBegin;
2616fa7f1dd8SStefano Zampini   /* MISSING CHECKS
2617fa7f1dd8SStefano Zampini     - rectangular case not covered (it is not allowed by MATIS)
2618fa7f1dd8SStefano Zampini   */
2619a57a6d2fSStefano Zampini   /* get info from mat */
2620fa7f1dd8SStefano Zampini   /* ierr = MatGetLocalToGlobalMapping(mat,&rmapping,&cmapping);CHKERRQ(ierr); */
2621a57a6d2fSStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
2622a57a6d2fSStefano Zampini   ierr = MatGetBlockSize(mat,&bs);CHKERRQ(ierr);
2623a57a6d2fSStefano Zampini   ierr = MatGetSize(matis->A,&local_rows,&local_cols);CHKERRQ(ierr);
2624a57a6d2fSStefano Zampini 
2625fa7f1dd8SStefano Zampini   /* work */
2626473ba861SJed Brown   ierr = PetscMalloc1(local_rows,&local_indices);CHKERRQ(ierr);
2627fa7f1dd8SStefano Zampini   for (i=0;i<local_rows;i++) local_indices[i]=i;
2628fa7f1dd8SStefano Zampini   /* map indices of local mat to global values */
2629fa7f1dd8SStefano Zampini   ierr = PetscMalloc(PetscMax(local_cols,local_rows)*sizeof(*global_indices),&global_indices);CHKERRQ(ierr);
2630fa7f1dd8SStefano Zampini   /* ierr = ISLocalToGlobalMappingApply(rmapping,local_rows,local_indices,global_indices);CHKERRQ(ierr); */
2631fa7f1dd8SStefano Zampini   ierr = ISLocalToGlobalMappingApply(matis->mapping,local_rows,local_indices,global_indices);CHKERRQ(ierr);
2632fa7f1dd8SStefano Zampini 
2633fa7f1dd8SStefano Zampini   if (reuse==MAT_INITIAL_MATRIX) {
2634fa7f1dd8SStefano Zampini     Vec         vec_dnz,vec_onz;
2635fa7f1dd8SStefano Zampini     PetscScalar *my_dnz,*my_onz;
2636fa7f1dd8SStefano Zampini     PetscInt    *dnz,*onz,*mat_ranges,*row_ownership;
2637fa7f1dd8SStefano Zampini     PetscInt    index_col,owner;
2638fa7f1dd8SStefano Zampini     PetscMPIInt nsubdomains;
2639fa7f1dd8SStefano Zampini 
2640fa7f1dd8SStefano Zampini     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&nsubdomains);CHKERRQ(ierr);
2641a57a6d2fSStefano Zampini     ierr = MatCreate(PetscObjectComm((PetscObject)mat),&new_mat);CHKERRQ(ierr);
2642a57a6d2fSStefano Zampini     ierr = MatSetSizes(new_mat,PETSC_DECIDE,PETSC_DECIDE,rows,cols);CHKERRQ(ierr);
2643a57a6d2fSStefano Zampini     ierr = MatSetBlockSize(new_mat,bs);CHKERRQ(ierr);
2644fa7f1dd8SStefano Zampini     ierr = MatSetType(new_mat,Mtype);CHKERRQ(ierr);
2645a57a6d2fSStefano Zampini     ierr = MatSetUp(new_mat);CHKERRQ(ierr);
2646a57a6d2fSStefano Zampini     ierr = MatGetLocalSize(new_mat,&lrows,&lcols);CHKERRQ(ierr);
2647a57a6d2fSStefano Zampini 
2648a57a6d2fSStefano Zampini     /*
2649a57a6d2fSStefano Zampini       preallocation
2650a57a6d2fSStefano Zampini     */
2651a57a6d2fSStefano Zampini 
2652a57a6d2fSStefano Zampini     ierr = MatPreallocateInitialize(PetscObjectComm((PetscObject)new_mat),lrows,lcols,dnz,onz);CHKERRQ(ierr);
2653a57a6d2fSStefano Zampini     /*
2654a57a6d2fSStefano Zampini        Some vectors are needed to sum up properly on shared interface dofs.
2655fa7f1dd8SStefano Zampini        Preallocation macros cannot do the job.
2656a57a6d2fSStefano Zampini        Note that preallocation is not exact, since it overestimates nonzeros
2657a57a6d2fSStefano Zampini     */
2658a57a6d2fSStefano Zampini     ierr = MatGetVecs(new_mat,NULL,&vec_dnz);CHKERRQ(ierr);
2659fa7f1dd8SStefano Zampini     /* ierr = VecSetLocalToGlobalMapping(vec_dnz,rmapping);CHKERRQ(ierr); */
2660fa7f1dd8SStefano Zampini     ierr = VecSetLocalToGlobalMapping(vec_dnz,matis->mapping);CHKERRQ(ierr);
2661c8587f34SStefano Zampini     ierr = VecDuplicate(vec_dnz,&vec_onz);CHKERRQ(ierr);
2662e7931f94SStefano Zampini     /* All processes need to compute entire row ownership */
2663785e854fSJed Brown     ierr = PetscMalloc1(rows,&row_ownership);CHKERRQ(ierr);
2664a57a6d2fSStefano Zampini     ierr = MatGetOwnershipRanges(new_mat,(const PetscInt**)&mat_ranges);CHKERRQ(ierr);
2665a57a6d2fSStefano Zampini     for (i=0;i<nsubdomains;i++) {
2666c8587f34SStefano Zampini       for (j=mat_ranges[i];j<mat_ranges[i+1];j++) {
2667c8587f34SStefano Zampini         row_ownership[j]=i;
2668c8587f34SStefano Zampini       }
2669c8587f34SStefano Zampini     }
2670c8587f34SStefano Zampini 
2671e7931f94SStefano Zampini     /*
2672e7931f94SStefano Zampini        my_dnz and my_onz contains exact contribution to preallocation from each local mat
2673e7931f94SStefano Zampini        then, they will be summed up properly. This way, preallocation is always sufficient
2674e7931f94SStefano Zampini     */
2675785e854fSJed Brown     ierr = PetscMalloc1(local_rows,&my_dnz);CHKERRQ(ierr);
2676785e854fSJed Brown     ierr = PetscMalloc1(local_rows,&my_onz);CHKERRQ(ierr);
2677a57a6d2fSStefano Zampini     ierr = PetscMemzero(my_dnz,local_rows*sizeof(*my_dnz));CHKERRQ(ierr);
2678a57a6d2fSStefano Zampini     ierr = PetscMemzero(my_onz,local_rows*sizeof(*my_onz));CHKERRQ(ierr);
2679a57a6d2fSStefano Zampini     for (i=0;i<local_rows;i++) {
2680a57a6d2fSStefano Zampini       index_row = global_indices[i];
2681a57a6d2fSStefano Zampini       for (j=i;j<local_rows;j++) {
2682a57a6d2fSStefano Zampini         owner = row_ownership[index_row];
2683a57a6d2fSStefano Zampini         index_col = global_indices[j];
2684a57a6d2fSStefano Zampini         if (index_col > mat_ranges[owner]-1 && index_col < mat_ranges[owner+1] ) { /* diag block */
2685c8587f34SStefano Zampini           my_dnz[i] += 1.0;
2686a57a6d2fSStefano Zampini         } else { /* offdiag block */
2687c8587f34SStefano Zampini           my_onz[i] += 1.0;
2688c8587f34SStefano Zampini         }
2689a57a6d2fSStefano Zampini         /* same as before, interchanging rows and cols */
2690c8587f34SStefano Zampini         if (i != j) {
2691a57a6d2fSStefano Zampini           owner = row_ownership[index_col];
2692a57a6d2fSStefano Zampini           if (index_row > mat_ranges[owner]-1 && index_row < mat_ranges[owner+1] ) {
2693c8587f34SStefano Zampini             my_dnz[j] += 1.0;
2694c8587f34SStefano Zampini           } else {
2695c8587f34SStefano Zampini             my_onz[j] += 1.0;
2696c8587f34SStefano Zampini           }
2697c8587f34SStefano Zampini         }
2698c8587f34SStefano Zampini       }
2699c8587f34SStefano Zampini     }
2700c8587f34SStefano Zampini     ierr = VecSet(vec_dnz,0.0);CHKERRQ(ierr);
2701c8587f34SStefano Zampini     ierr = VecSet(vec_onz,0.0);CHKERRQ(ierr);
270220a2ab83SStefano Zampini     if (local_rows) { /* multilevel guard */
2703fa7f1dd8SStefano Zampini       ierr = VecSetValuesLocal(vec_dnz,local_rows,local_indices,my_dnz,ADD_VALUES);CHKERRQ(ierr);
2704fa7f1dd8SStefano Zampini       ierr = VecSetValuesLocal(vec_onz,local_rows,local_indices,my_onz,ADD_VALUES);CHKERRQ(ierr);
2705c8587f34SStefano Zampini     }
2706c8587f34SStefano Zampini     ierr = VecAssemblyBegin(vec_dnz);CHKERRQ(ierr);
2707c8587f34SStefano Zampini     ierr = VecAssemblyBegin(vec_onz);CHKERRQ(ierr);
2708c8587f34SStefano Zampini     ierr = VecAssemblyEnd(vec_dnz);CHKERRQ(ierr);
2709c8587f34SStefano Zampini     ierr = VecAssemblyEnd(vec_onz);CHKERRQ(ierr);
2710c8587f34SStefano Zampini     ierr = PetscFree(my_dnz);CHKERRQ(ierr);
2711c8587f34SStefano Zampini     ierr = PetscFree(my_onz);CHKERRQ(ierr);
2712c8587f34SStefano Zampini     ierr = PetscFree(row_ownership);CHKERRQ(ierr);
2713a57a6d2fSStefano Zampini 
2714a57a6d2fSStefano Zampini     /* set computed preallocation in dnz and onz */
2715a57a6d2fSStefano Zampini     ierr = VecGetArray(vec_dnz,&array);CHKERRQ(ierr);
2716a57a6d2fSStefano Zampini     for (i=0; i<lrows; i++) dnz[i] = (PetscInt)PetscRealPart(array[i]);
2717a57a6d2fSStefano Zampini     ierr = VecRestoreArray(vec_dnz,&array);CHKERRQ(ierr);
2718a57a6d2fSStefano Zampini     ierr = VecGetArray(vec_onz,&array);CHKERRQ(ierr);
2719a57a6d2fSStefano Zampini     for (i=0;i<lrows;i++) onz[i] = (PetscInt)PetscRealPart(array[i]);
2720a57a6d2fSStefano Zampini     ierr = VecRestoreArray(vec_onz,&array);CHKERRQ(ierr);
2721c8587f34SStefano Zampini     ierr = VecDestroy(&vec_dnz);CHKERRQ(ierr);
2722c8587f34SStefano Zampini     ierr = VecDestroy(&vec_onz);CHKERRQ(ierr);
2723c8587f34SStefano Zampini 
2724e7931f94SStefano Zampini     /* Resize preallocation if overestimated */
2725c8587f34SStefano Zampini     for (i=0;i<lrows;i++) {
2726a57a6d2fSStefano Zampini       dnz[i] = PetscMin(dnz[i],lcols);
2727a57a6d2fSStefano Zampini       onz[i] = PetscMin(onz[i],cols-lcols);
2728c8587f34SStefano Zampini     }
2729fa7f1dd8SStefano Zampini     /* set preallocation */
2730a57a6d2fSStefano Zampini     ierr = MatMPIAIJSetPreallocation(new_mat,0,dnz,0,onz);CHKERRQ(ierr);
2731fa7f1dd8SStefano Zampini     for (i=0;i<lrows/bs;i++) {
2732fa7f1dd8SStefano Zampini       dnz[i] = dnz[i*bs]/bs;
2733fa7f1dd8SStefano Zampini       onz[i] = onz[i*bs]/bs;
2734fa7f1dd8SStefano Zampini     }
2735fa7f1dd8SStefano Zampini     ierr = MatMPIBAIJSetPreallocation(new_mat,bs,0,dnz,0,onz);CHKERRQ(ierr);
2736fa7f1dd8SStefano Zampini     for (i=0;i<lrows/bs;i++) {
2737fa7f1dd8SStefano Zampini       dnz[i] = dnz[i]-i;
2738fa7f1dd8SStefano Zampini     }
2739fa7f1dd8SStefano Zampini     ierr = MatMPISBAIJSetPreallocation(new_mat,bs,0,dnz,0,onz);CHKERRQ(ierr);
2740c8587f34SStefano Zampini     ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
2741fa7f1dd8SStefano Zampini     *M = new_mat;
2742fa7f1dd8SStefano Zampini   } else {
2743fa7f1dd8SStefano Zampini     PetscInt mbs,mrows,mcols;
2744fa7f1dd8SStefano Zampini     /* some checks */
2745fa7f1dd8SStefano Zampini     ierr = MatGetBlockSize(*M,&mbs);CHKERRQ(ierr);
2746fa7f1dd8SStefano Zampini     ierr = MatGetSize(*M,&mrows,&mcols);CHKERRQ(ierr);
2747fa7f1dd8SStefano Zampini     if (mrows != rows) {
2748fa7f1dd8SStefano Zampini       SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong number of rows (%d != %d)",rows,mrows);
2749fa7f1dd8SStefano Zampini     }
2750fa7f1dd8SStefano Zampini     if (mrows != rows) {
2751fa7f1dd8SStefano Zampini       SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong number of cols (%d != %d)",cols,mcols);
2752fa7f1dd8SStefano Zampini     }
2753fa7f1dd8SStefano Zampini     if (mbs != bs) {
2754fa7f1dd8SStefano Zampini       SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong block size (%d != %d)",bs,mbs);
2755fa7f1dd8SStefano Zampini     }
2756fa7f1dd8SStefano Zampini     ierr = MatZeroEntries(*M);CHKERRQ(ierr);
2757fa7f1dd8SStefano Zampini   }
2758fa7f1dd8SStefano Zampini   /* set local to global mappings */
2759fa7f1dd8SStefano Zampini   /* ierr = MatSetLocalToGlobalMapping(*M,rmapping,cmapping);CHKERRQ(ierr); */
2760fa7f1dd8SStefano Zampini   /* Set values */
2761fa7f1dd8SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQDENSE,&isdense);CHKERRQ(ierr);
2762fa7f1dd8SStefano Zampini   if (isdense) { /* special case for dense local matrices */
2763fa7f1dd8SStefano Zampini     ierr = MatSetOption(*M,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
2764fa7f1dd8SStefano Zampini     ierr = MatDenseGetArray(matis->A,&array);CHKERRQ(ierr);
2765fa7f1dd8SStefano Zampini     ierr = MatSetValues(*M,local_rows,global_indices,local_cols,global_indices,array,ADD_VALUES);CHKERRQ(ierr);
2766fa7f1dd8SStefano Zampini     ierr = MatDenseRestoreArray(matis->A,&array);CHKERRQ(ierr);
2767fa7f1dd8SStefano Zampini     ierr = PetscFree(local_indices);CHKERRQ(ierr);
2768fa7f1dd8SStefano Zampini     ierr = PetscFree(global_indices);CHKERRQ(ierr);
2769fa7f1dd8SStefano Zampini   } else { /* very basic values insertion for all other matrix types */
2770fa7f1dd8SStefano Zampini     ierr = PetscFree(local_indices);CHKERRQ(ierr);
2771a57a6d2fSStefano Zampini     for (i=0;i<local_rows;i++) {
2772a57a6d2fSStefano Zampini       ierr = MatGetRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2773fa7f1dd8SStefano Zampini       /* ierr = MatSetValuesLocal(*M,1,&i,j,local_indices,array,ADD_VALUES);CHKERRQ(ierr); */
2774a57a6d2fSStefano Zampini       ierr = ISLocalToGlobalMappingApply(matis->mapping,j,local_indices,global_indices);CHKERRQ(ierr);
2775a57a6d2fSStefano Zampini       ierr = ISLocalToGlobalMappingApply(matis->mapping,1,&i,&index_row);CHKERRQ(ierr);
2776fa7f1dd8SStefano Zampini       ierr = MatSetValues(*M,1,&index_row,j,global_indices,array,ADD_VALUES);CHKERRQ(ierr);
2777a57a6d2fSStefano Zampini       ierr = MatRestoreRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2778a57a6d2fSStefano Zampini     }
2779c9f409c0SStefano Zampini     ierr = PetscFree(global_indices);CHKERRQ(ierr);
2780fa7f1dd8SStefano Zampini   }
2781fa7f1dd8SStefano Zampini   ierr = MatAssemblyBegin(*M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2782fa7f1dd8SStefano Zampini   ierr = MatAssemblyEnd(*M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2783fa7f1dd8SStefano Zampini   if (isdense) {
2784fa7f1dd8SStefano Zampini     ierr = MatSetOption(*M,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
2785fa7f1dd8SStefano Zampini   }
2786a57a6d2fSStefano Zampini   PetscFunctionReturn(0);
2787a57a6d2fSStefano Zampini }
2788a57a6d2fSStefano Zampini 
2789e7931f94SStefano Zampini #undef __FUNCT__
279070cf5478SStefano Zampini #define __FUNCT__ "MatISGetSubassemblingPattern"
279128143c3dSStefano Zampini PetscErrorCode MatISGetSubassemblingPattern(Mat mat, PetscInt n_subdomains, PetscBool contiguous, IS* is_sends)
2792e7931f94SStefano Zampini {
2793e7931f94SStefano Zampini   Mat             subdomain_adj;
2794e7931f94SStefano Zampini   IS              new_ranks,ranks_send_to;
2795e7931f94SStefano Zampini   MatPartitioning partitioner;
2796e7931f94SStefano Zampini   Mat_IS          *matis;
2797e7931f94SStefano Zampini   PetscInt        n_neighs,*neighs,*n_shared,**shared;
2798e7931f94SStefano Zampini   PetscInt        prank;
2799e7931f94SStefano Zampini   PetscMPIInt     size,rank,color;
2800e7931f94SStefano Zampini   PetscInt        *xadj,*adjncy,*oldranks;
2801e7931f94SStefano Zampini   PetscInt        *adjncy_wgt,*v_wgt,*is_indices,*ranks_send_to_idx;
280228143c3dSStefano Zampini   PetscInt        i,j,local_size,threshold=0;
2803e7931f94SStefano Zampini   PetscErrorCode  ierr;
28042b510759SStefano Zampini   PetscBool       use_vwgt=PETSC_FALSE,use_square=PETSC_FALSE;
2805e7931f94SStefano Zampini   PetscSubcomm    subcomm;
2806a57a6d2fSStefano Zampini 
2807e7931f94SStefano Zampini   PetscFunctionBegin;
28082b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_square",&use_square,NULL);CHKERRQ(ierr);
28092b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
28102b510759SStefano Zampini   ierr = PetscOptionsGetInt(NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
2811e7931f94SStefano Zampini 
2812e7931f94SStefano Zampini   /* Get info on mapping */
2813e7931f94SStefano Zampini   matis = (Mat_IS*)(mat->data);
2814e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&local_size);CHKERRQ(ierr);
2815e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2816e7931f94SStefano Zampini 
2817e7931f94SStefano Zampini   /* build local CSR graph of subdomains' connectivity */
2818785e854fSJed Brown   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
2819e7931f94SStefano Zampini   xadj[0] = 0;
2820e7931f94SStefano Zampini   xadj[1] = PetscMax(n_neighs-1,0);
2821785e854fSJed Brown   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
2822785e854fSJed Brown   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
2823e7931f94SStefano Zampini 
28242b510759SStefano Zampini   if (threshold) {
28252b510759SStefano Zampini     PetscInt* count,min_threshold;
2826785e854fSJed Brown     ierr = PetscMalloc1(local_size,&count);CHKERRQ(ierr);
2827e7931f94SStefano Zampini     ierr = PetscMemzero(count,local_size*sizeof(PetscInt));CHKERRQ(ierr);
2828e7931f94SStefano Zampini     for (i=1;i<n_neighs;i++) {/* i=1 so I don't count myself -> faces nodes counts to 1 */
2829e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2830e7931f94SStefano Zampini         count[shared[i][j]] += 1;
2831e7931f94SStefano Zampini       }
2832e7931f94SStefano Zampini     }
28332b510759SStefano Zampini     /* adapt threshold since we dont want to lose significant connections */
28342b510759SStefano Zampini     min_threshold = n_neighs;
28352b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
28362b510759SStefano Zampini       for (j=0;j<n_shared[i];j++) {
28372b510759SStefano Zampini         min_threshold = PetscMin(count[shared[i][j]],min_threshold);
28382b510759SStefano Zampini       }
28392b510759SStefano Zampini     }
28402b510759SStefano Zampini     threshold = PetscMax(min_threshold+1,threshold);
2841e7931f94SStefano Zampini     xadj[1] = 0;
28422b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
2843e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2844e7931f94SStefano Zampini         if (count[shared[i][j]] < threshold) {
2845e7931f94SStefano Zampini           adjncy[xadj[1]] = neighs[i];
2846e7931f94SStefano Zampini           adjncy_wgt[xadj[1]] = n_shared[i];
2847e7931f94SStefano Zampini           xadj[1]++;
2848e7931f94SStefano Zampini           break;
2849e7931f94SStefano Zampini         }
2850e7931f94SStefano Zampini       }
2851e7931f94SStefano Zampini     }
2852e7931f94SStefano Zampini     ierr = PetscFree(count);CHKERRQ(ierr);
2853c8587f34SStefano Zampini   } else {
2854e7931f94SStefano Zampini     if (xadj[1]) {
2855e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy,&neighs[1],xadj[1]*sizeof(*adjncy));CHKERRQ(ierr);
2856e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy_wgt,&n_shared[1],xadj[1]*sizeof(*adjncy_wgt));CHKERRQ(ierr);
2857c8587f34SStefano Zampini     }
2858e7931f94SStefano Zampini   }
2859e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingRestoreInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2860e7931f94SStefano Zampini   if (use_square) {
2861e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2862e7931f94SStefano Zampini       adjncy_wgt[i] = adjncy_wgt[i]*adjncy_wgt[i];
2863e7931f94SStefano Zampini     }
2864e7931f94SStefano Zampini   }
2865e7931f94SStefano Zampini   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2866e7931f94SStefano Zampini 
2867e7931f94SStefano Zampini   ierr = PetscMalloc(sizeof(PetscInt),&ranks_send_to_idx);CHKERRQ(ierr);
2868e7931f94SStefano Zampini 
2869e7931f94SStefano Zampini   /*
2870e7931f94SStefano Zampini     Restrict work on active processes only.
2871e7931f94SStefano Zampini   */
2872e7931f94SStefano Zampini   ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&subcomm);CHKERRQ(ierr);
2873e7931f94SStefano Zampini   ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
2874e7931f94SStefano Zampini   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
28752b510759SStefano Zampini   ierr = PetscMPIIntCast(!local_size,&color);CHKERRQ(ierr);
2876d3531aaaSJed Brown   ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
2877e7931f94SStefano Zampini   if (color) {
2878e7931f94SStefano Zampini     ierr = PetscFree(xadj);CHKERRQ(ierr);
2879e7931f94SStefano Zampini     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2880e7931f94SStefano Zampini     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
2881c8587f34SStefano Zampini   } else {
288228143c3dSStefano Zampini     PetscInt coarsening_ratio;
2883e7931f94SStefano Zampini     ierr = MPI_Comm_size(subcomm->comm,&size);CHKERRQ(ierr);
2884785e854fSJed Brown     ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
2885e7931f94SStefano Zampini     prank = rank;
2886e7931f94SStefano Zampini     ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm->comm);CHKERRQ(ierr);
28878002ef2cSStefano Zampini     /*
2888e7931f94SStefano Zampini     for (i=0;i<size;i++) {
2889e7931f94SStefano Zampini       PetscPrintf(subcomm->comm,"oldranks[%d] = %d\n",i,oldranks[i]);
2890c8587f34SStefano Zampini     }
28918002ef2cSStefano Zampini     */
2892e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2893e7931f94SStefano Zampini       ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
2894c8587f34SStefano Zampini     }
2895e7931f94SStefano Zampini     ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2896e7931f94SStefano Zampini     ierr = MatCreateMPIAdj(subcomm->comm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
289722b6e8a2SStefano Zampini     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
2898e7931f94SStefano Zampini 
2899e7931f94SStefano Zampini     /* Partition */
2900e7931f94SStefano Zampini     ierr = MatPartitioningCreate(subcomm->comm,&partitioner);CHKERRQ(ierr);
2901e7931f94SStefano Zampini     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
2902e7931f94SStefano Zampini     if (use_vwgt) {
2903e7931f94SStefano Zampini       ierr = PetscMalloc(sizeof(*v_wgt),&v_wgt);CHKERRQ(ierr);
2904e7931f94SStefano Zampini       v_wgt[0] = local_size;
2905e7931f94SStefano Zampini       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
2906c8587f34SStefano Zampini     }
290728143c3dSStefano Zampini     n_subdomains = PetscMin((PetscInt)size,n_subdomains);
290828143c3dSStefano Zampini     coarsening_ratio = size/n_subdomains;
290928143c3dSStefano Zampini     /* Parmetis does not always give back nparts with small graphs! this should be taken into account */
291028143c3dSStefano Zampini     ierr = MatPartitioningSetNParts(partitioner,n_subdomains);CHKERRQ(ierr);
2911e7931f94SStefano Zampini     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
2912e7931f94SStefano Zampini     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
291322b6e8a2SStefano Zampini     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
2914e7931f94SStefano Zampini 
2915e7931f94SStefano Zampini     ierr = ISGetIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
291628143c3dSStefano Zampini     if (contiguous) {
291728143c3dSStefano Zampini       ranks_send_to_idx[0] = oldranks[is_indices[0]]; /* contiguos set of processes */
291828143c3dSStefano Zampini     } else {
291984ba6060SStefano Zampini       ranks_send_to_idx[0] = coarsening_ratio*oldranks[is_indices[0]]; /* scattered set of processes */
292028143c3dSStefano Zampini     }
2921e7931f94SStefano Zampini     ierr = ISRestoreIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2922e7931f94SStefano Zampini     /* clean up */
2923e7931f94SStefano Zampini     ierr = PetscFree(oldranks);CHKERRQ(ierr);
2924e7931f94SStefano Zampini     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
2925e7931f94SStefano Zampini     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
2926e7931f94SStefano Zampini     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
2927e7931f94SStefano Zampini   }
2928e7931f94SStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
2929e7931f94SStefano Zampini 
2930e7931f94SStefano Zampini   /* assemble parallel IS for sends */
2931e7931f94SStefano Zampini   i = 1;
2932e7931f94SStefano Zampini   if (color) i=0;
2933e7931f94SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,&ranks_send_to);CHKERRQ(ierr);
2934e7931f94SStefano Zampini 
2935e7931f94SStefano Zampini   /* get back IS */
2936e7931f94SStefano Zampini   *is_sends = ranks_send_to;
2937e7931f94SStefano Zampini   PetscFunctionReturn(0);
2938e7931f94SStefano Zampini }
2939e7931f94SStefano Zampini 
2940e7931f94SStefano Zampini typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
2941e7931f94SStefano Zampini 
2942e7931f94SStefano Zampini #undef __FUNCT__
2943e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble"
294428143c3dSStefano Zampini PetscErrorCode MatISSubassemble(Mat mat, IS is_sends, PetscInt n_subdomains, PetscBool restrict_comm, MatReuse reuse, Mat *mat_n, PetscInt nis, IS isarray[])
2945e7931f94SStefano Zampini {
294670cf5478SStefano Zampini   Mat                    local_mat;
2947e7931f94SStefano Zampini   Mat_IS                 *matis;
2948e7931f94SStefano Zampini   IS                     is_sends_internal;
2949e7931f94SStefano Zampini   PetscInt               rows,cols;
295028143c3dSStefano Zampini   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals;
295128143c3dSStefano Zampini   PetscBool              ismatis,isdense,destroy_mat;
2952e7931f94SStefano Zampini   ISLocalToGlobalMapping l2gmap;
2953e7931f94SStefano Zampini   PetscInt*              l2gmap_indices;
2954e7931f94SStefano Zampini   const PetscInt*        is_indices;
2955e7931f94SStefano Zampini   MatType                new_local_type;
2956e7931f94SStefano Zampini   /* buffers */
2957e7931f94SStefano Zampini   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
295828143c3dSStefano Zampini   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
2959e7931f94SStefano Zampini   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
2960e7931f94SStefano Zampini   /* MPI */
296128143c3dSStefano Zampini   MPI_Comm               comm,comm_n;
296228143c3dSStefano Zampini   PetscSubcomm           subcomm;
2963e7931f94SStefano Zampini   PetscMPIInt            n_sends,n_recvs,commsize;
296428143c3dSStefano Zampini   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
296528143c3dSStefano Zampini   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
296628143c3dSStefano Zampini   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,source_dest;
296728143c3dSStefano Zampini   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals;
296828143c3dSStefano Zampini   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals;
2969e7931f94SStefano Zampini   PetscErrorCode         ierr;
2970e7931f94SStefano Zampini 
2971e7931f94SStefano Zampini   PetscFunctionBegin;
297228143c3dSStefano Zampini   /* TODO: add missing checks */
297328143c3dSStefano Zampini   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
297428143c3dSStefano Zampini   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
297528143c3dSStefano Zampini   PetscValidLogicalCollectiveEnum(mat,reuse,5);
297628143c3dSStefano Zampini   PetscValidLogicalCollectiveInt(mat,nis,7);
2977e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
297828143c3dSStefano Zampini   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",__FUNCT__);
2979e7931f94SStefano Zampini   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2980e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
2981e7931f94SStefano Zampini   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
2982e7931f94SStefano Zampini   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
2983e7931f94SStefano Zampini   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
298428143c3dSStefano Zampini   if (reuse == MAT_REUSE_MATRIX && *mat_n) {
298570cf5478SStefano Zampini     PetscInt mrows,mcols,mnrows,mncols;
298670cf5478SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
298728143c3dSStefano Zampini     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
298870cf5478SStefano Zampini     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
298970cf5478SStefano Zampini     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
299070cf5478SStefano Zampini     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
299170cf5478SStefano Zampini     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
299270cf5478SStefano Zampini   }
2993e7931f94SStefano Zampini   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
2994e7931f94SStefano Zampini   PetscValidLogicalCollectiveInt(mat,bs,0);
2995e7931f94SStefano Zampini   /* prepare IS for sending if not provided */
2996e7931f94SStefano Zampini   if (!is_sends) {
299728143c3dSStefano Zampini     PetscBool pcontig = PETSC_TRUE;
299828143c3dSStefano Zampini     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
299928143c3dSStefano Zampini     ierr = MatISGetSubassemblingPattern(mat,n_subdomains,pcontig,&is_sends_internal);CHKERRQ(ierr);
3000c8587f34SStefano Zampini   } else {
3001e7931f94SStefano Zampini     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
3002e7931f94SStefano Zampini     is_sends_internal = is_sends;
3003c8587f34SStefano Zampini   }
3004e7931f94SStefano Zampini 
3005e7931f94SStefano Zampini   /* get pointer of MATIS data */
3006e7931f94SStefano Zampini   matis = (Mat_IS*)mat->data;
3007e7931f94SStefano Zampini 
3008e7931f94SStefano Zampini   /* get comm */
3009e7931f94SStefano Zampini   comm = PetscObjectComm((PetscObject)mat);
3010e7931f94SStefano Zampini 
3011e7931f94SStefano Zampini   /* compute number of sends */
3012e7931f94SStefano Zampini   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
3013e7931f94SStefano Zampini   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
3014e7931f94SStefano Zampini 
3015e7931f94SStefano Zampini   /* compute number of receives */
3016e7931f94SStefano Zampini   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
3017785e854fSJed Brown   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
3018e7931f94SStefano Zampini   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
3019e7931f94SStefano Zampini   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
3020e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
3021e7931f94SStefano Zampini   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
3022e7931f94SStefano Zampini   ierr = PetscFree(iflags);CHKERRQ(ierr);
3023e7931f94SStefano Zampini 
302428143c3dSStefano Zampini   /* restrict comm if requested */
302528143c3dSStefano Zampini   subcomm = 0;
302628143c3dSStefano Zampini   destroy_mat = PETSC_FALSE;
302728143c3dSStefano Zampini   if (restrict_comm) {
302828143c3dSStefano Zampini     PetscMPIInt color,rank,subcommsize;
302928143c3dSStefano Zampini     ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
303028143c3dSStefano Zampini     color = 0;
303128143c3dSStefano Zampini     if (n_sends && !n_recvs) color = 1; /* sending only processes will not partecipate in new comm */
303228143c3dSStefano Zampini     ierr = MPI_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
303328143c3dSStefano Zampini     subcommsize = commsize - subcommsize;
303428143c3dSStefano Zampini     /* check if reuse has been requested */
303528143c3dSStefano Zampini     if (reuse == MAT_REUSE_MATRIX) {
303628143c3dSStefano Zampini       if (*mat_n) {
303728143c3dSStefano Zampini         PetscMPIInt subcommsize2;
303828143c3dSStefano Zampini         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
303928143c3dSStefano Zampini         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
304028143c3dSStefano Zampini         comm_n = PetscObjectComm((PetscObject)*mat_n);
304128143c3dSStefano Zampini       } else {
304228143c3dSStefano Zampini         comm_n = PETSC_COMM_SELF;
304328143c3dSStefano Zampini       }
304428143c3dSStefano Zampini     } else { /* MAT_INITIAL_MATRIX */
304528143c3dSStefano Zampini       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
304628143c3dSStefano Zampini       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
304728143c3dSStefano Zampini       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
304828143c3dSStefano Zampini       comm_n = subcomm->comm;
304928143c3dSStefano Zampini     }
305028143c3dSStefano Zampini     /* flag to destroy *mat_n if not significative */
305128143c3dSStefano Zampini     if (color) destroy_mat = PETSC_TRUE;
305228143c3dSStefano Zampini   } else {
305328143c3dSStefano Zampini     comm_n = comm;
305428143c3dSStefano Zampini   }
305528143c3dSStefano Zampini 
3056e7931f94SStefano Zampini   /* prepare send/receive buffers */
3057785e854fSJed Brown   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
3058e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
3059785e854fSJed Brown   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
3060e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
306128143c3dSStefano Zampini   if (nis) {
306228143c3dSStefano Zampini     ierr = PetscMalloc(commsize*sizeof(*ilengths_idxs_is),&ilengths_idxs_is);CHKERRQ(ierr);
306328143c3dSStefano Zampini     ierr = PetscMemzero(ilengths_idxs_is,commsize*sizeof(*ilengths_idxs_is));CHKERRQ(ierr);
306428143c3dSStefano Zampini   }
3065e7931f94SStefano Zampini 
306628143c3dSStefano Zampini   /* Get data from local matrices */
3067e7931f94SStefano Zampini   if (!isdense) {
3068e7931f94SStefano Zampini     /* TODO: See below some guidelines on how to prepare the local buffers */
3069e7931f94SStefano Zampini     /*
3070e7931f94SStefano Zampini        send_buffer_vals should contain the raw values of the local matrix
3071e7931f94SStefano Zampini        send_buffer_idxs should contain:
3072e7931f94SStefano Zampini        - MatType_PRIVATE type
3073e7931f94SStefano Zampini        - PetscInt        size_of_l2gmap
3074e7931f94SStefano Zampini        - PetscInt        global_row_indices[size_of_l2gmap]
3075e7931f94SStefano Zampini        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
3076e7931f94SStefano Zampini     */
3077e7931f94SStefano Zampini   } else {
3078e7931f94SStefano Zampini     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
3079e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&i);CHKERRQ(ierr);
3080785e854fSJed Brown     ierr = PetscMalloc1((i+2),&send_buffer_idxs);CHKERRQ(ierr);
3081e7931f94SStefano Zampini     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
3082e7931f94SStefano Zampini     send_buffer_idxs[1] = i;
3083e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
3084e7931f94SStefano Zampini     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
3085e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingRestoreIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
3086e7931f94SStefano Zampini     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
3087e7931f94SStefano Zampini     for (i=0;i<n_sends;i++) {
3088e7931f94SStefano Zampini       ilengths_vals[is_indices[i]] = len*len;
3089e7931f94SStefano Zampini       ilengths_idxs[is_indices[i]] = len+2;
3090c8587f34SStefano Zampini     }
3091c8587f34SStefano Zampini   }
3092e7931f94SStefano Zampini   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
309328143c3dSStefano Zampini   /* additional is (if any) */
309428143c3dSStefano Zampini   if (nis) {
309528143c3dSStefano Zampini     PetscMPIInt psum;
309628143c3dSStefano Zampini     PetscInt j;
309728143c3dSStefano Zampini     for (j=0,psum=0;j<nis;j++) {
309828143c3dSStefano Zampini       PetscInt plen;
309928143c3dSStefano Zampini       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
310028143c3dSStefano Zampini       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
310128143c3dSStefano Zampini       psum += len+1; /* indices + lenght */
310228143c3dSStefano Zampini     }
310328143c3dSStefano Zampini     ierr = PetscMalloc(psum*sizeof(PetscInt),&send_buffer_idxs_is);CHKERRQ(ierr);
310428143c3dSStefano Zampini     for (j=0,psum=0;j<nis;j++) {
310528143c3dSStefano Zampini       PetscInt plen;
310628143c3dSStefano Zampini       const PetscInt *is_array_idxs;
310728143c3dSStefano Zampini       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
310828143c3dSStefano Zampini       send_buffer_idxs_is[psum] = plen;
310928143c3dSStefano Zampini       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
311028143c3dSStefano Zampini       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
311128143c3dSStefano Zampini       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
311228143c3dSStefano Zampini       psum += plen+1; /* indices + lenght */
311328143c3dSStefano Zampini     }
311428143c3dSStefano Zampini     for (i=0;i<n_sends;i++) {
311528143c3dSStefano Zampini       ilengths_idxs_is[is_indices[i]] = psum;
311628143c3dSStefano Zampini     }
311728143c3dSStefano Zampini     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
311828143c3dSStefano Zampini   }
311928143c3dSStefano Zampini 
3120e7931f94SStefano Zampini   buf_size_idxs = 0;
3121e7931f94SStefano Zampini   buf_size_vals = 0;
312228143c3dSStefano Zampini   buf_size_idxs_is = 0;
3123e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3124e7931f94SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
3125e7931f94SStefano Zampini     buf_size_vals += (PetscInt)olengths_vals[i];
312628143c3dSStefano Zampini     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
3127e7931f94SStefano Zampini   }
3128785e854fSJed Brown   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
3129785e854fSJed Brown   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
3130*95ecbf38SStefano Zampini   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
3131e7931f94SStefano Zampini 
3132e7931f94SStefano Zampini   /* get new tags for clean communications */
3133e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
3134e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
313528143c3dSStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
3136e7931f94SStefano Zampini 
3137e7931f94SStefano Zampini   /* allocate for requests */
3138785e854fSJed Brown   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
3139785e854fSJed Brown   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
3140*95ecbf38SStefano Zampini   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
3141785e854fSJed Brown   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
3142785e854fSJed Brown   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
3143*95ecbf38SStefano Zampini   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
3144e7931f94SStefano Zampini 
3145e7931f94SStefano Zampini   /* communications */
3146e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
3147e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
314828143c3dSStefano Zampini   ptr_idxs_is = recv_buffer_idxs_is;
3149e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3150e7931f94SStefano Zampini     source_dest = onodes[i];
3151e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
3152e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
3153e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3154e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
315528143c3dSStefano Zampini     if (nis) {
315628143c3dSStefano Zampini       ierr = MPI_Irecv(ptr_idxs_is,olengths_idxs_is[i],MPIU_INT,source_dest,tag_idxs_is,comm,&recv_req_idxs_is[i]);CHKERRQ(ierr);
315728143c3dSStefano Zampini       ptr_idxs_is += olengths_idxs_is[i];
315828143c3dSStefano Zampini     }
3159e7931f94SStefano Zampini   }
3160e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) {
3161e7931f94SStefano Zampini     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
3162e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
3163e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
316428143c3dSStefano Zampini     if (nis) {
316528143c3dSStefano Zampini       ierr = MPI_Isend(send_buffer_idxs_is,ilengths_idxs_is[source_dest],MPIU_INT,source_dest,tag_idxs_is,comm,&send_req_idxs_is[i]);CHKERRQ(ierr);
316628143c3dSStefano Zampini     }
3167e7931f94SStefano Zampini   }
3168e7931f94SStefano Zampini   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
3169e7931f94SStefano Zampini   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
3170e7931f94SStefano Zampini 
3171e7931f94SStefano Zampini   /* assemble new l2g map */
3172e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3173e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
3174e7931f94SStefano Zampini   buf_size_idxs = 0;
3175e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3176e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
3177e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3178e7931f94SStefano Zampini   }
3179785e854fSJed Brown   ierr = PetscMalloc1(buf_size_idxs,&l2gmap_indices);CHKERRQ(ierr);
3180e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
3181e7931f94SStefano Zampini   buf_size_idxs = 0;
3182e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3183e7931f94SStefano Zampini     ierr = PetscMemcpy(&l2gmap_indices[buf_size_idxs],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
3184e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
3185e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3186e7931f94SStefano Zampini   }
3187e7931f94SStefano Zampini   ierr = PetscSortRemoveDupsInt(&buf_size_idxs,l2gmap_indices);CHKERRQ(ierr);
318828143c3dSStefano Zampini   ierr = ISLocalToGlobalMappingCreate(comm_n,buf_size_idxs,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
3189e7931f94SStefano Zampini   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
3190e7931f94SStefano Zampini 
3191e7931f94SStefano Zampini   /* infer new local matrix type from received local matrices type */
3192e7931f94SStefano Zampini   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
3193e7931f94SStefano 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) */
3194e7931f94SStefano Zampini   if (n_recvs) {
319528143c3dSStefano Zampini     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
3196e7931f94SStefano Zampini     ptr_idxs = recv_buffer_idxs;
3197e7931f94SStefano Zampini     for (i=0;i<n_recvs;i++) {
3198e7931f94SStefano Zampini       if ((PetscInt)new_local_type_private != *ptr_idxs) {
3199e7931f94SStefano Zampini         new_local_type_private = MATAIJ_PRIVATE;
3200e7931f94SStefano Zampini         break;
3201e7931f94SStefano Zampini       }
3202e7931f94SStefano Zampini       ptr_idxs += olengths_idxs[i];
3203e7931f94SStefano Zampini     }
3204e7931f94SStefano Zampini     switch (new_local_type_private) {
320528143c3dSStefano Zampini       case MATDENSE_PRIVATE:
320628143c3dSStefano Zampini         if (n_recvs>1) { /* subassembling of dense matrices does not give a dense matrix! */
3207e7931f94SStefano Zampini           new_local_type = MATSEQAIJ;
3208e7931f94SStefano Zampini           bs = 1;
320928143c3dSStefano Zampini         } else { /* if I receive only 1 dense matrix */
321028143c3dSStefano Zampini           new_local_type = MATSEQDENSE;
321128143c3dSStefano Zampini           bs = 1;
321228143c3dSStefano Zampini         }
3213e7931f94SStefano Zampini         break;
3214e7931f94SStefano Zampini       case MATAIJ_PRIVATE:
3215e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
3216e7931f94SStefano Zampini         bs = 1;
3217e7931f94SStefano Zampini         break;
3218e7931f94SStefano Zampini       case MATBAIJ_PRIVATE:
3219e7931f94SStefano Zampini         new_local_type = MATSEQBAIJ;
3220e7931f94SStefano Zampini         break;
3221e7931f94SStefano Zampini       case MATSBAIJ_PRIVATE:
3222e7931f94SStefano Zampini         new_local_type = MATSEQSBAIJ;
3223e7931f94SStefano Zampini         break;
3224e7931f94SStefano Zampini       default:
322528143c3dSStefano Zampini         SETERRQ2(comm,PETSC_ERR_PLIB,"Unkwown private type %d in %s",new_local_type_private,__FUNCT__);
3226e7931f94SStefano Zampini         break;
3227e7931f94SStefano Zampini     }
322828143c3dSStefano Zampini   } else { /* by default, new_local_type is seqdense */
322928143c3dSStefano Zampini     new_local_type = MATSEQDENSE;
323028143c3dSStefano Zampini     bs = 1;
3231e7931f94SStefano Zampini   }
3232e7931f94SStefano Zampini 
323370cf5478SStefano Zampini   /* create MATIS object if needed */
323470cf5478SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
3235e7931f94SStefano Zampini     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
323628143c3dSStefano Zampini     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,mat_n);CHKERRQ(ierr);
323770cf5478SStefano Zampini   } else {
323870cf5478SStefano Zampini     /* it also destroys the local matrices */
323970cf5478SStefano Zampini     ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
324070cf5478SStefano Zampini   }
3241e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
324270cf5478SStefano Zampini   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
3243e7931f94SStefano Zampini   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
3244e7931f94SStefano Zampini   ierr = MatSetUp(local_mat);CHKERRQ(ierr); /* WARNING -> no preallocation yet */
3245e7931f94SStefano Zampini 
3246e7931f94SStefano Zampini   /* set values */
3247e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3248e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
3249e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
3250e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3251e7931f94SStefano Zampini     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
3252e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
325370cf5478SStefano Zampini       ierr = MatSetValues(*mat_n,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
3254e7931f94SStefano Zampini       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3255e7931f94SStefano Zampini       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3256e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
325728143c3dSStefano Zampini     } else {
325828143c3dSStefano Zampini       /* TODO */
3259e7931f94SStefano Zampini     }
3260e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3261e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
3262e7931f94SStefano Zampini   }
3263e7931f94SStefano Zampini   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3264e7931f94SStefano Zampini   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
326570cf5478SStefano Zampini   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
326670cf5478SStefano Zampini   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3267e7931f94SStefano Zampini 
3268dfd14d43SStefano Zampini #if 0
326928143c3dSStefano Zampini   if (!restrict_comm) { /* check */
3270e7931f94SStefano Zampini     Vec       lvec,rvec;
3271e7931f94SStefano Zampini     PetscReal infty_error;
3272e7931f94SStefano Zampini 
3273e7931f94SStefano Zampini     ierr = MatGetVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
3274e7931f94SStefano Zampini     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
3275e7931f94SStefano Zampini     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
3276e7931f94SStefano Zampini     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
327770cf5478SStefano Zampini     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
3278e7931f94SStefano Zampini     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3279e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
3280e7931f94SStefano Zampini     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
3281e7931f94SStefano Zampini     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
3282e7931f94SStefano Zampini   }
328328143c3dSStefano Zampini #endif
3284e7931f94SStefano Zampini 
328528143c3dSStefano Zampini   /* assemble new additional is (if any) */
328628143c3dSStefano Zampini   if (nis) {
328728143c3dSStefano Zampini     PetscInt **temp_idxs,*count_is,j,psum;
328828143c3dSStefano Zampini 
328928143c3dSStefano Zampini     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
329028143c3dSStefano Zampini     ierr = PetscMalloc(nis*sizeof(PetscInt),&count_is);CHKERRQ(ierr);
329128143c3dSStefano Zampini     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
329228143c3dSStefano Zampini     ptr_idxs = recv_buffer_idxs_is;
329328143c3dSStefano Zampini     psum = 0;
329428143c3dSStefano Zampini     for (i=0;i<n_recvs;i++) {
329528143c3dSStefano Zampini       for (j=0;j<nis;j++) {
329628143c3dSStefano Zampini         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
329728143c3dSStefano Zampini         count_is[j] += plen; /* increment counting of buffer for j-th IS */
329828143c3dSStefano Zampini         psum += plen;
329928143c3dSStefano Zampini         ptr_idxs += plen+1; /* shift pointer to received data */
330028143c3dSStefano Zampini       }
330128143c3dSStefano Zampini     }
330228143c3dSStefano Zampini     ierr = PetscMalloc(nis*sizeof(PetscInt*),&temp_idxs);CHKERRQ(ierr);
330328143c3dSStefano Zampini     ierr = PetscMalloc(psum*sizeof(PetscInt),&temp_idxs[0]);CHKERRQ(ierr);
330428143c3dSStefano Zampini     for (i=1;i<nis;i++) {
330528143c3dSStefano Zampini       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
330628143c3dSStefano Zampini     }
330728143c3dSStefano Zampini     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
330828143c3dSStefano Zampini     ptr_idxs = recv_buffer_idxs_is;
330928143c3dSStefano Zampini     for (i=0;i<n_recvs;i++) {
331028143c3dSStefano Zampini       for (j=0;j<nis;j++) {
331128143c3dSStefano Zampini         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
331228143c3dSStefano Zampini         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
331328143c3dSStefano Zampini         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
331428143c3dSStefano Zampini         ptr_idxs += plen+1; /* shift pointer to received data */
331528143c3dSStefano Zampini       }
331628143c3dSStefano Zampini     }
331728143c3dSStefano Zampini     for (i=0;i<nis;i++) {
331828143c3dSStefano Zampini       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
331928143c3dSStefano Zampini       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
332028143c3dSStefano Zampini       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
332128143c3dSStefano Zampini     }
332228143c3dSStefano Zampini     ierr = PetscFree(count_is);CHKERRQ(ierr);
332328143c3dSStefano Zampini     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
332428143c3dSStefano Zampini     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
332528143c3dSStefano Zampini   }
3326e7931f94SStefano Zampini   /* free workspace */
3327e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
3328e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
332928143c3dSStefano Zampini   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
3330e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3331e7931f94SStefano Zampini   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
3332e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3333e7931f94SStefano Zampini   if (isdense) {
3334e7931f94SStefano Zampini     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
3335e7931f94SStefano Zampini     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
3336e7931f94SStefano Zampini   } else {
3337e7931f94SStefano Zampini     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
3338e7931f94SStefano Zampini   }
333928143c3dSStefano Zampini   if (nis) {
334028143c3dSStefano Zampini     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
334128143c3dSStefano Zampini     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
334228143c3dSStefano Zampini   }
3343e7931f94SStefano Zampini   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
3344e7931f94SStefano Zampini   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
334528143c3dSStefano Zampini   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
3346e7931f94SStefano Zampini   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
3347e7931f94SStefano Zampini   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
334828143c3dSStefano Zampini   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
3349e7931f94SStefano Zampini   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
3350e7931f94SStefano Zampini   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
3351e7931f94SStefano Zampini   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
3352e7931f94SStefano Zampini   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
3353e7931f94SStefano Zampini   ierr = PetscFree(onodes);CHKERRQ(ierr);
335428143c3dSStefano Zampini   if (nis) {
335528143c3dSStefano Zampini     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
335628143c3dSStefano Zampini     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
335728143c3dSStefano Zampini     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
335828143c3dSStefano Zampini   }
335928143c3dSStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
336028143c3dSStefano Zampini   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
336128143c3dSStefano Zampini     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
336228143c3dSStefano Zampini     for (i=0;i<nis;i++) {
336328143c3dSStefano Zampini       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
336428143c3dSStefano Zampini     }
336528143c3dSStefano Zampini   }
3366e7931f94SStefano Zampini   PetscFunctionReturn(0);
3367e7931f94SStefano Zampini }
3368a57a6d2fSStefano Zampini 
336912edc857SStefano Zampini /* temporary hack into ksp private data structure */
337012edc857SStefano Zampini #include <petsc-private/kspimpl.h>
337112edc857SStefano Zampini 
3372c8587f34SStefano Zampini #undef __FUNCT__
3373c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
3374c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
3375c8587f34SStefano Zampini {
3376c8587f34SStefano Zampini   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
3377c8587f34SStefano Zampini   PC_IS                  *pcis = (PC_IS*)pc->data;
337820a2ab83SStefano Zampini   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
33799881197aSStefano Zampini   MatNullSpace           CoarseNullSpace=NULL;
338020a2ab83SStefano Zampini   ISLocalToGlobalMapping coarse_islg;
33816e683305SStefano Zampini   IS                     coarse_is,*isarray;
33826e683305SStefano Zampini   PetscInt               i,im_active=-1,active_procs=-1;
33836e683305SStefano Zampini   PetscInt               nis,nisdofs,nisneu;
3384f9eb5b7dSStefano Zampini   PC                     pc_temp;
3385c8587f34SStefano Zampini   PCType                 coarse_pc_type;
3386c8587f34SStefano Zampini   KSPType                coarse_ksp_type;
3387f9eb5b7dSStefano Zampini   PetscBool              multilevel_requested,multilevel_allowed;
33886e683305SStefano Zampini   PetscBool              setsym,issym,isherm,isbddc,isnn,coarse_reuse;
33896e683305SStefano Zampini   Mat                    t_coarse_mat_is;
33906e683305SStefano Zampini   PetscInt               void_procs,ncoarse_ml,ncoarse_ds,ncoarse;
33916e683305SStefano Zampini   PetscMPIInt            all_procs;
33926e683305SStefano Zampini   PetscBool              csin_ml,csin_ds,csin,csin_type_simple;
339368457ee5SStefano Zampini   PetscBool              compute_vecs = PETSC_FALSE;
33949881197aSStefano Zampini   PetscErrorCode         ierr;
3395fdc09c96SStefano Zampini 
3396c8587f34SStefano Zampini   PetscFunctionBegin;
3397c8587f34SStefano Zampini   /* Assign global numbering to coarse dofs */
339868457ee5SStefano Zampini   if (pcbddc->new_primal_space || pcbddc->coarse_size == -1) { /* a new primal space is present or it is the first initialization, so recompute global numbering */
339968457ee5SStefano Zampini     compute_vecs = PETSC_TRUE;
3400fa7f1dd8SStefano Zampini     PetscInt ocoarse_size;
3401fa7f1dd8SStefano Zampini     ocoarse_size = pcbddc->coarse_size;
3402f4ddd8eeSStefano Zampini     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3403f4ddd8eeSStefano Zampini     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
3404f4ddd8eeSStefano Zampini     /* see if we can avoid some work */
3405fa7f1dd8SStefano Zampini     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
3406fa7f1dd8SStefano Zampini       if (ocoarse_size != pcbddc->coarse_size) { /* ...but with different size, so reset it and set reuse flag to false */
3407727cdba6SStefano Zampini         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3408fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_FALSE;
3409fa7f1dd8SStefano Zampini       } else { /* we can safely reuse already computed coarse matrix */
3410fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_TRUE;
3411f4ddd8eeSStefano Zampini       }
3412fa7f1dd8SStefano Zampini     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
3413fa7f1dd8SStefano Zampini       coarse_reuse = PETSC_FALSE;
3414f4ddd8eeSStefano Zampini     }
341570cf5478SStefano Zampini     /* reset any subassembling information */
341670cf5478SStefano Zampini     ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
34176e683305SStefano Zampini     ierr = ISDestroy(&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
34186e683305SStefano Zampini   } else { /* primal space is unchanged, so we can reuse coarse matrix */
3419fa7f1dd8SStefano Zampini     coarse_reuse = PETSC_TRUE;
3420f4ddd8eeSStefano Zampini   }
3421c8587f34SStefano Zampini 
34226e683305SStefano Zampini   /* count "active" (i.e. with positive local size) and "void" processes */
34232b510759SStefano Zampini   im_active = !!(pcis->n);
34242b510759SStefano Zampini   ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
34256e683305SStefano Zampini   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&all_procs);CHKERRQ(ierr);
34266e683305SStefano Zampini   void_procs = all_procs-active_procs;
34276e683305SStefano Zampini   csin_type_simple = PETSC_TRUE;
34286e683305SStefano Zampini   if (pcbddc->current_level) {
34296e683305SStefano Zampini     csin_ml = PETSC_TRUE;
34306e683305SStefano Zampini     ncoarse_ml = void_procs;
34316e683305SStefano Zampini     csin_ds = PETSC_TRUE;
34326e683305SStefano Zampini     ncoarse_ds = void_procs;
34336e683305SStefano Zampini     if (!void_procs) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen");
34346e683305SStefano Zampini   } else {
34356e683305SStefano Zampini     csin_ml = PETSC_FALSE;
34366e683305SStefano Zampini     ncoarse_ml = all_procs;
34376e683305SStefano Zampini     if (void_procs) {
34386e683305SStefano Zampini       csin_ds = PETSC_TRUE;
34396e683305SStefano Zampini       ncoarse_ds = void_procs;
34406e683305SStefano Zampini       csin_type_simple = PETSC_FALSE;
34416e683305SStefano Zampini     } else {
34426e683305SStefano Zampini       csin_ds = PETSC_FALSE;
34436e683305SStefano Zampini       ncoarse_ds = all_procs;
34446e683305SStefano Zampini     }
34456e683305SStefano Zampini   }
34466e683305SStefano Zampini 
34476e683305SStefano Zampini   /*
34486e683305SStefano Zampini     test if we can go multilevel: three conditions must be satisfied:
34496e683305SStefano Zampini     - we have not exceeded the number of levels requested
34506e683305SStefano Zampini     - we can actually subassemble the active processes
34516e683305SStefano Zampini     - we can find a suitable number of MPI processes where we can place the subassembled problem
34526e683305SStefano Zampini   */
34536e683305SStefano Zampini   multilevel_allowed = PETSC_FALSE;
34546e683305SStefano Zampini   multilevel_requested = PETSC_FALSE;
34556e683305SStefano Zampini   if (pcbddc->current_level < pcbddc->max_levels) {
34566e683305SStefano Zampini     multilevel_requested = PETSC_TRUE;
34576e683305SStefano Zampini     if (active_procs/pcbddc->coarsening_ratio < 2 || ncoarse_ml/pcbddc->coarsening_ratio < 2) {
3458f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_FALSE;
34592b510759SStefano Zampini     } else {
3460f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_TRUE;
3461c8587f34SStefano Zampini     }
3462c8587f34SStefano Zampini   }
34636e683305SStefano Zampini   /* determine number of process partecipating to coarse solver */
34646e683305SStefano Zampini   if (multilevel_allowed) {
34656e683305SStefano Zampini     ncoarse = ncoarse_ml;
34666e683305SStefano Zampini     csin = csin_ml;
34676e683305SStefano Zampini   } else {
34686e683305SStefano Zampini     ncoarse = ncoarse_ds;
34696e683305SStefano Zampini     csin = csin_ds;
34706e683305SStefano Zampini   }
3471e7931f94SStefano Zampini 
3472abbbba34SStefano Zampini   /* creates temporary l2gmap and IS for coarse indexes */
3473abbbba34SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
3474abbbba34SStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
3475abbbba34SStefano Zampini 
3476abbbba34SStefano Zampini   /* creates temporary MATIS object for coarse matrix */
3477abbbba34SStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
34786e683305SStefano Zampini   ierr = MatCreateIS(PetscObjectComm((PetscObject)pc),1,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size,coarse_islg,&t_coarse_mat_is);CHKERRQ(ierr);
34796e683305SStefano Zampini   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
34806e683305SStefano Zampini   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
34816e683305SStefano Zampini   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3482abbbba34SStefano Zampini   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
3483abbbba34SStefano Zampini 
34846e683305SStefano Zampini   /* compute dofs splitting and neumann boundaries for coarse dofs */
34856e683305SStefano Zampini   if (multilevel_allowed && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal) ) { /* protects from unneded computations */
34866e683305SStefano Zampini     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
34876e683305SStefano Zampini     const PetscInt         *idxs;
34886e683305SStefano Zampini     ISLocalToGlobalMapping tmap;
34896e683305SStefano Zampini 
34906e683305SStefano Zampini     /* create map between primal indices (in local representative ordering) and local primal numbering */
34916e683305SStefano Zampini     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
34926e683305SStefano Zampini     /* allocate space for temporary storage */
34936e683305SStefano Zampini     ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&tidxs);CHKERRQ(ierr);
34946e683305SStefano Zampini     ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&tidxs2);CHKERRQ(ierr);
34956e683305SStefano Zampini     /* allocate for IS array */
34966e683305SStefano Zampini     nisdofs = pcbddc->n_ISForDofsLocal;
34976e683305SStefano Zampini     nisneu = !!pcbddc->NeumannBoundariesLocal;
34986e683305SStefano Zampini     nis = nisdofs + nisneu;
34996e683305SStefano Zampini     ierr = PetscMalloc(nis*sizeof(IS),&isarray);CHKERRQ(ierr);
35006e683305SStefano Zampini     /* dofs splitting */
35016e683305SStefano Zampini     for (i=0;i<nisdofs;i++) {
35026e683305SStefano Zampini       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
35036e683305SStefano Zampini       ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
35046e683305SStefano Zampini       ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
35056e683305SStefano Zampini       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
35066e683305SStefano Zampini       ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
35076e683305SStefano Zampini       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
35086e683305SStefano Zampini       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pcbddc->ISForDofsLocal[i]),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
35096e683305SStefano Zampini       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
35106e683305SStefano Zampini     }
35116e683305SStefano Zampini     /* neumann boundaries */
35126e683305SStefano Zampini     if (pcbddc->NeumannBoundariesLocal) {
35136e683305SStefano Zampini       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
35146e683305SStefano Zampini       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
35156e683305SStefano Zampini       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
35166e683305SStefano Zampini       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
35176e683305SStefano Zampini       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
35186e683305SStefano Zampini       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
35196e683305SStefano Zampini       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pcbddc->NeumannBoundariesLocal),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
35206e683305SStefano Zampini       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
35216e683305SStefano Zampini     }
35226e683305SStefano Zampini     /* free memory */
35236e683305SStefano Zampini     ierr = PetscFree(tidxs);CHKERRQ(ierr);
35246e683305SStefano Zampini     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
35256e683305SStefano Zampini     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
35266e683305SStefano Zampini   } else {
35276e683305SStefano Zampini     nis = 0;
35286e683305SStefano Zampini     nisdofs = 0;
35296e683305SStefano Zampini     nisneu = 0;
35306e683305SStefano Zampini     isarray = NULL;
35316e683305SStefano Zampini   }
35326e683305SStefano Zampini   /* destroy no longer needed map */
35336e683305SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
35346e683305SStefano Zampini 
35356e683305SStefano Zampini   /* restrict on coarse candidates (if needed) */
35366e683305SStefano Zampini   coarse_mat_is = NULL;
35376e683305SStefano Zampini   if (csin) {
35386e683305SStefano Zampini     if (!pcbddc->coarse_subassembling_init ) { /* creates subassembling init pattern if not present */
35396e683305SStefano Zampini       PetscInt j,tissize,*nisindices;
35406e683305SStefano Zampini       PetscInt *coarse_candidates;
35416e683305SStefano Zampini       const PetscInt* tisindices;
35426e683305SStefano Zampini       /* get coarse candidates' ranks in pc communicator */
35436e683305SStefano Zampini       ierr = PetscMalloc(all_procs*sizeof(PetscInt),&coarse_candidates);CHKERRQ(ierr);
35446e683305SStefano Zampini       ierr = MPI_Allgather(&im_active,1,MPIU_INT,coarse_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
35456e683305SStefano Zampini       for (i=0,j=0;i<all_procs;i++) {
35466e683305SStefano Zampini         if (!coarse_candidates[i]) {
35476e683305SStefano Zampini           coarse_candidates[j]=i;
35486e683305SStefano Zampini           j++;
35496e683305SStefano Zampini         }
35506e683305SStefano Zampini       }
35516e683305SStefano Zampini       if (j < ncoarse) SETERRQ2(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen! %d < %d",j,ncoarse);
35526e683305SStefano Zampini       /* get a suitable subassembling pattern */
35536e683305SStefano Zampini       if (csin_type_simple) {
35546e683305SStefano Zampini         PetscMPIInt rank;
35556e683305SStefano Zampini         PetscInt    issize,isidx;
35566e683305SStefano Zampini         ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
35576e683305SStefano Zampini         if (im_active) {
35586e683305SStefano Zampini           issize = 1;
35596e683305SStefano Zampini           isidx = (PetscInt)rank;
35606e683305SStefano Zampini         } else {
35616e683305SStefano Zampini           issize = 0;
35626e683305SStefano Zampini           isidx = -1;
35636e683305SStefano Zampini         }
35646e683305SStefano Zampini         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),issize,&isidx,PETSC_COPY_VALUES,&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
35656e683305SStefano Zampini       } else {
35666e683305SStefano Zampini         ierr = MatISGetSubassemblingPattern(t_coarse_mat_is,ncoarse,PETSC_TRUE,&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
35676e683305SStefano Zampini       }
35686e683305SStefano Zampini       if (pcbddc->dbg_flag) {
35696e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
35706e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Subassembling pattern init (before shift)\n");CHKERRQ(ierr);
35716e683305SStefano Zampini         ierr = ISView(pcbddc->coarse_subassembling_init,pcbddc->dbg_viewer);CHKERRQ(ierr);
35726e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse candidates\n");CHKERRQ(ierr);
35736e683305SStefano Zampini         for (i=0;i<j;i++) {
35746e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"%d ",coarse_candidates[i]);CHKERRQ(ierr);
35756e683305SStefano Zampini         }
35766e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"\n");CHKERRQ(ierr);
35776e683305SStefano Zampini         ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
35786e683305SStefano Zampini       }
35796e683305SStefano Zampini       /* shift the pattern on coarse candidates */
35806e683305SStefano Zampini       ierr = ISGetLocalSize(pcbddc->coarse_subassembling_init,&tissize);CHKERRQ(ierr);
35816e683305SStefano Zampini       ierr = ISGetIndices(pcbddc->coarse_subassembling_init,&tisindices);CHKERRQ(ierr);
35826e683305SStefano Zampini       ierr = PetscMalloc(tissize*sizeof(PetscInt),&nisindices);CHKERRQ(ierr);
35836e683305SStefano Zampini       for (i=0;i<tissize;i++) nisindices[i] = coarse_candidates[tisindices[i]];
35846e683305SStefano Zampini       ierr = ISRestoreIndices(pcbddc->coarse_subassembling_init,&tisindices);CHKERRQ(ierr);
35856e683305SStefano Zampini       ierr = ISGeneralSetIndices(pcbddc->coarse_subassembling_init,tissize,nisindices,PETSC_OWN_POINTER);CHKERRQ(ierr);
35866e683305SStefano Zampini       ierr = PetscFree(coarse_candidates);CHKERRQ(ierr);
35876e683305SStefano Zampini     }
35886e683305SStefano Zampini     if (pcbddc->dbg_flag) {
35896e683305SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
35906e683305SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Subassembling pattern init\n");CHKERRQ(ierr);
35916e683305SStefano Zampini       ierr = ISView(pcbddc->coarse_subassembling_init,pcbddc->dbg_viewer);CHKERRQ(ierr);
35926e683305SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
35936e683305SStefano Zampini     }
35946e683305SStefano Zampini     /* get temporary coarse mat in IS format restricted on coarse procs (plus additional index sets of isarray) */
35956e683305SStefano Zampini     ierr = MatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling_init,0,PETSC_TRUE,MAT_INITIAL_MATRIX,&coarse_mat_is,nis,isarray);CHKERRQ(ierr);
35966e683305SStefano Zampini   } else {
35976e683305SStefano Zampini     if (pcbddc->dbg_flag) {
35986e683305SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
35996e683305SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Subassembling pattern init not needed\n");CHKERRQ(ierr);
36006e683305SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
36016e683305SStefano Zampini     }
36026e683305SStefano Zampini     ierr = PetscObjectReference((PetscObject)t_coarse_mat_is);CHKERRQ(ierr);
36036e683305SStefano Zampini     coarse_mat_is = t_coarse_mat_is;
36046e683305SStefano Zampini   }
36056e683305SStefano Zampini 
36066e683305SStefano Zampini   /* create local to global scatters for coarse problem */
360768457ee5SStefano Zampini   if (compute_vecs) {
36086e683305SStefano Zampini     PetscInt lrows;
36096e683305SStefano Zampini     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
36106e683305SStefano Zampini     if (coarse_mat_is) {
36116e683305SStefano Zampini       ierr = MatGetLocalSize(coarse_mat_is,&lrows,NULL);CHKERRQ(ierr);
36126e683305SStefano Zampini     } else {
36136e683305SStefano Zampini       lrows = 0;
36146e683305SStefano Zampini     }
36156e683305SStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
36166e683305SStefano Zampini     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
36176e683305SStefano Zampini     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
36186e683305SStefano Zampini     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
36196e683305SStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
36206e683305SStefano Zampini   }
36216e683305SStefano Zampini   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
36226e683305SStefano Zampini   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
36236e683305SStefano Zampini 
3624f9eb5b7dSStefano Zampini   /* set defaults for coarse KSP and PC */
3625f9eb5b7dSStefano Zampini   if (multilevel_allowed) {
3626f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPRICHARDSON;
3627f9eb5b7dSStefano Zampini     coarse_pc_type = PCBDDC;
3628f9eb5b7dSStefano Zampini   } else {
3629f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPPREONLY;
3630f9eb5b7dSStefano Zampini     coarse_pc_type = PCREDUNDANT;
3631c8587f34SStefano Zampini   }
3632c8587f34SStefano Zampini 
36336e683305SStefano Zampini   /* print some info if requested */
36346e683305SStefano Zampini   if (pcbddc->dbg_flag) {
36356e683305SStefano Zampini     if (!multilevel_allowed) {
36366e683305SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
36376e683305SStefano Zampini       if (multilevel_requested) {
36386e683305SStefano 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);
36396e683305SStefano Zampini       } else if (pcbddc->max_levels) {
36406e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
36416e683305SStefano Zampini       }
36426e683305SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
36436e683305SStefano Zampini     }
36446e683305SStefano Zampini   }
36456e683305SStefano Zampini 
3646f9eb5b7dSStefano Zampini   /* create the coarse KSP object only once with defaults */
3647abbbba34SStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
36486e683305SStefano Zampini   issym = PETSC_FALSE;
36496e683305SStefano Zampini   isherm = PETSC_FALSE;
36506e683305SStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
36516e683305SStefano Zampini   ierr = MatIsHermitianKnown(pc->pmat,&setsym,&isherm);CHKERRQ(ierr);
36526e683305SStefano Zampini   if (coarse_mat_is) {
36536e683305SStefano Zampini     MatReuse coarse_mat_reuse;
36546e683305SStefano Zampini     PetscViewer dbg_viewer;
36556e683305SStefano Zampini     if (pcbddc->dbg_flag) {
36566e683305SStefano Zampini       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat_is));
36576e683305SStefano Zampini       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
36586e683305SStefano Zampini     }
3659f9eb5b7dSStefano Zampini     if (!pcbddc->coarse_ksp) {
3660312be037SStefano Zampini       char prefix[256],str_level[16];
3661e604994aSStefano Zampini       size_t len;
36626e683305SStefano Zampini       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat_is),&pcbddc->coarse_ksp);CHKERRQ(ierr);
3663c8587f34SStefano Zampini       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
3664f9eb5b7dSStefano Zampini       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
3665abbbba34SStefano Zampini       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat_is,coarse_mat_is,matstruct);CHKERRQ(ierr);
3666c8587f34SStefano Zampini       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
36676e683305SStefano Zampini       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
3668c8587f34SStefano Zampini       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3669c8587f34SStefano Zampini       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
3670e604994aSStefano Zampini       /* prefix */
3671e604994aSStefano Zampini       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
3672e604994aSStefano Zampini       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
3673e604994aSStefano Zampini       if (!pcbddc->current_level) {
3674e604994aSStefano Zampini         ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
3675e604994aSStefano Zampini         ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
3676c8587f34SStefano Zampini       } else {
3677e604994aSStefano Zampini         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
3678312be037SStefano Zampini         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
3679312be037SStefano Zampini         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
3680e604994aSStefano Zampini         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
3681e604994aSStefano Zampini         *(prefix+len)='\0';
3682312be037SStefano Zampini         sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
3683e604994aSStefano Zampini         ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
3684e604994aSStefano Zampini       }
3685e604994aSStefano Zampini       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
3686f9eb5b7dSStefano Zampini       /* allow user customization */
3687f9eb5b7dSStefano Zampini       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
3688312be037SStefano Zampini     }
3689f9eb5b7dSStefano Zampini 
3690f9eb5b7dSStefano Zampini     /* get some info after set from options */
3691f9eb5b7dSStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3692f9eb5b7dSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
3693f9eb5b7dSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
36946e683305SStefano Zampini     if (isbddc && !multilevel_allowed) { /* multilevel can only be requested via pc_bddc_set_levels */
3695f9eb5b7dSStefano Zampini       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
3696f9eb5b7dSStefano Zampini       isbddc = PETSC_FALSE;
3697f9eb5b7dSStefano Zampini     }
3698f9eb5b7dSStefano Zampini 
36996e683305SStefano Zampini     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
3700f9eb5b7dSStefano Zampini     ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
3701f9eb5b7dSStefano Zampini     ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
3702f9eb5b7dSStefano Zampini     ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
37036e683305SStefano Zampini     if (nisdofs) {
37046e683305SStefano Zampini       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
37056e683305SStefano Zampini       for (i=0;i<nisdofs;i++) {
37066e683305SStefano Zampini         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
37071035eff8SStefano Zampini       }
37081035eff8SStefano Zampini     }
37096e683305SStefano Zampini     if (nisneu) {
37106e683305SStefano Zampini       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
37116e683305SStefano Zampini       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
37121035eff8SStefano Zampini     }
3713fdc09c96SStefano Zampini 
3714f9eb5b7dSStefano Zampini     /* assemble coarse matrix */
37156e683305SStefano Zampini     if (coarse_reuse) {
37166e683305SStefano Zampini       ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL,NULL);CHKERRQ(ierr);
37176e683305SStefano Zampini       ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
37186e683305SStefano Zampini       coarse_mat_reuse = MAT_REUSE_MATRIX;
37196e683305SStefano Zampini     } else {
37206e683305SStefano Zampini       coarse_mat_reuse = MAT_INITIAL_MATRIX;
37216e683305SStefano Zampini     }
3722f9eb5b7dSStefano Zampini     if (isbddc || isnn) {
372370cf5478SStefano Zampini       if (!pcbddc->coarse_subassembling) { /* subassembling info is not present */
372428143c3dSStefano Zampini         ierr = MatISGetSubassemblingPattern(coarse_mat_is,active_procs/pcbddc->coarsening_ratio,PETSC_TRUE,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
372522b6e8a2SStefano Zampini         if (pcbddc->dbg_flag) {
37266e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
37276e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Subassembling pattern\n");CHKERRQ(ierr);
37286e683305SStefano Zampini           ierr = ISView(pcbddc->coarse_subassembling,dbg_viewer);CHKERRQ(ierr);
37296e683305SStefano Zampini           ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
373022b6e8a2SStefano Zampini         }
373170cf5478SStefano Zampini       }
37326e683305SStefano Zampini       ierr = MatISSubassemble(coarse_mat_is,pcbddc->coarse_subassembling,0,PETSC_FALSE,coarse_mat_reuse,&coarse_mat,0,NULL);CHKERRQ(ierr);
373370cf5478SStefano Zampini     } else {
37346e683305SStefano Zampini       ierr = MatISGetMPIXAIJ(coarse_mat_is,MATMPIAIJ,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
3735c8587f34SStefano Zampini     }
37362b510759SStefano Zampini     ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
37379881197aSStefano Zampini 
3738f9eb5b7dSStefano Zampini     /* propagate symmetry info to coarse matrix */
3739f9eb5b7dSStefano Zampini     ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,issym);CHKERRQ(ierr);
37405a16e3a0SStefano Zampini     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
3741f9eb5b7dSStefano Zampini 
37426e683305SStefano Zampini     /* set operators */
37436e683305SStefano Zampini     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat,matstruct);CHKERRQ(ierr);
37446e683305SStefano Zampini     if (pcbddc->dbg_flag) {
37456e683305SStefano Zampini       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
37466e683305SStefano Zampini     }
37476e683305SStefano Zampini   } else { /* processes non partecipating to coarse solver (if any) */
37486e683305SStefano Zampini     coarse_mat = 0;
37496e683305SStefano Zampini   }
37506e683305SStefano Zampini   ierr = PetscFree(isarray);CHKERRQ(ierr);
37516e683305SStefano Zampini 
3752b8ffe317SStefano Zampini   /* Compute coarse null space (special handling by BDDC only) */
3753b8ffe317SStefano Zampini   if (pcbddc->NullSpace) {
3754b8ffe317SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCoarse(pc,coarse_mat,&CoarseNullSpace);CHKERRQ(ierr);
375598a51de6SStefano Zampini   }
375698a51de6SStefano Zampini 
375798a51de6SStefano Zampini   if (pcbddc->coarse_ksp) {
375898a51de6SStefano Zampini     Vec crhs,csol;
375998a51de6SStefano Zampini     PetscBool ispreonly;
376098a51de6SStefano Zampini     if (CoarseNullSpace) {
3761b8ffe317SStefano Zampini       if (isbddc) {
3762b8ffe317SStefano Zampini         ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
3763b8ffe317SStefano Zampini       } else {
3764c8587f34SStefano Zampini         ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
3765c8587f34SStefano Zampini       }
3766c8587f34SStefano Zampini     }
3767f9eb5b7dSStefano Zampini     /* setup coarse ksp */
3768f9eb5b7dSStefano Zampini     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
3769f347579bSStefano Zampini     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
3770f347579bSStefano Zampini     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
37716e683305SStefano Zampini     /* hack */
3772f347579bSStefano Zampini     if (!csol) {
3773f347579bSStefano Zampini       ierr = MatGetVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
3774f347579bSStefano Zampini     }
3775f347579bSStefano Zampini     if (!crhs) {
3776f347579bSStefano Zampini       ierr = MatGetVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
3777f347579bSStefano Zampini     }
3778cbcc2c2aSStefano Zampini     /* Check coarse problem if in debug mode or if solving with an iterative method */
3779cbcc2c2aSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
37806e683305SStefano Zampini     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
3781c8587f34SStefano Zampini       KSP       check_ksp;
37822b510759SStefano Zampini       KSPType   check_ksp_type;
3783c8587f34SStefano Zampini       PC        check_pc;
37846e683305SStefano Zampini       Vec       check_vec,coarse_vec;
3785c8587f34SStefano Zampini       PetscReal abs_infty_error,infty_error,lambda_min,lambda_max;
37862b510759SStefano Zampini       PetscInt  its;
37876e683305SStefano Zampini       PetscBool compute_eigs;
37886e683305SStefano Zampini       PetscReal *eigs_r,*eigs_c;
37896e683305SStefano Zampini       PetscInt  neigs;
3790c8587f34SStefano Zampini 
37912b510759SStefano Zampini       /* Create ksp object suitable for estimation of extreme eigenvalues */
37926e683305SStefano Zampini       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
3793fdc635d7SStefano Zampini       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
3794f4ddd8eeSStefano Zampini       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
37952b510759SStefano Zampini       if (ispreonly) {
37962b510759SStefano Zampini         check_ksp_type = KSPPREONLY;
37976e683305SStefano Zampini         compute_eigs = PETSC_FALSE;
37982b510759SStefano Zampini       } else {
3799cbcc2c2aSStefano Zampini         check_ksp_type = KSPGMRES;
38006e683305SStefano Zampini         compute_eigs = PETSC_TRUE;
3801c8587f34SStefano Zampini       }
3802c8587f34SStefano Zampini       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
38036e683305SStefano Zampini       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
38046e683305SStefano Zampini       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
38056e683305SStefano Zampini       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
3806c8587f34SStefano Zampini       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
3807c8587f34SStefano Zampini       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
3808c8587f34SStefano Zampini       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
3809c8587f34SStefano Zampini       /* create random vec */
38106e683305SStefano Zampini       ierr = KSPGetSolution(pcbddc->coarse_ksp,&coarse_vec);CHKERRQ(ierr);
38116e683305SStefano Zampini       ierr = VecDuplicate(coarse_vec,&check_vec);CHKERRQ(ierr);
3812c8587f34SStefano Zampini       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
3813c8587f34SStefano Zampini       if (CoarseNullSpace) {
3814c8587f34SStefano Zampini         ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec);CHKERRQ(ierr);
3815c8587f34SStefano Zampini       }
38166e683305SStefano Zampini       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
3817c8587f34SStefano Zampini       /* solve coarse problem */
38186e683305SStefano Zampini       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
3819c8587f34SStefano Zampini       if (CoarseNullSpace) {
38206e683305SStefano Zampini         ierr = MatNullSpaceRemove(CoarseNullSpace,coarse_vec);CHKERRQ(ierr);
3821c8587f34SStefano Zampini       }
3822cbcc2c2aSStefano Zampini       /* set eigenvalue estimation if preonly has not been requested */
38236e683305SStefano Zampini       if (compute_eigs) {
38246e683305SStefano Zampini         ierr = PetscMalloc((pcbddc->coarse_size+1)*sizeof(PetscReal),&eigs_r);CHKERRQ(ierr);
38256e683305SStefano Zampini         ierr = PetscMalloc((pcbddc->coarse_size+1)*sizeof(PetscReal),&eigs_c);CHKERRQ(ierr);
38266e683305SStefano Zampini         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
38276e683305SStefano Zampini         lambda_max = eigs_r[neigs-1];
38286e683305SStefano Zampini         lambda_min = eigs_r[0];
38296e683305SStefano Zampini         if (pcbddc->use_coarse_estimates) {
38306e683305SStefano Zampini           if (lambda_max>lambda_min) {
3831cbcc2c2aSStefano Zampini             ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max,lambda_min);CHKERRQ(ierr);
3832cbcc2c2aSStefano Zampini             ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
3833cbcc2c2aSStefano Zampini           }
3834c8587f34SStefano Zampini         }
3835c8587f34SStefano Zampini       }
3836cbcc2c2aSStefano Zampini 
38376e683305SStefano Zampini       /* check coarse problem residual error */
38386e683305SStefano Zampini       if (pcbddc->dbg_flag) {
38396e683305SStefano Zampini         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
38406e683305SStefano Zampini         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
38416e683305SStefano Zampini         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
38426e683305SStefano Zampini         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
38436e683305SStefano Zampini         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
38446e683305SStefano Zampini         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
38456e683305SStefano Zampini         ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
38466e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (%d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
38476e683305SStefano Zampini         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
38486e683305SStefano Zampini         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
38496e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
38506e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
38516e683305SStefano Zampini         if (compute_eigs) {
38526e683305SStefano Zampini           PetscReal lambda_max_s,lambda_min_s;
38536e683305SStefano Zampini           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
38546e683305SStefano Zampini           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
38556e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem eigenvalues (estimated with %d iterations of %s): %1.6e %1.6e (%1.6e %1.6e)\n",its,check_ksp_type,lambda_min,lambda_max,lambda_min_s,lambda_max_s);CHKERRQ(ierr);
38566e683305SStefano Zampini           for (i=0;i<neigs;i++) {
38576e683305SStefano Zampini             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
38586e683305SStefano Zampini           }
38596e683305SStefano Zampini         }
38606e683305SStefano Zampini         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
38616e683305SStefano Zampini         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
38626e683305SStefano Zampini       }
38636e683305SStefano Zampini       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
38646e683305SStefano Zampini       if (compute_eigs) {
38656e683305SStefano Zampini         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
38666e683305SStefano Zampini         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
38676e683305SStefano Zampini       }
38686e683305SStefano Zampini     }
38696e683305SStefano Zampini   }
3870cbcc2c2aSStefano Zampini   /* print additional info */
3871cbcc2c2aSStefano Zampini   if (pcbddc->dbg_flag) {
38726e683305SStefano Zampini     /* waits until all processes reaches this point */
38736e683305SStefano Zampini     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
3874cbcc2c2aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
3875cbcc2c2aSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3876cbcc2c2aSStefano Zampini   }
3877cbcc2c2aSStefano Zampini 
38782b510759SStefano Zampini   /* free memory */
3879c8587f34SStefano Zampini   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
3880fdc635d7SStefano Zampini   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
3881c8587f34SStefano Zampini   PetscFunctionReturn(0);
3882c8587f34SStefano Zampini }
3883674ae819SStefano Zampini 
3884f34684f1SStefano Zampini #undef __FUNCT__
3885f34684f1SStefano Zampini #define __FUNCT__ "PCBDDCComputePrimalNumbering"
3886f34684f1SStefano Zampini PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
3887f34684f1SStefano Zampini {
3888f34684f1SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3889f34684f1SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
3890f34684f1SStefano Zampini   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
3891727cdba6SStefano Zampini   PetscInt       i,coarse_size;
3892727cdba6SStefano Zampini   PetscInt       *local_primal_indices;
3893f34684f1SStefano Zampini   PetscErrorCode ierr;
3894f34684f1SStefano Zampini 
3895f34684f1SStefano Zampini   PetscFunctionBegin;
3896f34684f1SStefano Zampini   /* Compute global number of coarse dofs */
389789c96988SStefano Zampini   if (!pcbddc->primal_indices_local_idxs && pcbddc->local_primal_size) {
389889c96988SStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Local primal indices have not been created");
3899727cdba6SStefano Zampini   }
3900727cdba6SStefano 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);
3901f34684f1SStefano Zampini 
3902f34684f1SStefano Zampini   /* check numbering */
3903f34684f1SStefano Zampini   if (pcbddc->dbg_flag) {
3904f34684f1SStefano Zampini     PetscScalar coarsesum,*array;
3905f34684f1SStefano Zampini 
3906f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3907f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3908f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
39090fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
3910f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
3911f34684f1SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
3912727cdba6SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
3913f34684f1SStefano Zampini     }
3914f34684f1SStefano Zampini     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
3915f34684f1SStefano Zampini     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
3916f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3917f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3918f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3919f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3920f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3921f34684f1SStefano Zampini     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3922f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3923f34684f1SStefano Zampini       if (array[i] == 1.0) {
3924f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %d owned by a single process!\n",PetscGlobalRank,i);CHKERRQ(ierr);
3925f34684f1SStefano Zampini       }
3926f34684f1SStefano Zampini     }
3927f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3928f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3929f34684f1SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
3930f34684f1SStefano Zampini     }
3931f34684f1SStefano Zampini     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3932f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3933f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3934f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3935f34684f1SStefano Zampini     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
3936f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
3937f34684f1SStefano Zampini     if (pcbddc->dbg_flag > 1) {
3938f34684f1SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
3939f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3940f34684f1SStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
3941f34684f1SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
3942727cdba6SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_primal_indices[%d]=%d (%d)\n",i,local_primal_indices[i],pcbddc->primal_indices_local_idxs[i]);
3943f34684f1SStefano Zampini       }
3944f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3945f34684f1SStefano Zampini     }
3946f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3947f34684f1SStefano Zampini   }
3948f34684f1SStefano Zampini   /* get back data */
3949f34684f1SStefano Zampini   *coarse_size_n = coarse_size;
3950f34684f1SStefano Zampini   *local_primal_indices_n = local_primal_indices;
3951674ae819SStefano Zampini   PetscFunctionReturn(0);
3952674ae819SStefano Zampini }
3953674ae819SStefano Zampini 
3954e456f2a8SStefano Zampini #undef __FUNCT__
3955e456f2a8SStefano Zampini #define __FUNCT__ "PCBDDCGlobalToLocal"
3956e456f2a8SStefano Zampini PetscErrorCode PCBDDCGlobalToLocal(PC pc,VecScatter ctx,IS globalis,IS* localis)
3957e456f2a8SStefano Zampini {
3958e456f2a8SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
3959e456f2a8SStefano Zampini   IS             localis_t;
3960e456f2a8SStefano Zampini   PetscInt       i,lsize,*idxs;
3961e456f2a8SStefano Zampini   PetscScalar    *vals;
3962e456f2a8SStefano Zampini   PetscErrorCode ierr;
3963e456f2a8SStefano Zampini 
3964e456f2a8SStefano Zampini   PetscFunctionBegin;
3965e456f2a8SStefano Zampini   /* get dirichlet indices in local ordering exploiting local to global map */
3966e456f2a8SStefano Zampini   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
3967e456f2a8SStefano Zampini   ierr = PetscMalloc(lsize*sizeof(PetscScalar),&vals);CHKERRQ(ierr);
3968e456f2a8SStefano Zampini   for (i=0;i<lsize;i++) vals[i] = 1.0;
3969e456f2a8SStefano Zampini   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
3970e456f2a8SStefano Zampini   ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
39711035eff8SStefano Zampini   if (idxs) { /* multilevel guard */
3972e456f2a8SStefano Zampini     ierr = VecSetValues(pcis->vec1_global,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
39731035eff8SStefano Zampini   }
3974e456f2a8SStefano Zampini   ierr = VecAssemblyBegin(pcis->vec1_global);CHKERRQ(ierr);
3975e456f2a8SStefano Zampini   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
3976e456f2a8SStefano Zampini   ierr = PetscFree(vals);CHKERRQ(ierr);
3977e456f2a8SStefano Zampini   ierr = VecAssemblyEnd(pcis->vec1_global);CHKERRQ(ierr);
3978e456f2a8SStefano Zampini   /* now compute dirichlet set in local ordering */
3979e456f2a8SStefano Zampini   ierr = VecScatterBegin(ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3980e456f2a8SStefano Zampini   ierr = VecScatterEnd(ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3981e456f2a8SStefano Zampini   ierr = VecGetArrayRead(pcis->vec1_N,(const PetscScalar**)&vals);CHKERRQ(ierr);
3982e456f2a8SStefano Zampini   for (i=0,lsize=0;i<pcis->n;i++) {
3983e456f2a8SStefano Zampini     if (vals[i] == 1.0) {
3984e456f2a8SStefano Zampini       lsize++;
3985e456f2a8SStefano Zampini     }
3986e456f2a8SStefano Zampini   }
3987e456f2a8SStefano Zampini   ierr = PetscMalloc(lsize*sizeof(PetscInt),&idxs);CHKERRQ(ierr);
3988e456f2a8SStefano Zampini   for (i=0,lsize=0;i<pcis->n;i++) {
3989e456f2a8SStefano Zampini     if (vals[i] == 1.0) {
3990e456f2a8SStefano Zampini       idxs[lsize++] = i;
3991e456f2a8SStefano Zampini     }
3992e456f2a8SStefano Zampini   }
3993e456f2a8SStefano Zampini   ierr = VecRestoreArrayRead(pcis->vec1_N,(const PetscScalar**)&vals);CHKERRQ(ierr);
3994e456f2a8SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
3995e456f2a8SStefano Zampini   *localis = localis_t;
3996e456f2a8SStefano Zampini   PetscFunctionReturn(0);
3997e456f2a8SStefano Zampini }
3998