xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision cbcc2c2a850c9751bb80dc1761d481e4e30ed56a)
1674ae819SStefano Zampini #include "bddc.h"
2674ae819SStefano Zampini #include "bddcprivate.h"
3674ae819SStefano Zampini #include <petscblaslapack.h>
4674ae819SStefano Zampini 
5674ae819SStefano Zampini #undef __FUNCT__
6c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpSolvers"
7c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpSolvers(PC pc)
8c8587f34SStefano Zampini {
9c8587f34SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
108629588bSStefano Zampini   PetscScalar    *coarse_submat_vals;
11c8587f34SStefano Zampini   PetscErrorCode ierr;
12c8587f34SStefano Zampini 
13c8587f34SStefano Zampini   PetscFunctionBegin;
14c8587f34SStefano Zampini   /* Compute matrix after change of basis and extract local submatrices */
15c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalMatrices(pc);CHKERRQ(ierr);
16c8587f34SStefano Zampini 
17f4ddd8eeSStefano Zampini   /* Setup local scatters R_to_B and (optionally) R_to_D */
18f4ddd8eeSStefano Zampini   /* PCBDDCSetUpLocalWorkVectors and PCBDDCSetUpLocalMatrices should be called first! */
19c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
20c8587f34SStefano Zampini 
21c8587f34SStefano Zampini   /* Setup local solvers ksp_D and ksp_R */
220fccc4e9SStefano Zampini   /* PCBDDCSetUpLocalScatters should be called first! */
23c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalSolvers(pc);CHKERRQ(ierr);
24c8587f34SStefano Zampini 
25c8587f34SStefano Zampini   /* Change global null space passed in by the user if change of basis has been requested */
26c8587f34SStefano Zampini   if (pcbddc->NullSpace && pcbddc->use_change_of_basis) {
27c8587f34SStefano Zampini     ierr = PCBDDCNullSpaceAdaptGlobal(pc);CHKERRQ(ierr);
28c8587f34SStefano Zampini   }
29c8587f34SStefano Zampini 
308629588bSStefano Zampini   /*
318629588bSStefano Zampini      Setup local correction and local part of coarse basis.
328629588bSStefano Zampini      Gives back the dense local part of the coarse matrix in column major ordering
338629588bSStefano Zampini   */
3447f4ddc3SStefano Zampini   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
358629588bSStefano Zampini 
368629588bSStefano Zampini   /* Compute total number of coarse nodes and setup coarse solver */
378629588bSStefano Zampini   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
388629588bSStefano Zampini 
398629588bSStefano Zampini   /* free */
408629588bSStefano Zampini   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
41c8587f34SStefano Zampini   PetscFunctionReturn(0);
42c8587f34SStefano Zampini }
43c8587f34SStefano Zampini 
44c8587f34SStefano Zampini #undef __FUNCT__
45674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetCustomization"
46674ae819SStefano Zampini PetscErrorCode PCBDDCResetCustomization(PC pc)
47674ae819SStefano Zampini {
48674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
49674ae819SStefano Zampini   PetscErrorCode ierr;
50674ae819SStefano Zampini 
51674ae819SStefano Zampini   PetscFunctionBegin;
52674ae819SStefano Zampini   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
53674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
54674ae819SStefano Zampini   ierr = MatNullSpaceDestroy(&pcbddc->NullSpace);CHKERRQ(ierr);
55674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
56785d1243SStefano Zampini   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
57674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
58f4ddd8eeSStefano Zampini   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
59f4ddd8eeSStefano Zampini   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
60785d1243SStefano Zampini   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
6163602bcaSStefano Zampini   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
6263602bcaSStefano Zampini   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
63674ae819SStefano Zampini   PetscFunctionReturn(0);
64674ae819SStefano Zampini }
65674ae819SStefano Zampini 
66674ae819SStefano Zampini #undef __FUNCT__
67674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetTopography"
68674ae819SStefano Zampini PetscErrorCode PCBDDCResetTopography(PC pc)
69674ae819SStefano Zampini {
70674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
71674ae819SStefano Zampini   PetscErrorCode ierr;
72674ae819SStefano Zampini 
73674ae819SStefano Zampini   PetscFunctionBegin;
74674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
75674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
76674ae819SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
77674ae819SStefano Zampini   PetscFunctionReturn(0);
78674ae819SStefano Zampini }
79674ae819SStefano Zampini 
80674ae819SStefano Zampini #undef __FUNCT__
81674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetSolvers"
82674ae819SStefano Zampini PetscErrorCode PCBDDCResetSolvers(PC pc)
83674ae819SStefano Zampini {
84674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
85674ae819SStefano Zampini   PetscErrorCode ierr;
86674ae819SStefano Zampini 
87674ae819SStefano Zampini   PetscFunctionBegin;
88674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
89674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_rhs);CHKERRQ(ierr);
90674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
91674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
9215aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
9315aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
94674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
95674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
96674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
97674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
98674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
99674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
1008ce42a96SStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
101674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
102674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
103674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
104f4ddd8eeSStefano Zampini   ierr = KSPDestroy(&pcbddc->ksp_D);CHKERRQ(ierr);
105f4ddd8eeSStefano Zampini   ierr = KSPDestroy(&pcbddc->ksp_R);CHKERRQ(ierr);
106f4ddd8eeSStefano Zampini   ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
107f4ddd8eeSStefano Zampini   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
108727cdba6SStefano Zampini   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
109f4ddd8eeSStefano Zampini   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
110674ae819SStefano Zampini   PetscFunctionReturn(0);
111674ae819SStefano Zampini }
112674ae819SStefano Zampini 
113674ae819SStefano Zampini #undef __FUNCT__
114f4ddd8eeSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalWorkVectors"
115f4ddd8eeSStefano Zampini PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
1166bfb1811SStefano Zampini {
1176bfb1811SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1186bfb1811SStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
1196bfb1811SStefano Zampini   VecType        impVecType;
120e9189074SStefano Zampini   PetscInt       n_constraints,n_R,old_size;
1216bfb1811SStefano Zampini   PetscErrorCode ierr;
1226bfb1811SStefano Zampini 
1236bfb1811SStefano Zampini   PetscFunctionBegin;
124f4ddd8eeSStefano Zampini   if (!pcbddc->ConstraintMatrix) {
125f4ddd8eeSStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Constraint matrix has not been created");
126f4ddd8eeSStefano Zampini   }
127e7b262bdSStefano Zampini   /* get sizes */
128e9189074SStefano Zampini   n_constraints = pcbddc->local_primal_size - pcbddc->n_actual_vertices;
129e9189074SStefano Zampini   n_R = pcis->n-pcbddc->n_actual_vertices;
1306bfb1811SStefano Zampini   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
131e7b262bdSStefano Zampini   /* local work vectors (try to avoid unneeded work)*/
132e7b262bdSStefano Zampini   /* R nodes */
133e7b262bdSStefano Zampini   old_size = -1;
134e7b262bdSStefano Zampini   if (pcbddc->vec1_R) {
135e7b262bdSStefano Zampini     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
136e7b262bdSStefano Zampini   }
137e7b262bdSStefano Zampini   if (n_R != old_size) {
138e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
139e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
1406bfb1811SStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
1416bfb1811SStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
1426bfb1811SStefano Zampini     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
1436bfb1811SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
144e7b262bdSStefano Zampini   }
145e7b262bdSStefano Zampini   /* local primal dofs */
146e7b262bdSStefano Zampini   old_size = -1;
147e7b262bdSStefano Zampini   if (pcbddc->vec1_P) {
148e7b262bdSStefano Zampini     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
149e7b262bdSStefano Zampini   }
150e9189074SStefano Zampini   if (pcbddc->local_primal_size != old_size) {
151e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
15283b7ccabSStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
153e9189074SStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
1546bfb1811SStefano Zampini     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
155e7b262bdSStefano Zampini   }
156e7b262bdSStefano Zampini   /* local explicit constraints */
157e7b262bdSStefano Zampini   old_size = -1;
158e7b262bdSStefano Zampini   if (pcbddc->vec1_C) {
159e7b262bdSStefano Zampini     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
160e7b262bdSStefano Zampini   }
161e7b262bdSStefano Zampini   if (n_constraints && n_constraints != old_size) {
162e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
16383b7ccabSStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
16483b7ccabSStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
16583b7ccabSStefano Zampini     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
16683b7ccabSStefano Zampini   }
1676bfb1811SStefano Zampini   PetscFunctionReturn(0);
1686bfb1811SStefano Zampini }
1696bfb1811SStefano Zampini 
1706bfb1811SStefano Zampini #undef __FUNCT__
17147f4ddc3SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCorrection"
17247f4ddc3SStefano Zampini PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
17388ebb749SStefano Zampini {
17425084f0cSStefano Zampini   PetscErrorCode         ierr;
17525084f0cSStefano Zampini   /* pointers to pcis and pcbddc */
17688ebb749SStefano Zampini   PC_IS*                 pcis = (PC_IS*)pc->data;
17788ebb749SStefano Zampini   PC_BDDC*               pcbddc = (PC_BDDC*)pc->data;
17825084f0cSStefano Zampini   /* submatrices of local problem */
17988ebb749SStefano Zampini   Mat                    A_RV,A_VR,A_VV;
18025084f0cSStefano Zampini   /* working matrices */
18125084f0cSStefano Zampini   Mat                    M1,M2,M3,C_CR;
18225084f0cSStefano Zampini   /* working vectors */
18325084f0cSStefano Zampini   Vec                    vec1_C,vec2_C,vec1_V,vec2_V;
18425084f0cSStefano Zampini   /* additional working stuff */
18525084f0cSStefano Zampini   IS                     is_aux;
18625084f0cSStefano Zampini   PetscScalar            *coarse_submat_vals; /* TODO: use a PETSc matrix */
18725084f0cSStefano Zampini   const PetscScalar      *array,*row_cmat_values;
18825084f0cSStefano Zampini   const PetscInt         *row_cmat_indices,*idx_R_local;
189e9189074SStefano Zampini   PetscInt               *idx_V_B,*auxindices;
19025084f0cSStefano Zampini   PetscInt               n_vertices,n_constraints,size_of_constraint;
19125084f0cSStefano Zampini   PetscInt               i,j,n_R,n_D,n_B;
19288ebb749SStefano Zampini   PetscBool              setsym=PETSC_FALSE,issym=PETSC_FALSE;
19345a1bb75SStefano Zampini   /* matrix type (vector type propagated downstream from vec1_C and local matrix type) */
19488ebb749SStefano Zampini   MatType                impMatType;
19525084f0cSStefano Zampini   /* some shortcuts to scalars */
19625084f0cSStefano Zampini   PetscScalar            zero=0.0,one=1.0,m_one=-1.0;
19725084f0cSStefano Zampini   /* for debugging purposes */
19888ebb749SStefano Zampini   PetscReal              *coarsefunctions_errors,*constraints_errors;
19988ebb749SStefano Zampini 
20088ebb749SStefano Zampini   PetscFunctionBegin;
201e9189074SStefano Zampini   /* get number of vertices (corners plus constraints with change of basis)
202e9189074SStefano Zampini      pcbddc->n_actual_vertices stores the actual number of vertices, pcbddc->n_vertices the number of corners computed */
203e9189074SStefano Zampini   n_vertices = pcbddc->n_actual_vertices;
20488ebb749SStefano Zampini   n_constraints = pcbddc->local_primal_size-n_vertices;
20588ebb749SStefano Zampini   /* Set Non-overlapping dimensions */
20688ebb749SStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
20788ebb749SStefano Zampini   n_R = pcis->n-n_vertices;
20888ebb749SStefano Zampini 
20988ebb749SStefano Zampini   /* Set types for local objects needed by BDDC precondtioner */
21088ebb749SStefano Zampini   impMatType = MATSEQDENSE;
21188ebb749SStefano Zampini 
21288ebb749SStefano Zampini   /* Allocating some extra storage just to be safe */
21388ebb749SStefano Zampini   ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&auxindices);CHKERRQ(ierr);
21488ebb749SStefano Zampini   for (i=0;i<pcis->n;i++) auxindices[i]=i;
21588ebb749SStefano Zampini 
21688ebb749SStefano Zampini   /* vertices in boundary numbering */
21788ebb749SStefano Zampini   ierr = PetscMalloc(n_vertices*sizeof(PetscInt),&idx_V_B);CHKERRQ(ierr);
218e9189074SStefano Zampini   ierr = ISGlobalToLocalMappingApply(pcbddc->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->primal_indices_local_idxs,&i,idx_V_B);CHKERRQ(ierr);
21988ebb749SStefano Zampini   if (i != n_vertices) {
22088ebb749SStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %d != %d\n",n_vertices,i);
22188ebb749SStefano Zampini   }
22288ebb749SStefano Zampini 
22388ebb749SStefano Zampini   /* Precompute stuffs needed for preprocessing and application of BDDC*/
22488ebb749SStefano Zampini   if (n_constraints) {
225f4ddd8eeSStefano Zampini     /* see if we can save some allocations */
226f4ddd8eeSStefano Zampini     if (pcbddc->local_auxmat2) {
227f4ddd8eeSStefano Zampini       PetscInt on_R,on_constraints;
228f4ddd8eeSStefano Zampini       ierr = MatGetSize(pcbddc->local_auxmat2,&on_R,&on_constraints);CHKERRQ(ierr);
229f4ddd8eeSStefano Zampini       if (on_R != n_R || on_constraints != n_constraints) {
230f4ddd8eeSStefano Zampini         ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
231f4ddd8eeSStefano Zampini         ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
232f4ddd8eeSStefano Zampini       }
233f4ddd8eeSStefano Zampini     }
23445a1bb75SStefano Zampini     /* work vectors */
23545a1bb75SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec1_C);CHKERRQ(ierr);
23645a1bb75SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec2_C);CHKERRQ(ierr);
23745a1bb75SStefano Zampini     /* auxiliary matrices */
238f4ddd8eeSStefano Zampini     if (!pcbddc->local_auxmat2) {
23988ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->local_auxmat2);CHKERRQ(ierr);
24025084f0cSStefano Zampini       ierr = MatSetSizes(pcbddc->local_auxmat2,n_R,n_constraints,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
24188ebb749SStefano Zampini       ierr = MatSetType(pcbddc->local_auxmat2,impMatType);CHKERRQ(ierr);
24225084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->local_auxmat2);CHKERRQ(ierr);
243f4ddd8eeSStefano Zampini     }
24488ebb749SStefano Zampini 
24525084f0cSStefano Zampini     /* Extract constraints on R nodes: C_{CR}  */
24625084f0cSStefano Zampini     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
2478ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
24825084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
24988ebb749SStefano Zampini 
25088ebb749SStefano Zampini     /* Assemble local_auxmat2 = - A_{RR}^{-1} C^T_{CR} needed by BDDC application */
25188ebb749SStefano Zampini     for (i=0;i<n_constraints;i++) {
25288ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
25388ebb749SStefano Zampini       /* Get row of constraint matrix in R numbering */
25425084f0cSStefano Zampini       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
25525084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_R,size_of_constraint,row_cmat_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
25625084f0cSStefano Zampini       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
25725084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_R);CHKERRQ(ierr);
25825084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_R);CHKERRQ(ierr);
25988ebb749SStefano Zampini       /* Solve for row of constraint matrix in R numbering */
26088ebb749SStefano Zampini       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
26125084f0cSStefano Zampini       /* Set values in local_auxmat2 */
26225084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
26388ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->local_auxmat2,n_R,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
26425084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
26588ebb749SStefano Zampini     }
26688ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
26788ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
26825084f0cSStefano Zampini     ierr = MatScale(pcbddc->local_auxmat2,m_one);CHKERRQ(ierr);
26988ebb749SStefano Zampini 
27088ebb749SStefano Zampini     /* Assemble explicitly M1 = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1} needed in preproc  */
27125084f0cSStefano Zampini     ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
27225084f0cSStefano Zampini     ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
27388ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&M1);CHKERRQ(ierr);
27488ebb749SStefano Zampini     ierr = MatSetSizes(M1,n_constraints,n_constraints,n_constraints,n_constraints);CHKERRQ(ierr);
27588ebb749SStefano Zampini     ierr = MatSetType(M1,impMatType);CHKERRQ(ierr);
27625084f0cSStefano Zampini     ierr = MatSetUp(M1);CHKERRQ(ierr);
27725084f0cSStefano Zampini     ierr = MatDuplicate(M1,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
27825084f0cSStefano Zampini     ierr = MatZeroEntries(M2);CHKERRQ(ierr);
27925084f0cSStefano Zampini     ierr = VecSet(vec1_C,m_one);CHKERRQ(ierr);
28025084f0cSStefano Zampini     ierr = MatDiagonalSet(M2,vec1_C,INSERT_VALUES);CHKERRQ(ierr);
28125084f0cSStefano Zampini     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
28225084f0cSStefano Zampini     ierr = MatDestroy(&M2);CHKERRQ(ierr);
28325084f0cSStefano Zampini     ierr = MatDestroy(&M3);CHKERRQ(ierr);
28488ebb749SStefano Zampini     /* Assemble local_auxmat1 = M1*C_{CR} needed by BDDC application in KSP and in preproc */
285f4ddd8eeSStefano Zampini     if (!pcbddc->local_auxmat1) {
28688ebb749SStefano Zampini       ierr = MatMatMult(M1,C_CR,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
287f4ddd8eeSStefano Zampini     } else {
288f4ddd8eeSStefano Zampini       ierr = MatMatMult(M1,C_CR,MAT_REUSE_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
289f4ddd8eeSStefano Zampini     }
29088ebb749SStefano Zampini   }
29188ebb749SStefano Zampini 
29288ebb749SStefano Zampini   /* Get submatrices from subdomain matrix */
29388ebb749SStefano Zampini   if (n_vertices) {
2943a50541eSStefano Zampini     PetscInt ibs,mbs;
2953a50541eSStefano Zampini     PetscBool issbaij;
296af732b37SStefano Zampini     Mat newmat;
2973a50541eSStefano Zampini 
2983a50541eSStefano Zampini     ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
2999577ea80SStefano Zampini     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
3009577ea80SStefano Zampini     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
3013a50541eSStefano Zampini     if (ibs != mbs) { /* need to convert to SEQAIJ */
3029577ea80SStefano Zampini       ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
3039577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3049577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3059577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3069577ea80SStefano Zampini       ierr = MatDestroy(&newmat);CHKERRQ(ierr);
3079577ea80SStefano Zampini     } else {
3083a50541eSStefano Zampini       /* this is safe */
3099577ea80SStefano Zampini       ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3103a50541eSStefano Zampini       ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
3113a50541eSStefano Zampini       if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
3123a50541eSStefano Zampini         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
31345a1bb75SStefano Zampini         /* which of the two approaches is faster? */
3143a50541eSStefano Zampini         /* ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3153a50541eSStefano Zampini         ierr = MatCreateTranspose(A_RV,&A_VR);CHKERRQ(ierr);*/
3163a50541eSStefano Zampini         ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3173a50541eSStefano Zampini         ierr = MatCreateTranspose(A_VR,&A_RV);CHKERRQ(ierr);
3183a50541eSStefano Zampini         ierr = MatDestroy(&newmat);CHKERRQ(ierr);
3193a50541eSStefano Zampini       } else {
3209577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3219577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3229577ea80SStefano Zampini       }
3233a50541eSStefano Zampini     }
32445a1bb75SStefano Zampini     ierr = MatGetVecs(A_RV,&vec1_V,NULL);CHKERRQ(ierr);
32545a1bb75SStefano Zampini     ierr = VecDuplicate(vec1_V,&vec2_V);CHKERRQ(ierr);
32625084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
32788ebb749SStefano Zampini   }
32888ebb749SStefano Zampini 
32988ebb749SStefano Zampini   /* Matrix of coarse basis functions (local) */
330f4ddd8eeSStefano Zampini   if (pcbddc->coarse_phi_B) {
331f4ddd8eeSStefano Zampini     PetscInt on_B,on_primal;
332f4ddd8eeSStefano Zampini     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
333f4ddd8eeSStefano Zampini     if (on_B != n_B || on_primal != pcbddc->local_primal_size) {
334f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
335f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
336f4ddd8eeSStefano Zampini     }
337f4ddd8eeSStefano Zampini   }
338f4ddd8eeSStefano Zampini   if (pcbddc->coarse_phi_D) {
339f4ddd8eeSStefano Zampini     PetscInt on_D,on_primal;
340f4ddd8eeSStefano Zampini     ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,&on_primal);CHKERRQ(ierr);
341f4ddd8eeSStefano Zampini     if (on_D != n_D || on_primal != pcbddc->local_primal_size) {
342f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
343f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
344f4ddd8eeSStefano Zampini     }
345f4ddd8eeSStefano Zampini   }
346f4ddd8eeSStefano Zampini   if (!pcbddc->coarse_phi_B) {
34788ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
34888ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_phi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
34988ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_phi_B,impMatType);CHKERRQ(ierr);
35025084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_phi_B);CHKERRQ(ierr);
351f4ddd8eeSStefano Zampini   }
352f4ddd8eeSStefano Zampini   if ( (pcbddc->switch_static || pcbddc->dbg_flag) && !pcbddc->coarse_phi_D ) {
35388ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
35488ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_phi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
35588ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_phi_D,impMatType);CHKERRQ(ierr);
35625084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_phi_D);CHKERRQ(ierr);
35788ebb749SStefano Zampini   }
35888ebb749SStefano Zampini 
35925084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
3608ce42a96SStefano Zampini     ierr = ISGetIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
36188ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*coarsefunctions_errors),&coarsefunctions_errors);CHKERRQ(ierr);
36288ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*constraints_errors),&constraints_errors);CHKERRQ(ierr);
36388ebb749SStefano Zampini   }
36488ebb749SStefano Zampini   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
36588ebb749SStefano Zampini   ierr = PetscMalloc((pcbddc->local_primal_size)*(pcbddc->local_primal_size)*sizeof(PetscScalar),&coarse_submat_vals);CHKERRQ(ierr);
36688ebb749SStefano Zampini 
36788ebb749SStefano Zampini   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
36825084f0cSStefano Zampini 
36925084f0cSStefano Zampini   /* vertices */
37088ebb749SStefano Zampini   for (i=0;i<n_vertices;i++) {
37145a1bb75SStefano Zampini     /* this should not be needed, but MatMult_BAIJ is broken when using compressed row routines */
372f4ddd8eeSStefano Zampini     ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr); /* TODO: REMOVE IT */
37388ebb749SStefano Zampini     ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
37488ebb749SStefano Zampini     ierr = VecSetValue(vec1_V,i,one,INSERT_VALUES);CHKERRQ(ierr);
37588ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
37688ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
37725084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on constraints multipliers */
37888ebb749SStefano Zampini     ierr = MatMult(A_RV,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
37988ebb749SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
38088ebb749SStefano Zampini     ierr = VecScale(pcbddc->vec1_R,m_one);CHKERRQ(ierr);
38188ebb749SStefano Zampini     if (n_constraints) {
38288ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec1_R,vec1_C);CHKERRQ(ierr);
38388ebb749SStefano Zampini       ierr = MatMultAdd(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
38488ebb749SStefano Zampini       ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
38588ebb749SStefano Zampini     }
38688ebb749SStefano Zampini     ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
38788ebb749SStefano Zampini     ierr = MatMultAdd(A_VV,vec1_V,vec2_V,vec2_V);CHKERRQ(ierr);
38888ebb749SStefano Zampini 
38988ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
39088ebb749SStefano Zampini     /* coarse basis functions */
39188ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
39288ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
39388ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
39425084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
39588ebb749SStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
39625084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
39788ebb749SStefano Zampini     ierr = MatSetValue(pcbddc->coarse_phi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
3988eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
39988ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40088ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40125084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
40288ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
40325084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
40488ebb749SStefano Zampini     }
40525084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
40625084f0cSStefano Zampini     ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
40725084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
40825084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
40988ebb749SStefano Zampini     if (n_constraints) {
41025084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
41125084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
41225084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
41388ebb749SStefano Zampini     }
41488ebb749SStefano Zampini 
41525084f0cSStefano Zampini     /* check */
41625084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
41725084f0cSStefano Zampini       /* assemble subdomain vector on local nodes */
41888ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
41925084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
42025084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
42125084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
422e9189074SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],one,INSERT_VALUES);CHKERRQ(ierr);
42325084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
42425084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
42588ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers (i.e. primal nodes) */
42688ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
42725084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
42825084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
42925084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
43088ebb749SStefano Zampini       if (n_constraints) {
43125084f0cSStefano Zampini         ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
43225084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
43325084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
43488ebb749SStefano Zampini       }
43525084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
43625084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
43788ebb749SStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
43888ebb749SStefano Zampini       /* check saddle point solution */
43988ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
44088ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
44188ebb749SStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i]);CHKERRQ(ierr);
44288ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
44325084f0cSStefano Zampini       /* shift by the identity matrix */
44425084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
44525084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
44625084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
44788ebb749SStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i]);CHKERRQ(ierr);
44888ebb749SStefano Zampini     }
44988ebb749SStefano Zampini   }
45088ebb749SStefano Zampini 
45125084f0cSStefano Zampini   /* constraints */
45288ebb749SStefano Zampini   for (i=0;i<n_constraints;i++) {
45388ebb749SStefano Zampini     ierr = VecSet(vec2_C,zero);CHKERRQ(ierr);
45488ebb749SStefano Zampini     ierr = VecSetValue(vec2_C,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
45588ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec2_C);CHKERRQ(ierr);
45688ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec2_C);CHKERRQ(ierr);
45725084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on vertices multipliers */
45888ebb749SStefano Zampini     ierr = MatMult(M1,vec2_C,vec1_C);CHKERRQ(ierr);
45988ebb749SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
46088ebb749SStefano Zampini     ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
46125084f0cSStefano Zampini     if (n_vertices) {
46225084f0cSStefano Zampini       ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
46325084f0cSStefano Zampini     }
46488ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
46588ebb749SStefano Zampini     /* coarse basis functions */
46625084f0cSStefano Zampini     j = i+n_vertices; /* don't touch this! */
46788ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
46888ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
46988ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
47025084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
47125084f0cSStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
47225084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
4738eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
47488ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
47588ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
47625084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
47725084f0cSStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
47825084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
47988ebb749SStefano Zampini     }
48025084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
48188ebb749SStefano Zampini     if (n_vertices) {
48225084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
48325084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
48425084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
48588ebb749SStefano Zampini     }
48625084f0cSStefano Zampini     ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
48725084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
48825084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
48988ebb749SStefano Zampini 
49025084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
49188ebb749SStefano Zampini       /* assemble subdomain vector on nodes */
49288ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
49325084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
49425084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
49525084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
49625084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
49725084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
49888ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers */
49988ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
50088ebb749SStefano Zampini       if (n_vertices) {
50125084f0cSStefano Zampini         ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
50225084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
50325084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
50488ebb749SStefano Zampini       }
50525084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
50625084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
50725084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
50825084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
50925084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
51025084f0cSStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
51188ebb749SStefano Zampini       /* check saddle point solution */
51288ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
51388ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
51425084f0cSStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[j]);CHKERRQ(ierr);
51588ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
51625084f0cSStefano Zampini       /* shift by the identity matrix */
51725084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,j,m_one,ADD_VALUES);CHKERRQ(ierr);
51825084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
51925084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
52025084f0cSStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[j]);CHKERRQ(ierr);
52188ebb749SStefano Zampini     }
52288ebb749SStefano Zampini   }
52325084f0cSStefano Zampini   /* call assembling routines for local coarse basis */
52488ebb749SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
52588ebb749SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5268eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
52788ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
52888ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
52988ebb749SStefano Zampini   }
53025084f0cSStefano Zampini 
53188ebb749SStefano Zampini   /* compute other basis functions for non-symmetric problems */
53288ebb749SStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
53388ebb749SStefano Zampini   if (!setsym || (setsym && !issym)) {
534f4ddd8eeSStefano Zampini     if (!pcbddc->coarse_psi_B) {
53588ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
53688ebb749SStefano Zampini       ierr = MatSetSizes(pcbddc->coarse_psi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
53788ebb749SStefano Zampini       ierr = MatSetType(pcbddc->coarse_psi_B,impMatType);CHKERRQ(ierr);
53825084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->coarse_psi_B);CHKERRQ(ierr);
539f4ddd8eeSStefano Zampini     }
540f4ddd8eeSStefano Zampini     if ( (pcbddc->switch_static || pcbddc->dbg_flag) && !pcbddc->coarse_psi_D) {
54188ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
54288ebb749SStefano Zampini       ierr = MatSetSizes(pcbddc->coarse_psi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
54388ebb749SStefano Zampini       ierr = MatSetType(pcbddc->coarse_psi_D,impMatType);CHKERRQ(ierr);
54425084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->coarse_psi_D);CHKERRQ(ierr);
54588ebb749SStefano Zampini     }
54688ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
54788ebb749SStefano Zampini       if (n_constraints) {
54888ebb749SStefano Zampini         ierr = VecSet(vec1_C,zero);CHKERRQ(ierr);
54988ebb749SStefano Zampini         for (j=0;j<n_constraints;j++) {
55025084f0cSStefano Zampini           ierr = VecSetValue(vec1_C,j,coarse_submat_vals[(j+n_vertices)*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
55188ebb749SStefano Zampini         }
55225084f0cSStefano Zampini         ierr = VecAssemblyBegin(vec1_C);CHKERRQ(ierr);
55325084f0cSStefano Zampini         ierr = VecAssemblyEnd(vec1_C);CHKERRQ(ierr);
55488ebb749SStefano Zampini       }
55588ebb749SStefano Zampini       if (i<n_vertices) {
55688ebb749SStefano Zampini         ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
55788ebb749SStefano Zampini         ierr = VecSetValue(vec1_V,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
55888ebb749SStefano Zampini         ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
55988ebb749SStefano Zampini         ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
56088ebb749SStefano Zampini         ierr = MatMultTranspose(A_VR,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
56188ebb749SStefano Zampini         if (n_constraints) {
56288ebb749SStefano Zampini           ierr = MatMultTransposeAdd(C_CR,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
56388ebb749SStefano Zampini         }
56488ebb749SStefano Zampini       } else {
56588ebb749SStefano Zampini         ierr = MatMultTranspose(C_CR,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
56688ebb749SStefano Zampini       }
56788ebb749SStefano Zampini       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
56888ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
56988ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
57088ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
57125084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
57288ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_psi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
57325084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
57488ebb749SStefano Zampini       if (i<n_vertices) {
57588ebb749SStefano Zampini         ierr = MatSetValue(pcbddc->coarse_psi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
57688ebb749SStefano Zampini       }
5778eeda7d8SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
57888ebb749SStefano Zampini         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
57988ebb749SStefano Zampini         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
58025084f0cSStefano Zampini         ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
58188ebb749SStefano Zampini         ierr = MatSetValues(pcbddc->coarse_psi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
58225084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
58388ebb749SStefano Zampini       }
58488ebb749SStefano Zampini 
58525084f0cSStefano Zampini       if (pcbddc->dbg_flag) {
58688ebb749SStefano Zampini         /* assemble subdomain vector on nodes */
58788ebb749SStefano Zampini         ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
58825084f0cSStefano Zampini         ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
58925084f0cSStefano Zampini         ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
59025084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
59125084f0cSStefano Zampini         if (i<n_vertices) {
592e9189074SStefano Zampini           ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],one,INSERT_VALUES);CHKERRQ(ierr);
59388ebb749SStefano Zampini         }
59425084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
59525084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
59625084f0cSStefano Zampini         /* assemble subdomain vector of lagrange multipliers */
59725084f0cSStefano Zampini         for (j=0;j<pcbddc->local_primal_size;j++) {
59825084f0cSStefano Zampini           ierr = VecSetValue(pcbddc->vec1_P,j,-coarse_submat_vals[j*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
59925084f0cSStefano Zampini         }
60025084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
60125084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
60288ebb749SStefano Zampini         /* check saddle point solution */
60388ebb749SStefano Zampini         ierr = MatMultTranspose(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
60488ebb749SStefano Zampini         ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
60588ebb749SStefano Zampini         ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
60688ebb749SStefano Zampini         ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
60725084f0cSStefano Zampini         /* shift by the identity matrix */
60825084f0cSStefano Zampini         ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
60925084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
61025084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
61188ebb749SStefano Zampini         ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
61288ebb749SStefano Zampini       }
61388ebb749SStefano Zampini     }
61488ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
61588ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6168eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
61788ebb749SStefano Zampini       ierr = MatAssemblyBegin(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
61888ebb749SStefano Zampini       ierr = MatAssemblyEnd(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
61988ebb749SStefano Zampini     }
62088ebb749SStefano Zampini   }
62188ebb749SStefano Zampini   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
62288ebb749SStefano Zampini   /* Checking coarse_sub_mat and coarse basis functios */
62388ebb749SStefano Zampini   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
62488ebb749SStefano Zampini   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
62525084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
62688ebb749SStefano Zampini     Mat         coarse_sub_mat;
62725084f0cSStefano Zampini     Mat         AUXMAT,TM1,TM2,TM3,TM4;
62888ebb749SStefano Zampini     Mat         coarse_phi_D,coarse_phi_B;
62988ebb749SStefano Zampini     Mat         coarse_psi_D,coarse_psi_B;
63088ebb749SStefano Zampini     Mat         A_II,A_BB,A_IB,A_BI;
63188ebb749SStefano Zampini     MatType     checkmattype=MATSEQAIJ;
63288ebb749SStefano Zampini     PetscReal   real_value;
63388ebb749SStefano Zampini 
63488ebb749SStefano Zampini     ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
63588ebb749SStefano Zampini     ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
63688ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
63788ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
63888ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
63988ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
64088ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
64188ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
64288ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
64388ebb749SStefano Zampini     }
64488ebb749SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
64588ebb749SStefano Zampini 
64625084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
64725084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat and local basis functions\n");CHKERRQ(ierr);
64825084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
64988ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
65088ebb749SStefano Zampini       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
65188ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
65288ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
65388ebb749SStefano Zampini       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
65488ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
65588ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
65688ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
65788ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
65888ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
65988ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
66088ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
66188ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
66288ebb749SStefano Zampini     } else {
66388ebb749SStefano Zampini       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
66488ebb749SStefano Zampini       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
66588ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
66688ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
66788ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
66888ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
66988ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
67088ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
67188ebb749SStefano Zampini     }
67288ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
67388ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
67488ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
67588ebb749SStefano Zampini     ierr = MatConvert(TM1,MATSEQDENSE,MAT_REUSE_MATRIX,&TM1);CHKERRQ(ierr);
67688ebb749SStefano Zampini     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
67788ebb749SStefano Zampini     ierr = MatNorm(TM1,NORM_INFINITY,&real_value);CHKERRQ(ierr);
6780fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
67925084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"----------------------------------\n");CHKERRQ(ierr);
68025084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d \n",PetscGlobalRank);CHKERRQ(ierr);
68125084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"matrix error = % 1.14e\n",real_value);CHKERRQ(ierr);
68225084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (phi) errors\n");CHKERRQ(ierr);
68388ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
68425084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,coarsefunctions_errors[i]);CHKERRQ(ierr);
68588ebb749SStefano Zampini     }
68625084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (phi) errors\n");CHKERRQ(ierr);
68788ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
68825084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,constraints_errors[i]);CHKERRQ(ierr);
68988ebb749SStefano Zampini     }
69088ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
69125084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (psi) errors\n");CHKERRQ(ierr);
69288ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
69325084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,coarsefunctions_errors[i]);CHKERRQ(ierr);
69488ebb749SStefano Zampini       }
69525084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (psi) errors\n");CHKERRQ(ierr);
69688ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
69725084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,constraints_errors[i]);CHKERRQ(ierr);
69888ebb749SStefano Zampini       }
69988ebb749SStefano Zampini     }
70025084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
70188ebb749SStefano Zampini     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
70288ebb749SStefano Zampini     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
70388ebb749SStefano Zampini     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
70488ebb749SStefano Zampini     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
70588ebb749SStefano Zampini     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
70688ebb749SStefano Zampini     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
70788ebb749SStefano Zampini     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
70888ebb749SStefano Zampini     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
70988ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
71088ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
71188ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
71288ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
71388ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
71488ebb749SStefano Zampini     }
71588ebb749SStefano Zampini     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
7168ce42a96SStefano Zampini     ierr = ISRestoreIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
71788ebb749SStefano Zampini     ierr = PetscFree(coarsefunctions_errors);CHKERRQ(ierr);
71888ebb749SStefano Zampini     ierr = PetscFree(constraints_errors);CHKERRQ(ierr);
71988ebb749SStefano Zampini   }
72088ebb749SStefano Zampini   /* free memory */
72188ebb749SStefano Zampini   if (n_vertices) {
72288ebb749SStefano Zampini     ierr = VecDestroy(&vec1_V);CHKERRQ(ierr);
72388ebb749SStefano Zampini     ierr = VecDestroy(&vec2_V);CHKERRQ(ierr);
72488ebb749SStefano Zampini     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
72588ebb749SStefano Zampini     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
72688ebb749SStefano Zampini     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
72788ebb749SStefano Zampini   }
72888ebb749SStefano Zampini   if (n_constraints) {
72988ebb749SStefano Zampini     ierr = VecDestroy(&vec1_C);CHKERRQ(ierr);
73088ebb749SStefano Zampini     ierr = VecDestroy(&vec2_C);CHKERRQ(ierr);
73188ebb749SStefano Zampini     ierr = MatDestroy(&M1);CHKERRQ(ierr);
73288ebb749SStefano Zampini     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
73388ebb749SStefano Zampini   }
73488ebb749SStefano Zampini   ierr = PetscFree(auxindices);CHKERRQ(ierr);
7358629588bSStefano Zampini   /* get back data */
7368629588bSStefano Zampini   *coarse_submat_vals_n = coarse_submat_vals;
73788ebb749SStefano Zampini   PetscFunctionReturn(0);
73888ebb749SStefano Zampini }
73988ebb749SStefano Zampini 
74088ebb749SStefano Zampini #undef __FUNCT__
741aa0d41d4SStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalMatrices"
742aa0d41d4SStefano Zampini PetscErrorCode PCBDDCSetUpLocalMatrices(PC pc)
743aa0d41d4SStefano Zampini {
744aa0d41d4SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
745aa0d41d4SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
746aa0d41d4SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
7479577ea80SStefano Zampini   PetscBool         issbaij,isbaij;
748aa0d41d4SStefano Zampini   /* manage repeated solves */
749aa0d41d4SStefano Zampini   MatReuse          reuse;
750aa0d41d4SStefano Zampini   MatStructure      matstruct;
751aa0d41d4SStefano Zampini   PetscErrorCode    ierr;
752aa0d41d4SStefano Zampini 
753aa0d41d4SStefano Zampini   PetscFunctionBegin;
754f4ddd8eeSStefano Zampini   if (pcbddc->use_change_of_basis && !pcbddc->ChangeOfBasisMatrix) {
755f4ddd8eeSStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Change of basis matrix has not been created");
756f4ddd8eeSStefano Zampini   }
757aa0d41d4SStefano Zampini   /* get mat flags */
758aa0d41d4SStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
759aa0d41d4SStefano Zampini   reuse = MAT_INITIAL_MATRIX;
760aa0d41d4SStefano Zampini   if (pc->setupcalled) {
761aa0d41d4SStefano Zampini     /* when matstruct is SAME_PRECONDITIONER, we shouldn't be here */
762aa0d41d4SStefano Zampini     if (matstruct == SAME_PRECONDITIONER) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen");
763aa0d41d4SStefano Zampini     if (matstruct == SAME_NONZERO_PATTERN) {
764aa0d41d4SStefano Zampini       reuse = MAT_REUSE_MATRIX;
765aa0d41d4SStefano Zampini     } else {
766aa0d41d4SStefano Zampini       reuse = MAT_INITIAL_MATRIX;
767aa0d41d4SStefano Zampini     }
768aa0d41d4SStefano Zampini   }
769aa0d41d4SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
770aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
771aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
772aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
773aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BB);CHKERRQ(ierr);
774aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
775aa0d41d4SStefano Zampini   }
776aa0d41d4SStefano Zampini 
777aa0d41d4SStefano Zampini   /* transform local matrices if needed */
778aa0d41d4SStefano Zampini   if (pcbddc->use_change_of_basis) {
779aa0d41d4SStefano Zampini     Mat         change_mat_all;
780aa0d41d4SStefano Zampini     PetscScalar *row_cmat_values;
781aa0d41d4SStefano Zampini     PetscInt    *row_cmat_indices;
782aa0d41d4SStefano Zampini     PetscInt    *nnz,*is_indices,*temp_indices;
783aa0d41d4SStefano Zampini     PetscInt    i,j,k,n_D,n_B;
784aa0d41d4SStefano Zampini 
785aa0d41d4SStefano Zampini     /* Get Non-overlapping dimensions */
786aa0d41d4SStefano Zampini     n_B = pcis->n_B;
787aa0d41d4SStefano Zampini     n_D = pcis->n-n_B;
788aa0d41d4SStefano Zampini 
789aa0d41d4SStefano Zampini     /* compute nonzero structure of change of basis on all local nodes */
790aa0d41d4SStefano Zampini     ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
791aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
792aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) nnz[is_indices[i]] = 1;
793aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
794aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
795aa0d41d4SStefano Zampini     k=1;
796aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
797aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
798aa0d41d4SStefano Zampini       nnz[is_indices[i]]=j;
799aa0d41d4SStefano Zampini       if (k < j) k = j;
800aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
801aa0d41d4SStefano Zampini     }
802aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
803aa0d41d4SStefano Zampini     /* assemble change of basis matrix on the whole set of local dofs */
804aa0d41d4SStefano Zampini     ierr = PetscMalloc(k*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
805aa0d41d4SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&change_mat_all);CHKERRQ(ierr);
806aa0d41d4SStefano Zampini     ierr = MatSetSizes(change_mat_all,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
807aa0d41d4SStefano Zampini     ierr = MatSetType(change_mat_all,MATSEQAIJ);CHKERRQ(ierr);
808aa0d41d4SStefano Zampini     ierr = MatSeqAIJSetPreallocation(change_mat_all,0,nnz);CHKERRQ(ierr);
809aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
810aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) {
811aa0d41d4SStefano Zampini       ierr = MatSetValue(change_mat_all,is_indices[i],is_indices[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
812aa0d41d4SStefano Zampini     }
813aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
814aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
815aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
816aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
817aa0d41d4SStefano Zampini       for (k=0; k<j; k++) temp_indices[k]=is_indices[row_cmat_indices[k]];
818aa0d41d4SStefano Zampini       ierr = MatSetValues(change_mat_all,1,&is_indices[i],j,temp_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
819aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
820aa0d41d4SStefano Zampini     }
821aa0d41d4SStefano Zampini     ierr = MatAssemblyBegin(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
822aa0d41d4SStefano Zampini     ierr = MatAssemblyEnd(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8239577ea80SStefano Zampini     /* TODO: HOW TO WORK WITH BAIJ and SBAIJ? PtAP not provided */
8249577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
8259577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQBAIJ,&isbaij);CHKERRQ(ierr);
8269577ea80SStefano Zampini     if (!issbaij && !isbaij) {
827aa0d41d4SStefano Zampini       ierr = MatPtAP(matis->A,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
828aa0d41d4SStefano Zampini     } else {
829aa0d41d4SStefano Zampini       Mat work_mat;
830aa0d41d4SStefano Zampini       ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
831aa0d41d4SStefano Zampini       ierr = MatPtAP(work_mat,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
832aa0d41d4SStefano Zampini       ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
833aa0d41d4SStefano Zampini     }
83445a1bb75SStefano Zampini     /*
83545a1bb75SStefano Zampini     ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
83645a1bb75SStefano Zampini     ierr = MatView(change_mat_all,(PetscViewer)0);CHKERRQ(ierr);
83745a1bb75SStefano Zampini     */
838aa0d41d4SStefano Zampini     ierr = MatDestroy(&change_mat_all);CHKERRQ(ierr);
839aa0d41d4SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
840aa0d41d4SStefano Zampini     ierr = PetscFree(temp_indices);CHKERRQ(ierr);
841aa0d41d4SStefano Zampini   } else {
842aa0d41d4SStefano Zampini     /* without change of basis, the local matrix is unchanged */
843aa0d41d4SStefano Zampini     if (!pcbddc->local_mat) {
844aa0d41d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)matis->A);CHKERRQ(ierr);
845aa0d41d4SStefano Zampini       pcbddc->local_mat = matis->A;
846aa0d41d4SStefano Zampini     }
847aa0d41d4SStefano Zampini   }
848aa0d41d4SStefano Zampini 
849aa0d41d4SStefano Zampini   /* get submatrices */
850aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_I_local,reuse,&pcis->A_II);CHKERRQ(ierr);
8519577ea80SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_B_local,reuse,&pcis->A_BB);CHKERRQ(ierr);
8529577ea80SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
8539577ea80SStefano Zampini   if (!issbaij) {
854aa0d41d4SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
855aa0d41d4SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
8569577ea80SStefano Zampini   } else {
8579577ea80SStefano Zampini     Mat newmat;
8589577ea80SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
8599577ea80SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
8609577ea80SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
8619577ea80SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
8629577ea80SStefano Zampini   }
863aa0d41d4SStefano Zampini   PetscFunctionReturn(0);
864aa0d41d4SStefano Zampini }
865aa0d41d4SStefano Zampini 
866aa0d41d4SStefano Zampini #undef __FUNCT__
867a64d13efSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalScatters"
8688ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
869a64d13efSStefano Zampini {
870a64d13efSStefano Zampini   PC_IS*         pcis = (PC_IS*)(pc->data);
871a64d13efSStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8728ce42a96SStefano Zampini   IS             is_aux1,is_aux2;
873e9189074SStefano Zampini   PetscInt       *aux_array1,*aux_array2,*is_indices,*idx_R_local;
8743a50541eSStefano Zampini   PetscInt       n_vertices,i,j,n_R,n_D,n_B;
8753a50541eSStefano Zampini   PetscInt       vbs,bs;
8764641a718SStefano Zampini   PetscBT        bitmask;
877a64d13efSStefano Zampini   PetscErrorCode ierr;
878a64d13efSStefano Zampini 
879a64d13efSStefano Zampini   PetscFunctionBegin;
880f4ddd8eeSStefano Zampini   /* No need to setup local scatters if primal space is unchanged */
881727cdba6SStefano Zampini   if (!pcbddc->new_primal_space_local) {
882f4ddd8eeSStefano Zampini     PetscFunctionReturn(0);
883f4ddd8eeSStefano Zampini   }
884f4ddd8eeSStefano Zampini   /* destroy old objects */
885f4ddd8eeSStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
886f4ddd8eeSStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
887f4ddd8eeSStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
888a64d13efSStefano Zampini   /* Set Non-overlapping dimensions */
889a64d13efSStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
890e9189074SStefano Zampini   n_vertices = pcbddc->n_actual_vertices;
8914641a718SStefano Zampini   /* create auxiliary bitmask */
8924641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
8934641a718SStefano Zampini   for (i=0;i<n_vertices;i++) {
894e9189074SStefano Zampini     ierr = PetscBTSet(bitmask,pcbddc->primal_indices_local_idxs[i]);CHKERRQ(ierr);
8954641a718SStefano Zampini   }
8963a50541eSStefano Zampini 
897a64d13efSStefano Zampini   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
898a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n-n_vertices)*sizeof(PetscInt),&idx_R_local);CHKERRQ(ierr);
899a64d13efSStefano Zampini   for (i=0, n_R=0; i<pcis->n; i++) {
9004641a718SStefano Zampini     if (!PetscBTLookup(bitmask,i)) {
901a64d13efSStefano Zampini       idx_R_local[n_R] = i;
902a64d13efSStefano Zampini       n_R++;
903a64d13efSStefano Zampini     }
904a64d13efSStefano Zampini   }
9053a50541eSStefano Zampini 
9063a50541eSStefano Zampini   /* Block code */
9073a50541eSStefano Zampini   vbs = 1;
9083a50541eSStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
9093a50541eSStefano Zampini   if (bs>1 && !(n_vertices%bs)) {
9103a50541eSStefano Zampini     PetscBool is_blocked = PETSC_TRUE;
9113a50541eSStefano Zampini     PetscInt  *vary;
9123a50541eSStefano Zampini     /* Verify if the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
9133a50541eSStefano Zampini     ierr = PetscMalloc(pcis->n/bs*sizeof(PetscInt),&vary);CHKERRQ(ierr);
9143a50541eSStefano Zampini     ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
915e9189074SStefano Zampini     for (i=0; i<n_vertices; i++) vary[pcbddc->primal_indices_local_idxs[i]/bs]++;
9163a50541eSStefano Zampini     for (i=0; i<n_vertices; i++) {
9173a50541eSStefano Zampini       if (vary[i]!=0 && vary[i]!=bs) {
9183a50541eSStefano Zampini         is_blocked = PETSC_FALSE;
9193a50541eSStefano Zampini         break;
9203a50541eSStefano Zampini       }
9213a50541eSStefano Zampini     }
9223a50541eSStefano Zampini     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
9233a50541eSStefano Zampini       vbs = bs;
9243a50541eSStefano Zampini       for (i=0;i<n_R/vbs;i++) {
9253a50541eSStefano Zampini         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
9263a50541eSStefano Zampini       }
9273a50541eSStefano Zampini     }
9283a50541eSStefano Zampini     ierr = PetscFree(vary);CHKERRQ(ierr);
9293a50541eSStefano Zampini   }
9303a50541eSStefano Zampini   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
9313a50541eSStefano Zampini   ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
932a64d13efSStefano Zampini 
933a64d13efSStefano Zampini   /* print some info if requested */
934a64d13efSStefano Zampini   if (pcbddc->dbg_flag) {
935a64d13efSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
936a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
9370fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
938a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
939a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
9403a50541eSStefano 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);
941a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr);
942a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
943a64d13efSStefano Zampini   }
944a64d13efSStefano Zampini 
945a64d13efSStefano Zampini   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
9463a50541eSStefano Zampini   ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
947a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
948a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array2);CHKERRQ(ierr);
949a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
9504641a718SStefano Zampini   for (i=0; i<n_D; i++) {
9514641a718SStefano Zampini     ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
9524641a718SStefano Zampini   }
953a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
954a64d13efSStefano Zampini   for (i=0, j=0; i<n_R; i++) {
9554641a718SStefano Zampini     if (!PetscBTLookup(bitmask,idx_R_local[i])) {
9564641a718SStefano Zampini       aux_array1[j++] = i;
957a64d13efSStefano Zampini     }
958a64d13efSStefano Zampini   }
959a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
960a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
961a64d13efSStefano Zampini   for (i=0, j=0; i<n_B; i++) {
9624641a718SStefano Zampini     if (!PetscBTLookup(bitmask,is_indices[i])) {
9634641a718SStefano Zampini       aux_array2[j++] = i;
964a64d13efSStefano Zampini     }
965a64d13efSStefano Zampini   }
966a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
967a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
968a64d13efSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
969a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
970a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
971a64d13efSStefano Zampini 
9728eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
973a64d13efSStefano Zampini     ierr = PetscMalloc(n_D*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
974a64d13efSStefano Zampini     for (i=0, j=0; i<n_R; i++) {
9754641a718SStefano Zampini       if (PetscBTLookup(bitmask,idx_R_local[i])) {
9764641a718SStefano Zampini         aux_array1[j++] = i;
977a64d13efSStefano Zampini       }
978a64d13efSStefano Zampini     }
979a64d13efSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
980a64d13efSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
981a64d13efSStefano Zampini     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
982a64d13efSStefano Zampini   }
9834641a718SStefano Zampini   ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
9843a50541eSStefano Zampini   ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
985a64d13efSStefano Zampini   PetscFunctionReturn(0);
986a64d13efSStefano Zampini }
987a64d13efSStefano Zampini 
988304d26faSStefano Zampini 
989304d26faSStefano Zampini #undef __FUNCT__
990304d26faSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
9918ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc)
992304d26faSStefano Zampini {
993304d26faSStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
994304d26faSStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
995304d26faSStefano Zampini   PC             pc_temp;
996304d26faSStefano Zampini   Mat            A_RR;
997304d26faSStefano Zampini   MatStructure   matstruct;
998f4ddd8eeSStefano Zampini   MatReuse       reuse;
999304d26faSStefano Zampini   PetscScalar    m_one = -1.0;
1000304d26faSStefano Zampini   PetscReal      value;
1001af732b37SStefano Zampini   PetscInt       n_D,n_R,ibs,mbs;
10029577ea80SStefano Zampini   PetscBool      use_exact,use_exact_reduced,issbaij;
1003304d26faSStefano Zampini   PetscErrorCode ierr;
1004e604994aSStefano Zampini   /* prefixes stuff */
1005e604994aSStefano Zampini   char           dir_prefix[256],neu_prefix[256],str_level[3];
1006e604994aSStefano Zampini   size_t         len;
1007304d26faSStefano Zampini 
1008304d26faSStefano Zampini   PetscFunctionBegin;
1009304d26faSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
1010304d26faSStefano Zampini 
1011e604994aSStefano Zampini   /* compute prefixes */
1012e604994aSStefano Zampini   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
1013e604994aSStefano Zampini   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
1014e604994aSStefano Zampini   if (!pcbddc->current_level) {
1015e604994aSStefano Zampini     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
1016e604994aSStefano Zampini     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
1017e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
1018e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
1019e604994aSStefano Zampini   } else {
1020e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
1021e604994aSStefano Zampini     sprintf(str_level,"%d_",(int)(pcbddc->current_level));
1022e604994aSStefano Zampini     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
1023e604994aSStefano Zampini     len -= 15; /* remove "pc_bddc_coarse_" */
1024e604994aSStefano Zampini     if (pcbddc->current_level>1) len -= 2; /* remove "X_" with X level number (works with 9 levels max) */
1025e604994aSStefano Zampini     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
1026e604994aSStefano Zampini     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
1027e604994aSStefano Zampini     *(dir_prefix+len)='\0';
1028e604994aSStefano Zampini     *(neu_prefix+len)='\0';
1029e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
1030e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
1031e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
1032e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
1033e604994aSStefano Zampini   }
1034e604994aSStefano Zampini 
1035304d26faSStefano Zampini   /* DIRICHLET PROBLEM */
1036ac78edfcSStefano Zampini   /* Matrix for Dirichlet problem is pcis->A_II */
10378ce42a96SStefano Zampini   ierr = ISGetSize(pcis->is_I_local,&n_D);CHKERRQ(ierr);
1038304d26faSStefano Zampini   if (!pcbddc->ksp_D) { /* create object if not yet build */
1039304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
1040304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
1041304d26faSStefano Zampini     /* default */
1042304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
1043e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
10449577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
1045304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
10469577ea80SStefano Zampini     if (issbaij) {
10479577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
10489577ea80SStefano Zampini     } else {
1049304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
10509577ea80SStefano Zampini     }
1051304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1052304d26faSStefano Zampini   }
1053304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II,matstruct);CHKERRQ(ierr);
1054304d26faSStefano Zampini   /* Allow user's customization */
1055304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
1056304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1057304d26faSStefano Zampini   if (!n_D) {
1058304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
1059304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1060304d26faSStefano Zampini   }
1061304d26faSStefano Zampini   /* Set Up KSP for Dirichlet problem of BDDC */
1062304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
1063304d26faSStefano Zampini   /* set ksp_D into pcis data */
1064304d26faSStefano Zampini   ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
1065304d26faSStefano Zampini   ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
1066304d26faSStefano Zampini   pcis->ksp_D = pcbddc->ksp_D;
1067304d26faSStefano Zampini 
1068304d26faSStefano Zampini   /* NEUMANN PROBLEM */
1069f4ddd8eeSStefano Zampini   /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
10708ce42a96SStefano Zampini   ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
1071f4ddd8eeSStefano Zampini   if (pcbddc->ksp_R) { /* already created ksp */
1072f4ddd8eeSStefano Zampini     PetscInt nn_R;
1073f4ddd8eeSStefano Zampini     ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR,NULL);CHKERRQ(ierr);
1074f4ddd8eeSStefano Zampini     ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
1075f4ddd8eeSStefano Zampini     ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
1076f4ddd8eeSStefano Zampini     if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
1077f4ddd8eeSStefano Zampini       ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
1078f4ddd8eeSStefano Zampini       ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1079f4ddd8eeSStefano Zampini       reuse = MAT_INITIAL_MATRIX;
1080f4ddd8eeSStefano Zampini     } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
1081727cdba6SStefano Zampini       if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
1082f4ddd8eeSStefano Zampini         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1083f4ddd8eeSStefano Zampini         reuse = MAT_INITIAL_MATRIX;
1084f4ddd8eeSStefano Zampini       } else { /* safe to reuse the matrix */
1085f4ddd8eeSStefano Zampini         reuse = MAT_REUSE_MATRIX;
1086f4ddd8eeSStefano Zampini       }
1087f4ddd8eeSStefano Zampini     }
1088f4ddd8eeSStefano Zampini     /* last check */
1089f4ddd8eeSStefano Zampini     if (matstruct == DIFFERENT_NONZERO_PATTERN) {
1090f4ddd8eeSStefano Zampini       ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1091f4ddd8eeSStefano Zampini       reuse = MAT_INITIAL_MATRIX;
1092f4ddd8eeSStefano Zampini     }
1093f4ddd8eeSStefano Zampini   } else { /* first time, so we need to create the matrix */
1094f4ddd8eeSStefano Zampini     reuse = MAT_INITIAL_MATRIX;
1095f4ddd8eeSStefano Zampini   }
1096f4ddd8eeSStefano Zampini   /* extract A_RR */
1097af732b37SStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
1098af732b37SStefano Zampini   ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
10993a50541eSStefano Zampini   if (ibs != mbs) {
1100af732b37SStefano Zampini     Mat newmat;
1101af732b37SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
1102f4ddd8eeSStefano Zampini     ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
1103af732b37SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
1104af732b37SStefano Zampini   } else {
1105f4ddd8eeSStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
1106af732b37SStefano Zampini   }
1107f4ddd8eeSStefano Zampini   if (!pcbddc->ksp_R) { /* create object if not present */
1108304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
1109304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
1110304d26faSStefano Zampini     /* default */
1111304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
1112e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
1113304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
11149577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
11159577ea80SStefano Zampini     if (issbaij) {
11169577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
11179577ea80SStefano Zampini     } else {
1118304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
11199577ea80SStefano Zampini     }
1120304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1121304d26faSStefano Zampini   }
1122304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR,matstruct);CHKERRQ(ierr);
1123304d26faSStefano Zampini   /* Allow user's customization */
1124304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
1125304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1126304d26faSStefano Zampini   if (!n_R) {
1127304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
1128304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1129304d26faSStefano Zampini   }
1130304d26faSStefano Zampini   /* Set Up KSP for Neumann problem of BDDC */
1131304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
1132304d26faSStefano Zampini 
1133304d26faSStefano Zampini   /* check Dirichlet and Neumann solvers and adapt them if a nullspace correction is needed */
11340fccc4e9SStefano Zampini   if (pcbddc->NullSpace || pcbddc->dbg_flag) {
1135304d26faSStefano Zampini     /* Dirichlet */
11360fccc4e9SStefano Zampini     ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
11370fccc4e9SStefano Zampini     ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
11380fccc4e9SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
11390fccc4e9SStefano Zampini     ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
11400fccc4e9SStefano Zampini     ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
1141304d26faSStefano Zampini     /* need to be adapted? */
1142b8ffe317SStefano Zampini     use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1143b8ffe317SStefano Zampini     ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1144b8ffe317SStefano Zampini     ierr = PCBDDCSetUseExactDirichlet(pc,use_exact_reduced);CHKERRQ(ierr);
1145304d26faSStefano Zampini     /* print info */
1146304d26faSStefano Zampini     if (pcbddc->dbg_flag) {
1147304d26faSStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
11480fccc4e9SStefano Zampini       ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
1149304d26faSStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
1150304d26faSStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Checking solution of Dirichlet and Neumann problems\n");CHKERRQ(ierr);
1151e604994aSStefano 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);
1152304d26faSStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1153304d26faSStefano Zampini     }
1154b8ffe317SStefano Zampini     if (pcbddc->NullSpace && !use_exact_reduced && !pcbddc->switch_static) {
11558ce42a96SStefano Zampini       ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcis->is_I_local);CHKERRQ(ierr);
1156304d26faSStefano Zampini     }
1157304d26faSStefano Zampini 
1158304d26faSStefano Zampini     /* Neumann */
11590fccc4e9SStefano Zampini     ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
11600fccc4e9SStefano Zampini     ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
11610fccc4e9SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
11620fccc4e9SStefano Zampini     ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
11630fccc4e9SStefano Zampini     ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
1164304d26faSStefano Zampini     /* need to be adapted? */
1165b8ffe317SStefano Zampini     use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1166b8ffe317SStefano Zampini     ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1167304d26faSStefano Zampini     /* print info */
1168304d26faSStefano Zampini     if (pcbddc->dbg_flag) {
1169e604994aSStefano 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);
1170304d26faSStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1171304d26faSStefano Zampini     }
1172b8ffe317SStefano Zampini     if (pcbddc->NullSpace && !use_exact_reduced) { /* is it the right logic? */
11738ce42a96SStefano Zampini       ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcbddc->is_R_local);CHKERRQ(ierr);
1174304d26faSStefano Zampini     }
11750fccc4e9SStefano Zampini   }
1176304d26faSStefano Zampini   /* free Neumann problem's matrix */
1177304d26faSStefano Zampini   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1178304d26faSStefano Zampini   PetscFunctionReturn(0);
1179304d26faSStefano Zampini }
1180304d26faSStefano Zampini 
1181304d26faSStefano Zampini #undef __FUNCT__
1182674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSolveSaddlePoint"
1183674ae819SStefano Zampini static PetscErrorCode  PCBDDCSolveSaddlePoint(PC pc)
1184674ae819SStefano Zampini {
1185674ae819SStefano Zampini   PetscErrorCode ierr;
1186674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1187674ae819SStefano Zampini 
1188674ae819SStefano Zampini   PetscFunctionBegin;
1189674ae819SStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
1190674ae819SStefano Zampini   if (pcbddc->local_auxmat1) {
1191674ae819SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec2_R,pcbddc->vec1_C);CHKERRQ(ierr);
1192674ae819SStefano Zampini     ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
1193674ae819SStefano Zampini   }
1194674ae819SStefano Zampini   PetscFunctionReturn(0);
1195674ae819SStefano Zampini }
1196674ae819SStefano Zampini 
1197674ae819SStefano Zampini #undef __FUNCT__
1198674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
1199674ae819SStefano Zampini PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc)
1200674ae819SStefano Zampini {
1201674ae819SStefano Zampini   PetscErrorCode ierr;
1202674ae819SStefano Zampini   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
1203674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)  (pc->data);
1204674ae819SStefano Zampini   const PetscScalar zero = 0.0;
1205674ae819SStefano Zampini 
1206674ae819SStefano Zampini   PetscFunctionBegin;
120715aaf578SStefano Zampini   /* Application of PHI^T (or PSI^T)  */
120815aaf578SStefano Zampini   if (pcbddc->coarse_psi_B) {
120915aaf578SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
12108eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
121115aaf578SStefano Zampini   } else {
1212674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
12138eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
121415aaf578SStefano Zampini   }
1215674ae819SStefano Zampini   /* Scatter data of coarse_rhs */
1216674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { ierr = VecSet(pcbddc->coarse_rhs,zero);CHKERRQ(ierr); }
1217674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1218674ae819SStefano Zampini 
1219674ae819SStefano Zampini   /* Local solution on R nodes */
1220674ae819SStefano Zampini   ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
1221674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1222674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
12238eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1224674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1225674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1226674ae819SStefano Zampini   }
1227674ae819SStefano Zampini   ierr = PCBDDCSolveSaddlePoint(pc);CHKERRQ(ierr);
1228674ae819SStefano Zampini   ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1229674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1230674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
12318eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1232674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1233674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1234674ae819SStefano Zampini   }
1235674ae819SStefano Zampini 
1236674ae819SStefano Zampini   /* Coarse solution */
1237674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1238674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { /* TODO remove null space when doing multilevel */
1239674ae819SStefano Zampini     ierr = KSPSolve(pcbddc->coarse_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
1240674ae819SStefano Zampini   }
1241674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1242674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd  (pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1243674ae819SStefano Zampini 
1244674ae819SStefano Zampini   /* Sum contributions from two levels */
1245674ae819SStefano Zampini   ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
12468eeda7d8SStefano Zampini   if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1247674ae819SStefano Zampini   PetscFunctionReturn(0);
1248674ae819SStefano Zampini }
1249674ae819SStefano Zampini 
1250674ae819SStefano Zampini #undef __FUNCT__
1251674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
1252674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1253674ae819SStefano Zampini {
1254674ae819SStefano Zampini   PetscErrorCode ierr;
1255674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1256674ae819SStefano Zampini 
1257674ae819SStefano Zampini   PetscFunctionBegin;
1258674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1259674ae819SStefano Zampini   PetscFunctionReturn(0);
1260674ae819SStefano Zampini }
1261674ae819SStefano Zampini 
1262674ae819SStefano Zampini #undef __FUNCT__
1263674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
1264674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1265674ae819SStefano Zampini {
1266674ae819SStefano Zampini   PetscErrorCode ierr;
1267674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1268674ae819SStefano Zampini 
1269674ae819SStefano Zampini   PetscFunctionBegin;
1270674ae819SStefano Zampini   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1271674ae819SStefano Zampini   PetscFunctionReturn(0);
1272674ae819SStefano Zampini }
1273674ae819SStefano Zampini 
1274984c4197SStefano Zampini /* uncomment for testing purposes */
1275984c4197SStefano Zampini /* #define PETSC_MISSING_LAPACK_GESVD 1 */
1276674ae819SStefano Zampini #undef __FUNCT__
1277674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp"
1278674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
1279674ae819SStefano Zampini {
1280674ae819SStefano Zampini   PetscErrorCode    ierr;
1281674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
1282674ae819SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
1283674ae819SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
1284984c4197SStefano Zampini   /* constraint and (optionally) change of basis matrix implemented as SeqAIJ */
1285674ae819SStefano Zampini   MatType           impMatType=MATSEQAIJ;
1286984c4197SStefano Zampini   /* one and zero */
1287984c4197SStefano Zampini   PetscScalar       one=1.0,zero=0.0;
1288984c4197SStefano Zampini   /* space to store constraints and their local indices */
1289984c4197SStefano Zampini   PetscScalar       *temp_quadrature_constraint;
1290984c4197SStefano Zampini   PetscInt          *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B;
1291984c4197SStefano Zampini   /* iterators */
1292984c4197SStefano Zampini   PetscInt          i,j,k,total_counts,temp_start_ptr;
1293984c4197SStefano Zampini   /* stuff to store connected components stored in pcbddc->mat_graph */
1294984c4197SStefano Zampini   IS                ISForVertices,*ISForFaces,*ISForEdges,*used_IS;
1295984c4197SStefano Zampini   PetscInt          n_ISForFaces,n_ISForEdges;
1296984c4197SStefano Zampini   /* near null space stuff */
1297674ae819SStefano Zampini   MatNullSpace      nearnullsp;
1298674ae819SStefano Zampini   const Vec         *nearnullvecs;
1299674ae819SStefano Zampini   Vec               *localnearnullsp;
1300984c4197SStefano Zampini   PetscBool         nnsp_has_cnst;
1301984c4197SStefano Zampini   PetscInt          nnsp_size;
1302984c4197SStefano Zampini   PetscScalar       *array;
1303984c4197SStefano Zampini   /* BLAS integers */
1304e310c8b4SStefano Zampini   PetscBLASInt      lwork,lierr;
1305e310c8b4SStefano Zampini   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
1306c4303822SStefano Zampini   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
1307984c4197SStefano Zampini   /* LAPACK working arrays for SVD or POD */
1308242a89d7SStefano Zampini   PetscBool         skip_lapack;
1309984c4197SStefano Zampini   PetscScalar       *work;
1310984c4197SStefano Zampini   PetscReal         *singular_vals;
1311984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1312984c4197SStefano Zampini   PetscReal         *rwork;
1313674ae819SStefano Zampini #endif
1314984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1315e310c8b4SStefano Zampini   PetscBLASInt      Blas_one_2=1;
1316984c4197SStefano Zampini   PetscScalar       *temp_basis,*correlation_mat;
1317b7d8b9f8SStefano Zampini #else
1318b7d8b9f8SStefano Zampini   PetscBLASInt      dummy_int_1=1,dummy_int_2=1;
1319b7d8b9f8SStefano Zampini   PetscScalar       dummy_scalar_1=0.0,dummy_scalar_2=0.0;
1320984c4197SStefano Zampini #endif
1321727cdba6SStefano Zampini   /* reuse */
1322727cdba6SStefano Zampini   PetscInt          olocal_primal_size;
1323727cdba6SStefano Zampini   PetscInt          *oprimal_indices_local_idxs;
1324984c4197SStefano Zampini   /* change of basis */
1325984c4197SStefano Zampini   PetscInt          *aux_primal_numbering,*aux_primal_minloc,*global_indices;
1326a717540cSStefano Zampini   PetscBool         boolforchange,qr_needed;
1327a717540cSStefano Zampini   PetscBT           touched,change_basis,qr_needed_idx;
1328984c4197SStefano Zampini   /* auxiliary stuff */
132939e2fb2aSStefano Zampini   PetscInt          *nnz,*is_indices,*aux_primal_numbering_B;
1330984c4197SStefano Zampini   /* some quantities */
133145a1bb75SStefano Zampini   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
1332984c4197SStefano Zampini   PetscInt          size_of_constraint,max_size_of_constraint,max_constraints,temp_constraints;
1333984c4197SStefano Zampini 
1334674ae819SStefano Zampini 
1335674ae819SStefano Zampini   PetscFunctionBegin;
13368e61c736SStefano Zampini   /* Destroy Mat objects computed previously */
13378e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
13388e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1339674ae819SStefano Zampini   /* Get index sets for faces, edges and vertices from graph */
13408eeda7d8SStefano Zampini   if (!pcbddc->use_faces && !pcbddc->use_edges && !pcbddc->use_vertices) {
13418eeda7d8SStefano Zampini     pcbddc->use_vertices = PETSC_TRUE;
1342674ae819SStefano Zampini   }
13438eeda7d8SStefano Zampini   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,pcbddc->use_faces,pcbddc->use_edges,pcbddc->use_vertices,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);
1344b8ffe317SStefano Zampini   /* HACK: provide functions to set change of basis */
1345b8ffe317SStefano Zampini   if (!ISForVertices && pcbddc->NullSpace) {
1346b8ffe317SStefano Zampini     pcbddc->use_change_of_basis = PETSC_TRUE;
1347b8ffe317SStefano Zampini     pcbddc->use_change_on_faces = PETSC_FALSE;
1348b8ffe317SStefano Zampini   }
1349984c4197SStefano Zampini   /* print some info */
1350674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
13510fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
1352674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1353674ae819SStefano Zampini     i = 0;
1354674ae819SStefano Zampini     if (ISForVertices) {
1355674ae819SStefano Zampini       ierr = ISGetSize(ISForVertices,&i);CHKERRQ(ierr);
1356674ae819SStefano Zampini     }
1357674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices\n",PetscGlobalRank,i);CHKERRQ(ierr);
1358674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges\n",PetscGlobalRank,n_ISForEdges);CHKERRQ(ierr);
135915aaf578SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces\n",PetscGlobalRank,n_ISForFaces);CHKERRQ(ierr);
1360674ae819SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1361674ae819SStefano Zampini   }
1362674ae819SStefano Zampini   /* check if near null space is attached to global mat */
1363674ae819SStefano Zampini   ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
1364674ae819SStefano Zampini   if (nearnullsp) {
1365674ae819SStefano Zampini     ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
1366f4ddd8eeSStefano Zampini     /* remove any stored info */
1367f4ddd8eeSStefano Zampini     ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
1368f4ddd8eeSStefano Zampini     ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1369f4ddd8eeSStefano Zampini     /* store information for BDDC solver reuse */
1370f4ddd8eeSStefano Zampini     ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
1371f4ddd8eeSStefano Zampini     pcbddc->onearnullspace = nearnullsp;
1372f4ddd8eeSStefano Zampini     ierr = PetscMalloc(nnsp_size*sizeof(PetscObjectState),&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1373f4ddd8eeSStefano Zampini     for (i=0;i<nnsp_size;i++) {
1374f4ddd8eeSStefano Zampini       ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
1375f4ddd8eeSStefano Zampini     }
1376984c4197SStefano Zampini   } else { /* if near null space is not provided BDDC uses constants by default */
1377984c4197SStefano Zampini     nnsp_size = 0;
1378674ae819SStefano Zampini     nnsp_has_cnst = PETSC_TRUE;
1379674ae819SStefano Zampini   }
1380984c4197SStefano Zampini   /* get max number of constraints on a single cc */
1381984c4197SStefano Zampini   max_constraints = nnsp_size;
1382984c4197SStefano Zampini   if (nnsp_has_cnst) max_constraints++;
1383984c4197SStefano Zampini 
1384674ae819SStefano Zampini   /*
1385674ae819SStefano Zampini        Evaluate maximum storage size needed by the procedure
1386674ae819SStefano Zampini        - temp_indices will contain start index of each constraint stored as follows
1387674ae819SStefano 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
1388674ae819SStefano 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
1389674ae819SStefano Zampini        - temp_quadrature_constraint  [temp_indices[i],...,temp[indices[i+1]-1] will contain the scalars representing the constraint itself
1390674ae819SStefano Zampini                                                                                                                                                          */
1391674ae819SStefano Zampini   total_counts = n_ISForFaces+n_ISForEdges;
1392984c4197SStefano Zampini   total_counts *= max_constraints;
1393674ae819SStefano Zampini   n_vertices = 0;
1394674ae819SStefano Zampini   if (ISForVertices) {
1395674ae819SStefano Zampini     ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
1396674ae819SStefano Zampini   }
1397674ae819SStefano Zampini   total_counts += n_vertices;
1398674ae819SStefano Zampini   ierr = PetscMalloc((total_counts+1)*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
13994641a718SStefano Zampini   ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
1400674ae819SStefano Zampini   total_counts = 0;
1401674ae819SStefano Zampini   max_size_of_constraint = 0;
1402674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1403674ae819SStefano Zampini     if (i<n_ISForEdges) {
1404674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1405674ae819SStefano Zampini     } else {
1406674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1407674ae819SStefano Zampini     }
1408674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
1409674ae819SStefano Zampini     total_counts += j;
1410674ae819SStefano Zampini     max_size_of_constraint = PetscMax(j,max_size_of_constraint);
1411674ae819SStefano Zampini   }
1412984c4197SStefano Zampini   total_counts *= max_constraints;
1413674ae819SStefano Zampini   total_counts += n_vertices;
1414674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&temp_quadrature_constraint);CHKERRQ(ierr);
1415674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint);CHKERRQ(ierr);
1416674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint_B);CHKERRQ(ierr);
1417984c4197SStefano Zampini   /* get local part of global near null space vectors */
1418984c4197SStefano Zampini   ierr = PetscMalloc(nnsp_size*sizeof(Vec),&localnearnullsp);CHKERRQ(ierr);
1419984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1420984c4197SStefano Zampini     ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
1421984c4197SStefano Zampini     ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1422984c4197SStefano Zampini     ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1423984c4197SStefano Zampini   }
1424674ae819SStefano Zampini 
1425242a89d7SStefano Zampini   /* whether or not to skip lapack calls */
1426242a89d7SStefano Zampini   skip_lapack = PETSC_TRUE;
1427242a89d7SStefano Zampini   if (n_ISForFaces+n_ISForEdges) skip_lapack = PETSC_FALSE;
1428242a89d7SStefano Zampini 
1429984c4197SStefano Zampini   /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
1430242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1431674ae819SStefano Zampini     PetscScalar temp_work;
1432674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1433984c4197SStefano Zampini     /* Proper Orthogonal Decomposition (POD) using the snapshot method */
1434984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*max_constraints*sizeof(PetscScalar),&correlation_mat);CHKERRQ(ierr);
1435984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1436984c4197SStefano Zampini     ierr = PetscMalloc(max_size_of_constraint*max_constraints*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr);
1437674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1438984c4197SStefano Zampini     ierr = PetscMalloc(3*max_constraints*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1439674ae819SStefano Zampini #endif
1440674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1441c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
1442c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
1443674ae819SStefano Zampini     lwork = -1;
1444674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1445674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1446c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
1447674ae819SStefano Zampini #else
1448c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
1449674ae819SStefano Zampini #endif
1450674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1451984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
1452674ae819SStefano Zampini #else /* on missing GESVD */
1453674ae819SStefano Zampini     /* SVD */
1454674ae819SStefano Zampini     PetscInt max_n,min_n;
1455674ae819SStefano Zampini     max_n = max_size_of_constraint;
1456984c4197SStefano Zampini     min_n = max_constraints;
1457984c4197SStefano Zampini     if (max_size_of_constraint < max_constraints) {
1458674ae819SStefano Zampini       min_n = max_size_of_constraint;
1459984c4197SStefano Zampini       max_n = max_constraints;
1460674ae819SStefano Zampini     }
1461674ae819SStefano Zampini     ierr = PetscMalloc(min_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1462674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1463674ae819SStefano Zampini     ierr = PetscMalloc(5*min_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1464674ae819SStefano Zampini #endif
1465674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1466674ae819SStefano Zampini     lwork = -1;
1467e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
1468e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
1469b7d8b9f8SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
1470674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1471674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1472e310c8b4SStefano 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));
1473674ae819SStefano Zampini #else
1474e310c8b4SStefano 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));
1475674ae819SStefano Zampini #endif
1476674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1477984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
1478984c4197SStefano Zampini #endif /* on missing GESVD */
1479674ae819SStefano Zampini     /* Allocate optimal workspace */
1480674ae819SStefano Zampini     ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
1481984c4197SStefano Zampini     ierr = PetscMalloc((PetscInt)lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
1482674ae819SStefano Zampini   }
1483674ae819SStefano Zampini   /* Now we can loop on constraining sets */
1484674ae819SStefano Zampini   total_counts = 0;
1485674ae819SStefano Zampini   temp_indices[0] = 0;
1486674ae819SStefano Zampini   /* vertices */
1487674ae819SStefano Zampini   if (ISForVertices) {
1488674ae819SStefano Zampini     ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1489674ae819SStefano Zampini     if (nnsp_has_cnst) { /* consider all vertices */
149039e2fb2aSStefano Zampini       ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
1491674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1492674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1493674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1494674ae819SStefano Zampini         total_counts++;
1495674ae819SStefano Zampini       }
1496674ae819SStefano Zampini     } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
1497984c4197SStefano Zampini       PetscBool used_vertex;
1498674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1499674ae819SStefano Zampini         used_vertex = PETSC_FALSE;
1500674ae819SStefano Zampini         k = 0;
1501674ae819SStefano Zampini         while (!used_vertex && k<nnsp_size) {
1502984c4197SStefano Zampini           ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1503984c4197SStefano Zampini           if (PetscAbsScalar(array[is_indices[i]])>0.0) {
1504674ae819SStefano Zampini             temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1505674ae819SStefano Zampini             temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1506674ae819SStefano Zampini             temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1507674ae819SStefano Zampini             total_counts++;
1508674ae819SStefano Zampini             used_vertex = PETSC_TRUE;
1509674ae819SStefano Zampini           }
1510984c4197SStefano Zampini           ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1511674ae819SStefano Zampini           k++;
1512674ae819SStefano Zampini         }
1513674ae819SStefano Zampini       }
1514674ae819SStefano Zampini     }
1515674ae819SStefano Zampini     ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1516674ae819SStefano Zampini     n_vertices = total_counts;
1517674ae819SStefano Zampini   }
1518984c4197SStefano Zampini 
1519674ae819SStefano Zampini   /* edges and faces */
1520674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1521674ae819SStefano Zampini     if (i<n_ISForEdges) {
1522674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1523984c4197SStefano Zampini       boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
1524674ae819SStefano Zampini     } else {
1525674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1526984c4197SStefano Zampini       boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
1527674ae819SStefano Zampini     }
1528674ae819SStefano Zampini     temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
1529674ae819SStefano Zampini     temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
1530674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
1531674ae819SStefano Zampini     ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1532984c4197SStefano Zampini     /* change of basis should not be performed on local periodic nodes */
1533984c4197SStefano Zampini     if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
1534674ae819SStefano Zampini     if (nnsp_has_cnst) {
15355b08dc53SStefano Zampini       PetscScalar quad_value;
1536674ae819SStefano Zampini       temp_constraints++;
1537674ae819SStefano Zampini       quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
153839e2fb2aSStefano Zampini       ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
1539674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1540674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
1541674ae819SStefano Zampini       }
1542674ae819SStefano Zampini       temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
1543674ae819SStefano Zampini       total_counts++;
1544674ae819SStefano Zampini     }
1545674ae819SStefano Zampini     for (k=0;k<nnsp_size;k++) {
1546984c4197SStefano Zampini       PetscReal real_value;
1547984c4197SStefano Zampini       ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
154839e2fb2aSStefano Zampini       ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
1549674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1550984c4197SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=array[is_indices[j]];
1551674ae819SStefano Zampini       }
1552984c4197SStefano Zampini       ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1553984c4197SStefano Zampini       /* check if array is null on the connected component */
1554e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1555e310c8b4SStefano Zampini       PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_one));
15565b08dc53SStefano Zampini       if (real_value > 0.0) { /* keep indices and values */
1557674ae819SStefano Zampini         temp_constraints++;
1558674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
1559674ae819SStefano Zampini         total_counts++;
1560674ae819SStefano Zampini       }
1561674ae819SStefano Zampini     }
1562674ae819SStefano Zampini     ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
156345a1bb75SStefano Zampini     valid_constraints = temp_constraints;
1564eb97c9d2SStefano 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 */
1565eb97c9d2SStefano Zampini     if (!pcbddc->use_nnsp_true && temp_constraints) {
1566984c4197SStefano Zampini       PetscReal tol = 1.0e-8; /* tolerance for retaining eigenmodes */
1567674ae819SStefano Zampini 
1568674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1569984c4197SStefano Zampini       /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
1570984c4197SStefano Zampini          POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
1571984c4197SStefano Zampini          -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
1572984c4197SStefano Zampini             the constraints basis will differ (by a complex factor with absolute value equal to 1)
1573984c4197SStefano Zampini             from that computed using LAPACKgesvd
1574984c4197SStefano Zampini          -> This is due to a different computation of eigenvectors in LAPACKheev
1575984c4197SStefano Zampini          -> The quality of the POD-computed basis will be the same */
1576984c4197SStefano Zampini       ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
1577674ae819SStefano Zampini       /* Store upper triangular part of correlation matrix */
1578e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1579984c4197SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1580674ae819SStefano Zampini       for (j=0;j<temp_constraints;j++) {
1581674ae819SStefano Zampini         for (k=0;k<j+1;k++) {
1582e310c8b4SStefano 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));
1583674ae819SStefano Zampini         }
1584674ae819SStefano Zampini       }
1585e310c8b4SStefano Zampini       /* compute eigenvalues and eigenvectors of correlation matrix */
1586e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1587e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
1588674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1589c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
1590674ae819SStefano Zampini #else
1591c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
1592674ae819SStefano Zampini #endif
1593674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1594984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
1595984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
1596674ae819SStefano Zampini       j=0;
1597984c4197SStefano Zampini       while (j < temp_constraints && singular_vals[j] < tol) j++;
1598674ae819SStefano Zampini       total_counts=total_counts-j;
159945a1bb75SStefano Zampini       valid_constraints = temp_constraints-j;
1600e310c8b4SStefano Zampini       /* scale and copy POD basis into used quadrature memory */
1601c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1602c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1603c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
1604c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1605c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
1606c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1607674ae819SStefano Zampini       if (j<temp_constraints) {
1608984c4197SStefano Zampini         PetscInt ii;
1609984c4197SStefano Zampini         for (k=j;k<temp_constraints;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]);
1610674ae819SStefano Zampini         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1611c4303822SStefano 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));
1612674ae819SStefano Zampini         ierr = PetscFPTrapPop();CHKERRQ(ierr);
1613984c4197SStefano Zampini         for (k=0;k<temp_constraints-j;k++) {
1614674ae819SStefano Zampini           for (ii=0;ii<size_of_constraint;ii++) {
1615984c4197SStefano 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];
1616674ae819SStefano Zampini           }
1617674ae819SStefano Zampini         }
1618674ae819SStefano Zampini       }
1619674ae819SStefano Zampini #else  /* on missing GESVD */
1620e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1621e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1622b7d8b9f8SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1623674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1624674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1625e310c8b4SStefano 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));
1626674ae819SStefano Zampini #else
1627e310c8b4SStefano 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));
1628674ae819SStefano Zampini #endif
1629984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
1630674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1631984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
1632e310c8b4SStefano Zampini       k = temp_constraints;
1633e310c8b4SStefano Zampini       if (k > size_of_constraint) k = size_of_constraint;
1634674ae819SStefano Zampini       j = 0;
1635e310c8b4SStefano Zampini       while (j < k && singular_vals[k-j-1] < tol) j++;
1636e310c8b4SStefano Zampini       total_counts = total_counts-temp_constraints+k-j;
163745a1bb75SStefano Zampini       valid_constraints = k-j;
1638984c4197SStefano Zampini #endif /* on missing GESVD */
1639674ae819SStefano Zampini     }
164045a1bb75SStefano Zampini     /* setting change_of_basis flag is safe now */
164145a1bb75SStefano Zampini     if (boolforchange) {
164245a1bb75SStefano Zampini       for (j=0;j<valid_constraints;j++) {
164345a1bb75SStefano Zampini         PetscBTSet(change_basis,total_counts-j-1);
164445a1bb75SStefano Zampini       }
164545a1bb75SStefano Zampini     }
1646674ae819SStefano Zampini   }
1647674ae819SStefano Zampini   /* free index sets of faces, edges and vertices */
1648674ae819SStefano Zampini   for (i=0;i<n_ISForFaces;i++) {
1649674ae819SStefano Zampini     ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
1650674ae819SStefano Zampini   }
1651674ae819SStefano Zampini   ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
1652674ae819SStefano Zampini   for (i=0;i<n_ISForEdges;i++) {
1653674ae819SStefano Zampini     ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
1654674ae819SStefano Zampini   }
1655674ae819SStefano Zampini   ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
1656674ae819SStefano Zampini   ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
165739e2fb2aSStefano Zampini   /* map temp_indices_to_constraint in boundary numbering */
165839e2fb2aSStefano Zampini   ierr = ISGlobalToLocalMappingApply(pcbddc->BtoNmap,IS_GTOLM_DROP,temp_indices[total_counts],temp_indices_to_constraint,&i,temp_indices_to_constraint_B);CHKERRQ(ierr);
165939e2fb2aSStefano Zampini   if (i != temp_indices[total_counts]) {
166039e2fb2aSStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for constraints indices %d != %d\n",temp_indices[total_counts],i);
166139e2fb2aSStefano Zampini   }
1662674ae819SStefano Zampini 
1663984c4197SStefano Zampini   /* free workspace */
1664242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1665984c4197SStefano Zampini     ierr = PetscFree(work);CHKERRQ(ierr);
1666984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1667984c4197SStefano Zampini     ierr = PetscFree(rwork);CHKERRQ(ierr);
1668984c4197SStefano Zampini #endif
1669984c4197SStefano Zampini     ierr = PetscFree(singular_vals);CHKERRQ(ierr);
1670984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1671984c4197SStefano Zampini     ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
1672984c4197SStefano Zampini     ierr = PetscFree(temp_basis);CHKERRQ(ierr);
1673984c4197SStefano Zampini #endif
1674984c4197SStefano Zampini   }
1675984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1676984c4197SStefano Zampini     ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
1677984c4197SStefano Zampini   }
1678984c4197SStefano Zampini   ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
1679984c4197SStefano Zampini 
1680727cdba6SStefano Zampini   /* set quantities in pcbddc data structure and store previous primal size */
1681984c4197SStefano Zampini   /* n_vertices defines the number of subdomain corners in the primal space */
1682674ae819SStefano Zampini   /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */
1683727cdba6SStefano Zampini   olocal_primal_size = pcbddc->local_primal_size;
1684984c4197SStefano Zampini   pcbddc->local_primal_size = total_counts;
1685674ae819SStefano Zampini   pcbddc->n_vertices = n_vertices;
1686984c4197SStefano Zampini   pcbddc->n_constraints = pcbddc->local_primal_size-pcbddc->n_vertices;
1687674ae819SStefano Zampini 
1688674ae819SStefano Zampini   /* Create constraint matrix */
1689674ae819SStefano Zampini   /* The constraint matrix is used to compute the l2g map of primal dofs */
1690674ae819SStefano Zampini   /* so we need to set it up properly either with or without change of basis */
1691674ae819SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1692674ae819SStefano Zampini   ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr);
1693984c4197SStefano Zampini   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
1694984c4197SStefano Zampini   /* array to compute a local numbering of constraints : vertices first then constraints */
1695984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_numbering);CHKERRQ(ierr);
1696984c4197SStefano Zampini   /* array to select the proper local node (of minimum index with respect to global ordering) when changing the basis */
1697984c4197SStefano 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 */
1698984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_minloc);CHKERRQ(ierr);
1699984c4197SStefano Zampini   /* auxiliary stuff for basis change */
1700984c4197SStefano Zampini   ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&global_indices);CHKERRQ(ierr);
17014641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n_B,&touched);CHKERRQ(ierr);
1702984c4197SStefano Zampini 
1703984c4197SStefano Zampini   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
1704984c4197SStefano Zampini   total_primal_vertices=0;
1705984c4197SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
1706674ae819SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
1707984c4197SStefano Zampini     if (size_of_constraint == 1) {
17084641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]]);CHKERRQ(ierr);
1709984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]];
1710984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=0;
1711984c4197SStefano Zampini       total_primal_vertices++;
17124641a718SStefano Zampini     } else if (PetscBTLookup(change_basis,i)) { /* Same procedure used in PCBDDCGetPrimalConstraintsLocalIdx */
1713984c4197SStefano Zampini       PetscInt min_loc,min_index;
1714984c4197SStefano Zampini       ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],global_indices);CHKERRQ(ierr);
1715984c4197SStefano Zampini       /* find first untouched local node */
1716674ae819SStefano Zampini       k = 0;
17174641a718SStefano Zampini       while (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) k++;
1718984c4197SStefano Zampini       min_index = global_indices[k];
1719984c4197SStefano Zampini       min_loc = k;
1720984c4197SStefano Zampini       /* search the minimum among global nodes already untouched on the cc */
1721984c4197SStefano Zampini       for (k=1;k<size_of_constraint;k++) {
1722984c4197SStefano Zampini         /* there can be more than one constraint on a single connected component */
17234641a718SStefano Zampini         if (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k]) && min_index > global_indices[k]) {
1724984c4197SStefano Zampini           min_index = global_indices[k];
1725984c4197SStefano Zampini           min_loc = k;
1726674ae819SStefano Zampini         }
1727674ae819SStefano Zampini       }
17284641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]+min_loc]);CHKERRQ(ierr);
1729984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]+min_loc];
1730984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=min_loc;
1731984c4197SStefano Zampini       total_primal_vertices++;
1732984c4197SStefano Zampini     }
1733984c4197SStefano Zampini   }
1734a717540cSStefano Zampini   /* determine if a QR strategy is needed for change of basis */
1735a717540cSStefano Zampini   qr_needed = PETSC_FALSE;
1736a717540cSStefano Zampini   ierr = PetscBTCreate(pcbddc->local_primal_size,&qr_needed_idx);CHKERRQ(ierr);
1737a717540cSStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1738a717540cSStefano Zampini     if (PetscBTLookup(change_basis,i)) {
1739a717540cSStefano Zampini       size_of_constraint = temp_indices[i+1]-temp_indices[i];
1740a717540cSStefano Zampini       j = 0;
1741a717540cSStefano Zampini       for (k=0;k<size_of_constraint;k++) {
1742a717540cSStefano Zampini         if (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) {
1743a717540cSStefano Zampini           j++;
1744a717540cSStefano Zampini         }
1745a717540cSStefano Zampini       }
1746a717540cSStefano Zampini       /* found more than one primal dof on the cc */
1747a717540cSStefano Zampini       if (j > 1) {
1748a717540cSStefano Zampini         PetscBTSet(qr_needed_idx,i);
1749a717540cSStefano Zampini         qr_needed = PETSC_TRUE;
1750a717540cSStefano Zampini       }
1751a717540cSStefano Zampini     }
1752a717540cSStefano Zampini   }
1753984c4197SStefano Zampini   /* free workspace */
1754984c4197SStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
175545a1bb75SStefano Zampini 
1756674ae819SStefano Zampini   /* permute indices in order to have a sorted set of vertices */
1757a717540cSStefano Zampini   ierr = PetscSortInt(total_primal_vertices,aux_primal_numbering);CHKERRQ(ierr);
1758984c4197SStefano Zampini 
1759984c4197SStefano Zampini   /* nonzero structure of constraint matrix */
1760984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1761984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) nnz[i]=1;
1762984c4197SStefano Zampini   j=total_primal_vertices;
1763984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
17644641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1765674ae819SStefano Zampini       nnz[j]=temp_indices[i+1]-temp_indices[i];
1766674ae819SStefano Zampini       j++;
1767674ae819SStefano Zampini     }
1768674ae819SStefano Zampini   }
1769674ae819SStefano Zampini   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
1770674ae819SStefano Zampini   ierr = PetscFree(nnz);CHKERRQ(ierr);
1771674ae819SStefano Zampini   /* set values in constraint matrix */
1772984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) {
1773984c4197SStefano Zampini     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,aux_primal_numbering[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
1774674ae819SStefano Zampini   }
1775984c4197SStefano Zampini   total_counts = total_primal_vertices;
1776984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
17774641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1778674ae819SStefano Zampini       size_of_constraint=temp_indices[i+1]-temp_indices[i];
1779674ae819SStefano 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);
1780674ae819SStefano Zampini       total_counts++;
1781674ae819SStefano Zampini     }
1782674ae819SStefano Zampini   }
1783674ae819SStefano Zampini   /* assembling */
1784674ae819SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1785674ae819SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1786984c4197SStefano Zampini   /*
178745a1bb75SStefano Zampini   ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
1788984c4197SStefano Zampini   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
1789984c4197SStefano Zampini   */
1790674ae819SStefano Zampini   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
1791674ae819SStefano Zampini   if (pcbddc->use_change_of_basis) {
1792026de310SStefano Zampini     /* dual and primal dofs on a single cc */
1793984c4197SStefano Zampini     PetscInt     dual_dofs,primal_dofs;
1794026de310SStefano Zampini     /* iterator on aux_primal_minloc (ordered as read from nearnullspace: vertices, edges and then constraints) */
1795026de310SStefano Zampini     PetscInt     primal_counter;
1796984c4197SStefano Zampini     /* working stuff for GEQRF */
1797984c4197SStefano Zampini     PetscScalar  *qr_basis,*qr_tau,*qr_work,lqr_work_t;
1798984c4197SStefano Zampini     PetscBLASInt lqr_work;
1799984c4197SStefano Zampini     /* working stuff for UNGQR */
1800984c4197SStefano Zampini     PetscScalar  *gqr_work,lgqr_work_t;
1801984c4197SStefano Zampini     PetscBLASInt lgqr_work;
1802984c4197SStefano Zampini     /* working stuff for TRTRS */
1803984c4197SStefano Zampini     PetscScalar  *trs_rhs;
18043f08241aSStefano Zampini     PetscBLASInt Blas_NRHS;
1805984c4197SStefano Zampini     /* pointers for values insertion into change of basis matrix */
1806984c4197SStefano Zampini     PetscInt     *start_rows,*start_cols;
1807984c4197SStefano Zampini     PetscScalar  *start_vals;
1808984c4197SStefano Zampini     /* working stuff for values insertion */
18094641a718SStefano Zampini     PetscBT      is_primal;
1810984c4197SStefano Zampini 
1811a717540cSStefano Zampini     /* change of basis acts on local interfaces -> dimension is n_B x n_B */
1812a717540cSStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
1813a717540cSStefano Zampini     ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr);
1814a717540cSStefano Zampini     ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr);
1815a717540cSStefano Zampini     /* work arrays */
1816a717540cSStefano Zampini     ierr = PetscMalloc(pcis->n_B*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1817a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) nnz[i]=1;
1818a717540cSStefano Zampini     /* nonzeros per row */
1819a717540cSStefano Zampini     for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1820a717540cSStefano Zampini       if (PetscBTLookup(change_basis,i)) {
1821a717540cSStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
1822a717540cSStefano Zampini         if (PetscBTLookup(qr_needed_idx,i)) {
1823a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1824a717540cSStefano Zampini         } else {
1825a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = 2;
1826a717540cSStefano Zampini           /* get local primal index on the cc */
1827a717540cSStefano Zampini           j = 0;
1828a717540cSStefano Zampini           while (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+j])) j++;
1829a717540cSStefano Zampini           nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1830a717540cSStefano Zampini         }
1831a717540cSStefano Zampini       }
1832a717540cSStefano Zampini     }
1833a717540cSStefano Zampini     ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
1834a717540cSStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
1835a717540cSStefano Zampini     /* Set initial identity in the matrix */
1836a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) {
1837a717540cSStefano Zampini       ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
1838a717540cSStefano Zampini     }
1839a717540cSStefano Zampini 
1840a717540cSStefano Zampini     if (pcbddc->dbg_flag) {
1841a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1842a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
1843a717540cSStefano Zampini     }
1844a717540cSStefano Zampini 
1845a717540cSStefano Zampini 
1846a717540cSStefano Zampini     /* Now we loop on the constraints which need a change of basis */
1847a717540cSStefano Zampini     /*
1848a717540cSStefano Zampini        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
1849a717540cSStefano Zampini        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
1850a717540cSStefano Zampini 
1851a717540cSStefano Zampini        Basic blocks of change of basis matrix T computed
1852a717540cSStefano Zampini 
1853a717540cSStefano Zampini           - Using the following block transformation if there is only a primal dof on the cc
1854a717540cSStefano Zampini             (in the example, primal dof is the last one of the edge in LOCAL ordering
1855a717540cSStefano Zampini              in this code, primal dof is the first one of the edge in GLOBAL ordering)
1856a717540cSStefano Zampini             | 1        0   ...        0     1 |
1857a717540cSStefano Zampini             | 0        1   ...        0     1 |
1858a717540cSStefano Zampini             |              ...                |
1859a717540cSStefano Zampini             | 0        ...            1     1 |
1860a717540cSStefano Zampini             | -s_1/s_n ...    -s_{n-1}/-s_n 1 |
1861a717540cSStefano Zampini 
1862a717540cSStefano Zampini           - via QR decomposition of constraints otherwise
1863a717540cSStefano Zampini     */
1864a717540cSStefano Zampini     if (qr_needed) {
1865984c4197SStefano Zampini       /* space to store Q */
1866984c4197SStefano Zampini       ierr = PetscMalloc((max_size_of_constraint)*(max_size_of_constraint)*sizeof(PetscScalar),&qr_basis);CHKERRQ(ierr);
1867984c4197SStefano Zampini       /* first we issue queries for optimal work */
18683f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
18693f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
18703f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1871984c4197SStefano Zampini       lqr_work = -1;
18723f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
1873984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
1874984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
1875984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lqr_work_t)*sizeof(*qr_work),&qr_work);CHKERRQ(ierr);
1876984c4197SStefano Zampini       lgqr_work = -1;
18773f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
18783f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
18793f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
18803f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
18813f08241aSStefano Zampini       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
18823f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
1883984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
1884984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
1885984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lgqr_work_t)*sizeof(*gqr_work),&gqr_work);CHKERRQ(ierr);
1886984c4197SStefano Zampini       /* array to store scaling factors for reflectors */
1887984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*sizeof(*qr_tau),&qr_tau);CHKERRQ(ierr);
1888984c4197SStefano Zampini       /* array to store rhs and solution of triangular solver */
1889984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*max_constraints*sizeof(*trs_rhs),&trs_rhs);CHKERRQ(ierr);
1890a717540cSStefano Zampini       /* allocating workspace for check */
1891a717540cSStefano Zampini       if (pcbddc->dbg_flag) {
1892a717540cSStefano Zampini         ierr = PetscMalloc(max_size_of_constraint*(max_constraints+max_size_of_constraint)*sizeof(*work),&work);CHKERRQ(ierr);
1893a717540cSStefano Zampini       }
1894a717540cSStefano Zampini     }
1895984c4197SStefano Zampini     /* array to store whether a node is primal or not */
18964641a718SStefano Zampini     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
189739e2fb2aSStefano Zampini     ierr = PetscMalloc(total_primal_vertices*sizeof(PetscInt),&aux_primal_numbering_B);CHKERRQ(ierr);
189839e2fb2aSStefano Zampini     ierr = ISGlobalToLocalMappingApply(pcbddc->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,aux_primal_numbering,&i,aux_primal_numbering_B);CHKERRQ(ierr);
189939e2fb2aSStefano Zampini     if (i != total_primal_vertices) {
190039e2fb2aSStefano Zampini       SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %d != %d\n",total_primal_vertices,i);
19014641a718SStefano Zampini     }
190239e2fb2aSStefano Zampini     for (i=0;i<total_primal_vertices;i++) {
190339e2fb2aSStefano Zampini       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
190439e2fb2aSStefano Zampini     }
190539e2fb2aSStefano Zampini     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
1906984c4197SStefano Zampini 
1907a717540cSStefano Zampini     /* loop on constraints and see whether or not they need a change of basis and compute it */
1908026de310SStefano Zampini     /* -> using implicit ordering contained in temp_indices data */
1909026de310SStefano Zampini     total_counts = pcbddc->n_vertices;
1910026de310SStefano Zampini     primal_counter = total_counts;
1911026de310SStefano Zampini     while (total_counts<pcbddc->local_primal_size) {
1912026de310SStefano Zampini       primal_dofs = 1;
19134641a718SStefano Zampini       if (PetscBTLookup(change_basis,total_counts)) {
1914026de310SStefano Zampini         /* get all constraints with same support: if more then one constraint is present on the cc then surely indices are stored contiguosly */
1915026de310SStefano 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]]) {
1916026de310SStefano Zampini           primal_dofs++;
1917674ae819SStefano Zampini         }
1918984c4197SStefano Zampini         /* get constraint info */
1919026de310SStefano Zampini         size_of_constraint = temp_indices[total_counts+1]-temp_indices[total_counts];
1920984c4197SStefano Zampini         dual_dofs = size_of_constraint-primal_dofs;
1921984c4197SStefano Zampini 
1922984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
1923a717540cSStefano 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);
1924674ae819SStefano Zampini         }
1925984c4197SStefano Zampini 
1926a717540cSStefano Zampini         if (primal_dofs > 1) { /* QR */
1927a717540cSStefano Zampini 
1928a717540cSStefano Zampini           /* copy quadrature constraints for change of basis check */
1929a717540cSStefano Zampini           if (pcbddc->dbg_flag) {
1930a717540cSStefano Zampini             ierr = PetscMemcpy(work,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1931a717540cSStefano Zampini           }
1932984c4197SStefano Zampini           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
1933026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1934984c4197SStefano Zampini 
1935984c4197SStefano Zampini           /* compute QR decomposition of constraints */
19363f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
19373f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
19383f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1939674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
19403f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
1941984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
1942674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1943984c4197SStefano Zampini 
1944984c4197SStefano Zampini           /* explictly compute R^-T */
1945984c4197SStefano Zampini           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
1946984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
19473f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
19483f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
19493f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
19503f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
1951984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
19523f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
1953984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
1954984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1955984c4197SStefano Zampini 
1956a717540cSStefano Zampini           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
19573f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
19583f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
19593f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
19603f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1961984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
19623f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
1963984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
1964984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1965984c4197SStefano Zampini 
1966984c4197SStefano Zampini           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
1967984c4197SStefano Zampini              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
1968984c4197SStefano Zampini              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
19693f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
19703f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
19713f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
19723f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
19733f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
19743f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1975984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1976c4303822SStefano 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));
1977984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1978026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1979984c4197SStefano Zampini 
1980984c4197SStefano Zampini           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
1981026de310SStefano Zampini           start_rows = &temp_indices_to_constraint_B[temp_indices[total_counts]];
1982984c4197SStefano Zampini           /* insert cols for primal dofs */
1983984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) {
1984984c4197SStefano Zampini             start_vals = &qr_basis[j*size_of_constraint];
1985026de310SStefano Zampini             start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter+j]];
1986984c4197SStefano Zampini             ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1987984c4197SStefano Zampini           }
1988984c4197SStefano Zampini           /* insert cols for dual dofs */
1989984c4197SStefano Zampini           for (j=0,k=0;j<dual_dofs;k++) {
19904641a718SStefano Zampini             if (!PetscBTLookup(is_primal,temp_indices_to_constraint_B[temp_indices[total_counts]+k])) {
1991984c4197SStefano Zampini               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
1992026de310SStefano Zampini               start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+k];
1993984c4197SStefano Zampini               ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1994984c4197SStefano Zampini               j++;
1995674ae819SStefano Zampini             }
1996674ae819SStefano Zampini           }
1997984c4197SStefano Zampini 
1998984c4197SStefano Zampini           /* check change of basis */
1999984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
2000984c4197SStefano Zampini             PetscInt   ii,jj;
2001984c4197SStefano Zampini             PetscBool valid_qr=PETSC_TRUE;
2002c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
2003c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2004c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
2005c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2006c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
2007c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
2008984c4197SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2009c4303822SStefano 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));
2010984c4197SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
2011984c4197SStefano Zampini             for (jj=0;jj<size_of_constraint;jj++) {
2012984c4197SStefano Zampini               for (ii=0;ii<primal_dofs;ii++) {
2013984c4197SStefano Zampini                 if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
2014984c4197SStefano Zampini                 if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
2015674ae819SStefano Zampini               }
2016674ae819SStefano Zampini             }
2017984c4197SStefano Zampini             if (!valid_qr) {
2018984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
2019984c4197SStefano Zampini               for (jj=0;jj<size_of_constraint;jj++) {
2020984c4197SStefano Zampini                 for (ii=0;ii<primal_dofs;ii++) {
2021984c4197SStefano Zampini                   if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
2022984c4197SStefano 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]));
2023674ae819SStefano Zampini                   }
2024984c4197SStefano Zampini                   if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
2025984c4197SStefano 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]));
2026984c4197SStefano Zampini                   }
2027984c4197SStefano Zampini                 }
2028984c4197SStefano Zampini               }
2029674ae819SStefano Zampini             } else {
2030984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
2031674ae819SStefano Zampini             }
2032674ae819SStefano Zampini           }
2033a717540cSStefano Zampini         } else { /* simple transformation block */
2034a717540cSStefano Zampini           PetscInt row,col;
2035a717540cSStefano Zampini           PetscScalar val;
2036a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) {
2037a717540cSStefano Zampini             row = temp_indices_to_constraint_B[temp_indices[total_counts]+j];
2038a717540cSStefano Zampini             if (!PetscBTLookup(is_primal,row)) {
2039a717540cSStefano Zampini               col = temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
2040a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
2041a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,1.0,INSERT_VALUES);CHKERRQ(ierr);
2042a717540cSStefano Zampini             } else {
2043a717540cSStefano Zampini               for (k=0;k<size_of_constraint;k++) {
2044a717540cSStefano Zampini                 col = temp_indices_to_constraint_B[temp_indices[total_counts]+k];
2045a717540cSStefano Zampini                 if (row != col) {
2046a717540cSStefano Zampini                   val = -temp_quadrature_constraint[temp_indices[total_counts]+k]/temp_quadrature_constraint[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
2047a717540cSStefano Zampini                 } else {
2048a717540cSStefano Zampini                   val = 1.0;
2049a717540cSStefano Zampini                 }
2050a717540cSStefano Zampini                 ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
2051a717540cSStefano Zampini               }
2052a717540cSStefano Zampini             }
2053a717540cSStefano Zampini           }
2054a717540cSStefano Zampini         }
2055026de310SStefano Zampini         /* increment primal counter */
2056026de310SStefano Zampini         primal_counter += primal_dofs;
2057984c4197SStefano Zampini       } else {
2058984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
2059026de310SStefano 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);
2060674ae819SStefano Zampini         }
2061674ae819SStefano Zampini       }
2062026de310SStefano Zampini       /* increment constraint counter total_counts */
2063026de310SStefano Zampini       total_counts += primal_dofs;
2064674ae819SStefano Zampini     }
2065a717540cSStefano Zampini 
2066a717540cSStefano Zampini     /* free workspace */
2067a717540cSStefano Zampini     if (qr_needed) {
2068984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
2069984c4197SStefano Zampini         ierr = PetscFree(work);CHKERRQ(ierr);
2070984c4197SStefano Zampini       }
2071984c4197SStefano Zampini       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
2072984c4197SStefano Zampini       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
2073984c4197SStefano Zampini       ierr = PetscFree(qr_work);CHKERRQ(ierr);
2074984c4197SStefano Zampini       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
2075984c4197SStefano Zampini       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
2076674ae819SStefano Zampini     }
2077a717540cSStefano Zampini     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
2078674ae819SStefano Zampini     /* assembling */
2079674ae819SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2080674ae819SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2081984c4197SStefano Zampini     /*
208245a1bb75SStefano Zampini     ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
2083984c4197SStefano Zampini     ierr = MatView(pcbddc->ChangeOfBasisMatrix,(PetscViewer)0);CHKERRQ(ierr);
2084984c4197SStefano Zampini     */
2085674ae819SStefano Zampini   }
2086a717540cSStefano Zampini 
2087727cdba6SStefano Zampini   /* get indices in local ordering for vertices and constraints */
2088727cdba6SStefano 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 */
2089727cdba6SStefano Zampini     ierr = PetscMalloc(olocal_primal_size*sizeof(PetscInt),&oprimal_indices_local_idxs);CHKERRQ(ierr);
2090727cdba6SStefano Zampini     ierr = PetscMemcpy(oprimal_indices_local_idxs,pcbddc->primal_indices_local_idxs,olocal_primal_size*sizeof(PetscInt));CHKERRQ(ierr);
2091727cdba6SStefano Zampini   }
2092727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2093727cdba6SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
2094727cdba6SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&i,&aux_primal_numbering);CHKERRQ(ierr);
2095727cdba6SStefano Zampini   ierr = PetscMemcpy(pcbddc->primal_indices_local_idxs,aux_primal_numbering,i*sizeof(PetscInt));CHKERRQ(ierr);
2096727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2097727cdba6SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&j,&aux_primal_numbering);CHKERRQ(ierr);
2098727cdba6SStefano Zampini   ierr = PetscMemcpy(&pcbddc->primal_indices_local_idxs[i],aux_primal_numbering,j*sizeof(PetscInt));CHKERRQ(ierr);
2099727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2100e9189074SStefano Zampini   /* set quantities in PCBDDC data struct */
2101e9189074SStefano Zampini   pcbddc->n_actual_vertices = i;
2102727cdba6SStefano Zampini   /* check if a new primal space has been introduced */
2103727cdba6SStefano Zampini   pcbddc->new_primal_space_local = PETSC_TRUE;
2104727cdba6SStefano Zampini   if (olocal_primal_size == pcbddc->local_primal_size) {
2105727cdba6SStefano Zampini     ierr = PetscMemcmp(pcbddc->primal_indices_local_idxs,oprimal_indices_local_idxs,olocal_primal_size,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
2106c1c8e736SStefano Zampini     pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
2107727cdba6SStefano Zampini     ierr = PetscFree(oprimal_indices_local_idxs);CHKERRQ(ierr);
2108727cdba6SStefano Zampini   }
210989c96988SStefano Zampini   /* need to set pcbddc->new_primal_space_local to true when the local primal space is empty, otherwise pcbddc->is_R_local will not be created */
211089c96988SStefano Zampini   if (!pcbddc->local_primal_size) pcbddc->new_primal_space_local = PETSC_TRUE;
2111727cdba6SStefano Zampini   /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
2112727cdba6SStefano Zampini   ierr = MPI_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2113727cdba6SStefano Zampini 
2114a717540cSStefano Zampini   /* flush dbg viewer */
2115b8ffe317SStefano Zampini   if (pcbddc->dbg_flag) {
2116b8ffe317SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2117b8ffe317SStefano Zampini   }
2118a717540cSStefano Zampini 
2119e310c8b4SStefano Zampini   /* free workspace */
2120a717540cSStefano Zampini   ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2121a717540cSStefano Zampini   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
2122984c4197SStefano Zampini   ierr = PetscFree(aux_primal_minloc);CHKERRQ(ierr);
2123674ae819SStefano Zampini   ierr = PetscFree(temp_indices);CHKERRQ(ierr);
21244641a718SStefano Zampini   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
2125674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr);
2126674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
2127674ae819SStefano Zampini   ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr);
2128674ae819SStefano Zampini   PetscFunctionReturn(0);
2129674ae819SStefano Zampini }
2130674ae819SStefano Zampini 
2131674ae819SStefano Zampini #undef __FUNCT__
2132674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
2133674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
2134674ae819SStefano Zampini {
2135674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
2136674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
2137674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
213863602bcaSStefano Zampini   PetscInt    ierr,i,vertex_size;
2139674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
2140674ae819SStefano Zampini 
2141674ae819SStefano Zampini   PetscFunctionBegin;
21428e61c736SStefano Zampini   /* Reset previously computed graph */
21438e61c736SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
2144674ae819SStefano Zampini   /* Init local Graph struct */
2145674ae819SStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr);
2146674ae819SStefano Zampini 
2147575ad6abSStefano Zampini   /* Check validity of the csr graph passed in by the user */
2148575ad6abSStefano Zampini   if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) {
2149575ad6abSStefano Zampini     ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
2150575ad6abSStefano Zampini   }
21519577ea80SStefano Zampini 
2152674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
2153674ae819SStefano Zampini   if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) {
2154674ae819SStefano Zampini     Mat mat_adj;
2155674ae819SStefano Zampini     const PetscInt *xadj,*adjncy;
2156674ae819SStefano Zampini     PetscBool flg_row=PETSC_TRUE;
2157674ae819SStefano Zampini 
2158674ae819SStefano Zampini     ierr = MatConvert(matis->A,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr);
2159674ae819SStefano Zampini     ierr = MatGetRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2160674ae819SStefano Zampini     if (!flg_row) {
2161674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ called in %s\n",__FUNCT__);
2162674ae819SStefano Zampini     }
2163674ae819SStefano Zampini     ierr = PCBDDCSetLocalAdjacencyGraph(pc,i,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
2164674ae819SStefano Zampini     ierr = MatRestoreRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2165674ae819SStefano Zampini     if (!flg_row) {
2166674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__);
2167674ae819SStefano Zampini     }
2168674ae819SStefano Zampini     ierr = MatDestroy(&mat_adj);CHKERRQ(ierr);
2169674ae819SStefano Zampini   }
2170674ae819SStefano Zampini 
217163602bcaSStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting or PCBDDCSetDofsSplittingLocal */
2172674ae819SStefano Zampini   vertex_size = 1;
217363602bcaSStefano Zampini   if (pcbddc->user_provided_isfordofs) {
217463602bcaSStefano Zampini     if (pcbddc->n_ISForDofs) { /* need to convert from global to local and remove references to global dofs splitting */
217563602bcaSStefano Zampini       ierr = PetscMalloc(pcbddc->n_ISForDofs*sizeof(IS),&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
217663602bcaSStefano Zampini       for (i=0;i<pcbddc->n_ISForDofs;i++) {
217763602bcaSStefano Zampini         ierr = PCBDDCGlobalToLocal(pc,matis->ctx,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
217863602bcaSStefano Zampini         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
2179674ae819SStefano Zampini       }
218063602bcaSStefano Zampini       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
218163602bcaSStefano Zampini       pcbddc->n_ISForDofs = 0;
218263602bcaSStefano Zampini       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
2183674ae819SStefano Zampini     }
218463602bcaSStefano Zampini     /* 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);
218663602bcaSStefano Zampini   } else {
218763602bcaSStefano Zampini     if (!pcbddc->n_ISForDofsLocal) { /* field split not present, create it in local ordering */
218863602bcaSStefano Zampini       ierr = MatGetBlockSize(pc->pmat,&pcbddc->n_ISForDofsLocal);CHKERRQ(ierr);
218963602bcaSStefano Zampini       ierr = PetscMalloc(pcbddc->n_ISForDofsLocal*sizeof(IS),&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
219063602bcaSStefano Zampini       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
219163602bcaSStefano Zampini         ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),pcis->n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
219263602bcaSStefano Zampini       }
219363602bcaSStefano Zampini     }
2194674ae819SStefano Zampini   }
2195674ae819SStefano Zampini 
2196674ae819SStefano Zampini   /* Setup of Graph */
2197785d1243SStefano Zampini   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) { /* need to convert from global to local */
2198e456f2a8SStefano Zampini     ierr = PCBDDCGlobalToLocal(pc,matis->ctx,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
2199785d1243SStefano Zampini   }
2200785d1243SStefano Zampini   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) { /* need to convert from global to local */
2201e456f2a8SStefano Zampini     ierr = PCBDDCGlobalToLocal(pc,matis->ctx,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
2202785d1243SStefano Zampini   }
220363602bcaSStefano Zampini   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices);
2204674ae819SStefano Zampini 
2205674ae819SStefano Zampini   /* Graph's connected components analysis */
2206674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
2207674ae819SStefano Zampini 
2208674ae819SStefano Zampini   /* print some info to stdout */
2209674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
2210e49050b4SStefano Zampini     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer);
2211674ae819SStefano Zampini   }
2212fb180af4SStefano Zampini 
2213fb180af4SStefano Zampini   /* mark topography has done */
2214fb180af4SStefano Zampini   pcbddc->recompute_topography = PETSC_FALSE;
2215674ae819SStefano Zampini   PetscFunctionReturn(0);
2216674ae819SStefano Zampini }
2217674ae819SStefano Zampini 
2218674ae819SStefano Zampini #undef __FUNCT__
2219674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx"
2220f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt **vertices_idx)
2221674ae819SStefano Zampini {
2222674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2223674ae819SStefano Zampini   PetscInt       *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size;
2224674ae819SStefano Zampini   PetscErrorCode ierr;
2225674ae819SStefano Zampini 
2226674ae819SStefano Zampini   PetscFunctionBegin;
2227674ae819SStefano Zampini   n = 0;
2228674ae819SStefano Zampini   vertices = 0;
2229674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2230674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr);
2231b120a5c6SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2232b120a5c6SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2233b120a5c6SStefano Zampini       if (size_of_constraint == 1) n++;
2234b120a5c6SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2235b120a5c6SStefano Zampini     }
2236811e8ca2SStefano Zampini     if (vertices_idx) {
2237b120a5c6SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&vertices);CHKERRQ(ierr);
2238b120a5c6SStefano Zampini       n = 0;
2239674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2240674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2241674ae819SStefano Zampini         if (size_of_constraint == 1) {
2242674ae819SStefano Zampini           vertices[n++]=row_cmat_indices[0];
2243674ae819SStefano Zampini         }
2244674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2245674ae819SStefano Zampini       }
2246674ae819SStefano Zampini     }
2247811e8ca2SStefano Zampini   }
2248674ae819SStefano Zampini   *n_vertices = n;
2249811e8ca2SStefano Zampini   if (vertices_idx) *vertices_idx = vertices;
2250674ae819SStefano Zampini   PetscFunctionReturn(0);
2251674ae819SStefano Zampini }
2252674ae819SStefano Zampini 
2253674ae819SStefano Zampini #undef __FUNCT__
2254674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx"
2255f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt **constraints_idx)
2256674ae819SStefano Zampini {
2257674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2258674ae819SStefano Zampini   PetscInt       *constraints_index,*row_cmat_indices,*row_cmat_global_indices;
2259674ae819SStefano Zampini   PetscInt       n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc;
22604641a718SStefano Zampini   PetscBT        touched;
2261674ae819SStefano Zampini   PetscErrorCode ierr;
2262674ae819SStefano Zampini 
2263f34684f1SStefano Zampini     /* This function assumes that the number of local constraints per connected component
2264f34684f1SStefano Zampini        is not greater than the number of nodes defined for the connected component
2265f34684f1SStefano Zampini        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
2266674ae819SStefano Zampini   PetscFunctionBegin;
2267674ae819SStefano Zampini   n = 0;
2268674ae819SStefano Zampini   constraints_index = 0;
2269674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2270674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr);
2271674ae819SStefano Zampini     max_size_of_constraint = 0;
2272674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2273674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2274674ae819SStefano Zampini       if (size_of_constraint > 1) {
2275674ae819SStefano Zampini         n++;
2276674ae819SStefano Zampini       }
2277674ae819SStefano Zampini       max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint);
2278674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2279674ae819SStefano Zampini     }
2280811e8ca2SStefano Zampini     if (constraints_idx) {
2281674ae819SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&constraints_index);CHKERRQ(ierr);
2282674ae819SStefano Zampini       ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&row_cmat_global_indices);CHKERRQ(ierr);
22834641a718SStefano Zampini       ierr = PetscBTCreate(local_size,&touched);CHKERRQ(ierr);
2284674ae819SStefano Zampini       n = 0;
2285674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2286674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2287674ae819SStefano Zampini         if (size_of_constraint > 1) {
2288674ae819SStefano Zampini           ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr);
228982d3d8afSStefano Zampini           /* find first untouched local node */
229082d3d8afSStefano Zampini           j = 0;
22914641a718SStefano Zampini           while (PetscBTLookup(touched,row_cmat_indices[j])) j++;
229282d3d8afSStefano Zampini           min_index = row_cmat_global_indices[j];
229382d3d8afSStefano Zampini           min_loc = j;
229482d3d8afSStefano Zampini           /* search the minimum among nodes not yet touched on the connected component
229582d3d8afSStefano Zampini              since there can be more than one constraint on a single cc */
2296674ae819SStefano Zampini           for (j=1;j<size_of_constraint;j++) {
22974641a718SStefano Zampini             if (!PetscBTLookup(touched,row_cmat_indices[j]) && min_index > row_cmat_global_indices[j]) {
2298674ae819SStefano Zampini               min_index = row_cmat_global_indices[j];
2299674ae819SStefano Zampini               min_loc = j;
2300674ae819SStefano Zampini             }
2301674ae819SStefano Zampini           }
23024641a718SStefano Zampini           ierr = PetscBTSet(touched,row_cmat_indices[min_loc]);CHKERRQ(ierr);
2303674ae819SStefano Zampini           constraints_index[n++] = row_cmat_indices[min_loc];
2304674ae819SStefano Zampini         }
2305674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2306674ae819SStefano Zampini       }
23074641a718SStefano Zampini       ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2308674ae819SStefano Zampini       ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr);
2309811e8ca2SStefano Zampini     }
2310811e8ca2SStefano Zampini   }
2311674ae819SStefano Zampini   *n_constraints = n;
2312811e8ca2SStefano Zampini   if (constraints_idx) *constraints_idx = constraints_index;
2313674ae819SStefano Zampini   PetscFunctionReturn(0);
2314674ae819SStefano Zampini }
2315674ae819SStefano Zampini 
2316674ae819SStefano Zampini /* the next two functions has been adapted from pcis.c */
2317674ae819SStefano Zampini #undef __FUNCT__
2318674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchur"
2319674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchur(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2320674ae819SStefano Zampini {
2321674ae819SStefano Zampini   PetscErrorCode ierr;
2322674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2323674ae819SStefano Zampini 
2324674ae819SStefano Zampini   PetscFunctionBegin;
2325674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2326674ae819SStefano Zampini   ierr = MatMult(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2327674ae819SStefano Zampini   ierr = MatMult(pcis->A_IB,v,vec1_D);CHKERRQ(ierr);
2328674ae819SStefano Zampini   ierr = KSPSolve(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2329674ae819SStefano Zampini   ierr = MatMult(pcis->A_BI,vec2_D,vec2_B);CHKERRQ(ierr);
2330674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2331674ae819SStefano Zampini   PetscFunctionReturn(0);
2332674ae819SStefano Zampini }
2333674ae819SStefano Zampini 
2334674ae819SStefano Zampini #undef __FUNCT__
2335674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchurTranspose"
2336674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchurTranspose(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2337674ae819SStefano Zampini {
2338674ae819SStefano Zampini   PetscErrorCode ierr;
2339674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2340674ae819SStefano Zampini 
2341674ae819SStefano Zampini   PetscFunctionBegin;
2342674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2343674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2344674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BI,v,vec1_D);CHKERRQ(ierr);
2345674ae819SStefano Zampini   ierr = KSPSolveTranspose(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2346674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_IB,vec2_D,vec2_B);CHKERRQ(ierr);
2347674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2348674ae819SStefano Zampini   PetscFunctionReturn(0);
2349674ae819SStefano Zampini }
2350674ae819SStefano Zampini 
2351674ae819SStefano Zampini #undef __FUNCT__
2352674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
2353674ae819SStefano 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[])
2354674ae819SStefano Zampini {
2355674ae819SStefano Zampini   Vec            local_vec,global_vec;
2356674ae819SStefano Zampini   IS             seqis,paris;
2357674ae819SStefano Zampini   VecScatter     scatter_ctx;
2358674ae819SStefano Zampini   PetscScalar    *array;
2359674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
2360674ae819SStefano Zampini   PetscScalar    globalsum;
2361674ae819SStefano Zampini   PetscInt       i,j,s;
2362674ae819SStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local;
2363674ae819SStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm,max_global;
2364674ae819SStefano Zampini   PetscMPIInt    *dof_sizes,*dof_displs;
2365674ae819SStefano Zampini   PetscBool      first_found;
2366674ae819SStefano Zampini   PetscErrorCode ierr;
2367674ae819SStefano Zampini 
2368674ae819SStefano Zampini   PetscFunctionBegin;
2369674ae819SStefano Zampini   /* mpi buffers */
2370674ae819SStefano Zampini   MPI_Comm_size(comm,&size_prec_comm);
2371674ae819SStefano Zampini   MPI_Comm_rank(comm,&rank_prec_comm);
2372674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
2373674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_sizes),&dof_sizes);CHKERRQ(ierr);
2374674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_displs),&dof_displs);CHKERRQ(ierr);
2375674ae819SStefano Zampini   /* get maximum size of subset */
2376674ae819SStefano Zampini   ierr = PetscMalloc(n_local_dofs*sizeof(PetscInt),&temp_global_dofs);CHKERRQ(ierr);
2377674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
2378674ae819SStefano Zampini   max_local = 0;
2379674ae819SStefano Zampini   if (n_local_dofs) {
2380674ae819SStefano Zampini     max_local = temp_global_dofs[0];
2381674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2382674ae819SStefano Zampini       if (max_local < temp_global_dofs[i] ) {
2383674ae819SStefano Zampini         max_local = temp_global_dofs[i];
2384674ae819SStefano Zampini       }
2385674ae819SStefano Zampini     }
2386674ae819SStefano Zampini   }
2387674ae819SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);
2388674ae819SStefano Zampini   max_global++;
2389674ae819SStefano Zampini   max_local = 0;
2390674ae819SStefano Zampini   if (n_local_dofs) {
2391674ae819SStefano Zampini     max_local = local_dofs[0];
2392674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2393674ae819SStefano Zampini       if (max_local < local_dofs[i] ) {
2394674ae819SStefano Zampini         max_local = local_dofs[i];
2395674ae819SStefano Zampini       }
2396674ae819SStefano Zampini     }
2397674ae819SStefano Zampini   }
2398674ae819SStefano Zampini   max_local++;
2399674ae819SStefano Zampini   /* allocate workspace */
2400674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
2401674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
2402674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
2403674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
2404674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
2405674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
2406674ae819SStefano Zampini   /* create scatter */
2407674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
2408674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
2409674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
2410674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
2411674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
2412674ae819SStefano Zampini   /* init array */
2413674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
2414674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2415674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2416674ae819SStefano Zampini   if (local_dofs_mult) {
2417674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2418674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
2419674ae819SStefano Zampini     }
2420674ae819SStefano Zampini   } else {
2421674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2422674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
2423674ae819SStefano Zampini     }
2424674ae819SStefano Zampini   }
2425674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2426674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
2427674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2428674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2429674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
24305b08dc53SStefano Zampini   *n_global_subset = (PetscInt)PetscRealPart(globalsum);
2431674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
2432674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
2433674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
2434674ae819SStefano Zampini   nlocals = 0;
2435674ae819SStefano Zampini   first_index = -1;
2436674ae819SStefano Zampini   first_found = PETSC_FALSE;
2437674ae819SStefano Zampini   for (i=0;i<s;i++) {
24385b08dc53SStefano Zampini     if (!first_found && PetscRealPart(array[i]) > 0.0) {
2439674ae819SStefano Zampini       first_found = PETSC_TRUE;
2440674ae819SStefano Zampini       first_index = i;
2441674ae819SStefano Zampini     }
24425b08dc53SStefano Zampini     nlocals += (PetscInt)PetscRealPart(array[i]);
2443674ae819SStefano Zampini   }
2444674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2445674ae819SStefano Zampini   if (!rank_prec_comm) {
2446674ae819SStefano Zampini     dof_displs[0]=0;
2447674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
2448674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
2449674ae819SStefano Zampini     }
2450674ae819SStefano Zampini   }
2451674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2452674ae819SStefano Zampini   if (first_found) {
2453674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
2454674ae819SStefano Zampini     old_index = first_index;
2455674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
24565b08dc53SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) {
2457674ae819SStefano Zampini         array[i] += array[old_index];
2458674ae819SStefano Zampini         old_index = i;
2459674ae819SStefano Zampini       }
2460674ae819SStefano Zampini     }
2461674ae819SStefano Zampini   }
2462674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
2463674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2464674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2465674ae819SStefano Zampini   ierr = VecScatterEnd  (scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2466674ae819SStefano Zampini   /* get global ordering of local dofs */
2467674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2468674ae819SStefano Zampini   if (local_dofs_mult) {
2469674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
24705b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i];
2471674ae819SStefano Zampini     }
2472674ae819SStefano Zampini   } else {
2473674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
24745b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1;
2475674ae819SStefano Zampini     }
2476674ae819SStefano Zampini   }
2477674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2478674ae819SStefano Zampini   /* free workspace */
2479674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
2480674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
2481674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
2482674ae819SStefano Zampini   ierr = PetscFree(dof_sizes);CHKERRQ(ierr);
2483674ae819SStefano Zampini   ierr = PetscFree(dof_displs);CHKERRQ(ierr);
2484674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
2485674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
2486674ae819SStefano Zampini   PetscFunctionReturn(0);
2487674ae819SStefano Zampini }
24889a7d3425SStefano Zampini 
24899a7d3425SStefano Zampini #undef __FUNCT__
24909a7d3425SStefano Zampini #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
24919a7d3425SStefano Zampini PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
24929a7d3425SStefano Zampini {
24939a7d3425SStefano Zampini   PetscInt       i,j;
24949a7d3425SStefano Zampini   PetscScalar    *alphas;
24959a7d3425SStefano Zampini   PetscErrorCode ierr;
24969a7d3425SStefano Zampini 
24979a7d3425SStefano Zampini   PetscFunctionBegin;
24989a7d3425SStefano Zampini   /* this implements stabilized Gram-Schmidt */
24999a7d3425SStefano Zampini   ierr = PetscMalloc(n*sizeof(PetscScalar),&alphas);CHKERRQ(ierr);
25009a7d3425SStefano Zampini   for (i=0;i<n;i++) {
25019a7d3425SStefano Zampini     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
25029a7d3425SStefano Zampini     if (i<n) { ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],&alphas[i+1]);CHKERRQ(ierr); }
25039a7d3425SStefano Zampini     for (j=i+1;j<n;j++) { ierr = VecAXPY(vecs[j],PetscConj(-alphas[j]),vecs[i]);CHKERRQ(ierr); }
25049a7d3425SStefano Zampini   }
25059a7d3425SStefano Zampini   ierr = PetscFree(alphas);CHKERRQ(ierr);
25069a7d3425SStefano Zampini   PetscFunctionReturn(0);
25079a7d3425SStefano Zampini }
25089a7d3425SStefano Zampini 
2509fa7f1dd8SStefano Zampini /* TODO
2510fa7f1dd8SStefano Zampini    - now preallocation is done assuming SEQDENSE local matrices
2511fa7f1dd8SStefano Zampini */
2512c8587f34SStefano Zampini #undef __FUNCT__
2513fa7f1dd8SStefano Zampini #define __FUNCT__ "MatISGetMPIXAIJ"
2514fa7f1dd8SStefano Zampini static PetscErrorCode MatISGetMPIXAIJ(Mat mat, MatType Mtype, MatReuse reuse, Mat *M)
2515c8587f34SStefano Zampini {
2516a57a6d2fSStefano Zampini   Mat                    new_mat;
2517a57a6d2fSStefano Zampini   Mat_IS                 *matis = (Mat_IS*)(mat->data);
2518a57a6d2fSStefano Zampini   /* info on mat */
2519fa7f1dd8SStefano Zampini   /* ISLocalToGlobalMapping rmapping,cmapping; */
2520a57a6d2fSStefano Zampini   PetscInt               bs,rows,cols;
2521a57a6d2fSStefano Zampini   PetscInt               lrows,lcols;
2522a57a6d2fSStefano Zampini   PetscInt               local_rows,local_cols;
2523fa7f1dd8SStefano Zampini   PetscBool              isdense;
2524fa7f1dd8SStefano Zampini   /* values insertion */
2525fa7f1dd8SStefano Zampini   PetscScalar            *array;
2526a57a6d2fSStefano Zampini   PetscInt               *local_indices,*global_indices;
2527a57a6d2fSStefano Zampini   /* work */
2528fa7f1dd8SStefano Zampini   PetscInt               i,j,index_row;
2529a57a6d2fSStefano Zampini   PetscErrorCode         ierr;
2530c8587f34SStefano Zampini 
2531a57a6d2fSStefano Zampini   PetscFunctionBegin;
2532fa7f1dd8SStefano Zampini   /* MISSING CHECKS
2533fa7f1dd8SStefano Zampini     - rectangular case not covered (it is not allowed by MATIS)
2534fa7f1dd8SStefano Zampini   */
2535a57a6d2fSStefano Zampini   /* get info from mat */
2536fa7f1dd8SStefano Zampini   /* ierr = MatGetLocalToGlobalMapping(mat,&rmapping,&cmapping);CHKERRQ(ierr); */
2537a57a6d2fSStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
2538a57a6d2fSStefano Zampini   ierr = MatGetBlockSize(mat,&bs);CHKERRQ(ierr);
2539a57a6d2fSStefano Zampini   ierr = MatGetSize(matis->A,&local_rows,&local_cols);CHKERRQ(ierr);
2540a57a6d2fSStefano Zampini 
2541fa7f1dd8SStefano Zampini   /* work */
2542fa7f1dd8SStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*local_indices),&local_indices);CHKERRQ(ierr);
2543fa7f1dd8SStefano Zampini   for (i=0;i<local_rows;i++) local_indices[i]=i;
2544fa7f1dd8SStefano Zampini   /* map indices of local mat to global values */
2545fa7f1dd8SStefano Zampini   ierr = PetscMalloc(PetscMax(local_cols,local_rows)*sizeof(*global_indices),&global_indices);CHKERRQ(ierr);
2546fa7f1dd8SStefano Zampini   /* ierr = ISLocalToGlobalMappingApply(rmapping,local_rows,local_indices,global_indices);CHKERRQ(ierr); */
2547fa7f1dd8SStefano Zampini   ierr = ISLocalToGlobalMappingApply(matis->mapping,local_rows,local_indices,global_indices);CHKERRQ(ierr);
2548fa7f1dd8SStefano Zampini 
2549fa7f1dd8SStefano Zampini   if (reuse==MAT_INITIAL_MATRIX) {
2550fa7f1dd8SStefano Zampini     Vec         vec_dnz,vec_onz;
2551fa7f1dd8SStefano Zampini     PetscScalar *my_dnz,*my_onz;
2552fa7f1dd8SStefano Zampini     PetscInt    *dnz,*onz,*mat_ranges,*row_ownership;
2553fa7f1dd8SStefano Zampini     PetscInt    index_col,owner;
2554fa7f1dd8SStefano Zampini     PetscMPIInt nsubdomains;
2555fa7f1dd8SStefano Zampini 
2556fa7f1dd8SStefano Zampini     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&nsubdomains);CHKERRQ(ierr);
2557a57a6d2fSStefano Zampini     ierr = MatCreate(PetscObjectComm((PetscObject)mat),&new_mat);CHKERRQ(ierr);
2558a57a6d2fSStefano Zampini     ierr = MatSetSizes(new_mat,PETSC_DECIDE,PETSC_DECIDE,rows,cols);CHKERRQ(ierr);
2559a57a6d2fSStefano Zampini     ierr = MatSetBlockSize(new_mat,bs);CHKERRQ(ierr);
2560fa7f1dd8SStefano Zampini     ierr = MatSetType(new_mat,Mtype);CHKERRQ(ierr);
2561a57a6d2fSStefano Zampini     ierr = MatSetUp(new_mat);CHKERRQ(ierr);
2562a57a6d2fSStefano Zampini     ierr = MatGetLocalSize(new_mat,&lrows,&lcols);CHKERRQ(ierr);
2563a57a6d2fSStefano Zampini 
2564a57a6d2fSStefano Zampini     /*
2565a57a6d2fSStefano Zampini       preallocation
2566a57a6d2fSStefano Zampini     */
2567a57a6d2fSStefano Zampini 
2568a57a6d2fSStefano Zampini     ierr = MatPreallocateInitialize(PetscObjectComm((PetscObject)new_mat),lrows,lcols,dnz,onz);CHKERRQ(ierr);
2569a57a6d2fSStefano Zampini     /*
2570a57a6d2fSStefano Zampini        Some vectors are needed to sum up properly on shared interface dofs.
2571fa7f1dd8SStefano Zampini        Preallocation macros cannot do the job.
2572a57a6d2fSStefano Zampini        Note that preallocation is not exact, since it overestimates nonzeros
2573a57a6d2fSStefano Zampini     */
2574a57a6d2fSStefano Zampini     ierr = MatGetVecs(new_mat,NULL,&vec_dnz);CHKERRQ(ierr);
2575fa7f1dd8SStefano Zampini     /* ierr = VecSetLocalToGlobalMapping(vec_dnz,rmapping);CHKERRQ(ierr); */
2576fa7f1dd8SStefano Zampini     ierr = VecSetLocalToGlobalMapping(vec_dnz,matis->mapping);CHKERRQ(ierr);
2577c8587f34SStefano Zampini     ierr = VecDuplicate(vec_dnz,&vec_onz);CHKERRQ(ierr);
2578e7931f94SStefano Zampini     /* All processes need to compute entire row ownership */
2579a57a6d2fSStefano Zampini     ierr = PetscMalloc(rows*sizeof(*row_ownership),&row_ownership);CHKERRQ(ierr);
2580a57a6d2fSStefano Zampini     ierr = MatGetOwnershipRanges(new_mat,(const PetscInt**)&mat_ranges);CHKERRQ(ierr);
2581a57a6d2fSStefano Zampini     for (i=0;i<nsubdomains;i++) {
2582c8587f34SStefano Zampini       for (j=mat_ranges[i];j<mat_ranges[i+1];j++) {
2583c8587f34SStefano Zampini         row_ownership[j]=i;
2584c8587f34SStefano Zampini       }
2585c8587f34SStefano Zampini     }
2586c8587f34SStefano Zampini 
2587e7931f94SStefano Zampini     /*
2588e7931f94SStefano Zampini        my_dnz and my_onz contains exact contribution to preallocation from each local mat
2589e7931f94SStefano Zampini        then, they will be summed up properly. This way, preallocation is always sufficient
2590e7931f94SStefano Zampini     */
2591a57a6d2fSStefano Zampini     ierr = PetscMalloc(local_rows*sizeof(*my_dnz),&my_dnz);CHKERRQ(ierr);
2592a57a6d2fSStefano Zampini     ierr = PetscMalloc(local_rows*sizeof(*my_onz),&my_onz);CHKERRQ(ierr);
2593a57a6d2fSStefano Zampini     ierr = PetscMemzero(my_dnz,local_rows*sizeof(*my_dnz));CHKERRQ(ierr);
2594a57a6d2fSStefano Zampini     ierr = PetscMemzero(my_onz,local_rows*sizeof(*my_onz));CHKERRQ(ierr);
2595a57a6d2fSStefano Zampini     for (i=0;i<local_rows;i++) {
2596a57a6d2fSStefano Zampini       index_row = global_indices[i];
2597a57a6d2fSStefano Zampini       for (j=i;j<local_rows;j++) {
2598a57a6d2fSStefano Zampini         owner = row_ownership[index_row];
2599a57a6d2fSStefano Zampini         index_col = global_indices[j];
2600a57a6d2fSStefano Zampini         if (index_col > mat_ranges[owner]-1 && index_col < mat_ranges[owner+1] ) { /* diag block */
2601c8587f34SStefano Zampini           my_dnz[i] += 1.0;
2602a57a6d2fSStefano Zampini         } else { /* offdiag block */
2603c8587f34SStefano Zampini           my_onz[i] += 1.0;
2604c8587f34SStefano Zampini         }
2605a57a6d2fSStefano Zampini         /* same as before, interchanging rows and cols */
2606c8587f34SStefano Zampini         if (i != j) {
2607a57a6d2fSStefano Zampini           owner = row_ownership[index_col];
2608a57a6d2fSStefano Zampini           if (index_row > mat_ranges[owner]-1 && index_row < mat_ranges[owner+1] ) {
2609c8587f34SStefano Zampini             my_dnz[j] += 1.0;
2610c8587f34SStefano Zampini           } else {
2611c8587f34SStefano Zampini             my_onz[j] += 1.0;
2612c8587f34SStefano Zampini           }
2613c8587f34SStefano Zampini         }
2614c8587f34SStefano Zampini       }
2615c8587f34SStefano Zampini     }
2616c8587f34SStefano Zampini     ierr = VecSet(vec_dnz,0.0);CHKERRQ(ierr);
2617c8587f34SStefano Zampini     ierr = VecSet(vec_onz,0.0);CHKERRQ(ierr);
261820a2ab83SStefano Zampini     if (local_rows) { /* multilevel guard */
2619fa7f1dd8SStefano Zampini       ierr = VecSetValuesLocal(vec_dnz,local_rows,local_indices,my_dnz,ADD_VALUES);CHKERRQ(ierr);
2620fa7f1dd8SStefano Zampini       ierr = VecSetValuesLocal(vec_onz,local_rows,local_indices,my_onz,ADD_VALUES);CHKERRQ(ierr);
2621c8587f34SStefano Zampini     }
2622c8587f34SStefano Zampini     ierr = VecAssemblyBegin(vec_dnz);CHKERRQ(ierr);
2623c8587f34SStefano Zampini     ierr = VecAssemblyBegin(vec_onz);CHKERRQ(ierr);
2624c8587f34SStefano Zampini     ierr = VecAssemblyEnd(vec_dnz);CHKERRQ(ierr);
2625c8587f34SStefano Zampini     ierr = VecAssemblyEnd(vec_onz);CHKERRQ(ierr);
2626c8587f34SStefano Zampini     ierr = PetscFree(my_dnz);CHKERRQ(ierr);
2627c8587f34SStefano Zampini     ierr = PetscFree(my_onz);CHKERRQ(ierr);
2628c8587f34SStefano Zampini     ierr = PetscFree(row_ownership);CHKERRQ(ierr);
2629a57a6d2fSStefano Zampini 
2630a57a6d2fSStefano Zampini     /* set computed preallocation in dnz and onz */
2631a57a6d2fSStefano Zampini     ierr = VecGetArray(vec_dnz,&array);CHKERRQ(ierr);
2632a57a6d2fSStefano Zampini     for (i=0; i<lrows; i++) dnz[i] = (PetscInt)PetscRealPart(array[i]);
2633a57a6d2fSStefano Zampini     ierr = VecRestoreArray(vec_dnz,&array);CHKERRQ(ierr);
2634a57a6d2fSStefano Zampini     ierr = VecGetArray(vec_onz,&array);CHKERRQ(ierr);
2635a57a6d2fSStefano Zampini     for (i=0;i<lrows;i++) onz[i] = (PetscInt)PetscRealPart(array[i]);
2636a57a6d2fSStefano Zampini     ierr = VecRestoreArray(vec_onz,&array);CHKERRQ(ierr);
2637c8587f34SStefano Zampini     ierr = VecDestroy(&vec_dnz);CHKERRQ(ierr);
2638c8587f34SStefano Zampini     ierr = VecDestroy(&vec_onz);CHKERRQ(ierr);
2639c8587f34SStefano Zampini 
2640e7931f94SStefano Zampini     /* Resize preallocation if overestimated */
2641c8587f34SStefano Zampini     for (i=0;i<lrows;i++) {
2642a57a6d2fSStefano Zampini       dnz[i] = PetscMin(dnz[i],lcols);
2643a57a6d2fSStefano Zampini       onz[i] = PetscMin(onz[i],cols-lcols);
2644c8587f34SStefano Zampini     }
2645fa7f1dd8SStefano Zampini     /* set preallocation */
2646a57a6d2fSStefano Zampini     ierr = MatMPIAIJSetPreallocation(new_mat,0,dnz,0,onz);CHKERRQ(ierr);
2647fa7f1dd8SStefano Zampini     for (i=0;i<lrows/bs;i++) {
2648fa7f1dd8SStefano Zampini       dnz[i] = dnz[i*bs]/bs;
2649fa7f1dd8SStefano Zampini       onz[i] = onz[i*bs]/bs;
2650fa7f1dd8SStefano Zampini     }
2651fa7f1dd8SStefano Zampini     ierr = MatMPIBAIJSetPreallocation(new_mat,bs,0,dnz,0,onz);CHKERRQ(ierr);
2652fa7f1dd8SStefano Zampini     for (i=0;i<lrows/bs;i++) {
2653fa7f1dd8SStefano Zampini       dnz[i] = dnz[i]-i;
2654fa7f1dd8SStefano Zampini     }
2655fa7f1dd8SStefano Zampini     ierr = MatMPISBAIJSetPreallocation(new_mat,bs,0,dnz,0,onz);CHKERRQ(ierr);
2656c8587f34SStefano Zampini     ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
2657fa7f1dd8SStefano Zampini     *M = new_mat;
2658fa7f1dd8SStefano Zampini   } else {
2659fa7f1dd8SStefano Zampini     PetscInt mbs,mrows,mcols;
2660fa7f1dd8SStefano Zampini     /* some checks */
2661fa7f1dd8SStefano Zampini     ierr = MatGetBlockSize(*M,&mbs);CHKERRQ(ierr);
2662fa7f1dd8SStefano Zampini     ierr = MatGetSize(*M,&mrows,&mcols);CHKERRQ(ierr);
2663fa7f1dd8SStefano Zampini     if (mrows != rows) {
2664fa7f1dd8SStefano Zampini       SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong number of rows (%d != %d)",rows,mrows);
2665fa7f1dd8SStefano Zampini     }
2666fa7f1dd8SStefano Zampini     if (mrows != rows) {
2667fa7f1dd8SStefano Zampini       SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong number of cols (%d != %d)",cols,mcols);
2668fa7f1dd8SStefano Zampini     }
2669fa7f1dd8SStefano Zampini     if (mbs != bs) {
2670fa7f1dd8SStefano Zampini       SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong block size (%d != %d)",bs,mbs);
2671fa7f1dd8SStefano Zampini     }
2672fa7f1dd8SStefano Zampini     ierr = MatZeroEntries(*M);CHKERRQ(ierr);
2673fa7f1dd8SStefano Zampini   }
2674fa7f1dd8SStefano Zampini   /* set local to global mappings */
2675fa7f1dd8SStefano Zampini   /* ierr = MatSetLocalToGlobalMapping(*M,rmapping,cmapping);CHKERRQ(ierr); */
2676fa7f1dd8SStefano Zampini   /* Set values */
2677fa7f1dd8SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQDENSE,&isdense);CHKERRQ(ierr);
2678fa7f1dd8SStefano Zampini   if (isdense) { /* special case for dense local matrices */
2679fa7f1dd8SStefano Zampini     ierr = MatSetOption(*M,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
2680fa7f1dd8SStefano Zampini     ierr = MatDenseGetArray(matis->A,&array);CHKERRQ(ierr);
2681fa7f1dd8SStefano Zampini     ierr = MatSetValues(*M,local_rows,global_indices,local_cols,global_indices,array,ADD_VALUES);CHKERRQ(ierr);
2682fa7f1dd8SStefano Zampini     ierr = MatDenseRestoreArray(matis->A,&array);CHKERRQ(ierr);
2683fa7f1dd8SStefano Zampini     ierr = PetscFree(local_indices);CHKERRQ(ierr);
2684fa7f1dd8SStefano Zampini     ierr = PetscFree(global_indices);CHKERRQ(ierr);
2685fa7f1dd8SStefano Zampini   } else { /* very basic values insertion for all other matrix types */
2686fa7f1dd8SStefano Zampini     ierr = PetscFree(local_indices);CHKERRQ(ierr);
2687fa7f1dd8SStefano Zampini     ierr = PetscFree(global_indices);CHKERRQ(ierr);
2688a57a6d2fSStefano Zampini     for (i=0;i<local_rows;i++) {
2689a57a6d2fSStefano Zampini       ierr = MatGetRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2690fa7f1dd8SStefano Zampini       /* ierr = MatSetValuesLocal(*M,1,&i,j,local_indices,array,ADD_VALUES);CHKERRQ(ierr); */
2691a57a6d2fSStefano Zampini       ierr = ISLocalToGlobalMappingApply(matis->mapping,j,local_indices,global_indices);CHKERRQ(ierr);
2692a57a6d2fSStefano Zampini       ierr = ISLocalToGlobalMappingApply(matis->mapping,1,&i,&index_row);CHKERRQ(ierr);
2693fa7f1dd8SStefano Zampini       ierr = MatSetValues(*M,1,&index_row,j,global_indices,array,ADD_VALUES);CHKERRQ(ierr);
2694a57a6d2fSStefano Zampini       ierr = MatRestoreRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2695a57a6d2fSStefano Zampini     }
2696fa7f1dd8SStefano Zampini   }
2697fa7f1dd8SStefano Zampini   ierr = MatAssemblyBegin(*M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2698fa7f1dd8SStefano Zampini   ierr = MatAssemblyEnd(*M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2699fa7f1dd8SStefano Zampini   if (isdense) {
2700fa7f1dd8SStefano Zampini     ierr = MatSetOption(*M,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
2701fa7f1dd8SStefano Zampini   }
2702a57a6d2fSStefano Zampini   PetscFunctionReturn(0);
2703a57a6d2fSStefano Zampini }
2704a57a6d2fSStefano Zampini 
2705e7931f94SStefano Zampini #undef __FUNCT__
2706e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble_Private"
2707e7931f94SStefano Zampini PetscErrorCode MatISSubassemble_Private(Mat mat, PetscInt coarsening_ratio, IS* is_sends)
2708e7931f94SStefano Zampini {
2709e7931f94SStefano Zampini   Mat             subdomain_adj;
2710e7931f94SStefano Zampini   IS              new_ranks,ranks_send_to;
2711e7931f94SStefano Zampini   MatPartitioning partitioner;
2712e7931f94SStefano Zampini   Mat_IS          *matis;
2713e7931f94SStefano Zampini   PetscInt        n_neighs,*neighs,*n_shared,**shared;
2714e7931f94SStefano Zampini   PetscInt        prank;
2715e7931f94SStefano Zampini   PetscMPIInt     size,rank,color;
2716e7931f94SStefano Zampini   PetscInt        *xadj,*adjncy,*oldranks;
2717e7931f94SStefano Zampini   PetscInt        *adjncy_wgt,*v_wgt,*is_indices,*ranks_send_to_idx;
2718e7931f94SStefano Zampini   PetscInt        i,j,n_subdomains,local_size,threshold=0;
2719e7931f94SStefano Zampini   PetscErrorCode  ierr;
27202b510759SStefano Zampini   PetscBool       use_vwgt=PETSC_FALSE,use_square=PETSC_FALSE;
2721e7931f94SStefano Zampini   PetscSubcomm    subcomm;
2722a57a6d2fSStefano Zampini 
2723e7931f94SStefano Zampini   PetscFunctionBegin;
27242b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_square",&use_square,NULL);CHKERRQ(ierr);
27252b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
27262b510759SStefano Zampini   ierr = PetscOptionsGetInt(NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
2727e7931f94SStefano Zampini 
2728e7931f94SStefano Zampini   /* Get info on mapping */
2729e7931f94SStefano Zampini   matis = (Mat_IS*)(mat->data);
2730e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&local_size);CHKERRQ(ierr);
2731e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2732e7931f94SStefano Zampini 
2733e7931f94SStefano Zampini   /* build local CSR graph of subdomains' connectivity */
2734e7931f94SStefano Zampini   ierr = PetscMalloc(2*sizeof(*xadj),&xadj);CHKERRQ(ierr);
2735e7931f94SStefano Zampini   xadj[0] = 0;
2736e7931f94SStefano Zampini   xadj[1] = PetscMax(n_neighs-1,0);
2737e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy),&adjncy);CHKERRQ(ierr);
2738e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy_wgt),&adjncy_wgt);CHKERRQ(ierr);
2739e7931f94SStefano Zampini 
27402b510759SStefano Zampini   if (threshold) {
27412b510759SStefano Zampini     PetscInt* count,min_threshold;
2742e7931f94SStefano Zampini     ierr = PetscMalloc(local_size*sizeof(PetscInt),&count);CHKERRQ(ierr);
2743e7931f94SStefano Zampini     ierr = PetscMemzero(count,local_size*sizeof(PetscInt));CHKERRQ(ierr);
2744e7931f94SStefano Zampini     for (i=1;i<n_neighs;i++) {/* i=1 so I don't count myself -> faces nodes counts to 1 */
2745e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2746e7931f94SStefano Zampini         count[shared[i][j]] += 1;
2747e7931f94SStefano Zampini       }
2748e7931f94SStefano Zampini     }
27492b510759SStefano Zampini     /* adapt threshold since we dont want to lose significant connections */
27502b510759SStefano Zampini     min_threshold = n_neighs;
27512b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
27522b510759SStefano Zampini       for (j=0;j<n_shared[i];j++) {
27532b510759SStefano Zampini         min_threshold = PetscMin(count[shared[i][j]],min_threshold);
27542b510759SStefano Zampini       }
27552b510759SStefano Zampini     }
27562b510759SStefano Zampini     threshold = PetscMax(min_threshold+1,threshold);
2757e7931f94SStefano Zampini     xadj[1] = 0;
27582b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
2759e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2760e7931f94SStefano Zampini         if (count[shared[i][j]] < threshold) {
2761e7931f94SStefano Zampini           adjncy[xadj[1]] = neighs[i];
2762e7931f94SStefano Zampini           adjncy_wgt[xadj[1]] = n_shared[i];
2763e7931f94SStefano Zampini           xadj[1]++;
2764e7931f94SStefano Zampini           break;
2765e7931f94SStefano Zampini         }
2766e7931f94SStefano Zampini       }
2767e7931f94SStefano Zampini     }
2768e7931f94SStefano Zampini     ierr = PetscFree(count);CHKERRQ(ierr);
2769c8587f34SStefano Zampini   } else {
2770e7931f94SStefano Zampini     if (xadj[1]) {
2771e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy,&neighs[1],xadj[1]*sizeof(*adjncy));CHKERRQ(ierr);
2772e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy_wgt,&n_shared[1],xadj[1]*sizeof(*adjncy_wgt));CHKERRQ(ierr);
2773c8587f34SStefano Zampini     }
2774e7931f94SStefano Zampini   }
2775e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingRestoreInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2776e7931f94SStefano Zampini   if (use_square) {
2777e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2778e7931f94SStefano Zampini       adjncy_wgt[i] = adjncy_wgt[i]*adjncy_wgt[i];
2779e7931f94SStefano Zampini     }
2780e7931f94SStefano Zampini   }
2781e7931f94SStefano Zampini   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2782e7931f94SStefano Zampini 
2783e7931f94SStefano Zampini   ierr = PetscMalloc(sizeof(PetscInt),&ranks_send_to_idx);CHKERRQ(ierr);
2784e7931f94SStefano Zampini 
2785e7931f94SStefano Zampini   /*
2786e7931f94SStefano Zampini     Restrict work on active processes only.
2787e7931f94SStefano Zampini   */
2788e7931f94SStefano Zampini   ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&subcomm);CHKERRQ(ierr);
2789e7931f94SStefano Zampini   ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
2790e7931f94SStefano Zampini   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
27912b510759SStefano Zampini   ierr = PetscMPIIntCast(!local_size,&color);CHKERRQ(ierr);
2792d3531aaaSJed Brown   ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
2793e7931f94SStefano Zampini   if (color) {
2794e7931f94SStefano Zampini     ierr = PetscFree(xadj);CHKERRQ(ierr);
2795e7931f94SStefano Zampini     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2796e7931f94SStefano Zampini     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
2797c8587f34SStefano Zampini   } else {
2798e7931f94SStefano Zampini     ierr = MPI_Comm_size(subcomm->comm,&size);CHKERRQ(ierr);
2799e7931f94SStefano Zampini     ierr = PetscMalloc(size*sizeof(*oldranks),&oldranks);CHKERRQ(ierr);
2800e7931f94SStefano Zampini     prank = rank;
2801e7931f94SStefano Zampini     ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm->comm);CHKERRQ(ierr);
2802e7931f94SStefano Zampini     for (i=0;i<size;i++) {
2803e7931f94SStefano Zampini       PetscPrintf(subcomm->comm,"oldranks[%d] = %d\n",i,oldranks[i]);
2804c8587f34SStefano Zampini     }
2805e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2806e7931f94SStefano Zampini       ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
2807c8587f34SStefano Zampini     }
2808e7931f94SStefano Zampini     ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2809e7931f94SStefano Zampini     ierr = MatCreateMPIAdj(subcomm->comm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
2810e7931f94SStefano Zampini     n_subdomains = (PetscInt)size;
2811e7931f94SStefano Zampini     ierr = MatView(subdomain_adj,0);CHKERRQ(ierr);
2812e7931f94SStefano Zampini 
2813e7931f94SStefano Zampini     /* Partition */
2814e7931f94SStefano Zampini     ierr = MatPartitioningCreate(subcomm->comm,&partitioner);CHKERRQ(ierr);
2815e7931f94SStefano Zampini     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
2816e7931f94SStefano Zampini     if (use_vwgt) {
2817e7931f94SStefano Zampini       ierr = PetscMalloc(sizeof(*v_wgt),&v_wgt);CHKERRQ(ierr);
2818e7931f94SStefano Zampini       v_wgt[0] = local_size;
2819e7931f94SStefano Zampini       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
2820c8587f34SStefano Zampini     }
2821e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)partitioner),"NPARTS %d\n",n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2822e7931f94SStefano Zampini     ierr = MatPartitioningSetNParts(partitioner,n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2823e7931f94SStefano Zampini     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
2824e7931f94SStefano Zampini     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
2825e7931f94SStefano Zampini     ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr);
2826e7931f94SStefano Zampini 
2827e7931f94SStefano Zampini     ierr = ISGetIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2828e7931f94SStefano Zampini     ranks_send_to_idx[0] = oldranks[is_indices[0]];
2829e7931f94SStefano Zampini     ierr = ISRestoreIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2830e7931f94SStefano Zampini     /* clean up */
2831e7931f94SStefano Zampini     ierr = PetscFree(oldranks);CHKERRQ(ierr);
2832e7931f94SStefano Zampini     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
2833e7931f94SStefano Zampini     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
2834e7931f94SStefano Zampini     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
2835e7931f94SStefano Zampini   }
2836e7931f94SStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
2837e7931f94SStefano Zampini 
2838e7931f94SStefano Zampini   /* assemble parallel IS for sends */
2839e7931f94SStefano Zampini   i = 1;
2840e7931f94SStefano Zampini   if (color) i=0;
2841e7931f94SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,&ranks_send_to);CHKERRQ(ierr);
2842e7931f94SStefano Zampini   ierr = ISView(ranks_send_to,0);CHKERRQ(ierr);
2843e7931f94SStefano Zampini 
2844e7931f94SStefano Zampini   /* get back IS */
2845e7931f94SStefano Zampini   *is_sends = ranks_send_to;
2846e7931f94SStefano Zampini   PetscFunctionReturn(0);
2847e7931f94SStefano Zampini }
2848e7931f94SStefano Zampini 
2849e7931f94SStefano Zampini typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
2850e7931f94SStefano Zampini 
2851e7931f94SStefano Zampini #undef __FUNCT__
2852e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble"
2853e7931f94SStefano Zampini PetscErrorCode MatISSubassemble(Mat mat, IS is_sends, PetscInt coarsening_ratio, Mat *mat_n)
2854e7931f94SStefano Zampini {
2855e7931f94SStefano Zampini   Mat                    local_mat,new_mat;
2856e7931f94SStefano Zampini   Mat_IS                 *matis;
2857e7931f94SStefano Zampini   IS                     is_sends_internal;
2858e7931f94SStefano Zampini   PetscInt               rows,cols;
2859e7931f94SStefano Zampini   PetscInt               i,bs,buf_size_idxs,buf_size_vals;
2860e7931f94SStefano Zampini   PetscBool              ismatis,isdense;
2861e7931f94SStefano Zampini   ISLocalToGlobalMapping l2gmap;
2862e7931f94SStefano Zampini   PetscInt*              l2gmap_indices;
2863e7931f94SStefano Zampini   const PetscInt*        is_indices;
2864e7931f94SStefano Zampini   MatType                new_local_type;
2865e7931f94SStefano Zampini   MatTypePrivate         new_local_type_private;
2866e7931f94SStefano Zampini   /* buffers */
2867e7931f94SStefano Zampini   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
2868e7931f94SStefano Zampini   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
2869e7931f94SStefano Zampini   /* MPI */
2870e7931f94SStefano Zampini   MPI_Comm               comm;
2871e7931f94SStefano Zampini   PetscMPIInt            n_sends,n_recvs,commsize;
2872e7931f94SStefano Zampini   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals;
2873e7931f94SStefano Zampini   PetscMPIInt            *onodes,*olengths_idxs,*olengths_vals;
2874e7931f94SStefano Zampini   PetscMPIInt            len,tag_idxs,tag_vals,source_dest;
2875e7931f94SStefano Zampini   MPI_Request            *send_req_idxs,*send_req_vals,*recv_req_idxs,*recv_req_vals;
2876e7931f94SStefano Zampini   PetscErrorCode         ierr;
2877e7931f94SStefano Zampini 
2878e7931f94SStefano Zampini   PetscFunctionBegin;
2879e7931f94SStefano Zampini   /* checks */
2880e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
2881e7931f94SStefano Zampini   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on an matrix object which is not of type MATIS",__FUNCT__);
2882e7931f94SStefano Zampini   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2883e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
2884e7931f94SStefano Zampini   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
2885e7931f94SStefano Zampini   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
2886e7931f94SStefano Zampini   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
2887e7931f94SStefano Zampini   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
2888e7931f94SStefano Zampini   PetscValidLogicalCollectiveInt(mat,bs,0);
2889e7931f94SStefano Zampini   /* prepare IS for sending if not provided */
2890e7931f94SStefano Zampini   if (!is_sends) {
2891e7931f94SStefano Zampini     if (!coarsening_ratio) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a coarsening ratio");
2892e7931f94SStefano Zampini     ierr = MatISSubassemble_Private(mat,coarsening_ratio,&is_sends_internal);CHKERRQ(ierr);
2893c8587f34SStefano Zampini   } else {
2894e7931f94SStefano Zampini     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
2895e7931f94SStefano Zampini     is_sends_internal = is_sends;
2896c8587f34SStefano Zampini   }
2897e7931f94SStefano Zampini 
2898e7931f94SStefano Zampini   /* get pointer of MATIS data */
2899e7931f94SStefano Zampini   matis = (Mat_IS*)mat->data;
2900e7931f94SStefano Zampini 
2901e7931f94SStefano Zampini   /* get comm */
2902e7931f94SStefano Zampini   comm = PetscObjectComm((PetscObject)mat);
2903e7931f94SStefano Zampini 
2904e7931f94SStefano Zampini   /* compute number of sends */
2905e7931f94SStefano Zampini   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
2906e7931f94SStefano Zampini   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
2907e7931f94SStefano Zampini 
2908e7931f94SStefano Zampini   /* compute number of receives */
2909e7931f94SStefano Zampini   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
2910e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*iflags),&iflags);CHKERRQ(ierr);
2911e7931f94SStefano Zampini   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
2912e7931f94SStefano Zampini   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2913e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
2914e7931f94SStefano Zampini   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
2915e7931f94SStefano Zampini   ierr = PetscFree(iflags);CHKERRQ(ierr);
2916e7931f94SStefano Zampini 
2917e7931f94SStefano Zampini   /* prepare send/receive buffers */
2918e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_idxs),&ilengths_idxs);CHKERRQ(ierr);
2919e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
2920e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_vals),&ilengths_vals);CHKERRQ(ierr);
2921e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
2922e7931f94SStefano Zampini 
2923e7931f94SStefano Zampini   /* Get data from local mat */
2924e7931f94SStefano Zampini   if (!isdense) {
2925e7931f94SStefano Zampini     /* TODO: See below some guidelines on how to prepare the local buffers */
2926e7931f94SStefano Zampini     /*
2927e7931f94SStefano Zampini        send_buffer_vals should contain the raw values of the local matrix
2928e7931f94SStefano Zampini        send_buffer_idxs should contain:
2929e7931f94SStefano Zampini        - MatType_PRIVATE type
2930e7931f94SStefano Zampini        - PetscInt        size_of_l2gmap
2931e7931f94SStefano Zampini        - PetscInt        global_row_indices[size_of_l2gmap]
2932e7931f94SStefano Zampini        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
2933e7931f94SStefano Zampini     */
2934e7931f94SStefano Zampini   } else {
2935e7931f94SStefano Zampini     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
2936e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&i);CHKERRQ(ierr);
2937e7931f94SStefano Zampini     ierr = PetscMalloc((i+2)*sizeof(PetscInt),&send_buffer_idxs);CHKERRQ(ierr);
2938e7931f94SStefano Zampini     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
2939e7931f94SStefano Zampini     send_buffer_idxs[1] = i;
2940e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2941e7931f94SStefano Zampini     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
2942e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingRestoreIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2943e7931f94SStefano Zampini     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
2944e7931f94SStefano Zampini     for (i=0;i<n_sends;i++) {
2945e7931f94SStefano Zampini       ilengths_vals[is_indices[i]] = len*len;
2946e7931f94SStefano Zampini       ilengths_idxs[is_indices[i]] = len+2;
2947c8587f34SStefano Zampini     }
2948c8587f34SStefano Zampini   }
2949e7931f94SStefano Zampini   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
2950e7931f94SStefano Zampini   buf_size_idxs = 0;
2951e7931f94SStefano Zampini   buf_size_vals = 0;
2952e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2953e7931f94SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
2954e7931f94SStefano Zampini     buf_size_vals += (PetscInt)olengths_vals[i];
2955e7931f94SStefano Zampini   }
2956e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&recv_buffer_idxs);CHKERRQ(ierr);
2957e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_vals*sizeof(PetscScalar),&recv_buffer_vals);CHKERRQ(ierr);
2958e7931f94SStefano Zampini 
2959e7931f94SStefano Zampini   /* get new tags for clean communications */
2960e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
2961e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
2962e7931f94SStefano Zampini 
2963e7931f94SStefano Zampini   /* allocate for requests */
2964e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_idxs);CHKERRQ(ierr);
2965e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_vals);CHKERRQ(ierr);
2966e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_idxs);CHKERRQ(ierr);
2967e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_vals);CHKERRQ(ierr);
2968e7931f94SStefano Zampini 
2969e7931f94SStefano Zampini   /* communications */
2970e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2971e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
2972e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2973e7931f94SStefano Zampini     source_dest = onodes[i];
2974e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
2975e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
2976e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2977e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
2978e7931f94SStefano Zampini   }
2979e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) {
2980e7931f94SStefano Zampini     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
2981e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
2982e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
2983e7931f94SStefano Zampini   }
2984e7931f94SStefano Zampini   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2985e7931f94SStefano Zampini   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
2986e7931f94SStefano Zampini 
2987e7931f94SStefano Zampini   /* assemble new l2g map */
2988e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2989e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2990e7931f94SStefano Zampini   buf_size_idxs = 0;
2991e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2992e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
2993e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2994e7931f94SStefano Zampini   }
2995e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&l2gmap_indices);CHKERRQ(ierr);
2996e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2997e7931f94SStefano Zampini   buf_size_idxs = 0;
2998e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2999e7931f94SStefano Zampini     ierr = PetscMemcpy(&l2gmap_indices[buf_size_idxs],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
3000e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
3001e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3002e7931f94SStefano Zampini   }
3003e7931f94SStefano Zampini   ierr = PetscSortRemoveDupsInt(&buf_size_idxs,l2gmap_indices);CHKERRQ(ierr);
3004e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingCreate(comm,buf_size_idxs,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
3005e7931f94SStefano Zampini   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
3006e7931f94SStefano Zampini 
3007e7931f94SStefano Zampini   /* infer new local matrix type from received local matrices type */
3008e7931f94SStefano Zampini   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
3009e7931f94SStefano 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) */
3010e7931f94SStefano Zampini   new_local_type_private = MATAIJ_PRIVATE;
3011e7931f94SStefano Zampini   new_local_type = MATSEQAIJ;
3012e7931f94SStefano Zampini   if (n_recvs) {
3013be4bc593SStefano Zampini     new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
3014e7931f94SStefano Zampini     ptr_idxs = recv_buffer_idxs;
3015e7931f94SStefano Zampini     for (i=0;i<n_recvs;i++) {
3016e7931f94SStefano Zampini       if ((PetscInt)new_local_type_private != *ptr_idxs) {
3017e7931f94SStefano Zampini         new_local_type_private = MATAIJ_PRIVATE;
3018e7931f94SStefano Zampini         break;
3019e7931f94SStefano Zampini       }
3020e7931f94SStefano Zampini       ptr_idxs += olengths_idxs[i];
3021e7931f94SStefano Zampini     }
3022e7931f94SStefano Zampini     switch (new_local_type_private) {
3023e7931f94SStefano Zampini       case MATDENSE_PRIVATE: /* subassembling of dense matrices does not give a dense matrix! */
3024e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
3025e7931f94SStefano Zampini         bs = 1;
3026e7931f94SStefano Zampini         break;
3027e7931f94SStefano Zampini       case MATAIJ_PRIVATE:
3028e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
3029e7931f94SStefano Zampini         bs = 1;
3030e7931f94SStefano Zampini         break;
3031e7931f94SStefano Zampini       case MATBAIJ_PRIVATE:
3032e7931f94SStefano Zampini         new_local_type = MATSEQBAIJ;
3033e7931f94SStefano Zampini         break;
3034e7931f94SStefano Zampini       case MATSBAIJ_PRIVATE:
3035e7931f94SStefano Zampini         new_local_type = MATSEQSBAIJ;
3036e7931f94SStefano Zampini         break;
3037e7931f94SStefano Zampini       default:
3038e7931f94SStefano Zampini         SETERRQ2(comm,PETSC_ERR_LIB,"Unkwown private type %d in %s",new_local_type_private,__FUNCT__);
3039e7931f94SStefano Zampini         break;
3040e7931f94SStefano Zampini     }
3041e7931f94SStefano Zampini   }
3042e7931f94SStefano Zampini 
3043e7931f94SStefano Zampini   /* create MATIS object */
3044e7931f94SStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
3045e7931f94SStefano Zampini   ierr = MatCreateIS(comm,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,&new_mat);CHKERRQ(ierr);
3046e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
3047e7931f94SStefano Zampini   ierr = MatISGetLocalMat(new_mat,&local_mat);CHKERRQ(ierr);
3048e7931f94SStefano Zampini   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
3049e7931f94SStefano Zampini   ierr = MatSetUp(local_mat);CHKERRQ(ierr); /* WARNING -> no preallocation yet */
3050e7931f94SStefano Zampini 
3051e7931f94SStefano Zampini   /* set values */
3052e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3053e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
3054e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
3055e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3056e7931f94SStefano Zampini     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
3057e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
3058e7931f94SStefano Zampini       ierr = MatSetValues(new_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
3059e7931f94SStefano Zampini       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3060e7931f94SStefano Zampini       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3061e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
3062e7931f94SStefano Zampini     }
3063e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3064e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
3065e7931f94SStefano Zampini   }
3066e7931f94SStefano Zampini   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3067e7931f94SStefano Zampini   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3068e7931f94SStefano Zampini   ierr = MatAssemblyBegin(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3069e7931f94SStefano Zampini   ierr = MatAssemblyEnd(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3070e7931f94SStefano Zampini 
3071e7931f94SStefano Zampini   { /* check */
3072e7931f94SStefano Zampini     Vec       lvec,rvec;
3073e7931f94SStefano Zampini     PetscReal infty_error;
3074e7931f94SStefano Zampini 
3075e7931f94SStefano Zampini     ierr = MatGetVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
3076e7931f94SStefano Zampini     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
3077e7931f94SStefano Zampini     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
3078e7931f94SStefano Zampini     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
3079e7931f94SStefano Zampini     ierr = MatMultAdd(new_mat,rvec,lvec,lvec);CHKERRQ(ierr);
3080e7931f94SStefano Zampini     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3081e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
3082e7931f94SStefano Zampini     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
3083e7931f94SStefano Zampini     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
3084e7931f94SStefano Zampini   }
3085e7931f94SStefano Zampini 
3086e7931f94SStefano Zampini   /* free workspace */
3087e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
3088e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
3089e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3090e7931f94SStefano Zampini   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
3091e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3092e7931f94SStefano Zampini   if (isdense) {
3093e7931f94SStefano Zampini     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
3094e7931f94SStefano Zampini     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
3095e7931f94SStefano Zampini   } else {
3096e7931f94SStefano Zampini     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
3097e7931f94SStefano Zampini   }
3098e7931f94SStefano Zampini   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
3099e7931f94SStefano Zampini   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
3100e7931f94SStefano Zampini   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
3101e7931f94SStefano Zampini   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
3102e7931f94SStefano Zampini   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
3103e7931f94SStefano Zampini   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
3104e7931f94SStefano Zampini   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
3105e7931f94SStefano Zampini   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
3106e7931f94SStefano Zampini   ierr = PetscFree(onodes);CHKERRQ(ierr);
3107e7931f94SStefano Zampini   /* get back new mat */
3108e7931f94SStefano Zampini   *mat_n = new_mat;
3109e7931f94SStefano Zampini   PetscFunctionReturn(0);
3110e7931f94SStefano Zampini }
3111a57a6d2fSStefano Zampini 
3112c8587f34SStefano Zampini #undef __FUNCT__
3113c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
3114c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
3115c8587f34SStefano Zampini {
3116c8587f34SStefano Zampini   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
3117c8587f34SStefano Zampini   PC_IS                  *pcis = (PC_IS*)pc->data;
311820a2ab83SStefano Zampini   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
31199881197aSStefano Zampini   MatNullSpace           CoarseNullSpace=NULL;
312020a2ab83SStefano Zampini   ISLocalToGlobalMapping coarse_islg;
312120a2ab83SStefano Zampini   IS                     coarse_is;
3122f4ddd8eeSStefano Zampini   PetscInt               max_it;
3123f9eb5b7dSStefano Zampini   PetscInt               im_active=-1,active_procs=-1;
3124f9eb5b7dSStefano Zampini   PC                     pc_temp;
3125c8587f34SStefano Zampini   PCType                 coarse_pc_type;
3126c8587f34SStefano Zampini   KSPType                coarse_ksp_type;
3127f9eb5b7dSStefano Zampini   PetscBool              multilevel_requested,multilevel_allowed;
3128*cbcc2c2aSStefano Zampini   PetscBool              setsym,issym,isherm,ispreonly,isbddc,isnn,coarse_reuse;
3129f9eb5b7dSStefano Zampini   MatStructure           matstruct;
31309881197aSStefano Zampini   PetscErrorCode         ierr;
3131fdc09c96SStefano Zampini 
3132c8587f34SStefano Zampini   PetscFunctionBegin;
3133c8587f34SStefano Zampini   /* Assign global numbering to coarse dofs */
3134fa7f1dd8SStefano Zampini   if (pcbddc->new_primal_space) { /* a new primal space is present, so recompute global numbering */
3135fa7f1dd8SStefano Zampini     PetscInt ocoarse_size;
3136fa7f1dd8SStefano Zampini     ocoarse_size = pcbddc->coarse_size;
3137f4ddd8eeSStefano Zampini     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3138f4ddd8eeSStefano Zampini     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
3139f4ddd8eeSStefano Zampini     /* see if we can avoid some work */
3140fa7f1dd8SStefano Zampini     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
3141fa7f1dd8SStefano Zampini       if (ocoarse_size != pcbddc->coarse_size) { /* ...but with different size, so reset it and set reuse flag to false */
3142727cdba6SStefano Zampini         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3143fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_FALSE;
3144fa7f1dd8SStefano Zampini       } else { /* we can safely reuse already computed coarse matrix */
3145fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_TRUE;
3146f4ddd8eeSStefano Zampini       }
3147fa7f1dd8SStefano Zampini     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
3148fa7f1dd8SStefano Zampini       coarse_reuse = PETSC_FALSE;
3149f4ddd8eeSStefano Zampini     }
3150fa7f1dd8SStefano Zampini   } else { /* primal space has not been changed, so we can reuse coarse matrix */
3151fa7f1dd8SStefano Zampini     coarse_reuse = PETSC_TRUE;
3152f4ddd8eeSStefano Zampini   }
3153c8587f34SStefano Zampini 
3154*cbcc2c2aSStefano Zampini   /* test if we can go multilevel */
3155f9eb5b7dSStefano Zampini   multilevel_allowed = PETSC_FALSE;
3156f9eb5b7dSStefano Zampini   multilevel_requested = PETSC_FALSE;
3157f9eb5b7dSStefano Zampini   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
3158f9eb5b7dSStefano Zampini   if (multilevel_requested) {
31592b510759SStefano Zampini     /* count "active processes" */
31602b510759SStefano Zampini     im_active = !!(pcis->n);
31612b510759SStefano Zampini     ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
31622b510759SStefano Zampini     if (active_procs/pcbddc->coarsening_ratio < 2) {
3163f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_FALSE;
31642b510759SStefano Zampini     } else {
3165f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_TRUE;
3166c8587f34SStefano Zampini     }
3167c8587f34SStefano Zampini   }
3168e7931f94SStefano Zampini 
3169f9eb5b7dSStefano Zampini   /* set defaults for coarse KSP and PC */
3170f9eb5b7dSStefano Zampini   if (multilevel_allowed) {
3171f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPRICHARDSON;
3172f9eb5b7dSStefano Zampini     coarse_pc_type = PCBDDC;
3173f9eb5b7dSStefano Zampini   } else {
3174f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPPREONLY;
3175f9eb5b7dSStefano Zampini     coarse_pc_type = PCREDUNDANT;
3176c8587f34SStefano Zampini   }
3177c8587f34SStefano Zampini 
3178f9eb5b7dSStefano Zampini   /* create the coarse KSP object only once with defaults */
3179f9eb5b7dSStefano Zampini   if (!pcbddc->coarse_ksp) {
3180e604994aSStefano Zampini     char prefix[256],str_level[3];
3181e604994aSStefano Zampini     size_t len;
3182f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_ksp);CHKERRQ(ierr);
3183c8587f34SStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
3184f9eb5b7dSStefano Zampini     ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
3185c8587f34SStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
3186c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3187c8587f34SStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
3188e604994aSStefano Zampini     /* prefix */
3189e604994aSStefano Zampini     ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
3190e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
3191e604994aSStefano Zampini     if (!pcbddc->current_level) {
3192e604994aSStefano Zampini       ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
3193e604994aSStefano Zampini       ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
3194c8587f34SStefano Zampini     } else {
3195e604994aSStefano Zampini       ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
3196e604994aSStefano Zampini       if (pcbddc->current_level>1) len -= 2;
3197e604994aSStefano Zampini       ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
3198e604994aSStefano Zampini       *(prefix+len)='\0';
3199e604994aSStefano Zampini       sprintf(str_level,"%d_",(int)(pcbddc->current_level));
3200e604994aSStefano Zampini       ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
3201e604994aSStefano Zampini     }
3202e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
3203f9eb5b7dSStefano Zampini   }
3204f9eb5b7dSStefano Zampini   /* allow user customization */
320585c4d303SStefano 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); */
3206f9eb5b7dSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
320785c4d303SStefano 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); */
3208f9eb5b7dSStefano Zampini 
3209f9eb5b7dSStefano Zampini   /* get some info after set from options */
3210f9eb5b7dSStefano Zampini   ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3211f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
3212f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
3213f9eb5b7dSStefano Zampini   if (isbddc && !multilevel_allowed) { /* prevent from infinite loop if user as requested bddc pc for coarse solver */
3214f9eb5b7dSStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
3215f9eb5b7dSStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
3216f9eb5b7dSStefano Zampini     isbddc = PETSC_FALSE;
3217f9eb5b7dSStefano Zampini   }
3218f9eb5b7dSStefano Zampini 
32191035eff8SStefano Zampini   /* creates temporary l2gmap and IS for coarse indexes */
32201035eff8SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
32211035eff8SStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
32221035eff8SStefano Zampini 
3223f9eb5b7dSStefano Zampini   /* propagate BDDC info to the next level */
3224f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
3225f9eb5b7dSStefano Zampini   ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
3226f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
32271035eff8SStefano Zampini   if (isbddc) { /* protects from unneded computations */
32281035eff8SStefano Zampini     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
32291035eff8SStefano Zampini     const PetscInt         *idxs;
32301035eff8SStefano Zampini     IS                     *c_isfordofs,c_isneumann;
32311035eff8SStefano Zampini     ISLocalToGlobalMapping tmap;
32321035eff8SStefano Zampini 
32331035eff8SStefano Zampini     /* create map between primal indices (in local representative ordering) and local subdomain numbering */
32341035eff8SStefano Zampini     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
32351035eff8SStefano Zampini     /* allocate space for temporary storage */
32361035eff8SStefano Zampini     ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&tidxs);CHKERRQ(ierr);
32371035eff8SStefano Zampini     ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&tidxs2);CHKERRQ(ierr);
32381035eff8SStefano Zampini     /* dofs splitting */
32391035eff8SStefano Zampini     ierr = PetscMalloc(pcbddc->n_ISForDofsLocal*sizeof(IS),&c_isfordofs);CHKERRQ(ierr);
32401035eff8SStefano Zampini     for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
32411035eff8SStefano Zampini       ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr);
32421035eff8SStefano Zampini       ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
32431035eff8SStefano Zampini       ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
32441035eff8SStefano Zampini       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
32451035eff8SStefano Zampini       ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
32461035eff8SStefano Zampini       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
32471035eff8SStefano Zampini       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pcbddc->ISForDofsLocal[i]),nout,tidxs2,PETSC_COPY_VALUES,&c_isfordofs[i]);CHKERRQ(ierr);
32481035eff8SStefano Zampini       ierr = ISView(c_isfordofs[i],0);CHKERRQ(ierr);
32491035eff8SStefano Zampini     }
32501035eff8SStefano Zampini     ierr = PCBDDCSetDofsSplitting(pc_temp,pcbddc->n_ISForDofsLocal,c_isfordofs);CHKERRQ(ierr);
32511035eff8SStefano Zampini     for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
32521035eff8SStefano Zampini       ierr = ISDestroy(&c_isfordofs[i]);CHKERRQ(ierr);
32531035eff8SStefano Zampini     }
32541035eff8SStefano Zampini     ierr = PetscFree(c_isfordofs);CHKERRQ(ierr);
32551035eff8SStefano Zampini     /* neumann boundaries */
32561035eff8SStefano Zampini     if (pcbddc->NeumannBoundariesLocal) {
32571035eff8SStefano Zampini       ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr);
32581035eff8SStefano Zampini       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
32591035eff8SStefano Zampini       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
32601035eff8SStefano Zampini       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
32611035eff8SStefano Zampini       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
32621035eff8SStefano Zampini       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
32631035eff8SStefano Zampini       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pcbddc->NeumannBoundariesLocal),nout,tidxs2,PETSC_COPY_VALUES,&c_isneumann);CHKERRQ(ierr);
32641035eff8SStefano Zampini       ierr = ISView(c_isneumann,0);CHKERRQ(ierr);
32651035eff8SStefano Zampini       ierr = PCBDDCSetNeumannBoundaries(pc_temp,c_isneumann);CHKERRQ(ierr);
32661035eff8SStefano Zampini     }
32671035eff8SStefano Zampini     ierr = ISDestroy(&c_isneumann);CHKERRQ(ierr);
32681035eff8SStefano Zampini     ierr = PetscFree(tidxs);CHKERRQ(ierr);
32691035eff8SStefano Zampini     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
32701035eff8SStefano Zampini     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
32711035eff8SStefano Zampini   }
3272f9eb5b7dSStefano Zampini 
3273f9eb5b7dSStefano Zampini   /* creates temporary MATIS object for coarse matrix */
3274a57a6d2fSStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
3275f4ddd8eeSStefano Zampini   ierr = MatCreateIS(PetscObjectComm((PetscObject)pc),1,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size,coarse_islg,&coarse_mat_is);CHKERRQ(ierr);
3276a57a6d2fSStefano Zampini   ierr = MatISSetLocalMat(coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
3277e7931f94SStefano Zampini   ierr = MatAssemblyBegin(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3278e7931f94SStefano Zampini   ierr = MatAssemblyEnd(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
327920a2ab83SStefano Zampini   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
328020a2ab83SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
3281fdc09c96SStefano Zampini 
3282f9eb5b7dSStefano Zampini   /* assemble coarse matrix */
3283f9eb5b7dSStefano Zampini   if (isbddc || isnn) {
3284f9eb5b7dSStefano Zampini     ierr = MatISSubassemble(coarse_mat_is,NULL,pcbddc->coarsening_ratio,&coarse_mat);CHKERRQ(ierr);
3285fa7f1dd8SStefano Zampini   } else {
3286fa7f1dd8SStefano Zampini     if (coarse_reuse) {
3287fa7f1dd8SStefano Zampini       ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL,NULL);CHKERRQ(ierr);
3288fa7f1dd8SStefano Zampini       ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
3289fa7f1dd8SStefano Zampini       ierr = MatISGetMPIXAIJ(coarse_mat_is,MATMPIAIJ,MAT_REUSE_MATRIX,&coarse_mat);CHKERRQ(ierr);
3290fa7f1dd8SStefano Zampini     } else {
3291fa7f1dd8SStefano Zampini       ierr = MatISGetMPIXAIJ(coarse_mat_is,MATMPIAIJ,MAT_INITIAL_MATRIX,&coarse_mat);CHKERRQ(ierr);
3292fa7f1dd8SStefano Zampini     }
3293c8587f34SStefano Zampini   }
32942b510759SStefano Zampini   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
32959881197aSStefano Zampini 
3296f9eb5b7dSStefano Zampini   /* create local to global scatters for coarse problem */
3297f4ddd8eeSStefano Zampini   if (pcbddc->new_primal_space) {
3298f4ddd8eeSStefano Zampini     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3299f4ddd8eeSStefano Zampini     ierr = VecDestroy(&pcbddc->coarse_rhs);CHKERRQ(ierr);
3300f4ddd8eeSStefano Zampini     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3301f9eb5b7dSStefano Zampini     ierr = MatGetVecs(coarse_mat,&pcbddc->coarse_vec,&pcbddc->coarse_rhs);CHKERRQ(ierr);
3302f9eb5b7dSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3303f4ddd8eeSStefano Zampini   }
3304f9eb5b7dSStefano Zampini   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
3305f9eb5b7dSStefano Zampini 
3306f9eb5b7dSStefano Zampini   /* propagate symmetry info to coarse matrix */
3307*cbcc2c2aSStefano Zampini   issym = PETSC_FALSE;
3308*cbcc2c2aSStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
3309f9eb5b7dSStefano Zampini   ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,issym);CHKERRQ(ierr);
3310*cbcc2c2aSStefano Zampini   isherm = PETSC_FALSE;
3311*cbcc2c2aSStefano Zampini   ierr = MatIsHermitianKnown(pc->pmat,&setsym,&isherm);CHKERRQ(ierr);
33125a16e3a0SStefano Zampini   ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
3313f9eb5b7dSStefano Zampini 
3314b8ffe317SStefano Zampini   /* Compute coarse null space (special handling by BDDC only) */
3315b8ffe317SStefano Zampini   if (pcbddc->NullSpace) {
3316b8ffe317SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCoarse(pc,coarse_mat,&CoarseNullSpace);CHKERRQ(ierr);
3317b8ffe317SStefano Zampini     if (isbddc) {
3318b8ffe317SStefano Zampini       ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
3319b8ffe317SStefano Zampini     } else {
3320c8587f34SStefano Zampini       ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
3321c8587f34SStefano Zampini     }
3322c8587f34SStefano Zampini   }
3323c8587f34SStefano Zampini 
3324f9eb5b7dSStefano Zampini   /* set operators */
3325f9eb5b7dSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
3326f9eb5b7dSStefano Zampini   ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat,matstruct);CHKERRQ(ierr);
3327f9eb5b7dSStefano Zampini 
3328f9eb5b7dSStefano Zampini   /* additional KSP customization */
3329f9eb5b7dSStefano Zampini   ierr = KSPGetTolerances(pcbddc->coarse_ksp,NULL,NULL,NULL,&max_it);CHKERRQ(ierr);
3330f9eb5b7dSStefano Zampini   if (max_it < 5) {
3331c8587f34SStefano Zampini     ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
3332f9eb5b7dSStefano Zampini   }
3333f9eb5b7dSStefano Zampini 
3334f9eb5b7dSStefano Zampini   /* print some info if requested */
3335f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
3336f9eb5b7dSStefano Zampini     ierr = KSPGetType(pcbddc->coarse_ksp,&coarse_ksp_type);CHKERRQ(ierr);
3337f9eb5b7dSStefano Zampini     ierr = PCGetType(pc_temp,&coarse_pc_type);CHKERRQ(ierr);
3338f9eb5b7dSStefano Zampini     if (!multilevel_allowed) {
3339f9eb5b7dSStefano Zampini       if (multilevel_requested) {
3340f9eb5b7dSStefano 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);
3341f9eb5b7dSStefano Zampini       } else if (pcbddc->max_levels) {
3342f9eb5b7dSStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
3343c8587f34SStefano Zampini       }
3344c8587f34SStefano Zampini     }
3345e604994aSStefano 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);
3346f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3347c8587f34SStefano Zampini   }
3348f9eb5b7dSStefano Zampini 
3349f9eb5b7dSStefano Zampini   /* setup coarse ksp */
3350f9eb5b7dSStefano Zampini   ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
3351f9eb5b7dSStefano Zampini 
3352*cbcc2c2aSStefano Zampini   /* Check coarse problem if in debug mode or if solving with an iterative method */
3353*cbcc2c2aSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
3354*cbcc2c2aSStefano Zampini   if (pcbddc->dbg_flag || !ispreonly) {
3355c8587f34SStefano Zampini     KSP       check_ksp;
33562b510759SStefano Zampini     KSPType   check_ksp_type;
3357c8587f34SStefano Zampini     PC        check_pc;
3358c8587f34SStefano Zampini     Vec       check_vec;
3359c8587f34SStefano Zampini     PetscReal abs_infty_error,infty_error,lambda_min,lambda_max;
33602b510759SStefano Zampini     PetscInt  its;
3361*cbcc2c2aSStefano Zampini     PetscBool compute;
3362c8587f34SStefano Zampini 
33632b510759SStefano Zampini     /* Create ksp object suitable for estimation of extreme eigenvalues */
3364f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&check_ksp);CHKERRQ(ierr);
3365fdc635d7SStefano Zampini     ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
3366f4ddd8eeSStefano Zampini     ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
33672b510759SStefano Zampini     if (ispreonly) {
33682b510759SStefano Zampini       check_ksp_type = KSPPREONLY;
3369f9eb5b7dSStefano Zampini       compute = PETSC_FALSE;
33702b510759SStefano Zampini     } else {
3371*cbcc2c2aSStefano Zampini       check_ksp_type = KSPGMRES;
3372f9eb5b7dSStefano Zampini       compute = PETSC_TRUE;
3373c8587f34SStefano Zampini     }
3374c8587f34SStefano Zampini     ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
3375f9eb5b7dSStefano Zampini     ierr = KSPSetComputeSingularValues(check_ksp,compute);CHKERRQ(ierr);
3376c8587f34SStefano Zampini     ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
3377c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
3378c8587f34SStefano Zampini     ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
3379c8587f34SStefano Zampini     /* create random vec */
3380c8587f34SStefano Zampini     ierr = VecDuplicate(pcbddc->coarse_vec,&check_vec);CHKERRQ(ierr);
3381c8587f34SStefano Zampini     ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
3382c8587f34SStefano Zampini     if (CoarseNullSpace) {
3383c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec);CHKERRQ(ierr);
3384c8587f34SStefano Zampini     }
3385fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3386c8587f34SStefano Zampini     /* solve coarse problem */
3387c8587f34SStefano Zampini     ierr = KSPSolve(check_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
3388c8587f34SStefano Zampini     if (CoarseNullSpace) {
3389c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,pcbddc->coarse_vec);CHKERRQ(ierr);
3390c8587f34SStefano Zampini     }
3391*cbcc2c2aSStefano Zampini     /* set eigenvalue estimation if preonly has not been requested */
3392*cbcc2c2aSStefano Zampini     if (!ispreonly) {
3393*cbcc2c2aSStefano Zampini       ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
3394*cbcc2c2aSStefano Zampini       ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max,lambda_min);CHKERRQ(ierr);
3395*cbcc2c2aSStefano Zampini       ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
3396*cbcc2c2aSStefano Zampini     }
3397c8587f34SStefano Zampini     /* check coarse problem residual error */
3398*cbcc2c2aSStefano Zampini     if (pcbddc->dbg_flag) {
3399c8587f34SStefano Zampini       ierr = VecAXPY(check_vec,-1.0,pcbddc->coarse_vec);CHKERRQ(ierr);
3400c8587f34SStefano Zampini       ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3401fdc635d7SStefano Zampini       ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3402c8587f34SStefano Zampini       ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
3403c8587f34SStefano Zampini       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
3404e604994aSStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem (%s) details\n",((PetscObject)(pcbddc->coarse_ksp))->prefix);CHKERRQ(ierr);
3405e604994aSStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
3406e604994aSStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
34072b510759SStefano Zampini       if (!ispreonly) {
340820a2ab83SStefano Zampini         ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
3409f9eb5b7dSStefano 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);
3410c8587f34SStefano Zampini       }
34112b510759SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3412*cbcc2c2aSStefano Zampini     }
3413c8587f34SStefano Zampini     ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
3414c8587f34SStefano Zampini   }
3415*cbcc2c2aSStefano Zampini 
3416*cbcc2c2aSStefano Zampini   /* print additional info */
3417*cbcc2c2aSStefano Zampini   if (pcbddc->dbg_flag) {
3418*cbcc2c2aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
3419*cbcc2c2aSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3420*cbcc2c2aSStefano Zampini     ierr = KSPView(pcbddc->coarse_ksp,pcbddc->dbg_viewer);CHKERRQ(ierr);
3421*cbcc2c2aSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3422*cbcc2c2aSStefano Zampini   }
3423*cbcc2c2aSStefano Zampini 
34242b510759SStefano Zampini   /* free memory */
3425c8587f34SStefano Zampini   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
3426fdc635d7SStefano Zampini   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
3427c8587f34SStefano Zampini   PetscFunctionReturn(0);
3428c8587f34SStefano Zampini }
3429674ae819SStefano Zampini 
3430f34684f1SStefano Zampini #undef __FUNCT__
3431f34684f1SStefano Zampini #define __FUNCT__ "PCBDDCComputePrimalNumbering"
3432f34684f1SStefano Zampini PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
3433f34684f1SStefano Zampini {
3434f34684f1SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3435f34684f1SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
3436f34684f1SStefano Zampini   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
3437727cdba6SStefano Zampini   PetscInt       i,coarse_size;
3438727cdba6SStefano Zampini   PetscInt       *local_primal_indices;
3439f34684f1SStefano Zampini   PetscErrorCode ierr;
3440f34684f1SStefano Zampini 
3441f34684f1SStefano Zampini   PetscFunctionBegin;
3442f34684f1SStefano Zampini   /* Compute global number of coarse dofs */
344389c96988SStefano Zampini   if (!pcbddc->primal_indices_local_idxs && pcbddc->local_primal_size) {
344489c96988SStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Local primal indices have not been created");
3445727cdba6SStefano Zampini   }
3446727cdba6SStefano 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);
3447f34684f1SStefano Zampini 
3448f34684f1SStefano Zampini   /* check numbering */
3449f34684f1SStefano Zampini   if (pcbddc->dbg_flag) {
3450f34684f1SStefano Zampini     PetscScalar coarsesum,*array;
3451f34684f1SStefano Zampini 
3452f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3453f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3454f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
34550fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
3456f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
3457f34684f1SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
3458727cdba6SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
3459f34684f1SStefano Zampini     }
3460f34684f1SStefano Zampini     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
3461f34684f1SStefano Zampini     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
3462f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3463f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3464f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3465f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3466f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3467f34684f1SStefano Zampini     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3468f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3469f34684f1SStefano Zampini       if (array[i] == 1.0) {
3470f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %d owned by a single process!\n",PetscGlobalRank,i);CHKERRQ(ierr);
3471f34684f1SStefano Zampini       }
3472f34684f1SStefano Zampini     }
3473f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3474f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3475f34684f1SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
3476f34684f1SStefano Zampini     }
3477f34684f1SStefano Zampini     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3478f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3479f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3480f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3481f34684f1SStefano Zampini     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
3482f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
3483f34684f1SStefano Zampini     if (pcbddc->dbg_flag > 1) {
3484f34684f1SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
3485f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3486f34684f1SStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
3487f34684f1SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
3488727cdba6SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_primal_indices[%d]=%d (%d)\n",i,local_primal_indices[i],pcbddc->primal_indices_local_idxs[i]);
3489f34684f1SStefano Zampini       }
3490f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3491f34684f1SStefano Zampini     }
3492f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3493f34684f1SStefano Zampini   }
3494f34684f1SStefano Zampini   /* get back data */
3495f34684f1SStefano Zampini   *coarse_size_n = coarse_size;
3496f34684f1SStefano Zampini   *local_primal_indices_n = local_primal_indices;
3497674ae819SStefano Zampini   PetscFunctionReturn(0);
3498674ae819SStefano Zampini }
3499674ae819SStefano Zampini 
3500e456f2a8SStefano Zampini #undef __FUNCT__
3501e456f2a8SStefano Zampini #define __FUNCT__ "PCBDDCGlobalToLocal"
3502e456f2a8SStefano Zampini PetscErrorCode PCBDDCGlobalToLocal(PC pc,VecScatter ctx,IS globalis,IS* localis)
3503e456f2a8SStefano Zampini {
3504e456f2a8SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
3505e456f2a8SStefano Zampini   IS             localis_t;
3506e456f2a8SStefano Zampini   PetscInt       i,lsize,*idxs;
3507e456f2a8SStefano Zampini   PetscScalar    *vals;
3508e456f2a8SStefano Zampini   PetscErrorCode ierr;
3509e456f2a8SStefano Zampini 
3510e456f2a8SStefano Zampini   PetscFunctionBegin;
3511e456f2a8SStefano Zampini   /* get dirichlet indices in local ordering exploiting local to global map */
3512e456f2a8SStefano Zampini   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
3513e456f2a8SStefano Zampini   ierr = PetscMalloc(lsize*sizeof(PetscScalar),&vals);CHKERRQ(ierr);
3514e456f2a8SStefano Zampini   for (i=0;i<lsize;i++) vals[i] = 1.0;
3515e456f2a8SStefano Zampini   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
3516e456f2a8SStefano Zampini   ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
35171035eff8SStefano Zampini   if (idxs) { /* multilevel guard */
3518e456f2a8SStefano Zampini     ierr = VecSetValues(pcis->vec1_global,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
35191035eff8SStefano Zampini   }
3520e456f2a8SStefano Zampini   ierr = VecAssemblyBegin(pcis->vec1_global);CHKERRQ(ierr);
3521e456f2a8SStefano Zampini   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
3522e456f2a8SStefano Zampini   ierr = PetscFree(vals);CHKERRQ(ierr);
3523e456f2a8SStefano Zampini   ierr = VecAssemblyEnd(pcis->vec1_global);CHKERRQ(ierr);
3524e456f2a8SStefano Zampini   /* now compute dirichlet set in local ordering */
3525e456f2a8SStefano Zampini   ierr = VecScatterBegin(ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3526e456f2a8SStefano Zampini   ierr = VecScatterEnd(ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3527e456f2a8SStefano Zampini   ierr = VecGetArrayRead(pcis->vec1_N,(const PetscScalar**)&vals);CHKERRQ(ierr);
3528e456f2a8SStefano Zampini   for (i=0,lsize=0;i<pcis->n;i++) {
3529e456f2a8SStefano Zampini     if (vals[i] == 1.0) {
3530e456f2a8SStefano Zampini       lsize++;
3531e456f2a8SStefano Zampini     }
3532e456f2a8SStefano Zampini   }
3533e456f2a8SStefano Zampini   ierr = PetscMalloc(lsize*sizeof(PetscInt),&idxs);CHKERRQ(ierr);
3534e456f2a8SStefano Zampini   for (i=0,lsize=0;i<pcis->n;i++) {
3535e456f2a8SStefano Zampini     if (vals[i] == 1.0) {
3536e456f2a8SStefano Zampini       idxs[lsize++] = i;
3537e456f2a8SStefano Zampini     }
3538e456f2a8SStefano Zampini   }
3539e456f2a8SStefano Zampini   ierr = VecRestoreArrayRead(pcis->vec1_N,(const PetscScalar**)&vals);CHKERRQ(ierr);
3540e456f2a8SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
3541e456f2a8SStefano Zampini   *localis = localis_t;
3542e456f2a8SStefano Zampini   PetscFunctionReturn(0);
3543e456f2a8SStefano Zampini }
3544