xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision d1e9a80f72efc361583d2fc822de9783b227627d)
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   PetscInt       i;
50674ae819SStefano Zampini   PetscErrorCode ierr;
51674ae819SStefano Zampini 
52674ae819SStefano Zampini   PetscFunctionBegin;
53674ae819SStefano Zampini   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
54674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
55674ae819SStefano Zampini   ierr = MatNullSpaceDestroy(&pcbddc->NullSpace);CHKERRQ(ierr);
56674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
57674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
58674ae819SStefano Zampini   for (i=0;i<pcbddc->n_ISForDofs;i++) {
59674ae819SStefano Zampini     ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
60674ae819SStefano Zampini   }
61674ae819SStefano Zampini   ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
629577ea80SStefano Zampini   pcbddc->n_ISForDofs = 0;
63f4ddd8eeSStefano Zampini   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
64f4ddd8eeSStefano Zampini   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
65674ae819SStefano Zampini   PetscFunctionReturn(0);
66674ae819SStefano Zampini }
67674ae819SStefano Zampini 
68674ae819SStefano Zampini #undef __FUNCT__
69674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetTopography"
70674ae819SStefano Zampini PetscErrorCode PCBDDCResetTopography(PC pc)
71674ae819SStefano Zampini {
72674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
73674ae819SStefano Zampini   PetscErrorCode ierr;
74674ae819SStefano Zampini 
75674ae819SStefano Zampini   PetscFunctionBegin;
76674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
77674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
78674ae819SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
79674ae819SStefano Zampini   PetscFunctionReturn(0);
80674ae819SStefano Zampini }
81674ae819SStefano Zampini 
82674ae819SStefano Zampini #undef __FUNCT__
83674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetSolvers"
84674ae819SStefano Zampini PetscErrorCode PCBDDCResetSolvers(PC pc)
85674ae819SStefano Zampini {
86674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
87674ae819SStefano Zampini   PetscErrorCode ierr;
88674ae819SStefano Zampini 
89674ae819SStefano Zampini   PetscFunctionBegin;
90674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
91674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_rhs);CHKERRQ(ierr);
92674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
93674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
9415aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
9515aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
96674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
97674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
98674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
99674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
100674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
101674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
1028ce42a96SStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
103674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
104674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
105674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
106f4ddd8eeSStefano Zampini   ierr = KSPDestroy(&pcbddc->ksp_D);CHKERRQ(ierr);
107f4ddd8eeSStefano Zampini   ierr = KSPDestroy(&pcbddc->ksp_R);CHKERRQ(ierr);
108f4ddd8eeSStefano Zampini   ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
109f4ddd8eeSStefano Zampini   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
110727cdba6SStefano Zampini   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
111f4ddd8eeSStefano Zampini   ierr = PetscFree(pcbddc->global_primal_indices);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;
19488ebb749SStefano Zampini   PetscBool              setsym=PETSC_FALSE,issym=PETSC_FALSE;
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) {
22288ebb749SStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"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     }
62288ebb749SStefano Zampini   }
62388ebb749SStefano Zampini   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
62488ebb749SStefano Zampini   /* Checking coarse_sub_mat and coarse basis functios */
62588ebb749SStefano Zampini   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
62688ebb749SStefano Zampini   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
62725084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
62888ebb749SStefano Zampini     Mat         coarse_sub_mat;
62925084f0cSStefano Zampini     Mat         AUXMAT,TM1,TM2,TM3,TM4;
63088ebb749SStefano Zampini     Mat         coarse_phi_D,coarse_phi_B;
63188ebb749SStefano Zampini     Mat         coarse_psi_D,coarse_psi_B;
63288ebb749SStefano Zampini     Mat         A_II,A_BB,A_IB,A_BI;
63388ebb749SStefano Zampini     MatType     checkmattype=MATSEQAIJ;
63488ebb749SStefano Zampini     PetscReal   real_value;
63588ebb749SStefano Zampini 
63688ebb749SStefano Zampini     ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
63788ebb749SStefano Zampini     ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
63888ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
63988ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
64088ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
64188ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
64288ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
64388ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
64488ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
64588ebb749SStefano Zampini     }
64688ebb749SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
64788ebb749SStefano Zampini 
64825084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
64925084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat and local basis functions\n");CHKERRQ(ierr);
65025084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
65188ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
65288ebb749SStefano Zampini       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
65388ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
65488ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
65588ebb749SStefano Zampini       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
65688ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
65788ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
65888ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
65988ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
66088ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
66188ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
66288ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
66388ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
66488ebb749SStefano Zampini     } else {
66588ebb749SStefano Zampini       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
66688ebb749SStefano Zampini       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
66788ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
66888ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_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_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
67288ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
67388ebb749SStefano Zampini     }
67488ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
67588ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
67688ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
67788ebb749SStefano Zampini     ierr = MatConvert(TM1,MATSEQDENSE,MAT_REUSE_MATRIX,&TM1);CHKERRQ(ierr);
67823ee1639SBarry Smith     ierr = MatAXPY(TM1,m_one,coarse_sub_mat);CHKERRQ(ierr);
67988ebb749SStefano Zampini     ierr = MatNorm(TM1,NORM_INFINITY,&real_value);CHKERRQ(ierr);
6800fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
68125084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"----------------------------------\n");CHKERRQ(ierr);
68225084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d \n",PetscGlobalRank);CHKERRQ(ierr);
68325084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"matrix error = % 1.14e\n",real_value);CHKERRQ(ierr);
68425084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (phi) errors\n");CHKERRQ(ierr);
68588ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
68625084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,coarsefunctions_errors[i]);CHKERRQ(ierr);
68788ebb749SStefano Zampini     }
68825084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (phi) errors\n");CHKERRQ(ierr);
68988ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
69025084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,constraints_errors[i]);CHKERRQ(ierr);
69188ebb749SStefano Zampini     }
69288ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
69325084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (psi) errors\n");CHKERRQ(ierr);
69488ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
69525084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,coarsefunctions_errors[i]);CHKERRQ(ierr);
69688ebb749SStefano Zampini       }
69725084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (psi) errors\n");CHKERRQ(ierr);
69888ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
69925084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,constraints_errors[i]);CHKERRQ(ierr);
70088ebb749SStefano Zampini       }
70188ebb749SStefano Zampini     }
70225084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
70388ebb749SStefano Zampini     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
70488ebb749SStefano Zampini     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
70588ebb749SStefano Zampini     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
70688ebb749SStefano Zampini     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
70788ebb749SStefano Zampini     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
70888ebb749SStefano Zampini     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
70988ebb749SStefano Zampini     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
71088ebb749SStefano Zampini     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
71188ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
71288ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
71388ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
71488ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
71588ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
71688ebb749SStefano Zampini     }
71788ebb749SStefano Zampini     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
7188ce42a96SStefano Zampini     ierr = ISRestoreIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
71988ebb749SStefano Zampini     ierr = PetscFree(coarsefunctions_errors);CHKERRQ(ierr);
72088ebb749SStefano Zampini     ierr = PetscFree(constraints_errors);CHKERRQ(ierr);
72188ebb749SStefano Zampini   }
72288ebb749SStefano Zampini   /* free memory */
72388ebb749SStefano Zampini   if (n_vertices) {
72488ebb749SStefano Zampini     ierr = VecDestroy(&vec1_V);CHKERRQ(ierr);
72588ebb749SStefano Zampini     ierr = VecDestroy(&vec2_V);CHKERRQ(ierr);
72688ebb749SStefano Zampini     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
72788ebb749SStefano Zampini     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
72888ebb749SStefano Zampini     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
72988ebb749SStefano Zampini   }
73088ebb749SStefano Zampini   if (n_constraints) {
73188ebb749SStefano Zampini     ierr = VecDestroy(&vec1_C);CHKERRQ(ierr);
73288ebb749SStefano Zampini     ierr = VecDestroy(&vec2_C);CHKERRQ(ierr);
73388ebb749SStefano Zampini     ierr = MatDestroy(&M1);CHKERRQ(ierr);
73488ebb749SStefano Zampini     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
73588ebb749SStefano Zampini   }
73688ebb749SStefano Zampini   ierr = PetscFree(auxindices);CHKERRQ(ierr);
7378629588bSStefano Zampini   /* get back data */
7388629588bSStefano Zampini   *coarse_submat_vals_n = coarse_submat_vals;
73988ebb749SStefano Zampini   PetscFunctionReturn(0);
74088ebb749SStefano Zampini }
74188ebb749SStefano Zampini 
74288ebb749SStefano Zampini #undef __FUNCT__
743aa0d41d4SStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalMatrices"
744aa0d41d4SStefano Zampini PetscErrorCode PCBDDCSetUpLocalMatrices(PC pc)
745aa0d41d4SStefano Zampini {
746aa0d41d4SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
747aa0d41d4SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
748aa0d41d4SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
7499577ea80SStefano Zampini   PetscBool         issbaij,isbaij;
750aa0d41d4SStefano Zampini   /* manage repeated solves */
751aa0d41d4SStefano Zampini   MatReuse          reuse;
752aa0d41d4SStefano Zampini   PetscErrorCode    ierr;
753aa0d41d4SStefano Zampini 
754aa0d41d4SStefano Zampini   PetscFunctionBegin;
755f4ddd8eeSStefano Zampini   if (pcbddc->use_change_of_basis && !pcbddc->ChangeOfBasisMatrix) {
756f4ddd8eeSStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Change of basis matrix has not been created");
757f4ddd8eeSStefano Zampini   }
758aa0d41d4SStefano Zampini   /* get mat flags */
759aa0d41d4SStefano Zampini   reuse = MAT_INITIAL_MATRIX;
760aa0d41d4SStefano Zampini   if (pc->setupcalled) {
761*d1e9a80fSBarry Smith     if (pc->flag == SAME_NONZERO_PATTERN) {
762aa0d41d4SStefano Zampini       reuse = MAT_REUSE_MATRIX;
763aa0d41d4SStefano Zampini     } else {
764aa0d41d4SStefano Zampini       reuse = MAT_INITIAL_MATRIX;
765aa0d41d4SStefano Zampini     }
766aa0d41d4SStefano Zampini   }
767aa0d41d4SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
768aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
769aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
770aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
771aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BB);CHKERRQ(ierr);
772aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
773aa0d41d4SStefano Zampini   }
774aa0d41d4SStefano Zampini 
775aa0d41d4SStefano Zampini   /* transform local matrices if needed */
776aa0d41d4SStefano Zampini   if (pcbddc->use_change_of_basis) {
777aa0d41d4SStefano Zampini     Mat         change_mat_all;
778aa0d41d4SStefano Zampini     PetscScalar *row_cmat_values;
779aa0d41d4SStefano Zampini     PetscInt    *row_cmat_indices;
780aa0d41d4SStefano Zampini     PetscInt    *nnz,*is_indices,*temp_indices;
781aa0d41d4SStefano Zampini     PetscInt    i,j,k,n_D,n_B;
782aa0d41d4SStefano Zampini 
783aa0d41d4SStefano Zampini     /* Get Non-overlapping dimensions */
784aa0d41d4SStefano Zampini     n_B = pcis->n_B;
785aa0d41d4SStefano Zampini     n_D = pcis->n-n_B;
786aa0d41d4SStefano Zampini 
787aa0d41d4SStefano Zampini     /* compute nonzero structure of change of basis on all local nodes */
788785e854fSJed Brown     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
789aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
790aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) nnz[is_indices[i]] = 1;
791aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
792aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
793aa0d41d4SStefano Zampini     k=1;
794aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
795aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
796aa0d41d4SStefano Zampini       nnz[is_indices[i]]=j;
797aa0d41d4SStefano Zampini       if (k < j) k = j;
798aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
799aa0d41d4SStefano Zampini     }
800aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
801aa0d41d4SStefano Zampini     /* assemble change of basis matrix on the whole set of local dofs */
802785e854fSJed Brown     ierr = PetscMalloc1(k,&temp_indices);CHKERRQ(ierr);
803aa0d41d4SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&change_mat_all);CHKERRQ(ierr);
804aa0d41d4SStefano Zampini     ierr = MatSetSizes(change_mat_all,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
805aa0d41d4SStefano Zampini     ierr = MatSetType(change_mat_all,MATSEQAIJ);CHKERRQ(ierr);
806aa0d41d4SStefano Zampini     ierr = MatSeqAIJSetPreallocation(change_mat_all,0,nnz);CHKERRQ(ierr);
807aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
808aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) {
809aa0d41d4SStefano Zampini       ierr = MatSetValue(change_mat_all,is_indices[i],is_indices[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
810aa0d41d4SStefano Zampini     }
811aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
812aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
813aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
814aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
815aa0d41d4SStefano Zampini       for (k=0; k<j; k++) temp_indices[k]=is_indices[row_cmat_indices[k]];
816aa0d41d4SStefano Zampini       ierr = MatSetValues(change_mat_all,1,&is_indices[i],j,temp_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
817aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
818aa0d41d4SStefano Zampini     }
819aa0d41d4SStefano Zampini     ierr = MatAssemblyBegin(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
820aa0d41d4SStefano Zampini     ierr = MatAssemblyEnd(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8219577ea80SStefano Zampini     /* TODO: HOW TO WORK WITH BAIJ and SBAIJ? PtAP not provided */
8229577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
8239577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQBAIJ,&isbaij);CHKERRQ(ierr);
8249577ea80SStefano Zampini     if (!issbaij && !isbaij) {
825aa0d41d4SStefano Zampini       ierr = MatPtAP(matis->A,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
826aa0d41d4SStefano Zampini     } else {
827aa0d41d4SStefano Zampini       Mat work_mat;
828aa0d41d4SStefano Zampini       ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
829aa0d41d4SStefano Zampini       ierr = MatPtAP(work_mat,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
830aa0d41d4SStefano Zampini       ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
831aa0d41d4SStefano Zampini     }
83245a1bb75SStefano Zampini     /*
83345a1bb75SStefano Zampini     ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
83445a1bb75SStefano Zampini     ierr = MatView(change_mat_all,(PetscViewer)0);CHKERRQ(ierr);
83545a1bb75SStefano Zampini     */
836aa0d41d4SStefano Zampini     ierr = MatDestroy(&change_mat_all);CHKERRQ(ierr);
837aa0d41d4SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
838aa0d41d4SStefano Zampini     ierr = PetscFree(temp_indices);CHKERRQ(ierr);
839aa0d41d4SStefano Zampini   } else {
840aa0d41d4SStefano Zampini     /* without change of basis, the local matrix is unchanged */
841aa0d41d4SStefano Zampini     if (!pcbddc->local_mat) {
842aa0d41d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)matis->A);CHKERRQ(ierr);
843aa0d41d4SStefano Zampini       pcbddc->local_mat = matis->A;
844aa0d41d4SStefano Zampini     }
845aa0d41d4SStefano Zampini   }
846aa0d41d4SStefano Zampini 
847aa0d41d4SStefano Zampini   /* get submatrices */
848aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_I_local,reuse,&pcis->A_II);CHKERRQ(ierr);
8499577ea80SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_B_local,reuse,&pcis->A_BB);CHKERRQ(ierr);
8509577ea80SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
8519577ea80SStefano Zampini   if (!issbaij) {
852aa0d41d4SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
853aa0d41d4SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
8549577ea80SStefano Zampini   } else {
8559577ea80SStefano Zampini     Mat newmat;
8569577ea80SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
8579577ea80SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
8589577ea80SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
8599577ea80SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
8609577ea80SStefano Zampini   }
861aa0d41d4SStefano Zampini   PetscFunctionReturn(0);
862aa0d41d4SStefano Zampini }
863aa0d41d4SStefano Zampini 
864aa0d41d4SStefano Zampini #undef __FUNCT__
865a64d13efSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalScatters"
8668ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
867a64d13efSStefano Zampini {
868a64d13efSStefano Zampini   PC_IS*         pcis = (PC_IS*)(pc->data);
869a64d13efSStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8708ce42a96SStefano Zampini   IS             is_aux1,is_aux2;
871e9189074SStefano Zampini   PetscInt       *aux_array1,*aux_array2,*is_indices,*idx_R_local;
8723a50541eSStefano Zampini   PetscInt       n_vertices,i,j,n_R,n_D,n_B;
8733a50541eSStefano Zampini   PetscInt       vbs,bs;
8744641a718SStefano Zampini   PetscBT        bitmask;
875a64d13efSStefano Zampini   PetscErrorCode ierr;
876a64d13efSStefano Zampini 
877a64d13efSStefano Zampini   PetscFunctionBegin;
878f4ddd8eeSStefano Zampini   /* No need to setup local scatters if primal space is unchanged */
879727cdba6SStefano Zampini   if (!pcbddc->new_primal_space_local) {
880f4ddd8eeSStefano Zampini     PetscFunctionReturn(0);
881f4ddd8eeSStefano Zampini   }
882f4ddd8eeSStefano Zampini   /* destroy old objects */
883f4ddd8eeSStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
884f4ddd8eeSStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
885f4ddd8eeSStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
886a64d13efSStefano Zampini   /* Set Non-overlapping dimensions */
887a64d13efSStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
888e9189074SStefano Zampini   n_vertices = pcbddc->n_actual_vertices;
8894641a718SStefano Zampini   /* create auxiliary bitmask */
8904641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
8914641a718SStefano Zampini   for (i=0;i<n_vertices;i++) {
892e9189074SStefano Zampini     ierr = PetscBTSet(bitmask,pcbddc->primal_indices_local_idxs[i]);CHKERRQ(ierr);
8934641a718SStefano Zampini   }
8943a50541eSStefano Zampini 
895a64d13efSStefano Zampini   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
896785e854fSJed Brown   ierr = PetscMalloc1((pcis->n-n_vertices),&idx_R_local);CHKERRQ(ierr);
897a64d13efSStefano Zampini   for (i=0, n_R=0; i<pcis->n; i++) {
8984641a718SStefano Zampini     if (!PetscBTLookup(bitmask,i)) {
899a64d13efSStefano Zampini       idx_R_local[n_R] = i;
900a64d13efSStefano Zampini       n_R++;
901a64d13efSStefano Zampini     }
902a64d13efSStefano Zampini   }
9033a50541eSStefano Zampini 
9043a50541eSStefano Zampini   /* Block code */
9053a50541eSStefano Zampini   vbs = 1;
9063a50541eSStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
9073a50541eSStefano Zampini   if (bs>1 && !(n_vertices%bs)) {
9083a50541eSStefano Zampini     PetscBool is_blocked = PETSC_TRUE;
9093a50541eSStefano Zampini     PetscInt  *vary;
9103a50541eSStefano Zampini     /* Verify if the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
911785e854fSJed Brown     ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
9123a50541eSStefano Zampini     ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
913e9189074SStefano Zampini     for (i=0; i<n_vertices; i++) vary[pcbddc->primal_indices_local_idxs[i]/bs]++;
9143a50541eSStefano Zampini     for (i=0; i<n_vertices; i++) {
9153a50541eSStefano Zampini       if (vary[i]!=0 && vary[i]!=bs) {
9163a50541eSStefano Zampini         is_blocked = PETSC_FALSE;
9173a50541eSStefano Zampini         break;
9183a50541eSStefano Zampini       }
9193a50541eSStefano Zampini     }
9203a50541eSStefano Zampini     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
9213a50541eSStefano Zampini       vbs = bs;
9223a50541eSStefano Zampini       for (i=0;i<n_R/vbs;i++) {
9233a50541eSStefano Zampini         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
9243a50541eSStefano Zampini       }
9253a50541eSStefano Zampini     }
9263a50541eSStefano Zampini     ierr = PetscFree(vary);CHKERRQ(ierr);
9273a50541eSStefano Zampini   }
9283a50541eSStefano Zampini   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
9293a50541eSStefano Zampini   ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
930a64d13efSStefano Zampini 
931a64d13efSStefano Zampini   /* print some info if requested */
932a64d13efSStefano Zampini   if (pcbddc->dbg_flag) {
933a64d13efSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
934a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
9350fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
936a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
937a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
9383a50541eSStefano 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);
939a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr);
940a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
941a64d13efSStefano Zampini   }
942a64d13efSStefano Zampini 
943a64d13efSStefano Zampini   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
9443a50541eSStefano Zampini   ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
945785e854fSJed Brown   ierr = PetscMalloc1((pcis->n_B-n_vertices),&aux_array1);CHKERRQ(ierr);
946785e854fSJed Brown   ierr = PetscMalloc1((pcis->n_B-n_vertices),&aux_array2);CHKERRQ(ierr);
947a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
9484641a718SStefano Zampini   for (i=0; i<n_D; i++) {
9494641a718SStefano Zampini     ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
9504641a718SStefano Zampini   }
951a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
952a64d13efSStefano Zampini   for (i=0, j=0; i<n_R; i++) {
9534641a718SStefano Zampini     if (!PetscBTLookup(bitmask,idx_R_local[i])) {
9544641a718SStefano Zampini       aux_array1[j++] = i;
955a64d13efSStefano Zampini     }
956a64d13efSStefano Zampini   }
957a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
958a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
959a64d13efSStefano Zampini   for (i=0, j=0; i<n_B; i++) {
9604641a718SStefano Zampini     if (!PetscBTLookup(bitmask,is_indices[i])) {
9614641a718SStefano Zampini       aux_array2[j++] = i;
962a64d13efSStefano Zampini     }
963a64d13efSStefano Zampini   }
964a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
965a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
966a64d13efSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
967a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
968a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
969a64d13efSStefano Zampini 
9708eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
971785e854fSJed Brown     ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
972a64d13efSStefano Zampini     for (i=0, j=0; i<n_R; i++) {
9734641a718SStefano Zampini       if (PetscBTLookup(bitmask,idx_R_local[i])) {
9744641a718SStefano Zampini         aux_array1[j++] = i;
975a64d13efSStefano Zampini       }
976a64d13efSStefano Zampini     }
977a64d13efSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
978a64d13efSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
979a64d13efSStefano Zampini     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
980a64d13efSStefano Zampini   }
9814641a718SStefano Zampini   ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
9823a50541eSStefano Zampini   ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
983a64d13efSStefano Zampini   PetscFunctionReturn(0);
984a64d13efSStefano Zampini }
985a64d13efSStefano Zampini 
986304d26faSStefano Zampini 
987304d26faSStefano Zampini #undef __FUNCT__
988304d26faSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
9898ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc)
990304d26faSStefano Zampini {
991304d26faSStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
992304d26faSStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
993304d26faSStefano Zampini   PC             pc_temp;
994304d26faSStefano Zampini   Mat            A_RR;
995f4ddd8eeSStefano Zampini   MatReuse       reuse;
996304d26faSStefano Zampini   PetscScalar    m_one = -1.0;
997304d26faSStefano Zampini   PetscReal      value;
998af732b37SStefano Zampini   PetscInt       n_D,n_R,ibs,mbs;
9999577ea80SStefano Zampini   PetscBool      use_exact,use_exact_reduced,issbaij;
1000304d26faSStefano Zampini   PetscErrorCode ierr;
1001e604994aSStefano Zampini   /* prefixes stuff */
1002e604994aSStefano Zampini   char           dir_prefix[256],neu_prefix[256],str_level[3];
1003e604994aSStefano Zampini   size_t         len;
1004304d26faSStefano Zampini 
1005304d26faSStefano Zampini   PetscFunctionBegin;
1006304d26faSStefano Zampini 
1007e604994aSStefano Zampini   /* compute prefixes */
1008e604994aSStefano Zampini   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
1009e604994aSStefano Zampini   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
1010e604994aSStefano Zampini   if (!pcbddc->current_level) {
1011e604994aSStefano Zampini     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
1012e604994aSStefano Zampini     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
1013e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
1014e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
1015e604994aSStefano Zampini   } else {
1016e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
1017e604994aSStefano Zampini     sprintf(str_level,"%d_",(int)(pcbddc->current_level));
1018e604994aSStefano Zampini     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
1019e604994aSStefano Zampini     len -= 15; /* remove "pc_bddc_coarse_" */
1020e604994aSStefano Zampini     if (pcbddc->current_level>1) len -= 2; /* remove "X_" with X level number (works with 9 levels max) */
1021e604994aSStefano Zampini     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
1022e604994aSStefano Zampini     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
1023e604994aSStefano Zampini     *(dir_prefix+len)='\0';
1024e604994aSStefano Zampini     *(neu_prefix+len)='\0';
1025e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
1026e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
1027e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
1028e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
1029e604994aSStefano Zampini   }
1030e604994aSStefano Zampini 
1031304d26faSStefano Zampini   /* DIRICHLET PROBLEM */
1032ac78edfcSStefano Zampini   /* Matrix for Dirichlet problem is pcis->A_II */
10338ce42a96SStefano Zampini   ierr = ISGetSize(pcis->is_I_local,&n_D);CHKERRQ(ierr);
1034304d26faSStefano Zampini   if (!pcbddc->ksp_D) { /* create object if not yet build */
1035304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
1036304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
1037304d26faSStefano Zampini     /* default */
1038304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
1039e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
10409577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
1041304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
10429577ea80SStefano Zampini     if (issbaij) {
10439577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
10449577ea80SStefano Zampini     } else {
1045304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
10469577ea80SStefano Zampini     }
1047304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1048304d26faSStefano Zampini   }
1049*d1e9a80fSBarry Smith   ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
1050304d26faSStefano Zampini   /* Allow user's customization */
1051304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
1052304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1053304d26faSStefano Zampini   if (!n_D) {
1054304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
1055304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1056304d26faSStefano Zampini   }
1057304d26faSStefano Zampini   /* Set Up KSP for Dirichlet problem of BDDC */
1058304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
1059304d26faSStefano Zampini   /* set ksp_D into pcis data */
1060304d26faSStefano Zampini   ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
1061304d26faSStefano Zampini   ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
1062304d26faSStefano Zampini   pcis->ksp_D = pcbddc->ksp_D;
1063304d26faSStefano Zampini 
1064304d26faSStefano Zampini   /* NEUMANN PROBLEM */
1065f4ddd8eeSStefano Zampini   /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
10668ce42a96SStefano Zampini   ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
1067f4ddd8eeSStefano Zampini   if (pcbddc->ksp_R) { /* already created ksp */
1068f4ddd8eeSStefano Zampini     PetscInt nn_R;
1069f4ddd8eeSStefano Zampini     ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR,NULL);CHKERRQ(ierr);
1070f4ddd8eeSStefano Zampini     ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
1071f4ddd8eeSStefano Zampini     ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
1072f4ddd8eeSStefano Zampini     if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
1073f4ddd8eeSStefano Zampini       ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
1074f4ddd8eeSStefano Zampini       ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1075f4ddd8eeSStefano Zampini       reuse = MAT_INITIAL_MATRIX;
1076f4ddd8eeSStefano Zampini     } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
1077727cdba6SStefano Zampini       if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
1078f4ddd8eeSStefano Zampini         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1079f4ddd8eeSStefano Zampini         reuse = MAT_INITIAL_MATRIX;
1080f4ddd8eeSStefano Zampini       } else { /* safe to reuse the matrix */
1081f4ddd8eeSStefano Zampini         reuse = MAT_REUSE_MATRIX;
1082f4ddd8eeSStefano Zampini       }
1083f4ddd8eeSStefano Zampini     }
1084f4ddd8eeSStefano Zampini     /* last check */
1085*d1e9a80fSBarry Smith     if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
1086f4ddd8eeSStefano Zampini       ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1087f4ddd8eeSStefano Zampini       reuse = MAT_INITIAL_MATRIX;
1088f4ddd8eeSStefano Zampini     }
1089f4ddd8eeSStefano Zampini   } else { /* first time, so we need to create the matrix */
1090f4ddd8eeSStefano Zampini     reuse = MAT_INITIAL_MATRIX;
1091f4ddd8eeSStefano Zampini   }
1092f4ddd8eeSStefano Zampini   /* extract A_RR */
1093af732b37SStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
1094af732b37SStefano Zampini   ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
10953a50541eSStefano Zampini   if (ibs != mbs) {
1096af732b37SStefano Zampini     Mat newmat;
1097af732b37SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
1098f4ddd8eeSStefano Zampini     ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
1099af732b37SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
1100af732b37SStefano Zampini   } else {
1101f4ddd8eeSStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
1102af732b37SStefano Zampini   }
1103f4ddd8eeSStefano Zampini   if (!pcbddc->ksp_R) { /* create object if not present */
1104304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
1105304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
1106304d26faSStefano Zampini     /* default */
1107304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
1108e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
1109304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
11109577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
11119577ea80SStefano Zampini     if (issbaij) {
11129577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
11139577ea80SStefano Zampini     } else {
1114304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
11159577ea80SStefano Zampini     }
1116304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1117304d26faSStefano Zampini   }
1118*d1e9a80fSBarry Smith   ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
1119304d26faSStefano Zampini   /* Allow user's customization */
1120304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
1121304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1122304d26faSStefano Zampini   if (!n_R) {
1123304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
1124304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1125304d26faSStefano Zampini   }
1126304d26faSStefano Zampini   /* Set Up KSP for Neumann problem of BDDC */
1127304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
1128304d26faSStefano Zampini 
1129304d26faSStefano Zampini   /* check Dirichlet and Neumann solvers and adapt them if a nullspace correction is needed */
11300fccc4e9SStefano Zampini   if (pcbddc->NullSpace || pcbddc->dbg_flag) {
1131304d26faSStefano Zampini     /* Dirichlet */
11320fccc4e9SStefano Zampini     ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
11330fccc4e9SStefano Zampini     ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
11340fccc4e9SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
11350fccc4e9SStefano Zampini     ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
11360fccc4e9SStefano Zampini     ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
1137304d26faSStefano Zampini     /* need to be adapted? */
1138b8ffe317SStefano Zampini     use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1139b8ffe317SStefano Zampini     ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1140b8ffe317SStefano Zampini     ierr = PCBDDCSetUseExactDirichlet(pc,use_exact_reduced);CHKERRQ(ierr);
1141304d26faSStefano Zampini     /* print info */
1142304d26faSStefano Zampini     if (pcbddc->dbg_flag) {
1143304d26faSStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
11440fccc4e9SStefano Zampini       ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
1145304d26faSStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
1146304d26faSStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Checking solution of Dirichlet and Neumann problems\n");CHKERRQ(ierr);
1147e604994aSStefano 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);
1148304d26faSStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1149304d26faSStefano Zampini     }
1150b8ffe317SStefano Zampini     if (pcbddc->NullSpace && !use_exact_reduced && !pcbddc->switch_static) {
11518ce42a96SStefano Zampini       ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcis->is_I_local);CHKERRQ(ierr);
1152304d26faSStefano Zampini     }
1153304d26faSStefano Zampini 
1154304d26faSStefano Zampini     /* Neumann */
11550fccc4e9SStefano Zampini     ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
11560fccc4e9SStefano Zampini     ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
11570fccc4e9SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
11580fccc4e9SStefano Zampini     ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
11590fccc4e9SStefano Zampini     ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
1160304d26faSStefano Zampini     /* need to be adapted? */
1161b8ffe317SStefano Zampini     use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1162b8ffe317SStefano Zampini     ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1163304d26faSStefano Zampini     /* print info */
1164304d26faSStefano Zampini     if (pcbddc->dbg_flag) {
1165e604994aSStefano 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);
1166304d26faSStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1167304d26faSStefano Zampini     }
1168b8ffe317SStefano Zampini     if (pcbddc->NullSpace && !use_exact_reduced) { /* is it the right logic? */
11698ce42a96SStefano Zampini       ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcbddc->is_R_local);CHKERRQ(ierr);
1170304d26faSStefano Zampini     }
11710fccc4e9SStefano Zampini   }
1172304d26faSStefano Zampini   /* free Neumann problem's matrix */
1173304d26faSStefano Zampini   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1174304d26faSStefano Zampini   PetscFunctionReturn(0);
1175304d26faSStefano Zampini }
1176304d26faSStefano Zampini 
1177304d26faSStefano Zampini #undef __FUNCT__
1178674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSolveSaddlePoint"
1179674ae819SStefano Zampini static PetscErrorCode  PCBDDCSolveSaddlePoint(PC pc)
1180674ae819SStefano Zampini {
1181674ae819SStefano Zampini   PetscErrorCode ierr;
1182674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1183674ae819SStefano Zampini 
1184674ae819SStefano Zampini   PetscFunctionBegin;
1185674ae819SStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
1186674ae819SStefano Zampini   if (pcbddc->local_auxmat1) {
1187674ae819SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec2_R,pcbddc->vec1_C);CHKERRQ(ierr);
1188674ae819SStefano Zampini     ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
1189674ae819SStefano Zampini   }
1190674ae819SStefano Zampini   PetscFunctionReturn(0);
1191674ae819SStefano Zampini }
1192674ae819SStefano Zampini 
1193674ae819SStefano Zampini #undef __FUNCT__
1194674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
1195674ae819SStefano Zampini PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc)
1196674ae819SStefano Zampini {
1197674ae819SStefano Zampini   PetscErrorCode ierr;
1198674ae819SStefano Zampini   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
1199674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)  (pc->data);
1200674ae819SStefano Zampini   const PetscScalar zero = 0.0;
1201674ae819SStefano Zampini 
1202674ae819SStefano Zampini   PetscFunctionBegin;
120315aaf578SStefano Zampini   /* Application of PHI^T (or PSI^T)  */
120415aaf578SStefano Zampini   if (pcbddc->coarse_psi_B) {
120515aaf578SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
12068eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
120715aaf578SStefano Zampini   } else {
1208674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
12098eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
121015aaf578SStefano Zampini   }
1211674ae819SStefano Zampini   /* Scatter data of coarse_rhs */
1212674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { ierr = VecSet(pcbddc->coarse_rhs,zero);CHKERRQ(ierr); }
1213674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1214674ae819SStefano Zampini 
1215674ae819SStefano Zampini   /* Local solution on R nodes */
1216674ae819SStefano Zampini   ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
1217674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1218674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
12198eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1220674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1221674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1222674ae819SStefano Zampini   }
1223674ae819SStefano Zampini   ierr = PCBDDCSolveSaddlePoint(pc);CHKERRQ(ierr);
1224674ae819SStefano Zampini   ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1225674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1226674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
12278eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1228674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1229674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1230674ae819SStefano Zampini   }
1231674ae819SStefano Zampini 
1232674ae819SStefano Zampini   /* Coarse solution */
1233674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1234674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { /* TODO remove null space when doing multilevel */
1235674ae819SStefano Zampini     ierr = KSPSolve(pcbddc->coarse_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
1236674ae819SStefano Zampini   }
1237674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1238674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd  (pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1239674ae819SStefano Zampini 
1240674ae819SStefano Zampini   /* Sum contributions from two levels */
1241674ae819SStefano Zampini   ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
12428eeda7d8SStefano Zampini   if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1243674ae819SStefano Zampini   PetscFunctionReturn(0);
1244674ae819SStefano Zampini }
1245674ae819SStefano Zampini 
1246674ae819SStefano Zampini #undef __FUNCT__
1247674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
1248674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1249674ae819SStefano Zampini {
1250674ae819SStefano Zampini   PetscErrorCode ierr;
1251674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1252674ae819SStefano Zampini 
1253674ae819SStefano Zampini   PetscFunctionBegin;
1254674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1255674ae819SStefano Zampini   PetscFunctionReturn(0);
1256674ae819SStefano Zampini }
1257674ae819SStefano Zampini 
1258674ae819SStefano Zampini #undef __FUNCT__
1259674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
1260674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1261674ae819SStefano Zampini {
1262674ae819SStefano Zampini   PetscErrorCode ierr;
1263674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1264674ae819SStefano Zampini 
1265674ae819SStefano Zampini   PetscFunctionBegin;
1266674ae819SStefano Zampini   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1267674ae819SStefano Zampini   PetscFunctionReturn(0);
1268674ae819SStefano Zampini }
1269674ae819SStefano Zampini 
1270984c4197SStefano Zampini /* uncomment for testing purposes */
1271984c4197SStefano Zampini /* #define PETSC_MISSING_LAPACK_GESVD 1 */
1272674ae819SStefano Zampini #undef __FUNCT__
1273674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp"
1274674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
1275674ae819SStefano Zampini {
1276674ae819SStefano Zampini   PetscErrorCode    ierr;
1277674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
1278674ae819SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
1279674ae819SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
1280984c4197SStefano Zampini   /* constraint and (optionally) change of basis matrix implemented as SeqAIJ */
1281674ae819SStefano Zampini   MatType           impMatType=MATSEQAIJ;
1282984c4197SStefano Zampini   /* one and zero */
1283984c4197SStefano Zampini   PetscScalar       one=1.0,zero=0.0;
1284984c4197SStefano Zampini   /* space to store constraints and their local indices */
1285984c4197SStefano Zampini   PetscScalar       *temp_quadrature_constraint;
1286984c4197SStefano Zampini   PetscInt          *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B;
1287984c4197SStefano Zampini   /* iterators */
1288984c4197SStefano Zampini   PetscInt          i,j,k,total_counts,temp_start_ptr;
1289984c4197SStefano Zampini   /* stuff to store connected components stored in pcbddc->mat_graph */
1290984c4197SStefano Zampini   IS                ISForVertices,*ISForFaces,*ISForEdges,*used_IS;
1291984c4197SStefano Zampini   PetscInt          n_ISForFaces,n_ISForEdges;
1292984c4197SStefano Zampini   /* near null space stuff */
1293674ae819SStefano Zampini   MatNullSpace      nearnullsp;
1294674ae819SStefano Zampini   const Vec         *nearnullvecs;
1295674ae819SStefano Zampini   Vec               *localnearnullsp;
1296984c4197SStefano Zampini   PetscBool         nnsp_has_cnst;
1297984c4197SStefano Zampini   PetscInt          nnsp_size;
1298984c4197SStefano Zampini   PetscScalar       *array;
1299984c4197SStefano Zampini   /* BLAS integers */
1300e310c8b4SStefano Zampini   PetscBLASInt      lwork,lierr;
1301e310c8b4SStefano Zampini   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
1302c4303822SStefano Zampini   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
1303984c4197SStefano Zampini   /* LAPACK working arrays for SVD or POD */
1304242a89d7SStefano Zampini   PetscBool         skip_lapack;
1305984c4197SStefano Zampini   PetscScalar       *work;
1306984c4197SStefano Zampini   PetscReal         *singular_vals;
1307984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1308984c4197SStefano Zampini   PetscReal         *rwork;
1309674ae819SStefano Zampini #endif
1310984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1311e310c8b4SStefano Zampini   PetscBLASInt      Blas_one_2=1;
1312984c4197SStefano Zampini   PetscScalar       *temp_basis,*correlation_mat;
1313b7d8b9f8SStefano Zampini #else
1314b7d8b9f8SStefano Zampini   PetscBLASInt      dummy_int_1=1,dummy_int_2=1;
1315b7d8b9f8SStefano Zampini   PetscScalar       dummy_scalar_1=0.0,dummy_scalar_2=0.0;
1316984c4197SStefano Zampini #endif
1317727cdba6SStefano Zampini   /* reuse */
1318727cdba6SStefano Zampini   PetscInt          olocal_primal_size;
1319727cdba6SStefano Zampini   PetscInt          *oprimal_indices_local_idxs;
1320984c4197SStefano Zampini   /* change of basis */
1321984c4197SStefano Zampini   PetscInt          *aux_primal_numbering,*aux_primal_minloc,*global_indices;
1322a717540cSStefano Zampini   PetscBool         boolforchange,qr_needed;
1323a717540cSStefano Zampini   PetscBT           touched,change_basis,qr_needed_idx;
1324984c4197SStefano Zampini   /* auxiliary stuff */
132539e2fb2aSStefano Zampini   PetscInt          *nnz,*is_indices,*aux_primal_numbering_B;
1326984c4197SStefano Zampini   /* some quantities */
132745a1bb75SStefano Zampini   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
1328984c4197SStefano Zampini   PetscInt          size_of_constraint,max_size_of_constraint,max_constraints,temp_constraints;
1329984c4197SStefano Zampini 
1330674ae819SStefano Zampini 
1331674ae819SStefano Zampini   PetscFunctionBegin;
13328e61c736SStefano Zampini   /* Destroy Mat objects computed previously */
13338e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
13348e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1335674ae819SStefano Zampini   /* Get index sets for faces, edges and vertices from graph */
13368eeda7d8SStefano Zampini   if (!pcbddc->use_faces && !pcbddc->use_edges && !pcbddc->use_vertices) {
13378eeda7d8SStefano Zampini     pcbddc->use_vertices = PETSC_TRUE;
1338674ae819SStefano Zampini   }
13398eeda7d8SStefano Zampini   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,pcbddc->use_faces,pcbddc->use_edges,pcbddc->use_vertices,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);
1340b8ffe317SStefano Zampini   /* HACK: provide functions to set change of basis */
1341b8ffe317SStefano Zampini   if (!ISForVertices && pcbddc->NullSpace) {
1342b8ffe317SStefano Zampini     pcbddc->use_change_of_basis = PETSC_TRUE;
1343b8ffe317SStefano Zampini     pcbddc->use_change_on_faces = PETSC_FALSE;
1344b8ffe317SStefano Zampini   }
1345984c4197SStefano Zampini   /* print some info */
1346674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
13470fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
1348674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1349674ae819SStefano Zampini     i = 0;
1350674ae819SStefano Zampini     if (ISForVertices) {
1351674ae819SStefano Zampini       ierr = ISGetSize(ISForVertices,&i);CHKERRQ(ierr);
1352674ae819SStefano Zampini     }
1353674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices\n",PetscGlobalRank,i);CHKERRQ(ierr);
1354674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges\n",PetscGlobalRank,n_ISForEdges);CHKERRQ(ierr);
135515aaf578SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces\n",PetscGlobalRank,n_ISForFaces);CHKERRQ(ierr);
1356674ae819SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1357674ae819SStefano Zampini   }
1358674ae819SStefano Zampini   /* check if near null space is attached to global mat */
1359674ae819SStefano Zampini   ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
1360674ae819SStefano Zampini   if (nearnullsp) {
1361674ae819SStefano Zampini     ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
1362f4ddd8eeSStefano Zampini     /* remove any stored info */
1363f4ddd8eeSStefano Zampini     ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
1364f4ddd8eeSStefano Zampini     ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1365f4ddd8eeSStefano Zampini     /* store information for BDDC solver reuse */
1366f4ddd8eeSStefano Zampini     ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
1367f4ddd8eeSStefano Zampini     pcbddc->onearnullspace = nearnullsp;
1368473ba861SJed Brown     ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1369f4ddd8eeSStefano Zampini     for (i=0;i<nnsp_size;i++) {
1370f4ddd8eeSStefano Zampini       ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
1371f4ddd8eeSStefano Zampini     }
1372984c4197SStefano Zampini   } else { /* if near null space is not provided BDDC uses constants by default */
1373984c4197SStefano Zampini     nnsp_size = 0;
1374674ae819SStefano Zampini     nnsp_has_cnst = PETSC_TRUE;
1375674ae819SStefano Zampini   }
1376984c4197SStefano Zampini   /* get max number of constraints on a single cc */
1377984c4197SStefano Zampini   max_constraints = nnsp_size;
1378984c4197SStefano Zampini   if (nnsp_has_cnst) max_constraints++;
1379984c4197SStefano Zampini 
1380674ae819SStefano Zampini   /*
1381674ae819SStefano Zampini        Evaluate maximum storage size needed by the procedure
1382674ae819SStefano Zampini        - temp_indices will contain start index of each constraint stored as follows
1383674ae819SStefano 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
1384674ae819SStefano 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
1385674ae819SStefano Zampini        - temp_quadrature_constraint  [temp_indices[i],...,temp[indices[i+1]-1] will contain the scalars representing the constraint itself
1386674ae819SStefano Zampini                                                                                                                                                          */
1387674ae819SStefano Zampini   total_counts = n_ISForFaces+n_ISForEdges;
1388984c4197SStefano Zampini   total_counts *= max_constraints;
1389674ae819SStefano Zampini   n_vertices = 0;
1390674ae819SStefano Zampini   if (ISForVertices) {
1391674ae819SStefano Zampini     ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
1392674ae819SStefano Zampini   }
1393674ae819SStefano Zampini   total_counts += n_vertices;
1394785e854fSJed Brown   ierr = PetscMalloc1((total_counts+1),&temp_indices);CHKERRQ(ierr);
13954641a718SStefano Zampini   ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
1396674ae819SStefano Zampini   total_counts = 0;
1397674ae819SStefano Zampini   max_size_of_constraint = 0;
1398674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1399674ae819SStefano Zampini     if (i<n_ISForEdges) {
1400674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1401674ae819SStefano Zampini     } else {
1402674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1403674ae819SStefano Zampini     }
1404674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
1405674ae819SStefano Zampini     total_counts += j;
1406674ae819SStefano Zampini     max_size_of_constraint = PetscMax(j,max_size_of_constraint);
1407674ae819SStefano Zampini   }
1408984c4197SStefano Zampini   total_counts *= max_constraints;
1409674ae819SStefano Zampini   total_counts += n_vertices;
1410785e854fSJed Brown   ierr = PetscMalloc1(total_counts,&temp_quadrature_constraint);CHKERRQ(ierr);
1411785e854fSJed Brown   ierr = PetscMalloc1(total_counts,&temp_indices_to_constraint);CHKERRQ(ierr);
1412785e854fSJed Brown   ierr = PetscMalloc1(total_counts,&temp_indices_to_constraint_B);CHKERRQ(ierr);
1413984c4197SStefano Zampini   /* get local part of global near null space vectors */
1414785e854fSJed Brown   ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
1415984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1416984c4197SStefano Zampini     ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
1417984c4197SStefano Zampini     ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1418984c4197SStefano Zampini     ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1419984c4197SStefano Zampini   }
1420674ae819SStefano Zampini 
1421242a89d7SStefano Zampini   /* whether or not to skip lapack calls */
1422242a89d7SStefano Zampini   skip_lapack = PETSC_TRUE;
1423242a89d7SStefano Zampini   if (n_ISForFaces+n_ISForEdges) skip_lapack = PETSC_FALSE;
1424242a89d7SStefano Zampini 
1425984c4197SStefano Zampini   /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
1426242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1427674ae819SStefano Zampini     PetscScalar temp_work;
1428674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1429984c4197SStefano Zampini     /* Proper Orthogonal Decomposition (POD) using the snapshot method */
1430785e854fSJed Brown     ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
1431785e854fSJed Brown     ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
1432785e854fSJed Brown     ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
1433674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1434785e854fSJed Brown     ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
1435674ae819SStefano Zampini #endif
1436674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1437c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
1438c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
1439674ae819SStefano Zampini     lwork = -1;
1440674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1441674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1442c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
1443674ae819SStefano Zampini #else
1444c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
1445674ae819SStefano Zampini #endif
1446674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1447984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
1448674ae819SStefano Zampini #else /* on missing GESVD */
1449674ae819SStefano Zampini     /* SVD */
1450674ae819SStefano Zampini     PetscInt max_n,min_n;
1451674ae819SStefano Zampini     max_n = max_size_of_constraint;
1452984c4197SStefano Zampini     min_n = max_constraints;
1453984c4197SStefano Zampini     if (max_size_of_constraint < max_constraints) {
1454674ae819SStefano Zampini       min_n = max_size_of_constraint;
1455984c4197SStefano Zampini       max_n = max_constraints;
1456674ae819SStefano Zampini     }
1457785e854fSJed Brown     ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
1458674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1459785e854fSJed Brown     ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
1460674ae819SStefano Zampini #endif
1461674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1462674ae819SStefano Zampini     lwork = -1;
1463e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
1464e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
1465b7d8b9f8SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
1466674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1467674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1468e310c8b4SStefano 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));
1469674ae819SStefano Zampini #else
1470e310c8b4SStefano 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));
1471674ae819SStefano Zampini #endif
1472674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1473984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
1474984c4197SStefano Zampini #endif /* on missing GESVD */
1475674ae819SStefano Zampini     /* Allocate optimal workspace */
1476674ae819SStefano Zampini     ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
1477785e854fSJed Brown     ierr = PetscMalloc1((PetscInt)lwork,&work);CHKERRQ(ierr);
1478674ae819SStefano Zampini   }
1479674ae819SStefano Zampini   /* Now we can loop on constraining sets */
1480674ae819SStefano Zampini   total_counts = 0;
1481674ae819SStefano Zampini   temp_indices[0] = 0;
1482674ae819SStefano Zampini   /* vertices */
1483674ae819SStefano Zampini   if (ISForVertices) {
1484674ae819SStefano Zampini     ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1485674ae819SStefano Zampini     if (nnsp_has_cnst) { /* consider all vertices */
148639e2fb2aSStefano Zampini       ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
1487674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1488674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1489674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1490674ae819SStefano Zampini         total_counts++;
1491674ae819SStefano Zampini       }
1492674ae819SStefano Zampini     } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
1493984c4197SStefano Zampini       PetscBool used_vertex;
1494674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1495674ae819SStefano Zampini         used_vertex = PETSC_FALSE;
1496674ae819SStefano Zampini         k = 0;
1497674ae819SStefano Zampini         while (!used_vertex && k<nnsp_size) {
1498984c4197SStefano Zampini           ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1499984c4197SStefano Zampini           if (PetscAbsScalar(array[is_indices[i]])>0.0) {
1500674ae819SStefano Zampini             temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1501674ae819SStefano Zampini             temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1502674ae819SStefano Zampini             temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1503674ae819SStefano Zampini             total_counts++;
1504674ae819SStefano Zampini             used_vertex = PETSC_TRUE;
1505674ae819SStefano Zampini           }
1506984c4197SStefano Zampini           ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1507674ae819SStefano Zampini           k++;
1508674ae819SStefano Zampini         }
1509674ae819SStefano Zampini       }
1510674ae819SStefano Zampini     }
1511674ae819SStefano Zampini     ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1512674ae819SStefano Zampini     n_vertices = total_counts;
1513674ae819SStefano Zampini   }
1514984c4197SStefano Zampini 
1515674ae819SStefano Zampini   /* edges and faces */
1516674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1517674ae819SStefano Zampini     if (i<n_ISForEdges) {
1518674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1519984c4197SStefano Zampini       boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
1520674ae819SStefano Zampini     } else {
1521674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1522984c4197SStefano Zampini       boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
1523674ae819SStefano Zampini     }
1524674ae819SStefano Zampini     temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
1525674ae819SStefano Zampini     temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
1526674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
1527674ae819SStefano Zampini     ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1528984c4197SStefano Zampini     /* change of basis should not be performed on local periodic nodes */
1529984c4197SStefano Zampini     if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
1530674ae819SStefano Zampini     if (nnsp_has_cnst) {
15315b08dc53SStefano Zampini       PetscScalar quad_value;
1532674ae819SStefano Zampini       temp_constraints++;
1533674ae819SStefano Zampini       quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
153439e2fb2aSStefano Zampini       ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
1535674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1536674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
1537674ae819SStefano Zampini       }
1538674ae819SStefano Zampini       temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
1539674ae819SStefano Zampini       total_counts++;
1540674ae819SStefano Zampini     }
1541674ae819SStefano Zampini     for (k=0;k<nnsp_size;k++) {
1542984c4197SStefano Zampini       PetscReal real_value;
1543984c4197SStefano Zampini       ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
154439e2fb2aSStefano Zampini       ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
1545674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1546984c4197SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=array[is_indices[j]];
1547674ae819SStefano Zampini       }
1548984c4197SStefano Zampini       ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1549984c4197SStefano Zampini       /* check if array is null on the connected component */
1550e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1551e310c8b4SStefano Zampini       PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_one));
15525b08dc53SStefano Zampini       if (real_value > 0.0) { /* keep indices and values */
1553674ae819SStefano Zampini         temp_constraints++;
1554674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
1555674ae819SStefano Zampini         total_counts++;
1556674ae819SStefano Zampini       }
1557674ae819SStefano Zampini     }
1558674ae819SStefano Zampini     ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
155945a1bb75SStefano Zampini     valid_constraints = temp_constraints;
1560eb97c9d2SStefano 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 */
1561eb97c9d2SStefano Zampini     if (!pcbddc->use_nnsp_true && temp_constraints) {
1562984c4197SStefano Zampini       PetscReal tol = 1.0e-8; /* tolerance for retaining eigenmodes */
1563674ae819SStefano Zampini 
1564674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1565984c4197SStefano Zampini       /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
1566984c4197SStefano Zampini          POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
1567984c4197SStefano Zampini          -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
1568984c4197SStefano Zampini             the constraints basis will differ (by a complex factor with absolute value equal to 1)
1569984c4197SStefano Zampini             from that computed using LAPACKgesvd
1570984c4197SStefano Zampini          -> This is due to a different computation of eigenvectors in LAPACKheev
1571984c4197SStefano Zampini          -> The quality of the POD-computed basis will be the same */
1572984c4197SStefano Zampini       ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
1573674ae819SStefano Zampini       /* Store upper triangular part of correlation matrix */
1574e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1575984c4197SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1576674ae819SStefano Zampini       for (j=0;j<temp_constraints;j++) {
1577674ae819SStefano Zampini         for (k=0;k<j+1;k++) {
1578e310c8b4SStefano 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));
1579674ae819SStefano Zampini         }
1580674ae819SStefano Zampini       }
1581e310c8b4SStefano Zampini       /* compute eigenvalues and eigenvectors of correlation matrix */
1582e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1583e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
1584674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1585c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
1586674ae819SStefano Zampini #else
1587c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
1588674ae819SStefano Zampini #endif
1589674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1590984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
1591984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
1592674ae819SStefano Zampini       j=0;
1593984c4197SStefano Zampini       while (j < temp_constraints && singular_vals[j] < tol) j++;
1594674ae819SStefano Zampini       total_counts=total_counts-j;
159545a1bb75SStefano Zampini       valid_constraints = temp_constraints-j;
1596e310c8b4SStefano Zampini       /* scale and copy POD basis into used quadrature memory */
1597c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1598c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1599c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
1600c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1601c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
1602c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1603674ae819SStefano Zampini       if (j<temp_constraints) {
1604984c4197SStefano Zampini         PetscInt ii;
1605984c4197SStefano Zampini         for (k=j;k<temp_constraints;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]);
1606674ae819SStefano Zampini         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1607c4303822SStefano 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));
1608674ae819SStefano Zampini         ierr = PetscFPTrapPop();CHKERRQ(ierr);
1609984c4197SStefano Zampini         for (k=0;k<temp_constraints-j;k++) {
1610674ae819SStefano Zampini           for (ii=0;ii<size_of_constraint;ii++) {
1611984c4197SStefano 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];
1612674ae819SStefano Zampini           }
1613674ae819SStefano Zampini         }
1614674ae819SStefano Zampini       }
1615674ae819SStefano Zampini #else  /* on missing GESVD */
1616e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1617e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1618b7d8b9f8SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1619674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1620674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1621e310c8b4SStefano 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));
1622674ae819SStefano Zampini #else
1623e310c8b4SStefano 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));
1624674ae819SStefano Zampini #endif
1625984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
1626674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1627984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
1628e310c8b4SStefano Zampini       k = temp_constraints;
1629e310c8b4SStefano Zampini       if (k > size_of_constraint) k = size_of_constraint;
1630674ae819SStefano Zampini       j = 0;
1631e310c8b4SStefano Zampini       while (j < k && singular_vals[k-j-1] < tol) j++;
1632e310c8b4SStefano Zampini       total_counts = total_counts-temp_constraints+k-j;
163345a1bb75SStefano Zampini       valid_constraints = k-j;
1634984c4197SStefano Zampini #endif /* on missing GESVD */
1635674ae819SStefano Zampini     }
163645a1bb75SStefano Zampini     /* setting change_of_basis flag is safe now */
163745a1bb75SStefano Zampini     if (boolforchange) {
163845a1bb75SStefano Zampini       for (j=0;j<valid_constraints;j++) {
163945a1bb75SStefano Zampini         PetscBTSet(change_basis,total_counts-j-1);
164045a1bb75SStefano Zampini       }
164145a1bb75SStefano Zampini     }
1642674ae819SStefano Zampini   }
1643674ae819SStefano Zampini   /* free index sets of faces, edges and vertices */
1644674ae819SStefano Zampini   for (i=0;i<n_ISForFaces;i++) {
1645674ae819SStefano Zampini     ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
1646674ae819SStefano Zampini   }
1647674ae819SStefano Zampini   ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
1648674ae819SStefano Zampini   for (i=0;i<n_ISForEdges;i++) {
1649674ae819SStefano Zampini     ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
1650674ae819SStefano Zampini   }
1651674ae819SStefano Zampini   ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
1652674ae819SStefano Zampini   ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
165339e2fb2aSStefano Zampini   /* map temp_indices_to_constraint in boundary numbering */
165439e2fb2aSStefano Zampini   ierr = ISGlobalToLocalMappingApply(pcbddc->BtoNmap,IS_GTOLM_DROP,temp_indices[total_counts],temp_indices_to_constraint,&i,temp_indices_to_constraint_B);CHKERRQ(ierr);
165539e2fb2aSStefano Zampini   if (i != temp_indices[total_counts]) {
165639e2fb2aSStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for constraints indices %d != %d\n",temp_indices[total_counts],i);
165739e2fb2aSStefano Zampini   }
1658674ae819SStefano Zampini 
1659984c4197SStefano Zampini   /* free workspace */
1660242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1661984c4197SStefano Zampini     ierr = PetscFree(work);CHKERRQ(ierr);
1662984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1663984c4197SStefano Zampini     ierr = PetscFree(rwork);CHKERRQ(ierr);
1664984c4197SStefano Zampini #endif
1665984c4197SStefano Zampini     ierr = PetscFree(singular_vals);CHKERRQ(ierr);
1666984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1667984c4197SStefano Zampini     ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
1668984c4197SStefano Zampini     ierr = PetscFree(temp_basis);CHKERRQ(ierr);
1669984c4197SStefano Zampini #endif
1670984c4197SStefano Zampini   }
1671984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1672984c4197SStefano Zampini     ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
1673984c4197SStefano Zampini   }
1674984c4197SStefano Zampini   ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
1675984c4197SStefano Zampini 
1676727cdba6SStefano Zampini   /* set quantities in pcbddc data structure and store previous primal size */
1677984c4197SStefano Zampini   /* n_vertices defines the number of subdomain corners in the primal space */
1678674ae819SStefano Zampini   /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */
1679727cdba6SStefano Zampini   olocal_primal_size = pcbddc->local_primal_size;
1680984c4197SStefano Zampini   pcbddc->local_primal_size = total_counts;
1681674ae819SStefano Zampini   pcbddc->n_vertices = n_vertices;
1682984c4197SStefano Zampini   pcbddc->n_constraints = pcbddc->local_primal_size-pcbddc->n_vertices;
1683674ae819SStefano Zampini 
1684674ae819SStefano Zampini   /* Create constraint matrix */
1685674ae819SStefano Zampini   /* The constraint matrix is used to compute the l2g map of primal dofs */
1686674ae819SStefano Zampini   /* so we need to set it up properly either with or without change of basis */
1687674ae819SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1688674ae819SStefano Zampini   ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr);
1689984c4197SStefano Zampini   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
1690984c4197SStefano Zampini   /* array to compute a local numbering of constraints : vertices first then constraints */
1691785e854fSJed Brown   ierr = PetscMalloc1(pcbddc->local_primal_size,&aux_primal_numbering);CHKERRQ(ierr);
1692984c4197SStefano Zampini   /* array to select the proper local node (of minimum index with respect to global ordering) when changing the basis */
1693984c4197SStefano 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 */
1694785e854fSJed Brown   ierr = PetscMalloc1(pcbddc->local_primal_size,&aux_primal_minloc);CHKERRQ(ierr);
1695984c4197SStefano Zampini   /* auxiliary stuff for basis change */
1696785e854fSJed Brown   ierr = PetscMalloc1(max_size_of_constraint,&global_indices);CHKERRQ(ierr);
16974641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n_B,&touched);CHKERRQ(ierr);
1698984c4197SStefano Zampini 
1699984c4197SStefano Zampini   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
1700984c4197SStefano Zampini   total_primal_vertices=0;
1701984c4197SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
1702674ae819SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
1703984c4197SStefano Zampini     if (size_of_constraint == 1) {
17044641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]]);CHKERRQ(ierr);
1705984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]];
1706984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=0;
1707984c4197SStefano Zampini       total_primal_vertices++;
17084641a718SStefano Zampini     } else if (PetscBTLookup(change_basis,i)) { /* Same procedure used in PCBDDCGetPrimalConstraintsLocalIdx */
1709984c4197SStefano Zampini       PetscInt min_loc,min_index;
1710984c4197SStefano Zampini       ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],global_indices);CHKERRQ(ierr);
1711984c4197SStefano Zampini       /* find first untouched local node */
1712674ae819SStefano Zampini       k = 0;
17134641a718SStefano Zampini       while (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) k++;
1714984c4197SStefano Zampini       min_index = global_indices[k];
1715984c4197SStefano Zampini       min_loc = k;
1716984c4197SStefano Zampini       /* search the minimum among global nodes already untouched on the cc */
1717984c4197SStefano Zampini       for (k=1;k<size_of_constraint;k++) {
1718984c4197SStefano Zampini         /* there can be more than one constraint on a single connected component */
17194641a718SStefano Zampini         if (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k]) && min_index > global_indices[k]) {
1720984c4197SStefano Zampini           min_index = global_indices[k];
1721984c4197SStefano Zampini           min_loc = k;
1722674ae819SStefano Zampini         }
1723674ae819SStefano Zampini       }
17244641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]+min_loc]);CHKERRQ(ierr);
1725984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]+min_loc];
1726984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=min_loc;
1727984c4197SStefano Zampini       total_primal_vertices++;
1728984c4197SStefano Zampini     }
1729984c4197SStefano Zampini   }
1730a717540cSStefano Zampini   /* determine if a QR strategy is needed for change of basis */
1731a717540cSStefano Zampini   qr_needed = PETSC_FALSE;
1732a717540cSStefano Zampini   ierr = PetscBTCreate(pcbddc->local_primal_size,&qr_needed_idx);CHKERRQ(ierr);
1733a717540cSStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1734a717540cSStefano Zampini     if (PetscBTLookup(change_basis,i)) {
1735a717540cSStefano Zampini       size_of_constraint = temp_indices[i+1]-temp_indices[i];
1736a717540cSStefano Zampini       j = 0;
1737a717540cSStefano Zampini       for (k=0;k<size_of_constraint;k++) {
1738a717540cSStefano Zampini         if (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) {
1739a717540cSStefano Zampini           j++;
1740a717540cSStefano Zampini         }
1741a717540cSStefano Zampini       }
1742a717540cSStefano Zampini       /* found more than one primal dof on the cc */
1743a717540cSStefano Zampini       if (j > 1) {
1744a717540cSStefano Zampini         PetscBTSet(qr_needed_idx,i);
1745a717540cSStefano Zampini         qr_needed = PETSC_TRUE;
1746a717540cSStefano Zampini       }
1747a717540cSStefano Zampini     }
1748a717540cSStefano Zampini   }
1749984c4197SStefano Zampini   /* free workspace */
1750984c4197SStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
175145a1bb75SStefano Zampini 
1752674ae819SStefano Zampini   /* permute indices in order to have a sorted set of vertices */
1753a717540cSStefano Zampini   ierr = PetscSortInt(total_primal_vertices,aux_primal_numbering);CHKERRQ(ierr);
1754984c4197SStefano Zampini 
1755984c4197SStefano Zampini   /* nonzero structure of constraint matrix */
1756785e854fSJed Brown   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
1757984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) nnz[i]=1;
1758984c4197SStefano Zampini   j=total_primal_vertices;
1759984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
17604641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1761674ae819SStefano Zampini       nnz[j]=temp_indices[i+1]-temp_indices[i];
1762674ae819SStefano Zampini       j++;
1763674ae819SStefano Zampini     }
1764674ae819SStefano Zampini   }
1765674ae819SStefano Zampini   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
1766674ae819SStefano Zampini   ierr = PetscFree(nnz);CHKERRQ(ierr);
1767674ae819SStefano Zampini   /* set values in constraint matrix */
1768984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) {
1769984c4197SStefano Zampini     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,aux_primal_numbering[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
1770674ae819SStefano Zampini   }
1771984c4197SStefano Zampini   total_counts = total_primal_vertices;
1772984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
17734641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1774674ae819SStefano Zampini       size_of_constraint=temp_indices[i+1]-temp_indices[i];
1775674ae819SStefano 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);
1776674ae819SStefano Zampini       total_counts++;
1777674ae819SStefano Zampini     }
1778674ae819SStefano Zampini   }
1779674ae819SStefano Zampini   /* assembling */
1780674ae819SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1781674ae819SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1782984c4197SStefano Zampini   /*
178345a1bb75SStefano Zampini   ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
1784984c4197SStefano Zampini   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
1785984c4197SStefano Zampini   */
1786674ae819SStefano Zampini   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
1787674ae819SStefano Zampini   if (pcbddc->use_change_of_basis) {
1788026de310SStefano Zampini     /* dual and primal dofs on a single cc */
1789984c4197SStefano Zampini     PetscInt     dual_dofs,primal_dofs;
1790026de310SStefano Zampini     /* iterator on aux_primal_minloc (ordered as read from nearnullspace: vertices, edges and then constraints) */
1791026de310SStefano Zampini     PetscInt     primal_counter;
1792984c4197SStefano Zampini     /* working stuff for GEQRF */
1793984c4197SStefano Zampini     PetscScalar  *qr_basis,*qr_tau,*qr_work,lqr_work_t;
1794984c4197SStefano Zampini     PetscBLASInt lqr_work;
1795984c4197SStefano Zampini     /* working stuff for UNGQR */
1796984c4197SStefano Zampini     PetscScalar  *gqr_work,lgqr_work_t;
1797984c4197SStefano Zampini     PetscBLASInt lgqr_work;
1798984c4197SStefano Zampini     /* working stuff for TRTRS */
1799984c4197SStefano Zampini     PetscScalar  *trs_rhs;
18003f08241aSStefano Zampini     PetscBLASInt Blas_NRHS;
1801984c4197SStefano Zampini     /* pointers for values insertion into change of basis matrix */
1802984c4197SStefano Zampini     PetscInt     *start_rows,*start_cols;
1803984c4197SStefano Zampini     PetscScalar  *start_vals;
1804984c4197SStefano Zampini     /* working stuff for values insertion */
18054641a718SStefano Zampini     PetscBT      is_primal;
1806984c4197SStefano Zampini 
1807a717540cSStefano Zampini     /* change of basis acts on local interfaces -> dimension is n_B x n_B */
1808a717540cSStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
1809a717540cSStefano Zampini     ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr);
1810a717540cSStefano Zampini     ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr);
1811a717540cSStefano Zampini     /* work arrays */
1812785e854fSJed Brown     ierr = PetscMalloc1(pcis->n_B,&nnz);CHKERRQ(ierr);
1813a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) nnz[i]=1;
1814a717540cSStefano Zampini     /* nonzeros per row */
1815a717540cSStefano Zampini     for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1816a717540cSStefano Zampini       if (PetscBTLookup(change_basis,i)) {
1817a717540cSStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
1818a717540cSStefano Zampini         if (PetscBTLookup(qr_needed_idx,i)) {
1819a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1820a717540cSStefano Zampini         } else {
1821a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = 2;
1822a717540cSStefano Zampini           /* get local primal index on the cc */
1823a717540cSStefano Zampini           j = 0;
1824a717540cSStefano Zampini           while (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+j])) j++;
1825a717540cSStefano Zampini           nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1826a717540cSStefano Zampini         }
1827a717540cSStefano Zampini       }
1828a717540cSStefano Zampini     }
1829a717540cSStefano Zampini     ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
1830a717540cSStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
1831a717540cSStefano Zampini     /* Set initial identity in the matrix */
1832a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) {
1833a717540cSStefano Zampini       ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
1834a717540cSStefano Zampini     }
1835a717540cSStefano Zampini 
1836a717540cSStefano Zampini     if (pcbddc->dbg_flag) {
1837a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1838a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
1839a717540cSStefano Zampini     }
1840a717540cSStefano Zampini 
1841a717540cSStefano Zampini 
1842a717540cSStefano Zampini     /* Now we loop on the constraints which need a change of basis */
1843a717540cSStefano Zampini     /*
1844a717540cSStefano Zampini        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
1845a717540cSStefano Zampini        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
1846a717540cSStefano Zampini 
1847a717540cSStefano Zampini        Basic blocks of change of basis matrix T computed
1848a717540cSStefano Zampini 
1849a717540cSStefano Zampini           - Using the following block transformation if there is only a primal dof on the cc
1850a717540cSStefano Zampini             (in the example, primal dof is the last one of the edge in LOCAL ordering
1851a717540cSStefano Zampini              in this code, primal dof is the first one of the edge in GLOBAL ordering)
1852a717540cSStefano Zampini             | 1        0   ...        0     1 |
1853a717540cSStefano Zampini             | 0        1   ...        0     1 |
1854a717540cSStefano Zampini             |              ...                |
1855a717540cSStefano Zampini             | 0        ...            1     1 |
1856a717540cSStefano Zampini             | -s_1/s_n ...    -s_{n-1}/-s_n 1 |
1857a717540cSStefano Zampini 
1858a717540cSStefano Zampini           - via QR decomposition of constraints otherwise
1859a717540cSStefano Zampini     */
1860a717540cSStefano Zampini     if (qr_needed) {
1861984c4197SStefano Zampini       /* space to store Q */
1862785e854fSJed Brown       ierr = PetscMalloc1((max_size_of_constraint)*(max_size_of_constraint),&qr_basis);CHKERRQ(ierr);
1863984c4197SStefano Zampini       /* first we issue queries for optimal work */
18643f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
18653f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
18663f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1867984c4197SStefano Zampini       lqr_work = -1;
18683f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
1869984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
1870984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
1871785e854fSJed Brown       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
1872984c4197SStefano Zampini       lgqr_work = -1;
18733f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
18743f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
18753f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
18763f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
18773f08241aSStefano Zampini       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
18783f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
1879984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
1880984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
1881785e854fSJed Brown       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
1882984c4197SStefano Zampini       /* array to store scaling factors for reflectors */
1883785e854fSJed Brown       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
1884984c4197SStefano Zampini       /* array to store rhs and solution of triangular solver */
1885785e854fSJed Brown       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
1886a717540cSStefano Zampini       /* allocating workspace for check */
1887a717540cSStefano Zampini       if (pcbddc->dbg_flag) {
1888785e854fSJed Brown         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&work);CHKERRQ(ierr);
1889a717540cSStefano Zampini       }
1890a717540cSStefano Zampini     }
1891984c4197SStefano Zampini     /* array to store whether a node is primal or not */
18924641a718SStefano Zampini     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
1893473ba861SJed Brown     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
189439e2fb2aSStefano Zampini     ierr = ISGlobalToLocalMappingApply(pcbddc->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,aux_primal_numbering,&i,aux_primal_numbering_B);CHKERRQ(ierr);
189539e2fb2aSStefano Zampini     if (i != total_primal_vertices) {
189639e2fb2aSStefano Zampini       SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %d != %d\n",total_primal_vertices,i);
18974641a718SStefano Zampini     }
189839e2fb2aSStefano Zampini     for (i=0;i<total_primal_vertices;i++) {
189939e2fb2aSStefano Zampini       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
190039e2fb2aSStefano Zampini     }
190139e2fb2aSStefano Zampini     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
1902984c4197SStefano Zampini 
1903a717540cSStefano Zampini     /* loop on constraints and see whether or not they need a change of basis and compute it */
1904026de310SStefano Zampini     /* -> using implicit ordering contained in temp_indices data */
1905026de310SStefano Zampini     total_counts = pcbddc->n_vertices;
1906026de310SStefano Zampini     primal_counter = total_counts;
1907026de310SStefano Zampini     while (total_counts<pcbddc->local_primal_size) {
1908026de310SStefano Zampini       primal_dofs = 1;
19094641a718SStefano Zampini       if (PetscBTLookup(change_basis,total_counts)) {
1910026de310SStefano Zampini         /* get all constraints with same support: if more then one constraint is present on the cc then surely indices are stored contiguosly */
1911026de310SStefano 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]]) {
1912026de310SStefano Zampini           primal_dofs++;
1913674ae819SStefano Zampini         }
1914984c4197SStefano Zampini         /* get constraint info */
1915026de310SStefano Zampini         size_of_constraint = temp_indices[total_counts+1]-temp_indices[total_counts];
1916984c4197SStefano Zampini         dual_dofs = size_of_constraint-primal_dofs;
1917984c4197SStefano Zampini 
1918984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
1919a717540cSStefano 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);
1920674ae819SStefano Zampini         }
1921984c4197SStefano Zampini 
1922a717540cSStefano Zampini         if (primal_dofs > 1) { /* QR */
1923a717540cSStefano Zampini 
1924a717540cSStefano Zampini           /* copy quadrature constraints for change of basis check */
1925a717540cSStefano Zampini           if (pcbddc->dbg_flag) {
1926a717540cSStefano Zampini             ierr = PetscMemcpy(work,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1927a717540cSStefano Zampini           }
1928984c4197SStefano Zampini           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
1929026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1930984c4197SStefano Zampini 
1931984c4197SStefano Zampini           /* compute QR decomposition of constraints */
19323f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
19333f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
19343f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1935674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
19363f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
1937984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
1938674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1939984c4197SStefano Zampini 
1940984c4197SStefano Zampini           /* explictly compute R^-T */
1941984c4197SStefano Zampini           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
1942984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
19433f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
19443f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
19453f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
19463f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
1947984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
19483f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
1949984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
1950984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1951984c4197SStefano Zampini 
1952a717540cSStefano Zampini           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
19533f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
19543f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
19553f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
19563f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1957984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
19583f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
1959984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
1960984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1961984c4197SStefano Zampini 
1962984c4197SStefano Zampini           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
1963984c4197SStefano Zampini              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
1964984c4197SStefano Zampini              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
19653f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
19663f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
19673f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
19683f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
19693f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
19703f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1971984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1972c4303822SStefano 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));
1973984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1974026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1975984c4197SStefano Zampini 
1976984c4197SStefano Zampini           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
1977026de310SStefano Zampini           start_rows = &temp_indices_to_constraint_B[temp_indices[total_counts]];
1978984c4197SStefano Zampini           /* insert cols for primal dofs */
1979984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) {
1980984c4197SStefano Zampini             start_vals = &qr_basis[j*size_of_constraint];
1981026de310SStefano Zampini             start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter+j]];
1982984c4197SStefano Zampini             ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1983984c4197SStefano Zampini           }
1984984c4197SStefano Zampini           /* insert cols for dual dofs */
1985984c4197SStefano Zampini           for (j=0,k=0;j<dual_dofs;k++) {
19864641a718SStefano Zampini             if (!PetscBTLookup(is_primal,temp_indices_to_constraint_B[temp_indices[total_counts]+k])) {
1987984c4197SStefano Zampini               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
1988026de310SStefano Zampini               start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+k];
1989984c4197SStefano Zampini               ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1990984c4197SStefano Zampini               j++;
1991674ae819SStefano Zampini             }
1992674ae819SStefano Zampini           }
1993984c4197SStefano Zampini 
1994984c4197SStefano Zampini           /* check change of basis */
1995984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
1996984c4197SStefano Zampini             PetscInt   ii,jj;
1997984c4197SStefano Zampini             PetscBool valid_qr=PETSC_TRUE;
1998c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
1999c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2000c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
2001c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2002c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
2003c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
2004984c4197SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2005c4303822SStefano 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));
2006984c4197SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
2007984c4197SStefano Zampini             for (jj=0;jj<size_of_constraint;jj++) {
2008984c4197SStefano Zampini               for (ii=0;ii<primal_dofs;ii++) {
2009984c4197SStefano Zampini                 if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
2010984c4197SStefano Zampini                 if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
2011674ae819SStefano Zampini               }
2012674ae819SStefano Zampini             }
2013984c4197SStefano Zampini             if (!valid_qr) {
2014984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
2015984c4197SStefano Zampini               for (jj=0;jj<size_of_constraint;jj++) {
2016984c4197SStefano Zampini                 for (ii=0;ii<primal_dofs;ii++) {
2017984c4197SStefano Zampini                   if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
2018984c4197SStefano 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]));
2019674ae819SStefano Zampini                   }
2020984c4197SStefano Zampini                   if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
2021984c4197SStefano 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]));
2022984c4197SStefano Zampini                   }
2023984c4197SStefano Zampini                 }
2024984c4197SStefano Zampini               }
2025674ae819SStefano Zampini             } else {
2026984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
2027674ae819SStefano Zampini             }
2028674ae819SStefano Zampini           }
2029a717540cSStefano Zampini         } else { /* simple transformation block */
2030a717540cSStefano Zampini           PetscInt row,col;
2031a717540cSStefano Zampini           PetscScalar val;
2032a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) {
2033a717540cSStefano Zampini             row = temp_indices_to_constraint_B[temp_indices[total_counts]+j];
2034a717540cSStefano Zampini             if (!PetscBTLookup(is_primal,row)) {
2035a717540cSStefano Zampini               col = temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
2036a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
2037a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,1.0,INSERT_VALUES);CHKERRQ(ierr);
2038a717540cSStefano Zampini             } else {
2039a717540cSStefano Zampini               for (k=0;k<size_of_constraint;k++) {
2040a717540cSStefano Zampini                 col = temp_indices_to_constraint_B[temp_indices[total_counts]+k];
2041a717540cSStefano Zampini                 if (row != col) {
2042a717540cSStefano Zampini                   val = -temp_quadrature_constraint[temp_indices[total_counts]+k]/temp_quadrature_constraint[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
2043a717540cSStefano Zampini                 } else {
2044a717540cSStefano Zampini                   val = 1.0;
2045a717540cSStefano Zampini                 }
2046a717540cSStefano Zampini                 ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
2047a717540cSStefano Zampini               }
2048a717540cSStefano Zampini             }
2049a717540cSStefano Zampini           }
2050a717540cSStefano Zampini         }
2051026de310SStefano Zampini         /* increment primal counter */
2052026de310SStefano Zampini         primal_counter += primal_dofs;
2053984c4197SStefano Zampini       } else {
2054984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
2055026de310SStefano 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);
2056674ae819SStefano Zampini         }
2057674ae819SStefano Zampini       }
2058026de310SStefano Zampini       /* increment constraint counter total_counts */
2059026de310SStefano Zampini       total_counts += primal_dofs;
2060674ae819SStefano Zampini     }
2061a717540cSStefano Zampini 
2062a717540cSStefano Zampini     /* free workspace */
2063a717540cSStefano Zampini     if (qr_needed) {
2064984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
2065984c4197SStefano Zampini         ierr = PetscFree(work);CHKERRQ(ierr);
2066984c4197SStefano Zampini       }
2067984c4197SStefano Zampini       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
2068984c4197SStefano Zampini       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
2069984c4197SStefano Zampini       ierr = PetscFree(qr_work);CHKERRQ(ierr);
2070984c4197SStefano Zampini       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
2071984c4197SStefano Zampini       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
2072674ae819SStefano Zampini     }
2073a717540cSStefano Zampini     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
2074674ae819SStefano Zampini     /* assembling */
2075674ae819SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2076674ae819SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2077984c4197SStefano Zampini     /*
207845a1bb75SStefano Zampini     ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
2079984c4197SStefano Zampini     ierr = MatView(pcbddc->ChangeOfBasisMatrix,(PetscViewer)0);CHKERRQ(ierr);
2080984c4197SStefano Zampini     */
2081674ae819SStefano Zampini   }
2082a717540cSStefano Zampini 
2083727cdba6SStefano Zampini   /* get indices in local ordering for vertices and constraints */
2084727cdba6SStefano 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 */
2085473ba861SJed Brown     ierr = PetscMalloc1(olocal_primal_size,&oprimal_indices_local_idxs);CHKERRQ(ierr);
2086727cdba6SStefano Zampini     ierr = PetscMemcpy(oprimal_indices_local_idxs,pcbddc->primal_indices_local_idxs,olocal_primal_size*sizeof(PetscInt));CHKERRQ(ierr);
2087727cdba6SStefano Zampini   }
2088727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2089473ba861SJed Brown   ierr = PetscMalloc1(pcbddc->local_primal_size,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
2090727cdba6SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&i,&aux_primal_numbering);CHKERRQ(ierr);
2091727cdba6SStefano Zampini   ierr = PetscMemcpy(pcbddc->primal_indices_local_idxs,aux_primal_numbering,i*sizeof(PetscInt));CHKERRQ(ierr);
2092727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2093727cdba6SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&j,&aux_primal_numbering);CHKERRQ(ierr);
2094727cdba6SStefano Zampini   ierr = PetscMemcpy(&pcbddc->primal_indices_local_idxs[i],aux_primal_numbering,j*sizeof(PetscInt));CHKERRQ(ierr);
2095727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2096e9189074SStefano Zampini   /* set quantities in PCBDDC data struct */
2097e9189074SStefano Zampini   pcbddc->n_actual_vertices = i;
2098727cdba6SStefano Zampini   /* check if a new primal space has been introduced */
2099727cdba6SStefano Zampini   pcbddc->new_primal_space_local = PETSC_TRUE;
2100727cdba6SStefano Zampini   if (olocal_primal_size == pcbddc->local_primal_size) {
2101727cdba6SStefano Zampini     ierr = PetscMemcmp(pcbddc->primal_indices_local_idxs,oprimal_indices_local_idxs,olocal_primal_size,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
2102c1c8e736SStefano Zampini     pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
2103727cdba6SStefano Zampini     ierr = PetscFree(oprimal_indices_local_idxs);CHKERRQ(ierr);
2104727cdba6SStefano Zampini   }
2105727cdba6SStefano Zampini   /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
2106727cdba6SStefano Zampini   ierr = MPI_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2107727cdba6SStefano Zampini 
2108a717540cSStefano Zampini   /* flush dbg viewer */
2109b8ffe317SStefano Zampini   if (pcbddc->dbg_flag) {
2110b8ffe317SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2111b8ffe317SStefano Zampini   }
2112a717540cSStefano Zampini 
2113e310c8b4SStefano Zampini   /* free workspace */
2114a717540cSStefano Zampini   ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2115a717540cSStefano Zampini   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
2116984c4197SStefano Zampini   ierr = PetscFree(aux_primal_minloc);CHKERRQ(ierr);
2117674ae819SStefano Zampini   ierr = PetscFree(temp_indices);CHKERRQ(ierr);
21184641a718SStefano Zampini   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
2119674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr);
2120674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
2121674ae819SStefano Zampini   ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr);
2122674ae819SStefano Zampini   PetscFunctionReturn(0);
2123674ae819SStefano Zampini }
2124674ae819SStefano Zampini 
2125674ae819SStefano Zampini #undef __FUNCT__
2126674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
2127674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
2128674ae819SStefano Zampini {
2129674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
2130674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
2131674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
2132674ae819SStefano Zampini   PetscInt    bs,ierr,i,vertex_size;
2133674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
2134674ae819SStefano Zampini 
2135674ae819SStefano Zampini   PetscFunctionBegin;
21368e61c736SStefano Zampini   /* Reset previously computed graph */
21378e61c736SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
2138674ae819SStefano Zampini   /* Init local Graph struct */
2139674ae819SStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr);
2140674ae819SStefano Zampini 
2141575ad6abSStefano Zampini   /* Check validity of the csr graph passed in by the user */
2142575ad6abSStefano Zampini   if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) {
2143575ad6abSStefano Zampini     ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
2144575ad6abSStefano Zampini   }
21459577ea80SStefano Zampini 
2146674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
2147674ae819SStefano Zampini   if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) {
2148674ae819SStefano Zampini     Mat mat_adj;
2149674ae819SStefano Zampini     const PetscInt *xadj,*adjncy;
2150674ae819SStefano Zampini     PetscBool flg_row=PETSC_TRUE;
2151674ae819SStefano Zampini 
2152674ae819SStefano Zampini     ierr = MatConvert(matis->A,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr);
2153674ae819SStefano Zampini     ierr = MatGetRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2154674ae819SStefano Zampini     if (!flg_row) {
2155674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ called in %s\n",__FUNCT__);
2156674ae819SStefano Zampini     }
2157674ae819SStefano Zampini     ierr = PCBDDCSetLocalAdjacencyGraph(pc,i,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
2158674ae819SStefano Zampini     ierr = MatRestoreRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2159674ae819SStefano Zampini     if (!flg_row) {
2160674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__);
2161674ae819SStefano Zampini     }
2162674ae819SStefano Zampini     ierr = MatDestroy(&mat_adj);CHKERRQ(ierr);
2163674ae819SStefano Zampini   }
2164674ae819SStefano Zampini 
2165674ae819SStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting */
2166674ae819SStefano Zampini   vertex_size = 1;
21679577ea80SStefano Zampini   if (!pcbddc->user_provided_isfordofs) {
2168674ae819SStefano Zampini     if (!pcbddc->n_ISForDofs) {
2169674ae819SStefano Zampini       IS *custom_ISForDofs;
2170674ae819SStefano Zampini 
2171674ae819SStefano Zampini       ierr = MatGetBlockSize(matis->A,&bs);CHKERRQ(ierr);
2172785e854fSJed Brown       ierr = PetscMalloc1(bs,&custom_ISForDofs);CHKERRQ(ierr);
2173674ae819SStefano Zampini       for (i=0;i<bs;i++) {
2174674ae819SStefano Zampini         ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n/bs,i,bs,&custom_ISForDofs[i]);CHKERRQ(ierr);
2175674ae819SStefano Zampini       }
2176674ae819SStefano Zampini       ierr = PCBDDCSetDofsSplitting(pc,bs,custom_ISForDofs);CHKERRQ(ierr);
21779577ea80SStefano Zampini       pcbddc->user_provided_isfordofs = PETSC_FALSE;
2178674ae819SStefano Zampini       /* remove my references to IS objects */
2179674ae819SStefano Zampini       for (i=0;i<bs;i++) {
2180674ae819SStefano Zampini         ierr = ISDestroy(&custom_ISForDofs[i]);CHKERRQ(ierr);
2181674ae819SStefano Zampini       }
2182674ae819SStefano Zampini       ierr = PetscFree(custom_ISForDofs);CHKERRQ(ierr);
21839577ea80SStefano Zampini     }
21849577ea80SStefano Zampini   } else { /* mat block size as vertex size (used for elasticity with rigid body modes as nearnullspace) */
2185674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
2186674ae819SStefano Zampini   }
2187674ae819SStefano Zampini 
2188674ae819SStefano Zampini   /* Setup of Graph */
2189674ae819SStefano Zampini   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundaries,pcbddc->DirichletBoundaries,pcbddc->n_ISForDofs,pcbddc->ISForDofs,pcbddc->user_primal_vertices);
2190674ae819SStefano Zampini 
2191674ae819SStefano Zampini   /* Graph's connected components analysis */
2192674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
2193674ae819SStefano Zampini 
2194674ae819SStefano Zampini   /* print some info to stdout */
2195674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
2196e49050b4SStefano Zampini     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer);
2197674ae819SStefano Zampini   }
2198fb180af4SStefano Zampini 
2199fb180af4SStefano Zampini   /* mark topography has done */
2200fb180af4SStefano Zampini   pcbddc->recompute_topography = PETSC_FALSE;
2201674ae819SStefano Zampini   PetscFunctionReturn(0);
2202674ae819SStefano Zampini }
2203674ae819SStefano Zampini 
2204674ae819SStefano Zampini #undef __FUNCT__
2205674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx"
2206f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt **vertices_idx)
2207674ae819SStefano Zampini {
2208674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2209674ae819SStefano Zampini   PetscInt       *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size;
2210674ae819SStefano Zampini   PetscErrorCode ierr;
2211674ae819SStefano Zampini 
2212674ae819SStefano Zampini   PetscFunctionBegin;
2213674ae819SStefano Zampini   n = 0;
2214674ae819SStefano Zampini   vertices = 0;
2215674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2216674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr);
2217b120a5c6SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2218b120a5c6SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2219b120a5c6SStefano Zampini       if (size_of_constraint == 1) n++;
2220b120a5c6SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2221b120a5c6SStefano Zampini     }
2222811e8ca2SStefano Zampini     if (vertices_idx) {
2223785e854fSJed Brown       ierr = PetscMalloc1(n,&vertices);CHKERRQ(ierr);
2224b120a5c6SStefano Zampini       n = 0;
2225674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2226674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2227674ae819SStefano Zampini         if (size_of_constraint == 1) {
2228674ae819SStefano Zampini           vertices[n++]=row_cmat_indices[0];
2229674ae819SStefano Zampini         }
2230674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2231674ae819SStefano Zampini       }
2232674ae819SStefano Zampini     }
2233811e8ca2SStefano Zampini   }
2234674ae819SStefano Zampini   *n_vertices = n;
2235811e8ca2SStefano Zampini   if (vertices_idx) *vertices_idx = vertices;
2236674ae819SStefano Zampini   PetscFunctionReturn(0);
2237674ae819SStefano Zampini }
2238674ae819SStefano Zampini 
2239674ae819SStefano Zampini #undef __FUNCT__
2240674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx"
2241f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt **constraints_idx)
2242674ae819SStefano Zampini {
2243674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2244674ae819SStefano Zampini   PetscInt       *constraints_index,*row_cmat_indices,*row_cmat_global_indices;
2245674ae819SStefano Zampini   PetscInt       n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc;
22464641a718SStefano Zampini   PetscBT        touched;
2247674ae819SStefano Zampini   PetscErrorCode ierr;
2248674ae819SStefano Zampini 
2249f34684f1SStefano Zampini     /* This function assumes that the number of local constraints per connected component
2250f34684f1SStefano Zampini        is not greater than the number of nodes defined for the connected component
2251f34684f1SStefano Zampini        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
2252674ae819SStefano Zampini   PetscFunctionBegin;
2253674ae819SStefano Zampini   n = 0;
2254674ae819SStefano Zampini   constraints_index = 0;
2255674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2256674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr);
2257674ae819SStefano Zampini     max_size_of_constraint = 0;
2258674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2259674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2260674ae819SStefano Zampini       if (size_of_constraint > 1) {
2261674ae819SStefano Zampini         n++;
2262674ae819SStefano Zampini       }
2263674ae819SStefano Zampini       max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint);
2264674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2265674ae819SStefano Zampini     }
2266811e8ca2SStefano Zampini     if (constraints_idx) {
2267785e854fSJed Brown       ierr = PetscMalloc1(n,&constraints_index);CHKERRQ(ierr);
2268785e854fSJed Brown       ierr = PetscMalloc1(max_size_of_constraint,&row_cmat_global_indices);CHKERRQ(ierr);
22694641a718SStefano Zampini       ierr = PetscBTCreate(local_size,&touched);CHKERRQ(ierr);
2270674ae819SStefano Zampini       n = 0;
2271674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2272674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2273674ae819SStefano Zampini         if (size_of_constraint > 1) {
2274674ae819SStefano Zampini           ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr);
227582d3d8afSStefano Zampini           /* find first untouched local node */
227682d3d8afSStefano Zampini           j = 0;
22774641a718SStefano Zampini           while (PetscBTLookup(touched,row_cmat_indices[j])) j++;
227882d3d8afSStefano Zampini           min_index = row_cmat_global_indices[j];
227982d3d8afSStefano Zampini           min_loc = j;
228082d3d8afSStefano Zampini           /* search the minimum among nodes not yet touched on the connected component
228182d3d8afSStefano Zampini              since there can be more than one constraint on a single cc */
2282674ae819SStefano Zampini           for (j=1;j<size_of_constraint;j++) {
22834641a718SStefano Zampini             if (!PetscBTLookup(touched,row_cmat_indices[j]) && min_index > row_cmat_global_indices[j]) {
2284674ae819SStefano Zampini               min_index = row_cmat_global_indices[j];
2285674ae819SStefano Zampini               min_loc = j;
2286674ae819SStefano Zampini             }
2287674ae819SStefano Zampini           }
22884641a718SStefano Zampini           ierr = PetscBTSet(touched,row_cmat_indices[min_loc]);CHKERRQ(ierr);
2289674ae819SStefano Zampini           constraints_index[n++] = row_cmat_indices[min_loc];
2290674ae819SStefano Zampini         }
2291674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2292674ae819SStefano Zampini       }
22934641a718SStefano Zampini       ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2294674ae819SStefano Zampini       ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr);
2295811e8ca2SStefano Zampini     }
2296811e8ca2SStefano Zampini   }
2297674ae819SStefano Zampini   *n_constraints = n;
2298811e8ca2SStefano Zampini   if (constraints_idx) *constraints_idx = constraints_index;
2299674ae819SStefano Zampini   PetscFunctionReturn(0);
2300674ae819SStefano Zampini }
2301674ae819SStefano Zampini 
2302674ae819SStefano Zampini /* the next two functions has been adapted from pcis.c */
2303674ae819SStefano Zampini #undef __FUNCT__
2304674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchur"
2305674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchur(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2306674ae819SStefano Zampini {
2307674ae819SStefano Zampini   PetscErrorCode ierr;
2308674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2309674ae819SStefano Zampini 
2310674ae819SStefano Zampini   PetscFunctionBegin;
2311674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2312674ae819SStefano Zampini   ierr = MatMult(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2313674ae819SStefano Zampini   ierr = MatMult(pcis->A_IB,v,vec1_D);CHKERRQ(ierr);
2314674ae819SStefano Zampini   ierr = KSPSolve(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2315674ae819SStefano Zampini   ierr = MatMult(pcis->A_BI,vec2_D,vec2_B);CHKERRQ(ierr);
2316674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2317674ae819SStefano Zampini   PetscFunctionReturn(0);
2318674ae819SStefano Zampini }
2319674ae819SStefano Zampini 
2320674ae819SStefano Zampini #undef __FUNCT__
2321674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchurTranspose"
2322674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchurTranspose(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2323674ae819SStefano Zampini {
2324674ae819SStefano Zampini   PetscErrorCode ierr;
2325674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2326674ae819SStefano Zampini 
2327674ae819SStefano Zampini   PetscFunctionBegin;
2328674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2329674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2330674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BI,v,vec1_D);CHKERRQ(ierr);
2331674ae819SStefano Zampini   ierr = KSPSolveTranspose(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2332674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_IB,vec2_D,vec2_B);CHKERRQ(ierr);
2333674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2334674ae819SStefano Zampini   PetscFunctionReturn(0);
2335674ae819SStefano Zampini }
2336674ae819SStefano Zampini 
2337674ae819SStefano Zampini #undef __FUNCT__
2338674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
2339674ae819SStefano 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[])
2340674ae819SStefano Zampini {
2341674ae819SStefano Zampini   Vec            local_vec,global_vec;
2342674ae819SStefano Zampini   IS             seqis,paris;
2343674ae819SStefano Zampini   VecScatter     scatter_ctx;
2344674ae819SStefano Zampini   PetscScalar    *array;
2345674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
2346674ae819SStefano Zampini   PetscScalar    globalsum;
2347674ae819SStefano Zampini   PetscInt       i,j,s;
2348674ae819SStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local;
2349674ae819SStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm,max_global;
2350674ae819SStefano Zampini   PetscMPIInt    *dof_sizes,*dof_displs;
2351674ae819SStefano Zampini   PetscBool      first_found;
2352674ae819SStefano Zampini   PetscErrorCode ierr;
2353674ae819SStefano Zampini 
2354674ae819SStefano Zampini   PetscFunctionBegin;
2355674ae819SStefano Zampini   /* mpi buffers */
2356674ae819SStefano Zampini   MPI_Comm_size(comm,&size_prec_comm);
2357674ae819SStefano Zampini   MPI_Comm_rank(comm,&rank_prec_comm);
2358674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
2359785e854fSJed Brown   ierr = PetscMalloc1(j,&dof_sizes);CHKERRQ(ierr);
2360785e854fSJed Brown   ierr = PetscMalloc1(j,&dof_displs);CHKERRQ(ierr);
2361674ae819SStefano Zampini   /* get maximum size of subset */
2362785e854fSJed Brown   ierr = PetscMalloc1(n_local_dofs,&temp_global_dofs);CHKERRQ(ierr);
2363674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
2364674ae819SStefano Zampini   max_local = 0;
2365674ae819SStefano Zampini   if (n_local_dofs) {
2366674ae819SStefano Zampini     max_local = temp_global_dofs[0];
2367674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2368674ae819SStefano Zampini       if (max_local < temp_global_dofs[i] ) {
2369674ae819SStefano Zampini         max_local = temp_global_dofs[i];
2370674ae819SStefano Zampini       }
2371674ae819SStefano Zampini     }
2372674ae819SStefano Zampini   }
2373674ae819SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);
2374674ae819SStefano Zampini   max_global++;
2375674ae819SStefano Zampini   max_local = 0;
2376674ae819SStefano Zampini   if (n_local_dofs) {
2377674ae819SStefano Zampini     max_local = local_dofs[0];
2378674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2379674ae819SStefano Zampini       if (max_local < local_dofs[i] ) {
2380674ae819SStefano Zampini         max_local = local_dofs[i];
2381674ae819SStefano Zampini       }
2382674ae819SStefano Zampini     }
2383674ae819SStefano Zampini   }
2384674ae819SStefano Zampini   max_local++;
2385674ae819SStefano Zampini   /* allocate workspace */
2386674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
2387674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
2388674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
2389674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
2390674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
2391674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
2392674ae819SStefano Zampini   /* create scatter */
2393674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
2394674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
2395674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
2396674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
2397674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
2398674ae819SStefano Zampini   /* init array */
2399674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
2400674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2401674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2402674ae819SStefano Zampini   if (local_dofs_mult) {
2403674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2404674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
2405674ae819SStefano Zampini     }
2406674ae819SStefano Zampini   } else {
2407674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2408674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
2409674ae819SStefano Zampini     }
2410674ae819SStefano Zampini   }
2411674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2412674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
2413674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2414674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2415674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
24165b08dc53SStefano Zampini   *n_global_subset = (PetscInt)PetscRealPart(globalsum);
2417674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
2418674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
2419674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
2420674ae819SStefano Zampini   nlocals = 0;
2421674ae819SStefano Zampini   first_index = -1;
2422674ae819SStefano Zampini   first_found = PETSC_FALSE;
2423674ae819SStefano Zampini   for (i=0;i<s;i++) {
24245b08dc53SStefano Zampini     if (!first_found && PetscRealPart(array[i]) > 0.0) {
2425674ae819SStefano Zampini       first_found = PETSC_TRUE;
2426674ae819SStefano Zampini       first_index = i;
2427674ae819SStefano Zampini     }
24285b08dc53SStefano Zampini     nlocals += (PetscInt)PetscRealPart(array[i]);
2429674ae819SStefano Zampini   }
2430674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2431674ae819SStefano Zampini   if (!rank_prec_comm) {
2432674ae819SStefano Zampini     dof_displs[0]=0;
2433674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
2434674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
2435674ae819SStefano Zampini     }
2436674ae819SStefano Zampini   }
2437674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2438674ae819SStefano Zampini   if (first_found) {
2439674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
2440674ae819SStefano Zampini     old_index = first_index;
2441674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
24425b08dc53SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) {
2443674ae819SStefano Zampini         array[i] += array[old_index];
2444674ae819SStefano Zampini         old_index = i;
2445674ae819SStefano Zampini       }
2446674ae819SStefano Zampini     }
2447674ae819SStefano Zampini   }
2448674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
2449674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2450674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2451674ae819SStefano Zampini   ierr = VecScatterEnd  (scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2452674ae819SStefano Zampini   /* get global ordering of local dofs */
2453674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2454674ae819SStefano Zampini   if (local_dofs_mult) {
2455674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
24565b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i];
2457674ae819SStefano Zampini     }
2458674ae819SStefano Zampini   } else {
2459674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
24605b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1;
2461674ae819SStefano Zampini     }
2462674ae819SStefano Zampini   }
2463674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2464674ae819SStefano Zampini   /* free workspace */
2465674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
2466674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
2467674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
2468674ae819SStefano Zampini   ierr = PetscFree(dof_sizes);CHKERRQ(ierr);
2469674ae819SStefano Zampini   ierr = PetscFree(dof_displs);CHKERRQ(ierr);
2470674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
2471674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
2472674ae819SStefano Zampini   PetscFunctionReturn(0);
2473674ae819SStefano Zampini }
24749a7d3425SStefano Zampini 
24759a7d3425SStefano Zampini #undef __FUNCT__
24769a7d3425SStefano Zampini #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
24779a7d3425SStefano Zampini PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
24789a7d3425SStefano Zampini {
24799a7d3425SStefano Zampini   PetscInt       i,j;
24809a7d3425SStefano Zampini   PetscScalar    *alphas;
24819a7d3425SStefano Zampini   PetscErrorCode ierr;
24829a7d3425SStefano Zampini 
24839a7d3425SStefano Zampini   PetscFunctionBegin;
24849a7d3425SStefano Zampini   /* this implements stabilized Gram-Schmidt */
2485785e854fSJed Brown   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
24869a7d3425SStefano Zampini   for (i=0;i<n;i++) {
24879a7d3425SStefano Zampini     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
24889a7d3425SStefano Zampini     if (i<n) { ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],&alphas[i+1]);CHKERRQ(ierr); }
24899a7d3425SStefano Zampini     for (j=i+1;j<n;j++) { ierr = VecAXPY(vecs[j],PetscConj(-alphas[j]),vecs[i]);CHKERRQ(ierr); }
24909a7d3425SStefano Zampini   }
24919a7d3425SStefano Zampini   ierr = PetscFree(alphas);CHKERRQ(ierr);
24929a7d3425SStefano Zampini   PetscFunctionReturn(0);
24939a7d3425SStefano Zampini }
24949a7d3425SStefano Zampini 
2495fa7f1dd8SStefano Zampini /* TODO
2496fa7f1dd8SStefano Zampini    - now preallocation is done assuming SEQDENSE local matrices
2497fa7f1dd8SStefano Zampini */
2498c8587f34SStefano Zampini #undef __FUNCT__
2499fa7f1dd8SStefano Zampini #define __FUNCT__ "MatISGetMPIXAIJ"
2500fa7f1dd8SStefano Zampini static PetscErrorCode MatISGetMPIXAIJ(Mat mat, MatType Mtype, MatReuse reuse, Mat *M)
2501c8587f34SStefano Zampini {
2502a57a6d2fSStefano Zampini   Mat                    new_mat;
2503a57a6d2fSStefano Zampini   Mat_IS                 *matis = (Mat_IS*)(mat->data);
2504a57a6d2fSStefano Zampini   /* info on mat */
2505fa7f1dd8SStefano Zampini   /* ISLocalToGlobalMapping rmapping,cmapping; */
2506a57a6d2fSStefano Zampini   PetscInt               bs,rows,cols;
2507a57a6d2fSStefano Zampini   PetscInt               lrows,lcols;
2508a57a6d2fSStefano Zampini   PetscInt               local_rows,local_cols;
2509fa7f1dd8SStefano Zampini   PetscBool              isdense;
2510fa7f1dd8SStefano Zampini   /* values insertion */
2511fa7f1dd8SStefano Zampini   PetscScalar            *array;
2512a57a6d2fSStefano Zampini   PetscInt               *local_indices,*global_indices;
2513a57a6d2fSStefano Zampini   /* work */
2514fa7f1dd8SStefano Zampini   PetscInt               i,j,index_row;
2515a57a6d2fSStefano Zampini   PetscErrorCode         ierr;
2516c8587f34SStefano Zampini 
2517a57a6d2fSStefano Zampini   PetscFunctionBegin;
2518fa7f1dd8SStefano Zampini   /* MISSING CHECKS
2519fa7f1dd8SStefano Zampini     - rectangular case not covered (it is not allowed by MATIS)
2520fa7f1dd8SStefano Zampini   */
2521a57a6d2fSStefano Zampini   /* get info from mat */
2522fa7f1dd8SStefano Zampini   /* ierr = MatGetLocalToGlobalMapping(mat,&rmapping,&cmapping);CHKERRQ(ierr); */
2523a57a6d2fSStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
2524a57a6d2fSStefano Zampini   ierr = MatGetBlockSize(mat,&bs);CHKERRQ(ierr);
2525a57a6d2fSStefano Zampini   ierr = MatGetSize(matis->A,&local_rows,&local_cols);CHKERRQ(ierr);
2526a57a6d2fSStefano Zampini 
2527fa7f1dd8SStefano Zampini   /* work */
2528473ba861SJed Brown   ierr = PetscMalloc1(local_rows,&local_indices);CHKERRQ(ierr);
2529fa7f1dd8SStefano Zampini   for (i=0;i<local_rows;i++) local_indices[i]=i;
2530fa7f1dd8SStefano Zampini   /* map indices of local mat to global values */
2531fa7f1dd8SStefano Zampini   ierr = PetscMalloc(PetscMax(local_cols,local_rows)*sizeof(*global_indices),&global_indices);CHKERRQ(ierr);
2532fa7f1dd8SStefano Zampini   /* ierr = ISLocalToGlobalMappingApply(rmapping,local_rows,local_indices,global_indices);CHKERRQ(ierr); */
2533fa7f1dd8SStefano Zampini   ierr = ISLocalToGlobalMappingApply(matis->mapping,local_rows,local_indices,global_indices);CHKERRQ(ierr);
2534fa7f1dd8SStefano Zampini 
2535fa7f1dd8SStefano Zampini   if (reuse==MAT_INITIAL_MATRIX) {
2536fa7f1dd8SStefano Zampini     Vec         vec_dnz,vec_onz;
2537fa7f1dd8SStefano Zampini     PetscScalar *my_dnz,*my_onz;
2538fa7f1dd8SStefano Zampini     PetscInt    *dnz,*onz,*mat_ranges,*row_ownership;
2539fa7f1dd8SStefano Zampini     PetscInt    index_col,owner;
2540fa7f1dd8SStefano Zampini     PetscMPIInt nsubdomains;
2541fa7f1dd8SStefano Zampini 
2542fa7f1dd8SStefano Zampini     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&nsubdomains);CHKERRQ(ierr);
2543a57a6d2fSStefano Zampini     ierr = MatCreate(PetscObjectComm((PetscObject)mat),&new_mat);CHKERRQ(ierr);
2544a57a6d2fSStefano Zampini     ierr = MatSetSizes(new_mat,PETSC_DECIDE,PETSC_DECIDE,rows,cols);CHKERRQ(ierr);
2545a57a6d2fSStefano Zampini     ierr = MatSetBlockSize(new_mat,bs);CHKERRQ(ierr);
2546fa7f1dd8SStefano Zampini     ierr = MatSetType(new_mat,Mtype);CHKERRQ(ierr);
2547a57a6d2fSStefano Zampini     ierr = MatSetUp(new_mat);CHKERRQ(ierr);
2548a57a6d2fSStefano Zampini     ierr = MatGetLocalSize(new_mat,&lrows,&lcols);CHKERRQ(ierr);
2549a57a6d2fSStefano Zampini 
2550a57a6d2fSStefano Zampini     /*
2551a57a6d2fSStefano Zampini       preallocation
2552a57a6d2fSStefano Zampini     */
2553a57a6d2fSStefano Zampini 
2554a57a6d2fSStefano Zampini     ierr = MatPreallocateInitialize(PetscObjectComm((PetscObject)new_mat),lrows,lcols,dnz,onz);CHKERRQ(ierr);
2555a57a6d2fSStefano Zampini     /*
2556a57a6d2fSStefano Zampini        Some vectors are needed to sum up properly on shared interface dofs.
2557fa7f1dd8SStefano Zampini        Preallocation macros cannot do the job.
2558a57a6d2fSStefano Zampini        Note that preallocation is not exact, since it overestimates nonzeros
2559a57a6d2fSStefano Zampini     */
2560a57a6d2fSStefano Zampini     ierr = MatGetVecs(new_mat,NULL,&vec_dnz);CHKERRQ(ierr);
2561fa7f1dd8SStefano Zampini     /* ierr = VecSetLocalToGlobalMapping(vec_dnz,rmapping);CHKERRQ(ierr); */
2562fa7f1dd8SStefano Zampini     ierr = VecSetLocalToGlobalMapping(vec_dnz,matis->mapping);CHKERRQ(ierr);
2563c8587f34SStefano Zampini     ierr = VecDuplicate(vec_dnz,&vec_onz);CHKERRQ(ierr);
2564e7931f94SStefano Zampini     /* All processes need to compute entire row ownership */
2565785e854fSJed Brown     ierr = PetscMalloc1(rows,&row_ownership);CHKERRQ(ierr);
2566a57a6d2fSStefano Zampini     ierr = MatGetOwnershipRanges(new_mat,(const PetscInt**)&mat_ranges);CHKERRQ(ierr);
2567a57a6d2fSStefano Zampini     for (i=0;i<nsubdomains;i++) {
2568c8587f34SStefano Zampini       for (j=mat_ranges[i];j<mat_ranges[i+1];j++) {
2569c8587f34SStefano Zampini         row_ownership[j]=i;
2570c8587f34SStefano Zampini       }
2571c8587f34SStefano Zampini     }
2572c8587f34SStefano Zampini 
2573e7931f94SStefano Zampini     /*
2574e7931f94SStefano Zampini        my_dnz and my_onz contains exact contribution to preallocation from each local mat
2575e7931f94SStefano Zampini        then, they will be summed up properly. This way, preallocation is always sufficient
2576e7931f94SStefano Zampini     */
2577785e854fSJed Brown     ierr = PetscMalloc1(local_rows,&my_dnz);CHKERRQ(ierr);
2578785e854fSJed Brown     ierr = PetscMalloc1(local_rows,&my_onz);CHKERRQ(ierr);
2579a57a6d2fSStefano Zampini     ierr = PetscMemzero(my_dnz,local_rows*sizeof(*my_dnz));CHKERRQ(ierr);
2580a57a6d2fSStefano Zampini     ierr = PetscMemzero(my_onz,local_rows*sizeof(*my_onz));CHKERRQ(ierr);
2581a57a6d2fSStefano Zampini     for (i=0;i<local_rows;i++) {
2582a57a6d2fSStefano Zampini       index_row = global_indices[i];
2583a57a6d2fSStefano Zampini       for (j=i;j<local_rows;j++) {
2584a57a6d2fSStefano Zampini         owner = row_ownership[index_row];
2585a57a6d2fSStefano Zampini         index_col = global_indices[j];
2586a57a6d2fSStefano Zampini         if (index_col > mat_ranges[owner]-1 && index_col < mat_ranges[owner+1] ) { /* diag block */
2587c8587f34SStefano Zampini           my_dnz[i] += 1.0;
2588a57a6d2fSStefano Zampini         } else { /* offdiag block */
2589c8587f34SStefano Zampini           my_onz[i] += 1.0;
2590c8587f34SStefano Zampini         }
2591a57a6d2fSStefano Zampini         /* same as before, interchanging rows and cols */
2592c8587f34SStefano Zampini         if (i != j) {
2593a57a6d2fSStefano Zampini           owner = row_ownership[index_col];
2594a57a6d2fSStefano Zampini           if (index_row > mat_ranges[owner]-1 && index_row < mat_ranges[owner+1] ) {
2595c8587f34SStefano Zampini             my_dnz[j] += 1.0;
2596c8587f34SStefano Zampini           } else {
2597c8587f34SStefano Zampini             my_onz[j] += 1.0;
2598c8587f34SStefano Zampini           }
2599c8587f34SStefano Zampini         }
2600c8587f34SStefano Zampini       }
2601c8587f34SStefano Zampini     }
2602c8587f34SStefano Zampini     ierr = VecSet(vec_dnz,0.0);CHKERRQ(ierr);
2603c8587f34SStefano Zampini     ierr = VecSet(vec_onz,0.0);CHKERRQ(ierr);
260420a2ab83SStefano Zampini     if (local_rows) { /* multilevel guard */
2605fa7f1dd8SStefano Zampini       ierr = VecSetValuesLocal(vec_dnz,local_rows,local_indices,my_dnz,ADD_VALUES);CHKERRQ(ierr);
2606fa7f1dd8SStefano Zampini       ierr = VecSetValuesLocal(vec_onz,local_rows,local_indices,my_onz,ADD_VALUES);CHKERRQ(ierr);
2607c8587f34SStefano Zampini     }
2608c8587f34SStefano Zampini     ierr = VecAssemblyBegin(vec_dnz);CHKERRQ(ierr);
2609c8587f34SStefano Zampini     ierr = VecAssemblyBegin(vec_onz);CHKERRQ(ierr);
2610c8587f34SStefano Zampini     ierr = VecAssemblyEnd(vec_dnz);CHKERRQ(ierr);
2611c8587f34SStefano Zampini     ierr = VecAssemblyEnd(vec_onz);CHKERRQ(ierr);
2612c8587f34SStefano Zampini     ierr = PetscFree(my_dnz);CHKERRQ(ierr);
2613c8587f34SStefano Zampini     ierr = PetscFree(my_onz);CHKERRQ(ierr);
2614c8587f34SStefano Zampini     ierr = PetscFree(row_ownership);CHKERRQ(ierr);
2615a57a6d2fSStefano Zampini 
2616a57a6d2fSStefano Zampini     /* set computed preallocation in dnz and onz */
2617a57a6d2fSStefano Zampini     ierr = VecGetArray(vec_dnz,&array);CHKERRQ(ierr);
2618a57a6d2fSStefano Zampini     for (i=0; i<lrows; i++) dnz[i] = (PetscInt)PetscRealPart(array[i]);
2619a57a6d2fSStefano Zampini     ierr = VecRestoreArray(vec_dnz,&array);CHKERRQ(ierr);
2620a57a6d2fSStefano Zampini     ierr = VecGetArray(vec_onz,&array);CHKERRQ(ierr);
2621a57a6d2fSStefano Zampini     for (i=0;i<lrows;i++) onz[i] = (PetscInt)PetscRealPart(array[i]);
2622a57a6d2fSStefano Zampini     ierr = VecRestoreArray(vec_onz,&array);CHKERRQ(ierr);
2623c8587f34SStefano Zampini     ierr = VecDestroy(&vec_dnz);CHKERRQ(ierr);
2624c8587f34SStefano Zampini     ierr = VecDestroy(&vec_onz);CHKERRQ(ierr);
2625c8587f34SStefano Zampini 
2626e7931f94SStefano Zampini     /* Resize preallocation if overestimated */
2627c8587f34SStefano Zampini     for (i=0;i<lrows;i++) {
2628a57a6d2fSStefano Zampini       dnz[i] = PetscMin(dnz[i],lcols);
2629a57a6d2fSStefano Zampini       onz[i] = PetscMin(onz[i],cols-lcols);
2630c8587f34SStefano Zampini     }
2631fa7f1dd8SStefano Zampini     /* set preallocation */
2632a57a6d2fSStefano Zampini     ierr = MatMPIAIJSetPreallocation(new_mat,0,dnz,0,onz);CHKERRQ(ierr);
2633fa7f1dd8SStefano Zampini     for (i=0;i<lrows/bs;i++) {
2634fa7f1dd8SStefano Zampini       dnz[i] = dnz[i*bs]/bs;
2635fa7f1dd8SStefano Zampini       onz[i] = onz[i*bs]/bs;
2636fa7f1dd8SStefano Zampini     }
2637fa7f1dd8SStefano Zampini     ierr = MatMPIBAIJSetPreallocation(new_mat,bs,0,dnz,0,onz);CHKERRQ(ierr);
2638fa7f1dd8SStefano Zampini     for (i=0;i<lrows/bs;i++) {
2639fa7f1dd8SStefano Zampini       dnz[i] = dnz[i]-i;
2640fa7f1dd8SStefano Zampini     }
2641fa7f1dd8SStefano Zampini     ierr = MatMPISBAIJSetPreallocation(new_mat,bs,0,dnz,0,onz);CHKERRQ(ierr);
2642c8587f34SStefano Zampini     ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
2643fa7f1dd8SStefano Zampini     *M = new_mat;
2644fa7f1dd8SStefano Zampini   } else {
2645fa7f1dd8SStefano Zampini     PetscInt mbs,mrows,mcols;
2646fa7f1dd8SStefano Zampini     /* some checks */
2647fa7f1dd8SStefano Zampini     ierr = MatGetBlockSize(*M,&mbs);CHKERRQ(ierr);
2648fa7f1dd8SStefano Zampini     ierr = MatGetSize(*M,&mrows,&mcols);CHKERRQ(ierr);
2649fa7f1dd8SStefano Zampini     if (mrows != rows) {
2650fa7f1dd8SStefano Zampini       SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong number of rows (%d != %d)",rows,mrows);
2651fa7f1dd8SStefano Zampini     }
2652fa7f1dd8SStefano Zampini     if (mrows != rows) {
2653fa7f1dd8SStefano Zampini       SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong number of cols (%d != %d)",cols,mcols);
2654fa7f1dd8SStefano Zampini     }
2655fa7f1dd8SStefano Zampini     if (mbs != bs) {
2656fa7f1dd8SStefano Zampini       SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong block size (%d != %d)",bs,mbs);
2657fa7f1dd8SStefano Zampini     }
2658fa7f1dd8SStefano Zampini     ierr = MatZeroEntries(*M);CHKERRQ(ierr);
2659fa7f1dd8SStefano Zampini   }
2660fa7f1dd8SStefano Zampini   /* set local to global mappings */
2661fa7f1dd8SStefano Zampini   /* ierr = MatSetLocalToGlobalMapping(*M,rmapping,cmapping);CHKERRQ(ierr); */
2662fa7f1dd8SStefano Zampini   /* Set values */
2663fa7f1dd8SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQDENSE,&isdense);CHKERRQ(ierr);
2664fa7f1dd8SStefano Zampini   if (isdense) { /* special case for dense local matrices */
2665fa7f1dd8SStefano Zampini     ierr = MatSetOption(*M,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
2666fa7f1dd8SStefano Zampini     ierr = MatDenseGetArray(matis->A,&array);CHKERRQ(ierr);
2667fa7f1dd8SStefano Zampini     ierr = MatSetValues(*M,local_rows,global_indices,local_cols,global_indices,array,ADD_VALUES);CHKERRQ(ierr);
2668fa7f1dd8SStefano Zampini     ierr = MatDenseRestoreArray(matis->A,&array);CHKERRQ(ierr);
2669fa7f1dd8SStefano Zampini     ierr = PetscFree(local_indices);CHKERRQ(ierr);
2670fa7f1dd8SStefano Zampini     ierr = PetscFree(global_indices);CHKERRQ(ierr);
2671fa7f1dd8SStefano Zampini   } else { /* very basic values insertion for all other matrix types */
2672fa7f1dd8SStefano Zampini     ierr = PetscFree(local_indices);CHKERRQ(ierr);
2673fa7f1dd8SStefano Zampini     ierr = PetscFree(global_indices);CHKERRQ(ierr);
2674a57a6d2fSStefano Zampini     for (i=0;i<local_rows;i++) {
2675a57a6d2fSStefano Zampini       ierr = MatGetRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2676fa7f1dd8SStefano Zampini       /* ierr = MatSetValuesLocal(*M,1,&i,j,local_indices,array,ADD_VALUES);CHKERRQ(ierr); */
2677a57a6d2fSStefano Zampini       ierr = ISLocalToGlobalMappingApply(matis->mapping,j,local_indices,global_indices);CHKERRQ(ierr);
2678a57a6d2fSStefano Zampini       ierr = ISLocalToGlobalMappingApply(matis->mapping,1,&i,&index_row);CHKERRQ(ierr);
2679fa7f1dd8SStefano Zampini       ierr = MatSetValues(*M,1,&index_row,j,global_indices,array,ADD_VALUES);CHKERRQ(ierr);
2680a57a6d2fSStefano Zampini       ierr = MatRestoreRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2681a57a6d2fSStefano Zampini     }
2682fa7f1dd8SStefano Zampini   }
2683fa7f1dd8SStefano Zampini   ierr = MatAssemblyBegin(*M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2684fa7f1dd8SStefano Zampini   ierr = MatAssemblyEnd(*M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2685fa7f1dd8SStefano Zampini   if (isdense) {
2686fa7f1dd8SStefano Zampini     ierr = MatSetOption(*M,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
2687fa7f1dd8SStefano Zampini   }
2688a57a6d2fSStefano Zampini   PetscFunctionReturn(0);
2689a57a6d2fSStefano Zampini }
2690a57a6d2fSStefano Zampini 
2691e7931f94SStefano Zampini #undef __FUNCT__
2692e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble_Private"
2693e7931f94SStefano Zampini PetscErrorCode MatISSubassemble_Private(Mat mat, PetscInt coarsening_ratio, IS* is_sends)
2694e7931f94SStefano Zampini {
2695e7931f94SStefano Zampini   Mat             subdomain_adj;
2696e7931f94SStefano Zampini   IS              new_ranks,ranks_send_to;
2697e7931f94SStefano Zampini   MatPartitioning partitioner;
2698e7931f94SStefano Zampini   Mat_IS          *matis;
2699e7931f94SStefano Zampini   PetscInt        n_neighs,*neighs,*n_shared,**shared;
2700e7931f94SStefano Zampini   PetscInt        prank;
2701e7931f94SStefano Zampini   PetscMPIInt     size,rank,color;
2702e7931f94SStefano Zampini   PetscInt        *xadj,*adjncy,*oldranks;
2703e7931f94SStefano Zampini   PetscInt        *adjncy_wgt,*v_wgt,*is_indices,*ranks_send_to_idx;
2704e7931f94SStefano Zampini   PetscInt        i,j,n_subdomains,local_size,threshold=0;
2705e7931f94SStefano Zampini   PetscErrorCode  ierr;
27062b510759SStefano Zampini   PetscBool       use_vwgt=PETSC_FALSE,use_square=PETSC_FALSE;
2707e7931f94SStefano Zampini   PetscSubcomm    subcomm;
2708a57a6d2fSStefano Zampini 
2709e7931f94SStefano Zampini   PetscFunctionBegin;
27102b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_square",&use_square,NULL);CHKERRQ(ierr);
27112b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
27122b510759SStefano Zampini   ierr = PetscOptionsGetInt(NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
2713e7931f94SStefano Zampini 
2714e7931f94SStefano Zampini   /* Get info on mapping */
2715e7931f94SStefano Zampini   matis = (Mat_IS*)(mat->data);
2716e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&local_size);CHKERRQ(ierr);
2717e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2718e7931f94SStefano Zampini 
2719e7931f94SStefano Zampini   /* build local CSR graph of subdomains' connectivity */
2720785e854fSJed Brown   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
2721e7931f94SStefano Zampini   xadj[0] = 0;
2722e7931f94SStefano Zampini   xadj[1] = PetscMax(n_neighs-1,0);
2723785e854fSJed Brown   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
2724785e854fSJed Brown   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
2725e7931f94SStefano Zampini 
27262b510759SStefano Zampini   if (threshold) {
27272b510759SStefano Zampini     PetscInt* count,min_threshold;
2728785e854fSJed Brown     ierr = PetscMalloc1(local_size,&count);CHKERRQ(ierr);
2729e7931f94SStefano Zampini     ierr = PetscMemzero(count,local_size*sizeof(PetscInt));CHKERRQ(ierr);
2730e7931f94SStefano Zampini     for (i=1;i<n_neighs;i++) {/* i=1 so I don't count myself -> faces nodes counts to 1 */
2731e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2732e7931f94SStefano Zampini         count[shared[i][j]] += 1;
2733e7931f94SStefano Zampini       }
2734e7931f94SStefano Zampini     }
27352b510759SStefano Zampini     /* adapt threshold since we dont want to lose significant connections */
27362b510759SStefano Zampini     min_threshold = n_neighs;
27372b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
27382b510759SStefano Zampini       for (j=0;j<n_shared[i];j++) {
27392b510759SStefano Zampini         min_threshold = PetscMin(count[shared[i][j]],min_threshold);
27402b510759SStefano Zampini       }
27412b510759SStefano Zampini     }
27422b510759SStefano Zampini     threshold = PetscMax(min_threshold+1,threshold);
2743e7931f94SStefano Zampini     xadj[1] = 0;
27442b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
2745e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2746e7931f94SStefano Zampini         if (count[shared[i][j]] < threshold) {
2747e7931f94SStefano Zampini           adjncy[xadj[1]] = neighs[i];
2748e7931f94SStefano Zampini           adjncy_wgt[xadj[1]] = n_shared[i];
2749e7931f94SStefano Zampini           xadj[1]++;
2750e7931f94SStefano Zampini           break;
2751e7931f94SStefano Zampini         }
2752e7931f94SStefano Zampini       }
2753e7931f94SStefano Zampini     }
2754e7931f94SStefano Zampini     ierr = PetscFree(count);CHKERRQ(ierr);
2755c8587f34SStefano Zampini   } else {
2756e7931f94SStefano Zampini     if (xadj[1]) {
2757e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy,&neighs[1],xadj[1]*sizeof(*adjncy));CHKERRQ(ierr);
2758e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy_wgt,&n_shared[1],xadj[1]*sizeof(*adjncy_wgt));CHKERRQ(ierr);
2759c8587f34SStefano Zampini     }
2760e7931f94SStefano Zampini   }
2761e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingRestoreInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2762e7931f94SStefano Zampini   if (use_square) {
2763e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2764e7931f94SStefano Zampini       adjncy_wgt[i] = adjncy_wgt[i]*adjncy_wgt[i];
2765e7931f94SStefano Zampini     }
2766e7931f94SStefano Zampini   }
2767e7931f94SStefano Zampini   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2768e7931f94SStefano Zampini 
2769e7931f94SStefano Zampini   ierr = PetscMalloc(sizeof(PetscInt),&ranks_send_to_idx);CHKERRQ(ierr);
2770e7931f94SStefano Zampini 
2771e7931f94SStefano Zampini   /*
2772e7931f94SStefano Zampini     Restrict work on active processes only.
2773e7931f94SStefano Zampini   */
2774e7931f94SStefano Zampini   ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&subcomm);CHKERRQ(ierr);
2775e7931f94SStefano Zampini   ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
2776e7931f94SStefano Zampini   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
27772b510759SStefano Zampini   ierr = PetscMPIIntCast(!local_size,&color);CHKERRQ(ierr);
2778d3531aaaSJed Brown   ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
2779e7931f94SStefano Zampini   if (color) {
2780e7931f94SStefano Zampini     ierr = PetscFree(xadj);CHKERRQ(ierr);
2781e7931f94SStefano Zampini     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2782e7931f94SStefano Zampini     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
2783c8587f34SStefano Zampini   } else {
2784e7931f94SStefano Zampini     ierr = MPI_Comm_size(subcomm->comm,&size);CHKERRQ(ierr);
2785785e854fSJed Brown     ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
2786e7931f94SStefano Zampini     prank = rank;
2787e7931f94SStefano Zampini     ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm->comm);CHKERRQ(ierr);
2788e7931f94SStefano Zampini     for (i=0;i<size;i++) {
2789e7931f94SStefano Zampini       PetscPrintf(subcomm->comm,"oldranks[%d] = %d\n",i,oldranks[i]);
2790c8587f34SStefano Zampini     }
2791e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2792e7931f94SStefano Zampini       ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
2793c8587f34SStefano Zampini     }
2794e7931f94SStefano Zampini     ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2795e7931f94SStefano Zampini     ierr = MatCreateMPIAdj(subcomm->comm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
2796e7931f94SStefano Zampini     n_subdomains = (PetscInt)size;
2797e7931f94SStefano Zampini     ierr = MatView(subdomain_adj,0);CHKERRQ(ierr);
2798e7931f94SStefano Zampini 
2799e7931f94SStefano Zampini     /* Partition */
2800e7931f94SStefano Zampini     ierr = MatPartitioningCreate(subcomm->comm,&partitioner);CHKERRQ(ierr);
2801e7931f94SStefano Zampini     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
2802e7931f94SStefano Zampini     if (use_vwgt) {
2803e7931f94SStefano Zampini       ierr = PetscMalloc(sizeof(*v_wgt),&v_wgt);CHKERRQ(ierr);
2804e7931f94SStefano Zampini       v_wgt[0] = local_size;
2805e7931f94SStefano Zampini       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
2806c8587f34SStefano Zampini     }
2807e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)partitioner),"NPARTS %d\n",n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2808e7931f94SStefano Zampini     ierr = MatPartitioningSetNParts(partitioner,n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2809e7931f94SStefano Zampini     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
2810e7931f94SStefano Zampini     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
2811e7931f94SStefano Zampini     ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr);
2812e7931f94SStefano Zampini 
2813e7931f94SStefano Zampini     ierr = ISGetIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2814e7931f94SStefano Zampini     ranks_send_to_idx[0] = oldranks[is_indices[0]];
2815e7931f94SStefano Zampini     ierr = ISRestoreIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2816e7931f94SStefano Zampini     /* clean up */
2817e7931f94SStefano Zampini     ierr = PetscFree(oldranks);CHKERRQ(ierr);
2818e7931f94SStefano Zampini     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
2819e7931f94SStefano Zampini     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
2820e7931f94SStefano Zampini     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
2821e7931f94SStefano Zampini   }
2822e7931f94SStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
2823e7931f94SStefano Zampini 
2824e7931f94SStefano Zampini   /* assemble parallel IS for sends */
2825e7931f94SStefano Zampini   i = 1;
2826e7931f94SStefano Zampini   if (color) i=0;
2827e7931f94SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,&ranks_send_to);CHKERRQ(ierr);
2828e7931f94SStefano Zampini   ierr = ISView(ranks_send_to,0);CHKERRQ(ierr);
2829e7931f94SStefano Zampini 
2830e7931f94SStefano Zampini   /* get back IS */
2831e7931f94SStefano Zampini   *is_sends = ranks_send_to;
2832e7931f94SStefano Zampini   PetscFunctionReturn(0);
2833e7931f94SStefano Zampini }
2834e7931f94SStefano Zampini 
2835e7931f94SStefano Zampini typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
2836e7931f94SStefano Zampini 
2837e7931f94SStefano Zampini #undef __FUNCT__
2838e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble"
2839e7931f94SStefano Zampini PetscErrorCode MatISSubassemble(Mat mat, IS is_sends, PetscInt coarsening_ratio, Mat *mat_n)
2840e7931f94SStefano Zampini {
2841e7931f94SStefano Zampini   Mat                    local_mat,new_mat;
2842e7931f94SStefano Zampini   Mat_IS                 *matis;
2843e7931f94SStefano Zampini   IS                     is_sends_internal;
2844e7931f94SStefano Zampini   PetscInt               rows,cols;
2845e7931f94SStefano Zampini   PetscInt               i,bs,buf_size_idxs,buf_size_vals;
2846e7931f94SStefano Zampini   PetscBool              ismatis,isdense;
2847e7931f94SStefano Zampini   ISLocalToGlobalMapping l2gmap;
2848e7931f94SStefano Zampini   PetscInt*              l2gmap_indices;
2849e7931f94SStefano Zampini   const PetscInt*        is_indices;
2850e7931f94SStefano Zampini   MatType                new_local_type;
2851e7931f94SStefano Zampini   MatTypePrivate         new_local_type_private;
2852e7931f94SStefano Zampini   /* buffers */
2853e7931f94SStefano Zampini   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
2854e7931f94SStefano Zampini   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
2855e7931f94SStefano Zampini   /* MPI */
2856e7931f94SStefano Zampini   MPI_Comm               comm;
2857e7931f94SStefano Zampini   PetscMPIInt            n_sends,n_recvs,commsize;
2858e7931f94SStefano Zampini   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals;
2859e7931f94SStefano Zampini   PetscMPIInt            *onodes,*olengths_idxs,*olengths_vals;
2860e7931f94SStefano Zampini   PetscMPIInt            len,tag_idxs,tag_vals,source_dest;
2861e7931f94SStefano Zampini   MPI_Request            *send_req_idxs,*send_req_vals,*recv_req_idxs,*recv_req_vals;
2862e7931f94SStefano Zampini   PetscErrorCode         ierr;
2863e7931f94SStefano Zampini 
2864e7931f94SStefano Zampini   PetscFunctionBegin;
2865e7931f94SStefano Zampini   /* checks */
2866e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
2867e7931f94SStefano Zampini   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on an matrix object which is not of type MATIS",__FUNCT__);
2868e7931f94SStefano Zampini   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2869e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
2870e7931f94SStefano Zampini   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
2871e7931f94SStefano Zampini   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
2872e7931f94SStefano Zampini   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
2873e7931f94SStefano Zampini   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
2874e7931f94SStefano Zampini   PetscValidLogicalCollectiveInt(mat,bs,0);
2875e7931f94SStefano Zampini   /* prepare IS for sending if not provided */
2876e7931f94SStefano Zampini   if (!is_sends) {
2877e7931f94SStefano Zampini     if (!coarsening_ratio) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a coarsening ratio");
2878e7931f94SStefano Zampini     ierr = MatISSubassemble_Private(mat,coarsening_ratio,&is_sends_internal);CHKERRQ(ierr);
2879c8587f34SStefano Zampini   } else {
2880e7931f94SStefano Zampini     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
2881e7931f94SStefano Zampini     is_sends_internal = is_sends;
2882c8587f34SStefano Zampini   }
2883e7931f94SStefano Zampini 
2884e7931f94SStefano Zampini   /* get pointer of MATIS data */
2885e7931f94SStefano Zampini   matis = (Mat_IS*)mat->data;
2886e7931f94SStefano Zampini 
2887e7931f94SStefano Zampini   /* get comm */
2888e7931f94SStefano Zampini   comm = PetscObjectComm((PetscObject)mat);
2889e7931f94SStefano Zampini 
2890e7931f94SStefano Zampini   /* compute number of sends */
2891e7931f94SStefano Zampini   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
2892e7931f94SStefano Zampini   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
2893e7931f94SStefano Zampini 
2894e7931f94SStefano Zampini   /* compute number of receives */
2895e7931f94SStefano Zampini   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
2896785e854fSJed Brown   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
2897e7931f94SStefano Zampini   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
2898e7931f94SStefano Zampini   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2899e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
2900e7931f94SStefano Zampini   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
2901e7931f94SStefano Zampini   ierr = PetscFree(iflags);CHKERRQ(ierr);
2902e7931f94SStefano Zampini 
2903e7931f94SStefano Zampini   /* prepare send/receive buffers */
2904785e854fSJed Brown   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
2905e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
2906785e854fSJed Brown   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
2907e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
2908e7931f94SStefano Zampini 
2909e7931f94SStefano Zampini   /* Get data from local mat */
2910e7931f94SStefano Zampini   if (!isdense) {
2911e7931f94SStefano Zampini     /* TODO: See below some guidelines on how to prepare the local buffers */
2912e7931f94SStefano Zampini     /*
2913e7931f94SStefano Zampini        send_buffer_vals should contain the raw values of the local matrix
2914e7931f94SStefano Zampini        send_buffer_idxs should contain:
2915e7931f94SStefano Zampini        - MatType_PRIVATE type
2916e7931f94SStefano Zampini        - PetscInt        size_of_l2gmap
2917e7931f94SStefano Zampini        - PetscInt        global_row_indices[size_of_l2gmap]
2918e7931f94SStefano Zampini        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
2919e7931f94SStefano Zampini     */
2920e7931f94SStefano Zampini   } else {
2921e7931f94SStefano Zampini     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
2922e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&i);CHKERRQ(ierr);
2923785e854fSJed Brown     ierr = PetscMalloc1((i+2),&send_buffer_idxs);CHKERRQ(ierr);
2924e7931f94SStefano Zampini     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
2925e7931f94SStefano Zampini     send_buffer_idxs[1] = i;
2926e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2927e7931f94SStefano Zampini     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
2928e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingRestoreIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2929e7931f94SStefano Zampini     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
2930e7931f94SStefano Zampini     for (i=0;i<n_sends;i++) {
2931e7931f94SStefano Zampini       ilengths_vals[is_indices[i]] = len*len;
2932e7931f94SStefano Zampini       ilengths_idxs[is_indices[i]] = len+2;
2933c8587f34SStefano Zampini     }
2934c8587f34SStefano Zampini   }
2935e7931f94SStefano Zampini   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
2936e7931f94SStefano Zampini   buf_size_idxs = 0;
2937e7931f94SStefano Zampini   buf_size_vals = 0;
2938e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2939e7931f94SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
2940e7931f94SStefano Zampini     buf_size_vals += (PetscInt)olengths_vals[i];
2941e7931f94SStefano Zampini   }
2942785e854fSJed Brown   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
2943785e854fSJed Brown   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
2944e7931f94SStefano Zampini 
2945e7931f94SStefano Zampini   /* get new tags for clean communications */
2946e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
2947e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
2948e7931f94SStefano Zampini 
2949e7931f94SStefano Zampini   /* allocate for requests */
2950785e854fSJed Brown   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
2951785e854fSJed Brown   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
2952785e854fSJed Brown   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
2953785e854fSJed Brown   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
2954e7931f94SStefano Zampini 
2955e7931f94SStefano Zampini   /* communications */
2956e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2957e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
2958e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2959e7931f94SStefano Zampini     source_dest = onodes[i];
2960e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
2961e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
2962e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2963e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
2964e7931f94SStefano Zampini   }
2965e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) {
2966e7931f94SStefano Zampini     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
2967e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
2968e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
2969e7931f94SStefano Zampini   }
2970e7931f94SStefano Zampini   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2971e7931f94SStefano Zampini   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
2972e7931f94SStefano Zampini 
2973e7931f94SStefano Zampini   /* assemble new l2g map */
2974e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2975e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2976e7931f94SStefano Zampini   buf_size_idxs = 0;
2977e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2978e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
2979e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2980e7931f94SStefano Zampini   }
2981785e854fSJed Brown   ierr = PetscMalloc1(buf_size_idxs,&l2gmap_indices);CHKERRQ(ierr);
2982e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2983e7931f94SStefano Zampini   buf_size_idxs = 0;
2984e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2985e7931f94SStefano Zampini     ierr = PetscMemcpy(&l2gmap_indices[buf_size_idxs],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
2986e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
2987e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2988e7931f94SStefano Zampini   }
2989e7931f94SStefano Zampini   ierr = PetscSortRemoveDupsInt(&buf_size_idxs,l2gmap_indices);CHKERRQ(ierr);
2990e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingCreate(comm,buf_size_idxs,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
2991e7931f94SStefano Zampini   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
2992e7931f94SStefano Zampini 
2993e7931f94SStefano Zampini   /* infer new local matrix type from received local matrices type */
2994e7931f94SStefano Zampini   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
2995e7931f94SStefano 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) */
2996e7931f94SStefano Zampini   new_local_type_private = MATAIJ_PRIVATE;
2997e7931f94SStefano Zampini   new_local_type = MATSEQAIJ;
2998e7931f94SStefano Zampini   if (n_recvs) {
2999be4bc593SStefano Zampini     new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
3000e7931f94SStefano Zampini     ptr_idxs = recv_buffer_idxs;
3001e7931f94SStefano Zampini     for (i=0;i<n_recvs;i++) {
3002e7931f94SStefano Zampini       if ((PetscInt)new_local_type_private != *ptr_idxs) {
3003e7931f94SStefano Zampini         new_local_type_private = MATAIJ_PRIVATE;
3004e7931f94SStefano Zampini         break;
3005e7931f94SStefano Zampini       }
3006e7931f94SStefano Zampini       ptr_idxs += olengths_idxs[i];
3007e7931f94SStefano Zampini     }
3008e7931f94SStefano Zampini     switch (new_local_type_private) {
3009e7931f94SStefano Zampini       case MATDENSE_PRIVATE: /* subassembling of dense matrices does not give a dense matrix! */
3010e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
3011e7931f94SStefano Zampini         bs = 1;
3012e7931f94SStefano Zampini         break;
3013e7931f94SStefano Zampini       case MATAIJ_PRIVATE:
3014e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
3015e7931f94SStefano Zampini         bs = 1;
3016e7931f94SStefano Zampini         break;
3017e7931f94SStefano Zampini       case MATBAIJ_PRIVATE:
3018e7931f94SStefano Zampini         new_local_type = MATSEQBAIJ;
3019e7931f94SStefano Zampini         break;
3020e7931f94SStefano Zampini       case MATSBAIJ_PRIVATE:
3021e7931f94SStefano Zampini         new_local_type = MATSEQSBAIJ;
3022e7931f94SStefano Zampini         break;
3023e7931f94SStefano Zampini       default:
3024e7931f94SStefano Zampini         SETERRQ2(comm,PETSC_ERR_LIB,"Unkwown private type %d in %s",new_local_type_private,__FUNCT__);
3025e7931f94SStefano Zampini         break;
3026e7931f94SStefano Zampini     }
3027e7931f94SStefano Zampini   }
3028e7931f94SStefano Zampini 
3029e7931f94SStefano Zampini   /* create MATIS object */
3030e7931f94SStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
3031e7931f94SStefano Zampini   ierr = MatCreateIS(comm,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,&new_mat);CHKERRQ(ierr);
3032e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
3033e7931f94SStefano Zampini   ierr = MatISGetLocalMat(new_mat,&local_mat);CHKERRQ(ierr);
3034e7931f94SStefano Zampini   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
3035e7931f94SStefano Zampini   ierr = MatSetUp(local_mat);CHKERRQ(ierr); /* WARNING -> no preallocation yet */
3036e7931f94SStefano Zampini 
3037e7931f94SStefano Zampini   /* set values */
3038e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3039e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
3040e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
3041e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3042e7931f94SStefano Zampini     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
3043e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
3044e7931f94SStefano Zampini       ierr = MatSetValues(new_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
3045e7931f94SStefano Zampini       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3046e7931f94SStefano Zampini       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3047e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
3048e7931f94SStefano Zampini     }
3049e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3050e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
3051e7931f94SStefano Zampini   }
3052e7931f94SStefano Zampini   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3053e7931f94SStefano Zampini   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3054e7931f94SStefano Zampini   ierr = MatAssemblyBegin(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3055e7931f94SStefano Zampini   ierr = MatAssemblyEnd(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3056e7931f94SStefano Zampini 
3057e7931f94SStefano Zampini   { /* check */
3058e7931f94SStefano Zampini     Vec       lvec,rvec;
3059e7931f94SStefano Zampini     PetscReal infty_error;
3060e7931f94SStefano Zampini 
3061e7931f94SStefano Zampini     ierr = MatGetVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
3062e7931f94SStefano Zampini     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
3063e7931f94SStefano Zampini     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
3064e7931f94SStefano Zampini     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
3065e7931f94SStefano Zampini     ierr = MatMultAdd(new_mat,rvec,lvec,lvec);CHKERRQ(ierr);
3066e7931f94SStefano Zampini     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3067e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
3068e7931f94SStefano Zampini     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
3069e7931f94SStefano Zampini     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
3070e7931f94SStefano Zampini   }
3071e7931f94SStefano Zampini 
3072e7931f94SStefano Zampini   /* free workspace */
3073e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
3074e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
3075e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3076e7931f94SStefano Zampini   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
3077e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3078e7931f94SStefano Zampini   if (isdense) {
3079e7931f94SStefano Zampini     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
3080e7931f94SStefano Zampini     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
3081e7931f94SStefano Zampini   } else {
3082e7931f94SStefano Zampini     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
3083e7931f94SStefano Zampini   }
3084e7931f94SStefano Zampini   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
3085e7931f94SStefano Zampini   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
3086e7931f94SStefano Zampini   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
3087e7931f94SStefano Zampini   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
3088e7931f94SStefano Zampini   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
3089e7931f94SStefano Zampini   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
3090e7931f94SStefano Zampini   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
3091e7931f94SStefano Zampini   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
3092e7931f94SStefano Zampini   ierr = PetscFree(onodes);CHKERRQ(ierr);
3093e7931f94SStefano Zampini   /* get back new mat */
3094e7931f94SStefano Zampini   *mat_n = new_mat;
3095e7931f94SStefano Zampini   PetscFunctionReturn(0);
3096e7931f94SStefano Zampini }
3097a57a6d2fSStefano Zampini 
3098c8587f34SStefano Zampini #undef __FUNCT__
3099c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
3100c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
3101c8587f34SStefano Zampini {
3102c8587f34SStefano Zampini   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
3103c8587f34SStefano Zampini   PC_IS                  *pcis = (PC_IS*)pc->data;
310420a2ab83SStefano Zampini   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
31059881197aSStefano Zampini   MatNullSpace           CoarseNullSpace=NULL;
310620a2ab83SStefano Zampini   ISLocalToGlobalMapping coarse_islg;
310720a2ab83SStefano Zampini   IS                     coarse_is;
3108f4ddd8eeSStefano Zampini   PetscInt               max_it;
3109f9eb5b7dSStefano Zampini   PetscInt               im_active=-1,active_procs=-1;
3110f9eb5b7dSStefano Zampini   PC                     pc_temp;
3111c8587f34SStefano Zampini   PCType                 coarse_pc_type;
3112c8587f34SStefano Zampini   KSPType                coarse_ksp_type;
3113f9eb5b7dSStefano Zampini   PetscBool              multilevel_requested,multilevel_allowed;
3114fa7f1dd8SStefano Zampini   PetscBool              setsym,issym,isbddc,isnn,coarse_reuse;
31159881197aSStefano Zampini   PetscErrorCode         ierr;
3116fdc09c96SStefano Zampini 
3117c8587f34SStefano Zampini   PetscFunctionBegin;
3118c8587f34SStefano Zampini   /* Assign global numbering to coarse dofs */
3119fa7f1dd8SStefano Zampini   if (pcbddc->new_primal_space) { /* a new primal space is present, so recompute global numbering */
3120fa7f1dd8SStefano Zampini     PetscInt ocoarse_size;
3121fa7f1dd8SStefano Zampini     ocoarse_size = pcbddc->coarse_size;
3122f4ddd8eeSStefano Zampini     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3123f4ddd8eeSStefano Zampini     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
3124f4ddd8eeSStefano Zampini     /* see if we can avoid some work */
3125fa7f1dd8SStefano Zampini     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
3126fa7f1dd8SStefano Zampini       if (ocoarse_size != pcbddc->coarse_size) { /* ...but with different size, so reset it and set reuse flag to false */
3127727cdba6SStefano Zampini         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3128fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_FALSE;
3129fa7f1dd8SStefano Zampini       } else { /* we can safely reuse already computed coarse matrix */
3130fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_TRUE;
3131f4ddd8eeSStefano Zampini       }
3132fa7f1dd8SStefano Zampini     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
3133fa7f1dd8SStefano Zampini       coarse_reuse = PETSC_FALSE;
3134f4ddd8eeSStefano Zampini     }
3135fa7f1dd8SStefano Zampini   } else { /* primal space has not been changed, so we can reuse coarse matrix */
3136fa7f1dd8SStefano Zampini     coarse_reuse = PETSC_TRUE;
3137f4ddd8eeSStefano Zampini   }
3138c8587f34SStefano Zampini 
3139f9eb5b7dSStefano Zampini   /* infer some info from user */
3140f9eb5b7dSStefano Zampini   issym = PETSC_FALSE;
3141f9eb5b7dSStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
3142f9eb5b7dSStefano Zampini   multilevel_allowed = PETSC_FALSE;
3143f9eb5b7dSStefano Zampini   multilevel_requested = PETSC_FALSE;
3144f9eb5b7dSStefano Zampini   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
3145f9eb5b7dSStefano Zampini   if (multilevel_requested) {
31462b510759SStefano Zampini     /* count "active processes" */
31472b510759SStefano Zampini     im_active = !!(pcis->n);
31482b510759SStefano Zampini     ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
31492b510759SStefano Zampini     if (active_procs/pcbddc->coarsening_ratio < 2) {
3150f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_FALSE;
31512b510759SStefano Zampini     } else {
3152f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_TRUE;
3153c8587f34SStefano Zampini     }
3154c8587f34SStefano Zampini   }
3155e7931f94SStefano Zampini 
3156f9eb5b7dSStefano Zampini   /* set defaults for coarse KSP and PC */
3157f9eb5b7dSStefano Zampini   if (multilevel_allowed) {
3158c8587f34SStefano Zampini     if (issym) {
3159f9eb5b7dSStefano Zampini       coarse_ksp_type = KSPRICHARDSON;
3160f9eb5b7dSStefano Zampini     } else {
3161f9eb5b7dSStefano Zampini       coarse_ksp_type = KSPCHEBYSHEV;
3162c8587f34SStefano Zampini     }
3163f9eb5b7dSStefano Zampini     coarse_pc_type = PCBDDC;
3164f9eb5b7dSStefano Zampini   } else {
3165f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPPREONLY;
3166f9eb5b7dSStefano Zampini     coarse_pc_type = PCREDUNDANT;
3167c8587f34SStefano Zampini   }
3168c8587f34SStefano Zampini 
3169f9eb5b7dSStefano Zampini   /* create the coarse KSP object only once with defaults */
3170f9eb5b7dSStefano Zampini   if (!pcbddc->coarse_ksp) {
3171e604994aSStefano Zampini     char prefix[256],str_level[3];
3172e604994aSStefano Zampini     size_t len;
3173f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_ksp);CHKERRQ(ierr);
3174c8587f34SStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
3175f9eb5b7dSStefano Zampini     ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
3176c8587f34SStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
3177c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3178c8587f34SStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
3179e604994aSStefano Zampini     /* prefix */
3180e604994aSStefano Zampini     ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
3181e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
3182e604994aSStefano Zampini     if (!pcbddc->current_level) {
3183e604994aSStefano Zampini       ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
3184e604994aSStefano Zampini       ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
3185c8587f34SStefano Zampini     } else {
3186e604994aSStefano Zampini       ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
3187e604994aSStefano Zampini       if (pcbddc->current_level>1) len -= 2;
3188e604994aSStefano Zampini       ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
3189e604994aSStefano Zampini       *(prefix+len)='\0';
3190e604994aSStefano Zampini       sprintf(str_level,"%d_",(int)(pcbddc->current_level));
3191e604994aSStefano Zampini       ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
3192e604994aSStefano Zampini     }
3193e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
3194f9eb5b7dSStefano Zampini   }
3195f9eb5b7dSStefano Zampini   /* allow user customization */
319685c4d303SStefano Zampini   /* ierr = PetscPrintf(PETSC_COMM_WORLD,"Type of %s before setting from options %s\n",((PetscObject)pcbddc->coarse_ksp)->prefix,((PetscObject)pcbddc->coarse_ksp)->type_name);CHKERRQ(ierr); */
3197f9eb5b7dSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
319885c4d303SStefano Zampini   /* ierr = PetscPrintf(PETSC_COMM_WORLD,"Type of %s after setting from options %s\n",((PetscObject)pcbddc->coarse_ksp)->prefix,((PetscObject)pcbddc->coarse_ksp)->type_name);CHKERRQ(ierr); */
3199f9eb5b7dSStefano Zampini 
3200f9eb5b7dSStefano Zampini   /* get some info after set from options */
3201f9eb5b7dSStefano Zampini   ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3202f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
3203f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
3204f9eb5b7dSStefano Zampini   if (isbddc && !multilevel_allowed) { /* prevent from infinite loop if user as requested bddc pc for coarse solver */
3205f9eb5b7dSStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
3206f9eb5b7dSStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
3207f9eb5b7dSStefano Zampini     isbddc = PETSC_FALSE;
3208f9eb5b7dSStefano Zampini   }
3209f9eb5b7dSStefano Zampini 
3210f9eb5b7dSStefano Zampini   /* propagate BDDC info to the next level */
3211f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
3212f9eb5b7dSStefano Zampini   ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
3213f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
3214f9eb5b7dSStefano Zampini 
3215f9eb5b7dSStefano Zampini   /* creates temporary MATIS object for coarse matrix */
3216f4ddd8eeSStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
3217a57a6d2fSStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
3218a57a6d2fSStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
3219f4ddd8eeSStefano Zampini   ierr = MatCreateIS(PetscObjectComm((PetscObject)pc),1,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size,coarse_islg,&coarse_mat_is);CHKERRQ(ierr);
3220a57a6d2fSStefano Zampini   ierr = MatISSetLocalMat(coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
3221e7931f94SStefano Zampini   ierr = MatAssemblyBegin(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3222e7931f94SStefano Zampini   ierr = MatAssemblyEnd(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
322320a2ab83SStefano Zampini   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
322420a2ab83SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
3225fdc09c96SStefano Zampini 
3226f9eb5b7dSStefano Zampini   /* assemble coarse matrix */
3227f9eb5b7dSStefano Zampini   if (isbddc || isnn) {
3228f9eb5b7dSStefano Zampini     ierr = MatISSubassemble(coarse_mat_is,NULL,pcbddc->coarsening_ratio,&coarse_mat);CHKERRQ(ierr);
3229f9eb5b7dSStefano Zampini   } else {
3230fa7f1dd8SStefano Zampini     if (coarse_reuse) {
3231fa7f1dd8SStefano Zampini       ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL,NULL);CHKERRQ(ierr);
3232fa7f1dd8SStefano Zampini       ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
3233fa7f1dd8SStefano Zampini       ierr = MatISGetMPIXAIJ(coarse_mat_is,MATMPIAIJ,MAT_REUSE_MATRIX,&coarse_mat);CHKERRQ(ierr);
3234fa7f1dd8SStefano Zampini     } else {
3235fa7f1dd8SStefano Zampini       ierr = MatISGetMPIXAIJ(coarse_mat_is,MATMPIAIJ,MAT_INITIAL_MATRIX,&coarse_mat);CHKERRQ(ierr);
3236fa7f1dd8SStefano Zampini     }
3237c8587f34SStefano Zampini   }
32382b510759SStefano Zampini   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
32399881197aSStefano Zampini 
3240f9eb5b7dSStefano Zampini   /* create local to global scatters for coarse problem */
3241f4ddd8eeSStefano Zampini   if (pcbddc->new_primal_space) {
3242f4ddd8eeSStefano Zampini     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3243f4ddd8eeSStefano Zampini     ierr = VecDestroy(&pcbddc->coarse_rhs);CHKERRQ(ierr);
3244f4ddd8eeSStefano Zampini     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3245f9eb5b7dSStefano Zampini     ierr = MatGetVecs(coarse_mat,&pcbddc->coarse_vec,&pcbddc->coarse_rhs);CHKERRQ(ierr);
3246f9eb5b7dSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3247f4ddd8eeSStefano Zampini   }
3248f9eb5b7dSStefano Zampini   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
3249f9eb5b7dSStefano Zampini 
3250f9eb5b7dSStefano Zampini   /* propagate symmetry info to coarse matrix */
3251f9eb5b7dSStefano Zampini   ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,issym);CHKERRQ(ierr);
3252f9eb5b7dSStefano Zampini 
3253b8ffe317SStefano Zampini   /* Compute coarse null space (special handling by BDDC only) */
3254b8ffe317SStefano Zampini   if (pcbddc->NullSpace) {
3255b8ffe317SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCoarse(pc,coarse_mat,&CoarseNullSpace);CHKERRQ(ierr);
3256b8ffe317SStefano Zampini     if (isbddc) {
3257b8ffe317SStefano Zampini       ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
3258b8ffe317SStefano Zampini     } else {
3259c8587f34SStefano Zampini       ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
3260c8587f34SStefano Zampini     }
3261c8587f34SStefano Zampini   }
3262c8587f34SStefano Zampini 
3263f9eb5b7dSStefano Zampini   /* set operators */
3264*d1e9a80fSBarry Smith   ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
3265f9eb5b7dSStefano Zampini 
3266f9eb5b7dSStefano Zampini   /* additional KSP customization */
3267f9eb5b7dSStefano Zampini   ierr = KSPGetTolerances(pcbddc->coarse_ksp,NULL,NULL,NULL,&max_it);CHKERRQ(ierr);
3268f9eb5b7dSStefano Zampini   if (max_it < 5) {
3269c8587f34SStefano Zampini     ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
3270f9eb5b7dSStefano Zampini   }
3271b8ffe317SStefano Zampini   /* ierr = KSPChebyshevSetEstimateEigenvalues(pcbddc->coarse_ksp,1.0,0.0,0.0,1.1);CHKERRQ(ierr); */
3272f9eb5b7dSStefano Zampini 
3273f9eb5b7dSStefano Zampini 
3274f9eb5b7dSStefano Zampini   /* print some info if requested */
3275f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
3276f9eb5b7dSStefano Zampini     ierr = KSPGetType(pcbddc->coarse_ksp,&coarse_ksp_type);CHKERRQ(ierr);
3277f9eb5b7dSStefano Zampini     ierr = PCGetType(pc_temp,&coarse_pc_type);CHKERRQ(ierr);
3278f9eb5b7dSStefano Zampini     if (!multilevel_allowed) {
3279f9eb5b7dSStefano Zampini       if (multilevel_requested) {
3280f9eb5b7dSStefano 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);
3281f9eb5b7dSStefano Zampini       } else if (pcbddc->max_levels) {
3282f9eb5b7dSStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
3283c8587f34SStefano Zampini       }
3284c8587f34SStefano Zampini     }
3285e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Calling %s/%s setup at level %d for coarse solver (%s)\n",coarse_ksp_type,coarse_pc_type,pcbddc->current_level,((PetscObject)pcbddc->coarse_ksp)->prefix);CHKERRQ(ierr);
3286f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3287c8587f34SStefano Zampini   }
3288f9eb5b7dSStefano Zampini 
3289f9eb5b7dSStefano Zampini   /* setup coarse ksp */
3290f9eb5b7dSStefano Zampini   ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
3291f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
3292f9eb5b7dSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
3293f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3294f9eb5b7dSStefano Zampini     ierr = KSPView(pcbddc->coarse_ksp,pcbddc->dbg_viewer);CHKERRQ(ierr);
3295f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3296f9eb5b7dSStefano Zampini   }
3297f9eb5b7dSStefano Zampini 
3298c8587f34SStefano Zampini   /* Check coarse problem if requested */
329920a2ab83SStefano Zampini   if (pcbddc->dbg_flag) {
3300c8587f34SStefano Zampini     KSP       check_ksp;
33012b510759SStefano Zampini     KSPType   check_ksp_type;
3302c8587f34SStefano Zampini     PC        check_pc;
3303c8587f34SStefano Zampini     Vec       check_vec;
3304c8587f34SStefano Zampini     PetscReal abs_infty_error,infty_error,lambda_min,lambda_max;
33052b510759SStefano Zampini     PetscInt  its;
3306f9eb5b7dSStefano Zampini     PetscBool ispreonly,compute;
3307c8587f34SStefano Zampini 
33082b510759SStefano Zampini     /* Create ksp object suitable for estimation of extreme eigenvalues */
3309f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&check_ksp);CHKERRQ(ierr);
331023ee1639SBarry Smith     ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
3311f4ddd8eeSStefano Zampini     ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
33122b510759SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
33132b510759SStefano Zampini     if (ispreonly) {
33142b510759SStefano Zampini       check_ksp_type = KSPPREONLY;
3315f9eb5b7dSStefano Zampini       compute = PETSC_FALSE;
33162b510759SStefano Zampini     } else {
3317c8587f34SStefano Zampini       if (issym) check_ksp_type = KSPCG;
3318c8587f34SStefano Zampini       else check_ksp_type = KSPGMRES;
3319f9eb5b7dSStefano Zampini       compute = PETSC_TRUE;
3320c8587f34SStefano Zampini     }
3321c8587f34SStefano Zampini     ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
3322f9eb5b7dSStefano Zampini     ierr = KSPSetComputeSingularValues(check_ksp,compute);CHKERRQ(ierr);
3323c8587f34SStefano Zampini     ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
3324c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
3325c8587f34SStefano Zampini     ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
3326c8587f34SStefano Zampini     /* create random vec */
3327c8587f34SStefano Zampini     ierr = VecDuplicate(pcbddc->coarse_vec,&check_vec);CHKERRQ(ierr);
3328c8587f34SStefano Zampini     ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
3329c8587f34SStefano Zampini     if (CoarseNullSpace) {
3330c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec);CHKERRQ(ierr);
3331c8587f34SStefano Zampini     }
3332fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3333c8587f34SStefano Zampini     /* solve coarse problem */
3334c8587f34SStefano Zampini     ierr = KSPSolve(check_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
3335c8587f34SStefano Zampini     if (CoarseNullSpace) {
3336c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,pcbddc->coarse_vec);CHKERRQ(ierr);
3337c8587f34SStefano Zampini     }
3338c8587f34SStefano Zampini     /* check coarse problem residual error */
3339c8587f34SStefano Zampini     ierr = VecAXPY(check_vec,-1.0,pcbddc->coarse_vec);CHKERRQ(ierr);
3340c8587f34SStefano Zampini     ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3341fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3342c8587f34SStefano Zampini     ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
3343c8587f34SStefano Zampini     ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
3344e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem (%s) details\n",((PetscObject)(pcbddc->coarse_ksp))->prefix);CHKERRQ(ierr);
3345e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
3346e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
3347f9eb5b7dSStefano Zampini     /* get eigenvalue estimation if preonly has not been requested */
33482b510759SStefano Zampini     if (!ispreonly) {
3349c8587f34SStefano Zampini       ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
335020a2ab83SStefano Zampini       ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
3351f9eb5b7dSStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem eigenvalues (estimated with %d iterations of %s): %1.6e %1.6e\n",its,check_ksp_type,lambda_min,lambda_max);CHKERRQ(ierr);
3352c8587f34SStefano Zampini     }
33532b510759SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3354c8587f34SStefano Zampini     ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
3355c8587f34SStefano Zampini   }
33562b510759SStefano Zampini   /* free memory */
3357c8587f34SStefano Zampini   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
3358fdc635d7SStefano Zampini   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
3359c8587f34SStefano Zampini   PetscFunctionReturn(0);
3360c8587f34SStefano Zampini }
3361674ae819SStefano Zampini 
3362f34684f1SStefano Zampini #undef __FUNCT__
3363f34684f1SStefano Zampini #define __FUNCT__ "PCBDDCComputePrimalNumbering"
3364f34684f1SStefano Zampini PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
3365f34684f1SStefano Zampini {
3366f34684f1SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3367f34684f1SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
3368f34684f1SStefano Zampini   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
3369727cdba6SStefano Zampini   PetscInt       i,coarse_size;
3370727cdba6SStefano Zampini   PetscInt       *local_primal_indices;
3371f34684f1SStefano Zampini   PetscErrorCode ierr;
3372f34684f1SStefano Zampini 
3373f34684f1SStefano Zampini   PetscFunctionBegin;
3374f34684f1SStefano Zampini   /* Compute global number of coarse dofs */
3375727cdba6SStefano Zampini   if (!pcbddc->primal_indices_local_idxs) {
3376727cdba6SStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Constraint matrix has not been created");
3377727cdba6SStefano Zampini   }
3378727cdba6SStefano 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);
3379f34684f1SStefano Zampini 
3380f34684f1SStefano Zampini   /* check numbering */
3381f34684f1SStefano Zampini   if (pcbddc->dbg_flag) {
3382f34684f1SStefano Zampini     PetscScalar coarsesum,*array;
3383f34684f1SStefano Zampini 
3384f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3385f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3386f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
33870fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
3388f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
3389f34684f1SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
3390727cdba6SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
3391f34684f1SStefano Zampini     }
3392f34684f1SStefano Zampini     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
3393f34684f1SStefano Zampini     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
3394f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3395f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3396f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3397f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3398f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3399f34684f1SStefano Zampini     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3400f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3401f34684f1SStefano Zampini       if (array[i] == 1.0) {
3402f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %d owned by a single process!\n",PetscGlobalRank,i);CHKERRQ(ierr);
3403f34684f1SStefano Zampini       }
3404f34684f1SStefano Zampini     }
3405f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3406f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3407f34684f1SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
3408f34684f1SStefano Zampini     }
3409f34684f1SStefano Zampini     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3410f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3411f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3412f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3413f34684f1SStefano Zampini     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
3414f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
3415f34684f1SStefano Zampini     if (pcbddc->dbg_flag > 1) {
3416f34684f1SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
3417f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3418f34684f1SStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
3419f34684f1SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
3420727cdba6SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_primal_indices[%d]=%d (%d)\n",i,local_primal_indices[i],pcbddc->primal_indices_local_idxs[i]);
3421f34684f1SStefano Zampini       }
3422f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3423f34684f1SStefano Zampini     }
3424f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3425f34684f1SStefano Zampini   }
3426f34684f1SStefano Zampini   /* get back data */
3427f34684f1SStefano Zampini   *coarse_size_n = coarse_size;
3428f34684f1SStefano Zampini   *local_primal_indices_n = local_primal_indices;
3429674ae819SStefano Zampini   PetscFunctionReturn(0);
3430674ae819SStefano Zampini }
3431674ae819SStefano Zampini 
3432