xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 39e2fb2acbe04a08c612a51de4e522023d995c41)
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   PetscInt       i;
50674ae819SStefano Zampini   PetscErrorCode ierr;
51674ae819SStefano Zampini 
52674ae819SStefano Zampini   PetscFunctionBegin;
53674ae819SStefano Zampini   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
54674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
55674ae819SStefano Zampini   ierr = MatNullSpaceDestroy(&pcbddc->NullSpace);CHKERRQ(ierr);
56674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
57674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
58674ae819SStefano Zampini   for (i=0;i<pcbddc->n_ISForDofs;i++) {
59674ae819SStefano Zampini     ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
60674ae819SStefano Zampini   }
61674ae819SStefano Zampini   ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
629577ea80SStefano Zampini   pcbddc->n_ISForDofs = 0;
63f4ddd8eeSStefano Zampini   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
64f4ddd8eeSStefano Zampini   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
65674ae819SStefano Zampini   PetscFunctionReturn(0);
66674ae819SStefano Zampini }
67674ae819SStefano Zampini 
68674ae819SStefano Zampini #undef __FUNCT__
69674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetTopography"
70674ae819SStefano Zampini PetscErrorCode PCBDDCResetTopography(PC pc)
71674ae819SStefano Zampini {
72674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
73674ae819SStefano Zampini   PetscErrorCode ierr;
74674ae819SStefano Zampini 
75674ae819SStefano Zampini   PetscFunctionBegin;
76674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
77674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
78674ae819SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
79674ae819SStefano Zampini   PetscFunctionReturn(0);
80674ae819SStefano Zampini }
81674ae819SStefano Zampini 
82674ae819SStefano Zampini #undef __FUNCT__
83674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetSolvers"
84674ae819SStefano Zampini PetscErrorCode PCBDDCResetSolvers(PC pc)
85674ae819SStefano Zampini {
86674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
87674ae819SStefano Zampini   PetscErrorCode ierr;
88674ae819SStefano Zampini 
89674ae819SStefano Zampini   PetscFunctionBegin;
90674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
91674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_rhs);CHKERRQ(ierr);
92674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
93674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
9415aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
9515aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
96674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
97674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
98674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
99674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
100674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
101674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
1028ce42a96SStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
103674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
104674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
105674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
106f4ddd8eeSStefano Zampini   ierr = KSPDestroy(&pcbddc->ksp_D);CHKERRQ(ierr);
107f4ddd8eeSStefano Zampini   ierr = KSPDestroy(&pcbddc->ksp_R);CHKERRQ(ierr);
108f4ddd8eeSStefano Zampini   ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
109f4ddd8eeSStefano Zampini   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
110727cdba6SStefano Zampini   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
111f4ddd8eeSStefano Zampini   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
112674ae819SStefano Zampini   PetscFunctionReturn(0);
113674ae819SStefano Zampini }
114674ae819SStefano Zampini 
115674ae819SStefano Zampini #undef __FUNCT__
116f4ddd8eeSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalWorkVectors"
117f4ddd8eeSStefano Zampini PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
1186bfb1811SStefano Zampini {
1196bfb1811SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1206bfb1811SStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
1216bfb1811SStefano Zampini   VecType        impVecType;
122e7b262bdSStefano Zampini   PetscInt       n_vertices,n_constraints,local_primal_size,n_R,old_size;
1236bfb1811SStefano Zampini   PetscErrorCode ierr;
1246bfb1811SStefano Zampini 
1256bfb1811SStefano Zampini   PetscFunctionBegin;
126f4ddd8eeSStefano Zampini   if (!pcbddc->ConstraintMatrix) {
127f4ddd8eeSStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Constraint matrix has not been created");
128f4ddd8eeSStefano Zampini   }
129e7b262bdSStefano Zampini   /* get sizes */
130e7b262bdSStefano Zampini   ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,NULL);CHKERRQ(ierr);
131f4ddd8eeSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,NULL);CHKERRQ(ierr);
132e7b262bdSStefano Zampini   n_constraints = local_primal_size - n_vertices;
1336bfb1811SStefano Zampini   n_R = pcis->n-n_vertices;
1346bfb1811SStefano Zampini   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
135e7b262bdSStefano Zampini   /* local work vectors (try to avoid unneeded work)*/
136e7b262bdSStefano Zampini   /* R nodes */
137e7b262bdSStefano Zampini   old_size = -1;
138e7b262bdSStefano Zampini   if (pcbddc->vec1_R) {
139e7b262bdSStefano Zampini     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
140e7b262bdSStefano Zampini   }
141e7b262bdSStefano Zampini   if (n_R != old_size) {
142e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
143e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
1446bfb1811SStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
1456bfb1811SStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
1466bfb1811SStefano Zampini     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
1476bfb1811SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
148e7b262bdSStefano Zampini   }
149e7b262bdSStefano Zampini   /* local primal dofs */
150e7b262bdSStefano Zampini   old_size = -1;
151e7b262bdSStefano Zampini   if (pcbddc->vec1_P) {
152e7b262bdSStefano Zampini     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
153e7b262bdSStefano Zampini   }
154e7b262bdSStefano Zampini   if (local_primal_size != old_size) {
155e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
15683b7ccabSStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
1576bfb1811SStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,local_primal_size);CHKERRQ(ierr);
1586bfb1811SStefano Zampini     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
159e7b262bdSStefano Zampini   }
160e7b262bdSStefano Zampini   /* local explicit constraints */
161e7b262bdSStefano Zampini   old_size = -1;
162e7b262bdSStefano Zampini   if (pcbddc->vec1_C) {
163e7b262bdSStefano Zampini     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
164e7b262bdSStefano Zampini   }
165e7b262bdSStefano Zampini   if (n_constraints && n_constraints != old_size) {
166e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
16783b7ccabSStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
16883b7ccabSStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
16983b7ccabSStefano Zampini     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
17083b7ccabSStefano Zampini   }
1716bfb1811SStefano Zampini   PetscFunctionReturn(0);
1726bfb1811SStefano Zampini }
1736bfb1811SStefano Zampini 
1746bfb1811SStefano Zampini #undef __FUNCT__
17547f4ddc3SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCorrection"
17647f4ddc3SStefano Zampini PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
17788ebb749SStefano Zampini {
17825084f0cSStefano Zampini   PetscErrorCode         ierr;
17925084f0cSStefano Zampini   /* pointers to pcis and pcbddc */
18088ebb749SStefano Zampini   PC_IS*                 pcis = (PC_IS*)pc->data;
18188ebb749SStefano Zampini   PC_BDDC*               pcbddc = (PC_BDDC*)pc->data;
18225084f0cSStefano Zampini   /* submatrices of local problem */
18388ebb749SStefano Zampini   Mat                    A_RV,A_VR,A_VV;
18425084f0cSStefano Zampini   /* working matrices */
18525084f0cSStefano Zampini   Mat                    M1,M2,M3,C_CR;
18625084f0cSStefano Zampini   /* working vectors */
18725084f0cSStefano Zampini   Vec                    vec1_C,vec2_C,vec1_V,vec2_V;
18825084f0cSStefano Zampini   /* additional working stuff */
18925084f0cSStefano Zampini   IS                     is_aux;
19025084f0cSStefano Zampini   PetscScalar            *coarse_submat_vals; /* TODO: use a PETSc matrix */
19125084f0cSStefano Zampini   const PetscScalar      *array,*row_cmat_values;
19225084f0cSStefano Zampini   const PetscInt         *row_cmat_indices,*idx_R_local;
19325084f0cSStefano Zampini   PetscInt               *vertices,*idx_V_B,*auxindices;
19425084f0cSStefano Zampini   PetscInt               n_vertices,n_constraints,size_of_constraint;
19525084f0cSStefano Zampini   PetscInt               i,j,n_R,n_D,n_B;
19688ebb749SStefano Zampini   PetscBool              setsym=PETSC_FALSE,issym=PETSC_FALSE;
19745a1bb75SStefano Zampini   /* matrix type (vector type propagated downstream from vec1_C and local matrix type) */
19888ebb749SStefano Zampini   MatType                impMatType;
19925084f0cSStefano Zampini   /* some shortcuts to scalars */
20025084f0cSStefano Zampini   PetscScalar            zero=0.0,one=1.0,m_one=-1.0;
20125084f0cSStefano Zampini   /* for debugging purposes */
20288ebb749SStefano Zampini   PetscReal              *coarsefunctions_errors,*constraints_errors;
20388ebb749SStefano Zampini 
20488ebb749SStefano Zampini   PetscFunctionBegin;
20525084f0cSStefano Zampini   /* get number of vertices and their local indices */
20625084f0cSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
20788ebb749SStefano Zampini   n_constraints = pcbddc->local_primal_size-n_vertices;
20888ebb749SStefano Zampini   /* Set Non-overlapping dimensions */
20988ebb749SStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
21088ebb749SStefano Zampini   n_R = pcis->n-n_vertices;
21188ebb749SStefano Zampini 
21288ebb749SStefano Zampini   /* Set types for local objects needed by BDDC precondtioner */
21388ebb749SStefano Zampini   impMatType = MATSEQDENSE;
21488ebb749SStefano Zampini 
21588ebb749SStefano Zampini   /* Allocating some extra storage just to be safe */
21688ebb749SStefano Zampini   ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&auxindices);CHKERRQ(ierr);
21788ebb749SStefano Zampini   for (i=0;i<pcis->n;i++) auxindices[i]=i;
21888ebb749SStefano Zampini 
21988ebb749SStefano Zampini   /* vertices in boundary numbering */
22088ebb749SStefano Zampini   ierr = PetscMalloc(n_vertices*sizeof(PetscInt),&idx_V_B);CHKERRQ(ierr);
221*39e2fb2aSStefano Zampini   ierr = ISGlobalToLocalMappingApply(pcbddc->BtoNmap,IS_GTOLM_DROP,n_vertices,vertices,&i,idx_V_B);CHKERRQ(ierr);
22288ebb749SStefano Zampini   if (i != n_vertices) {
22388ebb749SStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %d != %d\n",n_vertices,i);
22488ebb749SStefano Zampini   }
22588ebb749SStefano Zampini 
22688ebb749SStefano Zampini   /* Precompute stuffs needed for preprocessing and application of BDDC*/
22788ebb749SStefano Zampini   if (n_constraints) {
228f4ddd8eeSStefano Zampini     /* see if we can save some allocations */
229f4ddd8eeSStefano Zampini     if (pcbddc->local_auxmat2) {
230f4ddd8eeSStefano Zampini       PetscInt on_R,on_constraints;
231f4ddd8eeSStefano Zampini       ierr = MatGetSize(pcbddc->local_auxmat2,&on_R,&on_constraints);CHKERRQ(ierr);
232f4ddd8eeSStefano Zampini       if (on_R != n_R || on_constraints != n_constraints) {
233f4ddd8eeSStefano Zampini         ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
234f4ddd8eeSStefano Zampini         ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
235f4ddd8eeSStefano Zampini       }
236f4ddd8eeSStefano Zampini     }
23745a1bb75SStefano Zampini     /* work vectors */
23845a1bb75SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec1_C);CHKERRQ(ierr);
23945a1bb75SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec2_C);CHKERRQ(ierr);
24045a1bb75SStefano Zampini     /* auxiliary matrices */
241f4ddd8eeSStefano Zampini     if (!pcbddc->local_auxmat2) {
24288ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->local_auxmat2);CHKERRQ(ierr);
24325084f0cSStefano Zampini       ierr = MatSetSizes(pcbddc->local_auxmat2,n_R,n_constraints,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
24488ebb749SStefano Zampini       ierr = MatSetType(pcbddc->local_auxmat2,impMatType);CHKERRQ(ierr);
24525084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->local_auxmat2);CHKERRQ(ierr);
246f4ddd8eeSStefano Zampini     }
24788ebb749SStefano Zampini 
24825084f0cSStefano Zampini     /* Extract constraints on R nodes: C_{CR}  */
24925084f0cSStefano Zampini     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
2508ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
25125084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
25288ebb749SStefano Zampini 
25388ebb749SStefano Zampini     /* Assemble local_auxmat2 = - A_{RR}^{-1} C^T_{CR} needed by BDDC application */
25488ebb749SStefano Zampini     for (i=0;i<n_constraints;i++) {
25588ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
25688ebb749SStefano Zampini       /* Get row of constraint matrix in R numbering */
25725084f0cSStefano Zampini       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
25825084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_R,size_of_constraint,row_cmat_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
25925084f0cSStefano Zampini       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
26025084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_R);CHKERRQ(ierr);
26125084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_R);CHKERRQ(ierr);
26288ebb749SStefano Zampini       /* Solve for row of constraint matrix in R numbering */
26388ebb749SStefano Zampini       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
26425084f0cSStefano Zampini       /* Set values in local_auxmat2 */
26525084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
26688ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->local_auxmat2,n_R,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
26725084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
26888ebb749SStefano Zampini     }
26988ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
27088ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
27125084f0cSStefano Zampini     ierr = MatScale(pcbddc->local_auxmat2,m_one);CHKERRQ(ierr);
27288ebb749SStefano Zampini 
27388ebb749SStefano Zampini     /* Assemble explicitly M1 = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1} needed in preproc  */
27425084f0cSStefano Zampini     ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
27525084f0cSStefano Zampini     ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
27688ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&M1);CHKERRQ(ierr);
27788ebb749SStefano Zampini     ierr = MatSetSizes(M1,n_constraints,n_constraints,n_constraints,n_constraints);CHKERRQ(ierr);
27888ebb749SStefano Zampini     ierr = MatSetType(M1,impMatType);CHKERRQ(ierr);
27925084f0cSStefano Zampini     ierr = MatSetUp(M1);CHKERRQ(ierr);
28025084f0cSStefano Zampini     ierr = MatDuplicate(M1,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
28125084f0cSStefano Zampini     ierr = MatZeroEntries(M2);CHKERRQ(ierr);
28225084f0cSStefano Zampini     ierr = VecSet(vec1_C,m_one);CHKERRQ(ierr);
28325084f0cSStefano Zampini     ierr = MatDiagonalSet(M2,vec1_C,INSERT_VALUES);CHKERRQ(ierr);
28425084f0cSStefano Zampini     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
28525084f0cSStefano Zampini     ierr = MatDestroy(&M2);CHKERRQ(ierr);
28625084f0cSStefano Zampini     ierr = MatDestroy(&M3);CHKERRQ(ierr);
28788ebb749SStefano Zampini     /* Assemble local_auxmat1 = M1*C_{CR} needed by BDDC application in KSP and in preproc */
288f4ddd8eeSStefano Zampini     if (!pcbddc->local_auxmat1) {
28988ebb749SStefano Zampini       ierr = MatMatMult(M1,C_CR,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
290f4ddd8eeSStefano Zampini     } else {
291f4ddd8eeSStefano Zampini       ierr = MatMatMult(M1,C_CR,MAT_REUSE_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
292f4ddd8eeSStefano Zampini     }
29388ebb749SStefano Zampini   }
29488ebb749SStefano Zampini 
29588ebb749SStefano Zampini   /* Get submatrices from subdomain matrix */
29688ebb749SStefano Zampini   if (n_vertices) {
2973a50541eSStefano Zampini     PetscInt ibs,mbs;
2983a50541eSStefano Zampini     PetscBool issbaij;
299af732b37SStefano Zampini     Mat newmat;
3003a50541eSStefano Zampini 
3013a50541eSStefano Zampini     ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
3029577ea80SStefano Zampini     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
3039577ea80SStefano Zampini     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
3043a50541eSStefano Zampini     if (ibs != mbs) { /* need to convert to SEQAIJ */
3059577ea80SStefano Zampini       ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
3069577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3079577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3089577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3099577ea80SStefano Zampini       ierr = MatDestroy(&newmat);CHKERRQ(ierr);
3109577ea80SStefano Zampini     } else {
3113a50541eSStefano Zampini       /* this is safe */
3129577ea80SStefano Zampini       ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3133a50541eSStefano Zampini       ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
3143a50541eSStefano Zampini       if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
3153a50541eSStefano Zampini         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
31645a1bb75SStefano Zampini         /* which of the two approaches is faster? */
3173a50541eSStefano Zampini         /* ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3183a50541eSStefano Zampini         ierr = MatCreateTranspose(A_RV,&A_VR);CHKERRQ(ierr);*/
3193a50541eSStefano Zampini         ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3203a50541eSStefano Zampini         ierr = MatCreateTranspose(A_VR,&A_RV);CHKERRQ(ierr);
3213a50541eSStefano Zampini         ierr = MatDestroy(&newmat);CHKERRQ(ierr);
3223a50541eSStefano Zampini       } else {
3239577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3249577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3259577ea80SStefano Zampini       }
3263a50541eSStefano Zampini     }
32745a1bb75SStefano Zampini     ierr = MatGetVecs(A_RV,&vec1_V,NULL);CHKERRQ(ierr);
32845a1bb75SStefano Zampini     ierr = VecDuplicate(vec1_V,&vec2_V);CHKERRQ(ierr);
32925084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
33088ebb749SStefano Zampini   }
33188ebb749SStefano Zampini 
33288ebb749SStefano Zampini   /* Matrix of coarse basis functions (local) */
333f4ddd8eeSStefano Zampini   if (pcbddc->coarse_phi_B) {
334f4ddd8eeSStefano Zampini     PetscInt on_B,on_primal;
335f4ddd8eeSStefano Zampini     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
336f4ddd8eeSStefano Zampini     if (on_B != n_B || on_primal != pcbddc->local_primal_size) {
337f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
338f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
339f4ddd8eeSStefano Zampini     }
340f4ddd8eeSStefano Zampini   }
341f4ddd8eeSStefano Zampini   if (pcbddc->coarse_phi_D) {
342f4ddd8eeSStefano Zampini     PetscInt on_D,on_primal;
343f4ddd8eeSStefano Zampini     ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,&on_primal);CHKERRQ(ierr);
344f4ddd8eeSStefano Zampini     if (on_D != n_D || on_primal != pcbddc->local_primal_size) {
345f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
346f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
347f4ddd8eeSStefano Zampini     }
348f4ddd8eeSStefano Zampini   }
349f4ddd8eeSStefano Zampini   if (!pcbddc->coarse_phi_B) {
35088ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
35188ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_phi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
35288ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_phi_B,impMatType);CHKERRQ(ierr);
35325084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_phi_B);CHKERRQ(ierr);
354f4ddd8eeSStefano Zampini   }
355f4ddd8eeSStefano Zampini   if ( (pcbddc->switch_static || pcbddc->dbg_flag) && !pcbddc->coarse_phi_D ) {
35688ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
35788ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_phi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
35888ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_phi_D,impMatType);CHKERRQ(ierr);
35925084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_phi_D);CHKERRQ(ierr);
36088ebb749SStefano Zampini   }
36188ebb749SStefano Zampini 
36225084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
3638ce42a96SStefano Zampini     ierr = ISGetIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
36488ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*coarsefunctions_errors),&coarsefunctions_errors);CHKERRQ(ierr);
36588ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*constraints_errors),&constraints_errors);CHKERRQ(ierr);
36688ebb749SStefano Zampini   }
36788ebb749SStefano Zampini   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
36888ebb749SStefano Zampini   ierr = PetscMalloc((pcbddc->local_primal_size)*(pcbddc->local_primal_size)*sizeof(PetscScalar),&coarse_submat_vals);CHKERRQ(ierr);
36988ebb749SStefano Zampini 
37088ebb749SStefano Zampini   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
37125084f0cSStefano Zampini 
37225084f0cSStefano Zampini   /* vertices */
37388ebb749SStefano Zampini   for (i=0;i<n_vertices;i++) {
37445a1bb75SStefano Zampini     /* this should not be needed, but MatMult_BAIJ is broken when using compressed row routines */
375f4ddd8eeSStefano Zampini     ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr); /* TODO: REMOVE IT */
37688ebb749SStefano Zampini     ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
37788ebb749SStefano Zampini     ierr = VecSetValue(vec1_V,i,one,INSERT_VALUES);CHKERRQ(ierr);
37888ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
37988ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
38025084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on constraints multipliers */
38188ebb749SStefano Zampini     ierr = MatMult(A_RV,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
38288ebb749SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
38388ebb749SStefano Zampini     ierr = VecScale(pcbddc->vec1_R,m_one);CHKERRQ(ierr);
38488ebb749SStefano Zampini     if (n_constraints) {
38588ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec1_R,vec1_C);CHKERRQ(ierr);
38688ebb749SStefano Zampini       ierr = MatMultAdd(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
38788ebb749SStefano Zampini       ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
38888ebb749SStefano Zampini     }
38988ebb749SStefano Zampini     ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
39088ebb749SStefano Zampini     ierr = MatMultAdd(A_VV,vec1_V,vec2_V,vec2_V);CHKERRQ(ierr);
39188ebb749SStefano Zampini 
39288ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
39388ebb749SStefano Zampini     /* coarse basis functions */
39488ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
39588ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
39688ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
39725084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
39888ebb749SStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
39925084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
40088ebb749SStefano Zampini     ierr = MatSetValue(pcbddc->coarse_phi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
4018eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
40288ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40388ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40425084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
40588ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
40625084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
40788ebb749SStefano Zampini     }
40825084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
40925084f0cSStefano Zampini     ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
41025084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
41125084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
41288ebb749SStefano Zampini     if (n_constraints) {
41325084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
41425084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
41525084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
41688ebb749SStefano Zampini     }
41788ebb749SStefano Zampini 
41825084f0cSStefano Zampini     /* check */
41925084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
42025084f0cSStefano Zampini       /* assemble subdomain vector on local nodes */
42188ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
42225084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
42325084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
42425084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
42525084f0cSStefano Zampini       ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
42625084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
42725084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
42888ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers (i.e. primal nodes) */
42988ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
43025084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
43125084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
43225084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
43388ebb749SStefano Zampini       if (n_constraints) {
43425084f0cSStefano Zampini         ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
43525084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
43625084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
43788ebb749SStefano Zampini       }
43825084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
43925084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
44088ebb749SStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
44188ebb749SStefano Zampini       /* check saddle point solution */
44288ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
44388ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
44488ebb749SStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i]);CHKERRQ(ierr);
44588ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
44625084f0cSStefano Zampini       /* shift by the identity matrix */
44725084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
44825084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
44925084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
45088ebb749SStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i]);CHKERRQ(ierr);
45188ebb749SStefano Zampini     }
45288ebb749SStefano Zampini   }
45388ebb749SStefano Zampini 
45425084f0cSStefano Zampini   /* constraints */
45588ebb749SStefano Zampini   for (i=0;i<n_constraints;i++) {
45688ebb749SStefano Zampini     ierr = VecSet(vec2_C,zero);CHKERRQ(ierr);
45788ebb749SStefano Zampini     ierr = VecSetValue(vec2_C,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
45888ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec2_C);CHKERRQ(ierr);
45988ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec2_C);CHKERRQ(ierr);
46025084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on vertices multipliers */
46188ebb749SStefano Zampini     ierr = MatMult(M1,vec2_C,vec1_C);CHKERRQ(ierr);
46288ebb749SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
46388ebb749SStefano Zampini     ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
46425084f0cSStefano Zampini     if (n_vertices) {
46525084f0cSStefano Zampini       ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
46625084f0cSStefano Zampini     }
46788ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
46888ebb749SStefano Zampini     /* coarse basis functions */
46925084f0cSStefano Zampini     j = i+n_vertices; /* don't touch this! */
47088ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
47188ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
47288ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
47325084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
47425084f0cSStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
47525084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
4768eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
47788ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
47888ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
47925084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
48025084f0cSStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
48125084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
48288ebb749SStefano Zampini     }
48325084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
48488ebb749SStefano Zampini     if (n_vertices) {
48525084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
48625084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
48725084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
48888ebb749SStefano Zampini     }
48925084f0cSStefano Zampini     ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
49025084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
49125084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
49288ebb749SStefano Zampini 
49325084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
49488ebb749SStefano Zampini       /* assemble subdomain vector on nodes */
49588ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
49625084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
49725084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
49825084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
49925084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
50025084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
50188ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers */
50288ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
50388ebb749SStefano Zampini       if (n_vertices) {
50425084f0cSStefano Zampini         ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
50525084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
50625084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
50788ebb749SStefano Zampini       }
50825084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
50925084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
51025084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
51125084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
51225084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
51325084f0cSStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
51488ebb749SStefano Zampini       /* check saddle point solution */
51588ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
51688ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
51725084f0cSStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[j]);CHKERRQ(ierr);
51888ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
51925084f0cSStefano Zampini       /* shift by the identity matrix */
52025084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,j,m_one,ADD_VALUES);CHKERRQ(ierr);
52125084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
52225084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
52325084f0cSStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[j]);CHKERRQ(ierr);
52488ebb749SStefano Zampini     }
52588ebb749SStefano Zampini   }
52625084f0cSStefano Zampini   /* call assembling routines for local coarse basis */
52788ebb749SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
52888ebb749SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5298eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
53088ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
53188ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
53288ebb749SStefano Zampini   }
53325084f0cSStefano Zampini 
53488ebb749SStefano Zampini   /* compute other basis functions for non-symmetric problems */
53588ebb749SStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
53688ebb749SStefano Zampini   if (!setsym || (setsym && !issym)) {
537f4ddd8eeSStefano Zampini     if (!pcbddc->coarse_psi_B) {
53888ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
53988ebb749SStefano Zampini       ierr = MatSetSizes(pcbddc->coarse_psi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
54088ebb749SStefano Zampini       ierr = MatSetType(pcbddc->coarse_psi_B,impMatType);CHKERRQ(ierr);
54125084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->coarse_psi_B);CHKERRQ(ierr);
542f4ddd8eeSStefano Zampini     }
543f4ddd8eeSStefano Zampini     if ( (pcbddc->switch_static || pcbddc->dbg_flag) && !pcbddc->coarse_psi_D) {
54488ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
54588ebb749SStefano Zampini       ierr = MatSetSizes(pcbddc->coarse_psi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
54688ebb749SStefano Zampini       ierr = MatSetType(pcbddc->coarse_psi_D,impMatType);CHKERRQ(ierr);
54725084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->coarse_psi_D);CHKERRQ(ierr);
54888ebb749SStefano Zampini     }
54988ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
55088ebb749SStefano Zampini       if (n_constraints) {
55188ebb749SStefano Zampini         ierr = VecSet(vec1_C,zero);CHKERRQ(ierr);
55288ebb749SStefano Zampini         for (j=0;j<n_constraints;j++) {
55325084f0cSStefano Zampini           ierr = VecSetValue(vec1_C,j,coarse_submat_vals[(j+n_vertices)*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
55488ebb749SStefano Zampini         }
55525084f0cSStefano Zampini         ierr = VecAssemblyBegin(vec1_C);CHKERRQ(ierr);
55625084f0cSStefano Zampini         ierr = VecAssemblyEnd(vec1_C);CHKERRQ(ierr);
55788ebb749SStefano Zampini       }
55888ebb749SStefano Zampini       if (i<n_vertices) {
55988ebb749SStefano Zampini         ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
56088ebb749SStefano Zampini         ierr = VecSetValue(vec1_V,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
56188ebb749SStefano Zampini         ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
56288ebb749SStefano Zampini         ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
56388ebb749SStefano Zampini         ierr = MatMultTranspose(A_VR,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
56488ebb749SStefano Zampini         if (n_constraints) {
56588ebb749SStefano Zampini           ierr = MatMultTransposeAdd(C_CR,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
56688ebb749SStefano Zampini         }
56788ebb749SStefano Zampini       } else {
56888ebb749SStefano Zampini         ierr = MatMultTranspose(C_CR,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
56988ebb749SStefano Zampini       }
57088ebb749SStefano Zampini       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
57188ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
57288ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
57388ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
57425084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
57588ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_psi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
57625084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
57788ebb749SStefano Zampini       if (i<n_vertices) {
57888ebb749SStefano Zampini         ierr = MatSetValue(pcbddc->coarse_psi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
57988ebb749SStefano Zampini       }
5808eeda7d8SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
58188ebb749SStefano Zampini         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
58288ebb749SStefano Zampini         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
58325084f0cSStefano Zampini         ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
58488ebb749SStefano Zampini         ierr = MatSetValues(pcbddc->coarse_psi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
58525084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
58688ebb749SStefano Zampini       }
58788ebb749SStefano Zampini 
58825084f0cSStefano Zampini       if (pcbddc->dbg_flag) {
58988ebb749SStefano Zampini         /* assemble subdomain vector on nodes */
59088ebb749SStefano Zampini         ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
59125084f0cSStefano Zampini         ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
59225084f0cSStefano Zampini         ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
59325084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
59425084f0cSStefano Zampini         if (i<n_vertices) {
59525084f0cSStefano Zampini           ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
59688ebb749SStefano Zampini         }
59725084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
59825084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
59925084f0cSStefano Zampini         /* assemble subdomain vector of lagrange multipliers */
60025084f0cSStefano Zampini         for (j=0;j<pcbddc->local_primal_size;j++) {
60125084f0cSStefano Zampini           ierr = VecSetValue(pcbddc->vec1_P,j,-coarse_submat_vals[j*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
60225084f0cSStefano Zampini         }
60325084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
60425084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
60588ebb749SStefano Zampini         /* check saddle point solution */
60688ebb749SStefano Zampini         ierr = MatMultTranspose(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
60788ebb749SStefano Zampini         ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
60888ebb749SStefano Zampini         ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
60988ebb749SStefano Zampini         ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
61025084f0cSStefano Zampini         /* shift by the identity matrix */
61125084f0cSStefano Zampini         ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
61225084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
61325084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
61488ebb749SStefano Zampini         ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
61588ebb749SStefano Zampini       }
61688ebb749SStefano Zampini     }
61788ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
61888ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6198eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
62088ebb749SStefano Zampini       ierr = MatAssemblyBegin(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
62188ebb749SStefano Zampini       ierr = MatAssemblyEnd(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
62288ebb749SStefano Zampini     }
62388ebb749SStefano Zampini   }
62488ebb749SStefano Zampini   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
62588ebb749SStefano Zampini   /* Checking coarse_sub_mat and coarse basis functios */
62688ebb749SStefano Zampini   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
62788ebb749SStefano Zampini   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
62825084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
62988ebb749SStefano Zampini     Mat         coarse_sub_mat;
63025084f0cSStefano Zampini     Mat         AUXMAT,TM1,TM2,TM3,TM4;
63188ebb749SStefano Zampini     Mat         coarse_phi_D,coarse_phi_B;
63288ebb749SStefano Zampini     Mat         coarse_psi_D,coarse_psi_B;
63388ebb749SStefano Zampini     Mat         A_II,A_BB,A_IB,A_BI;
63488ebb749SStefano Zampini     MatType     checkmattype=MATSEQAIJ;
63588ebb749SStefano Zampini     PetscReal   real_value;
63688ebb749SStefano Zampini 
63788ebb749SStefano Zampini     ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
63888ebb749SStefano Zampini     ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
63988ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
64088ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
64188ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
64288ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
64388ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
64488ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
64588ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
64688ebb749SStefano Zampini     }
64788ebb749SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
64888ebb749SStefano Zampini 
64925084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
65025084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat and local basis functions\n");CHKERRQ(ierr);
65125084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
65288ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
65388ebb749SStefano Zampini       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
65488ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
65588ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
65688ebb749SStefano Zampini       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
65788ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
65888ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
65988ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
66088ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
66188ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
66288ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
66388ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
66488ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
66588ebb749SStefano Zampini     } else {
66688ebb749SStefano Zampini       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
66788ebb749SStefano Zampini       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
66888ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
66988ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
67088ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
67188ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
67288ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
67388ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
67488ebb749SStefano Zampini     }
67588ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
67688ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
67788ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
67888ebb749SStefano Zampini     ierr = MatConvert(TM1,MATSEQDENSE,MAT_REUSE_MATRIX,&TM1);CHKERRQ(ierr);
67988ebb749SStefano Zampini     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
68088ebb749SStefano Zampini     ierr = MatNorm(TM1,NORM_INFINITY,&real_value);CHKERRQ(ierr);
6810fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
68225084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"----------------------------------\n");CHKERRQ(ierr);
68325084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d \n",PetscGlobalRank);CHKERRQ(ierr);
68425084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"matrix error = % 1.14e\n",real_value);CHKERRQ(ierr);
68525084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (phi) errors\n");CHKERRQ(ierr);
68688ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
68725084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,coarsefunctions_errors[i]);CHKERRQ(ierr);
68888ebb749SStefano Zampini     }
68925084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (phi) errors\n");CHKERRQ(ierr);
69088ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
69125084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,constraints_errors[i]);CHKERRQ(ierr);
69288ebb749SStefano Zampini     }
69388ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
69425084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (psi) errors\n");CHKERRQ(ierr);
69588ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
69625084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,coarsefunctions_errors[i]);CHKERRQ(ierr);
69788ebb749SStefano Zampini       }
69825084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (psi) errors\n");CHKERRQ(ierr);
69988ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
70025084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,constraints_errors[i]);CHKERRQ(ierr);
70188ebb749SStefano Zampini       }
70288ebb749SStefano Zampini     }
70325084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
70488ebb749SStefano Zampini     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
70588ebb749SStefano Zampini     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
70688ebb749SStefano Zampini     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
70788ebb749SStefano Zampini     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
70888ebb749SStefano Zampini     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
70988ebb749SStefano Zampini     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
71088ebb749SStefano Zampini     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
71188ebb749SStefano Zampini     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
71288ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
71388ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
71488ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
71588ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
71688ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
71788ebb749SStefano Zampini     }
71888ebb749SStefano Zampini     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
7198ce42a96SStefano Zampini     ierr = ISRestoreIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
72088ebb749SStefano Zampini     ierr = PetscFree(coarsefunctions_errors);CHKERRQ(ierr);
72188ebb749SStefano Zampini     ierr = PetscFree(constraints_errors);CHKERRQ(ierr);
72288ebb749SStefano Zampini   }
72388ebb749SStefano Zampini   /* free memory */
72488ebb749SStefano Zampini   if (n_vertices) {
72588ebb749SStefano Zampini     ierr = PetscFree(vertices);CHKERRQ(ierr);
72688ebb749SStefano Zampini     ierr = VecDestroy(&vec1_V);CHKERRQ(ierr);
72788ebb749SStefano Zampini     ierr = VecDestroy(&vec2_V);CHKERRQ(ierr);
72888ebb749SStefano Zampini     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
72988ebb749SStefano Zampini     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
73088ebb749SStefano Zampini     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
73188ebb749SStefano Zampini   }
73288ebb749SStefano Zampini   if (n_constraints) {
73388ebb749SStefano Zampini     ierr = VecDestroy(&vec1_C);CHKERRQ(ierr);
73488ebb749SStefano Zampini     ierr = VecDestroy(&vec2_C);CHKERRQ(ierr);
73588ebb749SStefano Zampini     ierr = MatDestroy(&M1);CHKERRQ(ierr);
73688ebb749SStefano Zampini     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
73788ebb749SStefano Zampini   }
73888ebb749SStefano Zampini   ierr = PetscFree(auxindices);CHKERRQ(ierr);
7398629588bSStefano Zampini   /* get back data */
7408629588bSStefano Zampini   *coarse_submat_vals_n = coarse_submat_vals;
74188ebb749SStefano Zampini   PetscFunctionReturn(0);
74288ebb749SStefano Zampini }
74388ebb749SStefano Zampini 
74488ebb749SStefano Zampini #undef __FUNCT__
745aa0d41d4SStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalMatrices"
746aa0d41d4SStefano Zampini PetscErrorCode PCBDDCSetUpLocalMatrices(PC pc)
747aa0d41d4SStefano Zampini {
748aa0d41d4SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
749aa0d41d4SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
750aa0d41d4SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
7519577ea80SStefano Zampini   PetscBool         issbaij,isbaij;
752aa0d41d4SStefano Zampini   /* manage repeated solves */
753aa0d41d4SStefano Zampini   MatReuse          reuse;
754aa0d41d4SStefano Zampini   MatStructure      matstruct;
755aa0d41d4SStefano Zampini   PetscErrorCode    ierr;
756aa0d41d4SStefano Zampini 
757aa0d41d4SStefano Zampini   PetscFunctionBegin;
758f4ddd8eeSStefano Zampini   if (pcbddc->use_change_of_basis && !pcbddc->ChangeOfBasisMatrix) {
759f4ddd8eeSStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Change of basis matrix has not been created");
760f4ddd8eeSStefano Zampini   }
761aa0d41d4SStefano Zampini   /* get mat flags */
762aa0d41d4SStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
763aa0d41d4SStefano Zampini   reuse = MAT_INITIAL_MATRIX;
764aa0d41d4SStefano Zampini   if (pc->setupcalled) {
765aa0d41d4SStefano Zampini     /* when matstruct is SAME_PRECONDITIONER, we shouldn't be here */
766aa0d41d4SStefano Zampini     if (matstruct == SAME_PRECONDITIONER) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen");
767aa0d41d4SStefano Zampini     if (matstruct == SAME_NONZERO_PATTERN) {
768aa0d41d4SStefano Zampini       reuse = MAT_REUSE_MATRIX;
769aa0d41d4SStefano Zampini     } else {
770aa0d41d4SStefano Zampini       reuse = MAT_INITIAL_MATRIX;
771aa0d41d4SStefano Zampini     }
772aa0d41d4SStefano Zampini   }
773aa0d41d4SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
774aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
775aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
776aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
777aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BB);CHKERRQ(ierr);
778aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
779aa0d41d4SStefano Zampini   }
780aa0d41d4SStefano Zampini 
781aa0d41d4SStefano Zampini   /* transform local matrices if needed */
782aa0d41d4SStefano Zampini   if (pcbddc->use_change_of_basis) {
783aa0d41d4SStefano Zampini     Mat         change_mat_all;
784aa0d41d4SStefano Zampini     PetscScalar *row_cmat_values;
785aa0d41d4SStefano Zampini     PetscInt    *row_cmat_indices;
786aa0d41d4SStefano Zampini     PetscInt    *nnz,*is_indices,*temp_indices;
787aa0d41d4SStefano Zampini     PetscInt    i,j,k,n_D,n_B;
788aa0d41d4SStefano Zampini 
789aa0d41d4SStefano Zampini     /* Get Non-overlapping dimensions */
790aa0d41d4SStefano Zampini     n_B = pcis->n_B;
791aa0d41d4SStefano Zampini     n_D = pcis->n-n_B;
792aa0d41d4SStefano Zampini 
793aa0d41d4SStefano Zampini     /* compute nonzero structure of change of basis on all local nodes */
794aa0d41d4SStefano Zampini     ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
795aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
796aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) nnz[is_indices[i]] = 1;
797aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
798aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
799aa0d41d4SStefano Zampini     k=1;
800aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
801aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
802aa0d41d4SStefano Zampini       nnz[is_indices[i]]=j;
803aa0d41d4SStefano Zampini       if (k < j) k = j;
804aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
805aa0d41d4SStefano Zampini     }
806aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
807aa0d41d4SStefano Zampini     /* assemble change of basis matrix on the whole set of local dofs */
808aa0d41d4SStefano Zampini     ierr = PetscMalloc(k*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
809aa0d41d4SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&change_mat_all);CHKERRQ(ierr);
810aa0d41d4SStefano Zampini     ierr = MatSetSizes(change_mat_all,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
811aa0d41d4SStefano Zampini     ierr = MatSetType(change_mat_all,MATSEQAIJ);CHKERRQ(ierr);
812aa0d41d4SStefano Zampini     ierr = MatSeqAIJSetPreallocation(change_mat_all,0,nnz);CHKERRQ(ierr);
813aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
814aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) {
815aa0d41d4SStefano Zampini       ierr = MatSetValue(change_mat_all,is_indices[i],is_indices[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
816aa0d41d4SStefano Zampini     }
817aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
818aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
819aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
820aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
821aa0d41d4SStefano Zampini       for (k=0; k<j; k++) temp_indices[k]=is_indices[row_cmat_indices[k]];
822aa0d41d4SStefano Zampini       ierr = MatSetValues(change_mat_all,1,&is_indices[i],j,temp_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
823aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
824aa0d41d4SStefano Zampini     }
825aa0d41d4SStefano Zampini     ierr = MatAssemblyBegin(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
826aa0d41d4SStefano Zampini     ierr = MatAssemblyEnd(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8279577ea80SStefano Zampini     /* TODO: HOW TO WORK WITH BAIJ and SBAIJ? PtAP not provided */
8289577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
8299577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQBAIJ,&isbaij);CHKERRQ(ierr);
8309577ea80SStefano Zampini     if (!issbaij && !isbaij) {
831aa0d41d4SStefano Zampini       ierr = MatPtAP(matis->A,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
832aa0d41d4SStefano Zampini     } else {
833aa0d41d4SStefano Zampini       Mat work_mat;
834aa0d41d4SStefano Zampini       ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
835aa0d41d4SStefano Zampini       ierr = MatPtAP(work_mat,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
836aa0d41d4SStefano Zampini       ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
837aa0d41d4SStefano Zampini     }
83845a1bb75SStefano Zampini     /*
83945a1bb75SStefano Zampini     ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
84045a1bb75SStefano Zampini     ierr = MatView(change_mat_all,(PetscViewer)0);CHKERRQ(ierr);
84145a1bb75SStefano Zampini     */
842aa0d41d4SStefano Zampini     ierr = MatDestroy(&change_mat_all);CHKERRQ(ierr);
843aa0d41d4SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
844aa0d41d4SStefano Zampini     ierr = PetscFree(temp_indices);CHKERRQ(ierr);
845aa0d41d4SStefano Zampini   } else {
846aa0d41d4SStefano Zampini     /* without change of basis, the local matrix is unchanged */
847aa0d41d4SStefano Zampini     if (!pcbddc->local_mat) {
848aa0d41d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)matis->A);CHKERRQ(ierr);
849aa0d41d4SStefano Zampini       pcbddc->local_mat = matis->A;
850aa0d41d4SStefano Zampini     }
851aa0d41d4SStefano Zampini   }
852aa0d41d4SStefano Zampini 
853aa0d41d4SStefano Zampini   /* get submatrices */
854aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_I_local,reuse,&pcis->A_II);CHKERRQ(ierr);
8559577ea80SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_B_local,reuse,&pcis->A_BB);CHKERRQ(ierr);
8569577ea80SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
8579577ea80SStefano Zampini   if (!issbaij) {
858aa0d41d4SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
859aa0d41d4SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
8609577ea80SStefano Zampini   } else {
8619577ea80SStefano Zampini     Mat newmat;
8629577ea80SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
8639577ea80SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
8649577ea80SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
8659577ea80SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
8669577ea80SStefano Zampini   }
867aa0d41d4SStefano Zampini   PetscFunctionReturn(0);
868aa0d41d4SStefano Zampini }
869aa0d41d4SStefano Zampini 
870aa0d41d4SStefano Zampini #undef __FUNCT__
871a64d13efSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalScatters"
8728ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
873a64d13efSStefano Zampini {
874a64d13efSStefano Zampini   PC_IS*         pcis = (PC_IS*)(pc->data);
875a64d13efSStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8768ce42a96SStefano Zampini   IS             is_aux1,is_aux2;
877a64d13efSStefano Zampini   PetscInt       *vertices,*aux_array1,*aux_array2,*is_indices,*idx_R_local;
8783a50541eSStefano Zampini   PetscInt       n_vertices,i,j,n_R,n_D,n_B;
8793a50541eSStefano Zampini   PetscInt       vbs,bs;
8804641a718SStefano Zampini   PetscBT        bitmask;
881a64d13efSStefano Zampini   PetscErrorCode ierr;
882a64d13efSStefano Zampini 
883a64d13efSStefano Zampini   PetscFunctionBegin;
884f4ddd8eeSStefano Zampini   /* No need to setup local scatters if primal space is unchanged */
885727cdba6SStefano Zampini   if (!pcbddc->new_primal_space_local) {
886f4ddd8eeSStefano Zampini     PetscFunctionReturn(0);
887f4ddd8eeSStefano Zampini   }
888f4ddd8eeSStefano Zampini   /* destroy old objects */
889f4ddd8eeSStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
890f4ddd8eeSStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
891f4ddd8eeSStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
892a64d13efSStefano Zampini   /* Set Non-overlapping dimensions */
893a64d13efSStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
894a64d13efSStefano Zampini   /* get vertex indices from constraint matrix */
895a64d13efSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
8963a50541eSStefano Zampini 
8974641a718SStefano Zampini   /* create auxiliary bitmask */
8984641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
8994641a718SStefano Zampini   for (i=0;i<n_vertices;i++) {
9004641a718SStefano Zampini     ierr = PetscBTSet(bitmask,vertices[i]);CHKERRQ(ierr);
9014641a718SStefano Zampini   }
9023a50541eSStefano Zampini 
903a64d13efSStefano Zampini   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
904a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n-n_vertices)*sizeof(PetscInt),&idx_R_local);CHKERRQ(ierr);
905a64d13efSStefano Zampini   for (i=0, n_R=0; i<pcis->n; i++) {
9064641a718SStefano Zampini     if (!PetscBTLookup(bitmask,i)) {
907a64d13efSStefano Zampini       idx_R_local[n_R] = i;
908a64d13efSStefano Zampini       n_R++;
909a64d13efSStefano Zampini     }
910a64d13efSStefano Zampini   }
9113a50541eSStefano Zampini 
9123a50541eSStefano Zampini   /* Block code */
9133a50541eSStefano Zampini   vbs = 1;
9143a50541eSStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
9153a50541eSStefano Zampini   if (bs>1 && !(n_vertices%bs)) {
9163a50541eSStefano Zampini     PetscBool is_blocked = PETSC_TRUE;
9173a50541eSStefano Zampini     PetscInt  *vary;
9183a50541eSStefano Zampini     /* Verify if the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
9193a50541eSStefano Zampini     ierr = PetscMalloc(pcis->n/bs*sizeof(PetscInt),&vary);CHKERRQ(ierr);
9203a50541eSStefano Zampini     ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
9213a50541eSStefano Zampini     for (i=0; i<n_vertices; i++) vary[vertices[i]/bs]++;
9223a50541eSStefano Zampini     for (i=0; i<n_vertices; i++) {
9233a50541eSStefano Zampini       if (vary[i]!=0 && vary[i]!=bs) {
9243a50541eSStefano Zampini         is_blocked = PETSC_FALSE;
9253a50541eSStefano Zampini         break;
9263a50541eSStefano Zampini       }
9273a50541eSStefano Zampini     }
9283a50541eSStefano Zampini     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
9293a50541eSStefano Zampini       vbs = bs;
9303a50541eSStefano Zampini       for (i=0;i<n_R/vbs;i++) {
9313a50541eSStefano Zampini         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
9323a50541eSStefano Zampini       }
9333a50541eSStefano Zampini     }
9343a50541eSStefano Zampini     ierr = PetscFree(vary);CHKERRQ(ierr);
9353a50541eSStefano Zampini   }
936a64d13efSStefano Zampini   ierr = PetscFree(vertices);CHKERRQ(ierr);
9373a50541eSStefano Zampini   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
9383a50541eSStefano Zampini   ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
939a64d13efSStefano Zampini 
940a64d13efSStefano Zampini   /* print some info if requested */
941a64d13efSStefano Zampini   if (pcbddc->dbg_flag) {
942a64d13efSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
943a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
9440fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
945a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
946a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
9473a50541eSStefano 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);
948a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr);
949a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
950a64d13efSStefano Zampini   }
951a64d13efSStefano Zampini 
952a64d13efSStefano Zampini   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
9533a50541eSStefano Zampini   ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
954a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
955a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array2);CHKERRQ(ierr);
956a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
9574641a718SStefano Zampini   for (i=0; i<n_D; i++) {
9584641a718SStefano Zampini     ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
9594641a718SStefano Zampini   }
960a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
961a64d13efSStefano Zampini   for (i=0, j=0; i<n_R; i++) {
9624641a718SStefano Zampini     if (!PetscBTLookup(bitmask,idx_R_local[i])) {
9634641a718SStefano Zampini       aux_array1[j++] = i;
964a64d13efSStefano Zampini     }
965a64d13efSStefano Zampini   }
966a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
967a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
968a64d13efSStefano Zampini   for (i=0, j=0; i<n_B; i++) {
9694641a718SStefano Zampini     if (!PetscBTLookup(bitmask,is_indices[i])) {
9704641a718SStefano Zampini       aux_array2[j++] = i;
971a64d13efSStefano Zampini     }
972a64d13efSStefano Zampini   }
973a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
974a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
975a64d13efSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
976a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
977a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
978a64d13efSStefano Zampini 
9798eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
980a64d13efSStefano Zampini     ierr = PetscMalloc(n_D*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
981a64d13efSStefano Zampini     for (i=0, j=0; i<n_R; i++) {
9824641a718SStefano Zampini       if (PetscBTLookup(bitmask,idx_R_local[i])) {
9834641a718SStefano Zampini         aux_array1[j++] = i;
984a64d13efSStefano Zampini       }
985a64d13efSStefano Zampini     }
986a64d13efSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
987a64d13efSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
988a64d13efSStefano Zampini     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
989a64d13efSStefano Zampini   }
9904641a718SStefano Zampini   ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
9913a50541eSStefano Zampini   ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
992a64d13efSStefano Zampini   PetscFunctionReturn(0);
993a64d13efSStefano Zampini }
994a64d13efSStefano Zampini 
995304d26faSStefano Zampini 
996304d26faSStefano Zampini #undef __FUNCT__
997304d26faSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
9988ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc)
999304d26faSStefano Zampini {
1000304d26faSStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1001304d26faSStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
1002304d26faSStefano Zampini   PC             pc_temp;
1003304d26faSStefano Zampini   Mat            A_RR;
1004304d26faSStefano Zampini   MatStructure   matstruct;
1005f4ddd8eeSStefano Zampini   MatReuse       reuse;
1006304d26faSStefano Zampini   PetscScalar    m_one = -1.0;
1007304d26faSStefano Zampini   PetscReal      value;
1008af732b37SStefano Zampini   PetscInt       n_D,n_R,ibs,mbs;
10099577ea80SStefano Zampini   PetscBool      use_exact,use_exact_reduced,issbaij;
1010304d26faSStefano Zampini   PetscErrorCode ierr;
1011e604994aSStefano Zampini   /* prefixes stuff */
1012e604994aSStefano Zampini   char           dir_prefix[256],neu_prefix[256],str_level[3];
1013e604994aSStefano Zampini   size_t         len;
1014304d26faSStefano Zampini 
1015304d26faSStefano Zampini   PetscFunctionBegin;
1016304d26faSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
1017304d26faSStefano Zampini 
1018e604994aSStefano Zampini   /* compute prefixes */
1019e604994aSStefano Zampini   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
1020e604994aSStefano Zampini   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
1021e604994aSStefano Zampini   if (!pcbddc->current_level) {
1022e604994aSStefano Zampini     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
1023e604994aSStefano Zampini     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
1024e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
1025e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
1026e604994aSStefano Zampini   } else {
1027e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
1028e604994aSStefano Zampini     sprintf(str_level,"%d_",(int)(pcbddc->current_level));
1029e604994aSStefano Zampini     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
1030e604994aSStefano Zampini     len -= 15; /* remove "pc_bddc_coarse_" */
1031e604994aSStefano Zampini     if (pcbddc->current_level>1) len -= 2; /* remove "X_" with X level number (works with 9 levels max) */
1032e604994aSStefano Zampini     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
1033e604994aSStefano Zampini     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
1034e604994aSStefano Zampini     *(dir_prefix+len)='\0';
1035e604994aSStefano Zampini     *(neu_prefix+len)='\0';
1036e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
1037e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
1038e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
1039e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
1040e604994aSStefano Zampini   }
1041e604994aSStefano Zampini 
1042304d26faSStefano Zampini   /* DIRICHLET PROBLEM */
1043ac78edfcSStefano Zampini   /* Matrix for Dirichlet problem is pcis->A_II */
10448ce42a96SStefano Zampini   ierr = ISGetSize(pcis->is_I_local,&n_D);CHKERRQ(ierr);
1045304d26faSStefano Zampini   if (!pcbddc->ksp_D) { /* create object if not yet build */
1046304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
1047304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
1048304d26faSStefano Zampini     /* default */
1049304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
1050e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
10519577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
1052304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
10539577ea80SStefano Zampini     if (issbaij) {
10549577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
10559577ea80SStefano Zampini     } else {
1056304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
10579577ea80SStefano Zampini     }
1058304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1059304d26faSStefano Zampini   }
1060304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II,matstruct);CHKERRQ(ierr);
1061304d26faSStefano Zampini   /* Allow user's customization */
1062304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
1063304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1064304d26faSStefano Zampini   if (!n_D) {
1065304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
1066304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1067304d26faSStefano Zampini   }
1068304d26faSStefano Zampini   /* Set Up KSP for Dirichlet problem of BDDC */
1069304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
1070304d26faSStefano Zampini   /* set ksp_D into pcis data */
1071304d26faSStefano Zampini   ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
1072304d26faSStefano Zampini   ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
1073304d26faSStefano Zampini   pcis->ksp_D = pcbddc->ksp_D;
1074304d26faSStefano Zampini 
1075304d26faSStefano Zampini   /* NEUMANN PROBLEM */
1076f4ddd8eeSStefano Zampini   /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
10778ce42a96SStefano Zampini   ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
1078f4ddd8eeSStefano Zampini   if (pcbddc->ksp_R) { /* already created ksp */
1079f4ddd8eeSStefano Zampini     PetscInt nn_R;
1080f4ddd8eeSStefano Zampini     ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR,NULL);CHKERRQ(ierr);
1081f4ddd8eeSStefano Zampini     ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
1082f4ddd8eeSStefano Zampini     ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
1083f4ddd8eeSStefano Zampini     if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
1084f4ddd8eeSStefano Zampini       ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
1085f4ddd8eeSStefano Zampini       ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1086f4ddd8eeSStefano Zampini       reuse = MAT_INITIAL_MATRIX;
1087f4ddd8eeSStefano Zampini     } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
1088727cdba6SStefano Zampini       if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
1089f4ddd8eeSStefano Zampini         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1090f4ddd8eeSStefano Zampini         reuse = MAT_INITIAL_MATRIX;
1091f4ddd8eeSStefano Zampini       } else { /* safe to reuse the matrix */
1092f4ddd8eeSStefano Zampini         reuse = MAT_REUSE_MATRIX;
1093f4ddd8eeSStefano Zampini       }
1094f4ddd8eeSStefano Zampini     }
1095f4ddd8eeSStefano Zampini     /* last check */
1096f4ddd8eeSStefano Zampini     if (matstruct == DIFFERENT_NONZERO_PATTERN) {
1097f4ddd8eeSStefano Zampini       ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1098f4ddd8eeSStefano Zampini       reuse = MAT_INITIAL_MATRIX;
1099f4ddd8eeSStefano Zampini     }
1100f4ddd8eeSStefano Zampini   } else { /* first time, so we need to create the matrix */
1101f4ddd8eeSStefano Zampini     reuse = MAT_INITIAL_MATRIX;
1102f4ddd8eeSStefano Zampini   }
1103f4ddd8eeSStefano Zampini   /* extract A_RR */
1104af732b37SStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
1105af732b37SStefano Zampini   ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
11063a50541eSStefano Zampini   if (ibs != mbs) {
1107af732b37SStefano Zampini     Mat newmat;
1108af732b37SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
1109f4ddd8eeSStefano Zampini     ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
1110af732b37SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
1111af732b37SStefano Zampini   } else {
1112f4ddd8eeSStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
1113af732b37SStefano Zampini   }
1114f4ddd8eeSStefano Zampini   if (!pcbddc->ksp_R) { /* create object if not present */
1115304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
1116304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
1117304d26faSStefano Zampini     /* default */
1118304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
1119e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
1120304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
11219577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
11229577ea80SStefano Zampini     if (issbaij) {
11239577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
11249577ea80SStefano Zampini     } else {
1125304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
11269577ea80SStefano Zampini     }
1127304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1128304d26faSStefano Zampini   }
1129304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR,matstruct);CHKERRQ(ierr);
1130304d26faSStefano Zampini   /* Allow user's customization */
1131304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
1132304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1133304d26faSStefano Zampini   if (!n_R) {
1134304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
1135304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1136304d26faSStefano Zampini   }
1137304d26faSStefano Zampini   /* Set Up KSP for Neumann problem of BDDC */
1138304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
1139304d26faSStefano Zampini 
1140304d26faSStefano Zampini   /* check Dirichlet and Neumann solvers and adapt them if a nullspace correction is needed */
11410fccc4e9SStefano Zampini   if (pcbddc->NullSpace || pcbddc->dbg_flag) {
1142304d26faSStefano Zampini     /* Dirichlet */
11430fccc4e9SStefano Zampini     ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
11440fccc4e9SStefano Zampini     ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
11450fccc4e9SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
11460fccc4e9SStefano Zampini     ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
11470fccc4e9SStefano Zampini     ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
1148304d26faSStefano Zampini     /* need to be adapted? */
1149b8ffe317SStefano Zampini     use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1150b8ffe317SStefano Zampini     ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1151b8ffe317SStefano Zampini     ierr = PCBDDCSetUseExactDirichlet(pc,use_exact_reduced);CHKERRQ(ierr);
1152304d26faSStefano Zampini     /* print info */
1153304d26faSStefano Zampini     if (pcbddc->dbg_flag) {
1154304d26faSStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
11550fccc4e9SStefano Zampini       ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
1156304d26faSStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
1157304d26faSStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Checking solution of Dirichlet and Neumann problems\n");CHKERRQ(ierr);
1158e604994aSStefano 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);
1159304d26faSStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1160304d26faSStefano Zampini     }
1161b8ffe317SStefano Zampini     if (pcbddc->NullSpace && !use_exact_reduced && !pcbddc->switch_static) {
11628ce42a96SStefano Zampini       ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcis->is_I_local);CHKERRQ(ierr);
1163304d26faSStefano Zampini     }
1164304d26faSStefano Zampini 
1165304d26faSStefano Zampini     /* Neumann */
11660fccc4e9SStefano Zampini     ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
11670fccc4e9SStefano Zampini     ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
11680fccc4e9SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
11690fccc4e9SStefano Zampini     ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
11700fccc4e9SStefano Zampini     ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
1171304d26faSStefano Zampini     /* need to be adapted? */
1172b8ffe317SStefano Zampini     use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1173b8ffe317SStefano Zampini     ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1174304d26faSStefano Zampini     /* print info */
1175304d26faSStefano Zampini     if (pcbddc->dbg_flag) {
1176e604994aSStefano 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);
1177304d26faSStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1178304d26faSStefano Zampini     }
1179b8ffe317SStefano Zampini     if (pcbddc->NullSpace && !use_exact_reduced) { /* is it the right logic? */
11808ce42a96SStefano Zampini       ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcbddc->is_R_local);CHKERRQ(ierr);
1181304d26faSStefano Zampini     }
11820fccc4e9SStefano Zampini   }
1183304d26faSStefano Zampini   /* free Neumann problem's matrix */
1184304d26faSStefano Zampini   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1185304d26faSStefano Zampini   PetscFunctionReturn(0);
1186304d26faSStefano Zampini }
1187304d26faSStefano Zampini 
1188304d26faSStefano Zampini #undef __FUNCT__
1189674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSolveSaddlePoint"
1190674ae819SStefano Zampini static PetscErrorCode  PCBDDCSolveSaddlePoint(PC pc)
1191674ae819SStefano Zampini {
1192674ae819SStefano Zampini   PetscErrorCode ierr;
1193674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1194674ae819SStefano Zampini 
1195674ae819SStefano Zampini   PetscFunctionBegin;
1196674ae819SStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
1197674ae819SStefano Zampini   if (pcbddc->local_auxmat1) {
1198674ae819SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec2_R,pcbddc->vec1_C);CHKERRQ(ierr);
1199674ae819SStefano Zampini     ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
1200674ae819SStefano Zampini   }
1201674ae819SStefano Zampini   PetscFunctionReturn(0);
1202674ae819SStefano Zampini }
1203674ae819SStefano Zampini 
1204674ae819SStefano Zampini #undef __FUNCT__
1205674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
1206674ae819SStefano Zampini PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc)
1207674ae819SStefano Zampini {
1208674ae819SStefano Zampini   PetscErrorCode ierr;
1209674ae819SStefano Zampini   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
1210674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)  (pc->data);
1211674ae819SStefano Zampini   const PetscScalar zero = 0.0;
1212674ae819SStefano Zampini 
1213674ae819SStefano Zampini   PetscFunctionBegin;
121415aaf578SStefano Zampini   /* Application of PHI^T (or PSI^T)  */
121515aaf578SStefano Zampini   if (pcbddc->coarse_psi_B) {
121615aaf578SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
12178eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
121815aaf578SStefano Zampini   } else {
1219674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
12208eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
122115aaf578SStefano Zampini   }
1222674ae819SStefano Zampini   /* Scatter data of coarse_rhs */
1223674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { ierr = VecSet(pcbddc->coarse_rhs,zero);CHKERRQ(ierr); }
1224674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1225674ae819SStefano Zampini 
1226674ae819SStefano Zampini   /* Local solution on R nodes */
1227674ae819SStefano Zampini   ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
1228674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1229674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
12308eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1231674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1232674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1233674ae819SStefano Zampini   }
1234674ae819SStefano Zampini   ierr = PCBDDCSolveSaddlePoint(pc);CHKERRQ(ierr);
1235674ae819SStefano Zampini   ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1236674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1237674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
12388eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1239674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1240674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1241674ae819SStefano Zampini   }
1242674ae819SStefano Zampini 
1243674ae819SStefano Zampini   /* Coarse solution */
1244674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1245674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { /* TODO remove null space when doing multilevel */
1246674ae819SStefano Zampini     ierr = KSPSolve(pcbddc->coarse_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
1247674ae819SStefano Zampini   }
1248674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1249674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd  (pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1250674ae819SStefano Zampini 
1251674ae819SStefano Zampini   /* Sum contributions from two levels */
1252674ae819SStefano Zampini   ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
12538eeda7d8SStefano Zampini   if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1254674ae819SStefano Zampini   PetscFunctionReturn(0);
1255674ae819SStefano Zampini }
1256674ae819SStefano Zampini 
1257674ae819SStefano Zampini #undef __FUNCT__
1258674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
1259674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1260674ae819SStefano Zampini {
1261674ae819SStefano Zampini   PetscErrorCode ierr;
1262674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1263674ae819SStefano Zampini 
1264674ae819SStefano Zampini   PetscFunctionBegin;
1265674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1266674ae819SStefano Zampini   PetscFunctionReturn(0);
1267674ae819SStefano Zampini }
1268674ae819SStefano Zampini 
1269674ae819SStefano Zampini #undef __FUNCT__
1270674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
1271674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1272674ae819SStefano Zampini {
1273674ae819SStefano Zampini   PetscErrorCode ierr;
1274674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1275674ae819SStefano Zampini 
1276674ae819SStefano Zampini   PetscFunctionBegin;
1277674ae819SStefano Zampini   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1278674ae819SStefano Zampini   PetscFunctionReturn(0);
1279674ae819SStefano Zampini }
1280674ae819SStefano Zampini 
1281984c4197SStefano Zampini /* uncomment for testing purposes */
1282984c4197SStefano Zampini /* #define PETSC_MISSING_LAPACK_GESVD 1 */
1283674ae819SStefano Zampini #undef __FUNCT__
1284674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp"
1285674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
1286674ae819SStefano Zampini {
1287674ae819SStefano Zampini   PetscErrorCode    ierr;
1288674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
1289674ae819SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
1290674ae819SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
1291984c4197SStefano Zampini   /* constraint and (optionally) change of basis matrix implemented as SeqAIJ */
1292674ae819SStefano Zampini   MatType           impMatType=MATSEQAIJ;
1293984c4197SStefano Zampini   /* one and zero */
1294984c4197SStefano Zampini   PetscScalar       one=1.0,zero=0.0;
1295984c4197SStefano Zampini   /* space to store constraints and their local indices */
1296984c4197SStefano Zampini   PetscScalar       *temp_quadrature_constraint;
1297984c4197SStefano Zampini   PetscInt          *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B;
1298984c4197SStefano Zampini   /* iterators */
1299984c4197SStefano Zampini   PetscInt          i,j,k,total_counts,temp_start_ptr;
1300984c4197SStefano Zampini   /* stuff to store connected components stored in pcbddc->mat_graph */
1301984c4197SStefano Zampini   IS                ISForVertices,*ISForFaces,*ISForEdges,*used_IS;
1302984c4197SStefano Zampini   PetscInt          n_ISForFaces,n_ISForEdges;
1303984c4197SStefano Zampini   /* near null space stuff */
1304674ae819SStefano Zampini   MatNullSpace      nearnullsp;
1305674ae819SStefano Zampini   const Vec         *nearnullvecs;
1306674ae819SStefano Zampini   Vec               *localnearnullsp;
1307984c4197SStefano Zampini   PetscBool         nnsp_has_cnst;
1308984c4197SStefano Zampini   PetscInt          nnsp_size;
1309984c4197SStefano Zampini   PetscScalar       *array;
1310984c4197SStefano Zampini   /* BLAS integers */
1311e310c8b4SStefano Zampini   PetscBLASInt      lwork,lierr;
1312e310c8b4SStefano Zampini   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
1313c4303822SStefano Zampini   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
1314984c4197SStefano Zampini   /* LAPACK working arrays for SVD or POD */
1315242a89d7SStefano Zampini   PetscBool         skip_lapack;
1316984c4197SStefano Zampini   PetscScalar       *work;
1317984c4197SStefano Zampini   PetscReal         *singular_vals;
1318984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1319984c4197SStefano Zampini   PetscReal         *rwork;
1320674ae819SStefano Zampini #endif
1321984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1322e310c8b4SStefano Zampini   PetscBLASInt      Blas_one_2=1;
1323984c4197SStefano Zampini   PetscScalar       *temp_basis,*correlation_mat;
1324b7d8b9f8SStefano Zampini #else
1325b7d8b9f8SStefano Zampini   PetscBLASInt      dummy_int_1=1,dummy_int_2=1;
1326b7d8b9f8SStefano Zampini   PetscScalar       dummy_scalar_1=0.0,dummy_scalar_2=0.0;
1327984c4197SStefano Zampini #endif
1328727cdba6SStefano Zampini   /* reuse */
1329727cdba6SStefano Zampini   PetscInt          olocal_primal_size;
1330727cdba6SStefano Zampini   PetscInt          *oprimal_indices_local_idxs;
1331984c4197SStefano Zampini   /* change of basis */
1332984c4197SStefano Zampini   PetscInt          *aux_primal_numbering,*aux_primal_minloc,*global_indices;
1333a717540cSStefano Zampini   PetscBool         boolforchange,qr_needed;
1334a717540cSStefano Zampini   PetscBT           touched,change_basis,qr_needed_idx;
1335984c4197SStefano Zampini   /* auxiliary stuff */
1336*39e2fb2aSStefano Zampini   PetscInt          *nnz,*is_indices,*aux_primal_numbering_B;
1337984c4197SStefano Zampini   /* some quantities */
133845a1bb75SStefano Zampini   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
1339984c4197SStefano Zampini   PetscInt          size_of_constraint,max_size_of_constraint,max_constraints,temp_constraints;
1340984c4197SStefano Zampini 
1341674ae819SStefano Zampini 
1342674ae819SStefano Zampini   PetscFunctionBegin;
13438e61c736SStefano Zampini   /* Destroy Mat objects computed previously */
13448e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
13458e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1346674ae819SStefano Zampini   /* Get index sets for faces, edges and vertices from graph */
13478eeda7d8SStefano Zampini   if (!pcbddc->use_faces && !pcbddc->use_edges && !pcbddc->use_vertices) {
13488eeda7d8SStefano Zampini     pcbddc->use_vertices = PETSC_TRUE;
1349674ae819SStefano Zampini   }
13508eeda7d8SStefano Zampini   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,pcbddc->use_faces,pcbddc->use_edges,pcbddc->use_vertices,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);
1351b8ffe317SStefano Zampini   /* HACK: provide functions to set change of basis */
1352b8ffe317SStefano Zampini   if (!ISForVertices && pcbddc->NullSpace) {
1353b8ffe317SStefano Zampini     pcbddc->use_change_of_basis = PETSC_TRUE;
1354b8ffe317SStefano Zampini     pcbddc->use_change_on_faces = PETSC_FALSE;
1355b8ffe317SStefano Zampini   }
1356984c4197SStefano Zampini   /* print some info */
1357674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
13580fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
1359674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1360674ae819SStefano Zampini     i = 0;
1361674ae819SStefano Zampini     if (ISForVertices) {
1362674ae819SStefano Zampini       ierr = ISGetSize(ISForVertices,&i);CHKERRQ(ierr);
1363674ae819SStefano Zampini     }
1364674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices\n",PetscGlobalRank,i);CHKERRQ(ierr);
1365674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges\n",PetscGlobalRank,n_ISForEdges);CHKERRQ(ierr);
136615aaf578SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces\n",PetscGlobalRank,n_ISForFaces);CHKERRQ(ierr);
1367674ae819SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1368674ae819SStefano Zampini   }
1369674ae819SStefano Zampini   /* check if near null space is attached to global mat */
1370674ae819SStefano Zampini   ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
1371674ae819SStefano Zampini   if (nearnullsp) {
1372674ae819SStefano Zampini     ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
1373f4ddd8eeSStefano Zampini     /* remove any stored info */
1374f4ddd8eeSStefano Zampini     ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
1375f4ddd8eeSStefano Zampini     ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1376f4ddd8eeSStefano Zampini     /* store information for BDDC solver reuse */
1377f4ddd8eeSStefano Zampini     ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
1378f4ddd8eeSStefano Zampini     pcbddc->onearnullspace = nearnullsp;
1379f4ddd8eeSStefano Zampini     ierr = PetscMalloc(nnsp_size*sizeof(PetscObjectState),&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1380f4ddd8eeSStefano Zampini     for (i=0;i<nnsp_size;i++) {
1381f4ddd8eeSStefano Zampini       ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
1382f4ddd8eeSStefano Zampini     }
1383984c4197SStefano Zampini   } else { /* if near null space is not provided BDDC uses constants by default */
1384984c4197SStefano Zampini     nnsp_size = 0;
1385674ae819SStefano Zampini     nnsp_has_cnst = PETSC_TRUE;
1386674ae819SStefano Zampini   }
1387984c4197SStefano Zampini   /* get max number of constraints on a single cc */
1388984c4197SStefano Zampini   max_constraints = nnsp_size;
1389984c4197SStefano Zampini   if (nnsp_has_cnst) max_constraints++;
1390984c4197SStefano Zampini 
1391674ae819SStefano Zampini   /*
1392674ae819SStefano Zampini        Evaluate maximum storage size needed by the procedure
1393674ae819SStefano Zampini        - temp_indices will contain start index of each constraint stored as follows
1394674ae819SStefano 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
1395674ae819SStefano 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
1396674ae819SStefano Zampini        - temp_quadrature_constraint  [temp_indices[i],...,temp[indices[i+1]-1] will contain the scalars representing the constraint itself
1397674ae819SStefano Zampini                                                                                                                                                          */
1398674ae819SStefano Zampini   total_counts = n_ISForFaces+n_ISForEdges;
1399984c4197SStefano Zampini   total_counts *= max_constraints;
1400674ae819SStefano Zampini   n_vertices = 0;
1401674ae819SStefano Zampini   if (ISForVertices) {
1402674ae819SStefano Zampini     ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
1403674ae819SStefano Zampini   }
1404674ae819SStefano Zampini   total_counts += n_vertices;
1405674ae819SStefano Zampini   ierr = PetscMalloc((total_counts+1)*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
14064641a718SStefano Zampini   ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
1407674ae819SStefano Zampini   total_counts = 0;
1408674ae819SStefano Zampini   max_size_of_constraint = 0;
1409674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1410674ae819SStefano Zampini     if (i<n_ISForEdges) {
1411674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1412674ae819SStefano Zampini     } else {
1413674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1414674ae819SStefano Zampini     }
1415674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
1416674ae819SStefano Zampini     total_counts += j;
1417674ae819SStefano Zampini     max_size_of_constraint = PetscMax(j,max_size_of_constraint);
1418674ae819SStefano Zampini   }
1419984c4197SStefano Zampini   total_counts *= max_constraints;
1420674ae819SStefano Zampini   total_counts += n_vertices;
1421674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&temp_quadrature_constraint);CHKERRQ(ierr);
1422674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint);CHKERRQ(ierr);
1423674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint_B);CHKERRQ(ierr);
1424984c4197SStefano Zampini   /* get local part of global near null space vectors */
1425984c4197SStefano Zampini   ierr = PetscMalloc(nnsp_size*sizeof(Vec),&localnearnullsp);CHKERRQ(ierr);
1426984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1427984c4197SStefano Zampini     ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
1428984c4197SStefano Zampini     ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1429984c4197SStefano Zampini     ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1430984c4197SStefano Zampini   }
1431674ae819SStefano Zampini 
1432242a89d7SStefano Zampini   /* whether or not to skip lapack calls */
1433242a89d7SStefano Zampini   skip_lapack = PETSC_TRUE;
1434242a89d7SStefano Zampini   if (n_ISForFaces+n_ISForEdges) skip_lapack = PETSC_FALSE;
1435242a89d7SStefano Zampini 
1436984c4197SStefano Zampini   /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
1437242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1438674ae819SStefano Zampini     PetscScalar temp_work;
1439674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1440984c4197SStefano Zampini     /* Proper Orthogonal Decomposition (POD) using the snapshot method */
1441984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*max_constraints*sizeof(PetscScalar),&correlation_mat);CHKERRQ(ierr);
1442984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1443984c4197SStefano Zampini     ierr = PetscMalloc(max_size_of_constraint*max_constraints*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr);
1444674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1445984c4197SStefano Zampini     ierr = PetscMalloc(3*max_constraints*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1446674ae819SStefano Zampini #endif
1447674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1448c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
1449c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
1450674ae819SStefano Zampini     lwork = -1;
1451674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1452674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1453c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
1454674ae819SStefano Zampini #else
1455c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
1456674ae819SStefano Zampini #endif
1457674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1458984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
1459674ae819SStefano Zampini #else /* on missing GESVD */
1460674ae819SStefano Zampini     /* SVD */
1461674ae819SStefano Zampini     PetscInt max_n,min_n;
1462674ae819SStefano Zampini     max_n = max_size_of_constraint;
1463984c4197SStefano Zampini     min_n = max_constraints;
1464984c4197SStefano Zampini     if (max_size_of_constraint < max_constraints) {
1465674ae819SStefano Zampini       min_n = max_size_of_constraint;
1466984c4197SStefano Zampini       max_n = max_constraints;
1467674ae819SStefano Zampini     }
1468674ae819SStefano Zampini     ierr = PetscMalloc(min_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1469674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1470674ae819SStefano Zampini     ierr = PetscMalloc(5*min_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1471674ae819SStefano Zampini #endif
1472674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1473674ae819SStefano Zampini     lwork = -1;
1474e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
1475e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
1476b7d8b9f8SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
1477674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1478674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1479e310c8b4SStefano 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));
1480674ae819SStefano Zampini #else
1481e310c8b4SStefano 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));
1482674ae819SStefano Zampini #endif
1483674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1484984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
1485984c4197SStefano Zampini #endif /* on missing GESVD */
1486674ae819SStefano Zampini     /* Allocate optimal workspace */
1487674ae819SStefano Zampini     ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
1488984c4197SStefano Zampini     ierr = PetscMalloc((PetscInt)lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
1489674ae819SStefano Zampini   }
1490674ae819SStefano Zampini   /* Now we can loop on constraining sets */
1491674ae819SStefano Zampini   total_counts = 0;
1492674ae819SStefano Zampini   temp_indices[0] = 0;
1493674ae819SStefano Zampini   /* vertices */
1494674ae819SStefano Zampini   if (ISForVertices) {
1495674ae819SStefano Zampini     ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1496674ae819SStefano Zampini     if (nnsp_has_cnst) { /* consider all vertices */
1497*39e2fb2aSStefano Zampini       ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
1498674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1499674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1500674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1501674ae819SStefano Zampini         total_counts++;
1502674ae819SStefano Zampini       }
1503674ae819SStefano Zampini     } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
1504984c4197SStefano Zampini       PetscBool used_vertex;
1505674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1506674ae819SStefano Zampini         used_vertex = PETSC_FALSE;
1507674ae819SStefano Zampini         k = 0;
1508674ae819SStefano Zampini         while (!used_vertex && k<nnsp_size) {
1509984c4197SStefano Zampini           ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1510984c4197SStefano Zampini           if (PetscAbsScalar(array[is_indices[i]])>0.0) {
1511674ae819SStefano Zampini             temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1512674ae819SStefano Zampini             temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1513674ae819SStefano Zampini             temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1514674ae819SStefano Zampini             total_counts++;
1515674ae819SStefano Zampini             used_vertex = PETSC_TRUE;
1516674ae819SStefano Zampini           }
1517984c4197SStefano Zampini           ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1518674ae819SStefano Zampini           k++;
1519674ae819SStefano Zampini         }
1520674ae819SStefano Zampini       }
1521674ae819SStefano Zampini     }
1522674ae819SStefano Zampini     ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1523674ae819SStefano Zampini     n_vertices = total_counts;
1524674ae819SStefano Zampini   }
1525984c4197SStefano Zampini 
1526674ae819SStefano Zampini   /* edges and faces */
1527674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1528674ae819SStefano Zampini     if (i<n_ISForEdges) {
1529674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1530984c4197SStefano Zampini       boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
1531674ae819SStefano Zampini     } else {
1532674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1533984c4197SStefano Zampini       boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
1534674ae819SStefano Zampini     }
1535674ae819SStefano Zampini     temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
1536674ae819SStefano Zampini     temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
1537674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
1538674ae819SStefano Zampini     ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1539984c4197SStefano Zampini     /* change of basis should not be performed on local periodic nodes */
1540984c4197SStefano Zampini     if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
1541674ae819SStefano Zampini     if (nnsp_has_cnst) {
15425b08dc53SStefano Zampini       PetscScalar quad_value;
1543674ae819SStefano Zampini       temp_constraints++;
1544674ae819SStefano Zampini       quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
1545*39e2fb2aSStefano Zampini       ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
1546674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1547674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
1548674ae819SStefano Zampini       }
1549674ae819SStefano Zampini       temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
1550674ae819SStefano Zampini       total_counts++;
1551674ae819SStefano Zampini     }
1552674ae819SStefano Zampini     for (k=0;k<nnsp_size;k++) {
1553984c4197SStefano Zampini       PetscReal real_value;
1554984c4197SStefano Zampini       ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1555*39e2fb2aSStefano Zampini       ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
1556674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1557984c4197SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=array[is_indices[j]];
1558674ae819SStefano Zampini       }
1559984c4197SStefano Zampini       ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1560984c4197SStefano Zampini       /* check if array is null on the connected component */
1561e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1562e310c8b4SStefano Zampini       PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_one));
15635b08dc53SStefano Zampini       if (real_value > 0.0) { /* keep indices and values */
1564674ae819SStefano Zampini         temp_constraints++;
1565674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
1566674ae819SStefano Zampini         total_counts++;
1567674ae819SStefano Zampini       }
1568674ae819SStefano Zampini     }
1569674ae819SStefano Zampini     ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
157045a1bb75SStefano Zampini     valid_constraints = temp_constraints;
1571eb97c9d2SStefano 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 */
1572eb97c9d2SStefano Zampini     if (!pcbddc->use_nnsp_true && temp_constraints) {
1573984c4197SStefano Zampini       PetscReal tol = 1.0e-8; /* tolerance for retaining eigenmodes */
1574674ae819SStefano Zampini 
1575674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1576984c4197SStefano Zampini       /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
1577984c4197SStefano Zampini          POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
1578984c4197SStefano Zampini          -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
1579984c4197SStefano Zampini             the constraints basis will differ (by a complex factor with absolute value equal to 1)
1580984c4197SStefano Zampini             from that computed using LAPACKgesvd
1581984c4197SStefano Zampini          -> This is due to a different computation of eigenvectors in LAPACKheev
1582984c4197SStefano Zampini          -> The quality of the POD-computed basis will be the same */
1583984c4197SStefano Zampini       ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
1584674ae819SStefano Zampini       /* Store upper triangular part of correlation matrix */
1585e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1586984c4197SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1587674ae819SStefano Zampini       for (j=0;j<temp_constraints;j++) {
1588674ae819SStefano Zampini         for (k=0;k<j+1;k++) {
1589e310c8b4SStefano 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));
1590674ae819SStefano Zampini         }
1591674ae819SStefano Zampini       }
1592e310c8b4SStefano Zampini       /* compute eigenvalues and eigenvectors of correlation matrix */
1593e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1594e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
1595674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1596c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
1597674ae819SStefano Zampini #else
1598c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
1599674ae819SStefano Zampini #endif
1600674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1601984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
1602984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
1603674ae819SStefano Zampini       j=0;
1604984c4197SStefano Zampini       while (j < temp_constraints && singular_vals[j] < tol) j++;
1605674ae819SStefano Zampini       total_counts=total_counts-j;
160645a1bb75SStefano Zampini       valid_constraints = temp_constraints-j;
1607e310c8b4SStefano Zampini       /* scale and copy POD basis into used quadrature memory */
1608c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1609c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1610c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
1611c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1612c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
1613c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1614674ae819SStefano Zampini       if (j<temp_constraints) {
1615984c4197SStefano Zampini         PetscInt ii;
1616984c4197SStefano Zampini         for (k=j;k<temp_constraints;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]);
1617674ae819SStefano Zampini         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1618c4303822SStefano 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));
1619674ae819SStefano Zampini         ierr = PetscFPTrapPop();CHKERRQ(ierr);
1620984c4197SStefano Zampini         for (k=0;k<temp_constraints-j;k++) {
1621674ae819SStefano Zampini           for (ii=0;ii<size_of_constraint;ii++) {
1622984c4197SStefano 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];
1623674ae819SStefano Zampini           }
1624674ae819SStefano Zampini         }
1625674ae819SStefano Zampini       }
1626674ae819SStefano Zampini #else  /* on missing GESVD */
1627e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1628e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1629b7d8b9f8SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1630674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1631674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1632e310c8b4SStefano 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));
1633674ae819SStefano Zampini #else
1634e310c8b4SStefano 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));
1635674ae819SStefano Zampini #endif
1636984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
1637674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1638984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
1639e310c8b4SStefano Zampini       k = temp_constraints;
1640e310c8b4SStefano Zampini       if (k > size_of_constraint) k = size_of_constraint;
1641674ae819SStefano Zampini       j = 0;
1642e310c8b4SStefano Zampini       while (j < k && singular_vals[k-j-1] < tol) j++;
1643e310c8b4SStefano Zampini       total_counts = total_counts-temp_constraints+k-j;
164445a1bb75SStefano Zampini       valid_constraints = k-j;
1645984c4197SStefano Zampini #endif /* on missing GESVD */
1646674ae819SStefano Zampini     }
164745a1bb75SStefano Zampini     /* setting change_of_basis flag is safe now */
164845a1bb75SStefano Zampini     if (boolforchange) {
164945a1bb75SStefano Zampini       for (j=0;j<valid_constraints;j++) {
165045a1bb75SStefano Zampini         PetscBTSet(change_basis,total_counts-j-1);
165145a1bb75SStefano Zampini       }
165245a1bb75SStefano Zampini     }
1653674ae819SStefano Zampini   }
1654674ae819SStefano Zampini   /* free index sets of faces, edges and vertices */
1655674ae819SStefano Zampini   for (i=0;i<n_ISForFaces;i++) {
1656674ae819SStefano Zampini     ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
1657674ae819SStefano Zampini   }
1658674ae819SStefano Zampini   ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
1659674ae819SStefano Zampini   for (i=0;i<n_ISForEdges;i++) {
1660674ae819SStefano Zampini     ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
1661674ae819SStefano Zampini   }
1662674ae819SStefano Zampini   ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
1663674ae819SStefano Zampini   ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
1664*39e2fb2aSStefano Zampini   /* map temp_indices_to_constraint in boundary numbering */
1665*39e2fb2aSStefano Zampini   ierr = ISGlobalToLocalMappingApply(pcbddc->BtoNmap,IS_GTOLM_DROP,temp_indices[total_counts],temp_indices_to_constraint,&i,temp_indices_to_constraint_B);CHKERRQ(ierr);
1666*39e2fb2aSStefano Zampini   if (i != temp_indices[total_counts]) {
1667*39e2fb2aSStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for constraints indices %d != %d\n",temp_indices[total_counts],i);
1668*39e2fb2aSStefano Zampini   }
1669674ae819SStefano Zampini 
1670984c4197SStefano Zampini   /* free workspace */
1671242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1672984c4197SStefano Zampini     ierr = PetscFree(work);CHKERRQ(ierr);
1673984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1674984c4197SStefano Zampini     ierr = PetscFree(rwork);CHKERRQ(ierr);
1675984c4197SStefano Zampini #endif
1676984c4197SStefano Zampini     ierr = PetscFree(singular_vals);CHKERRQ(ierr);
1677984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1678984c4197SStefano Zampini     ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
1679984c4197SStefano Zampini     ierr = PetscFree(temp_basis);CHKERRQ(ierr);
1680984c4197SStefano Zampini #endif
1681984c4197SStefano Zampini   }
1682984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1683984c4197SStefano Zampini     ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
1684984c4197SStefano Zampini   }
1685984c4197SStefano Zampini   ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
1686984c4197SStefano Zampini 
1687727cdba6SStefano Zampini   /* set quantities in pcbddc data structure and store previous primal size */
1688984c4197SStefano Zampini   /* n_vertices defines the number of subdomain corners in the primal space */
1689674ae819SStefano Zampini   /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */
1690727cdba6SStefano Zampini   olocal_primal_size = pcbddc->local_primal_size;
1691984c4197SStefano Zampini   pcbddc->local_primal_size = total_counts;
1692674ae819SStefano Zampini   pcbddc->n_vertices = n_vertices;
1693984c4197SStefano Zampini   pcbddc->n_constraints = pcbddc->local_primal_size-pcbddc->n_vertices;
1694674ae819SStefano Zampini 
1695674ae819SStefano Zampini   /* Create constraint matrix */
1696674ae819SStefano Zampini   /* The constraint matrix is used to compute the l2g map of primal dofs */
1697674ae819SStefano Zampini   /* so we need to set it up properly either with or without change of basis */
1698674ae819SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1699674ae819SStefano Zampini   ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr);
1700984c4197SStefano Zampini   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
1701984c4197SStefano Zampini   /* array to compute a local numbering of constraints : vertices first then constraints */
1702984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_numbering);CHKERRQ(ierr);
1703984c4197SStefano Zampini   /* array to select the proper local node (of minimum index with respect to global ordering) when changing the basis */
1704984c4197SStefano 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 */
1705984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_minloc);CHKERRQ(ierr);
1706984c4197SStefano Zampini   /* auxiliary stuff for basis change */
1707984c4197SStefano Zampini   ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&global_indices);CHKERRQ(ierr);
17084641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n_B,&touched);CHKERRQ(ierr);
1709984c4197SStefano Zampini 
1710984c4197SStefano Zampini   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
1711984c4197SStefano Zampini   total_primal_vertices=0;
1712984c4197SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
1713674ae819SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
1714984c4197SStefano Zampini     if (size_of_constraint == 1) {
17154641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]]);CHKERRQ(ierr);
1716984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]];
1717984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=0;
1718984c4197SStefano Zampini       total_primal_vertices++;
17194641a718SStefano Zampini     } else if (PetscBTLookup(change_basis,i)) { /* Same procedure used in PCBDDCGetPrimalConstraintsLocalIdx */
1720984c4197SStefano Zampini       PetscInt min_loc,min_index;
1721984c4197SStefano Zampini       ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],global_indices);CHKERRQ(ierr);
1722984c4197SStefano Zampini       /* find first untouched local node */
1723674ae819SStefano Zampini       k = 0;
17244641a718SStefano Zampini       while (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) k++;
1725984c4197SStefano Zampini       min_index = global_indices[k];
1726984c4197SStefano Zampini       min_loc = k;
1727984c4197SStefano Zampini       /* search the minimum among global nodes already untouched on the cc */
1728984c4197SStefano Zampini       for (k=1;k<size_of_constraint;k++) {
1729984c4197SStefano Zampini         /* there can be more than one constraint on a single connected component */
17304641a718SStefano Zampini         if (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k]) && min_index > global_indices[k]) {
1731984c4197SStefano Zampini           min_index = global_indices[k];
1732984c4197SStefano Zampini           min_loc = k;
1733674ae819SStefano Zampini         }
1734674ae819SStefano Zampini       }
17354641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]+min_loc]);CHKERRQ(ierr);
1736984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]+min_loc];
1737984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=min_loc;
1738984c4197SStefano Zampini       total_primal_vertices++;
1739984c4197SStefano Zampini     }
1740984c4197SStefano Zampini   }
1741a717540cSStefano Zampini   /* determine if a QR strategy is needed for change of basis */
1742a717540cSStefano Zampini   qr_needed = PETSC_FALSE;
1743a717540cSStefano Zampini   ierr = PetscBTCreate(pcbddc->local_primal_size,&qr_needed_idx);CHKERRQ(ierr);
1744a717540cSStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1745a717540cSStefano Zampini     if (PetscBTLookup(change_basis,i)) {
1746a717540cSStefano Zampini       size_of_constraint = temp_indices[i+1]-temp_indices[i];
1747a717540cSStefano Zampini       j = 0;
1748a717540cSStefano Zampini       for (k=0;k<size_of_constraint;k++) {
1749a717540cSStefano Zampini         if (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) {
1750a717540cSStefano Zampini           j++;
1751a717540cSStefano Zampini         }
1752a717540cSStefano Zampini       }
1753a717540cSStefano Zampini       /* found more than one primal dof on the cc */
1754a717540cSStefano Zampini       if (j > 1) {
1755a717540cSStefano Zampini         PetscBTSet(qr_needed_idx,i);
1756a717540cSStefano Zampini         qr_needed = PETSC_TRUE;
1757a717540cSStefano Zampini       }
1758a717540cSStefano Zampini     }
1759a717540cSStefano Zampini   }
1760984c4197SStefano Zampini   /* free workspace */
1761984c4197SStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
176245a1bb75SStefano Zampini 
1763674ae819SStefano Zampini   /* permute indices in order to have a sorted set of vertices */
1764a717540cSStefano Zampini   ierr = PetscSortInt(total_primal_vertices,aux_primal_numbering);CHKERRQ(ierr);
1765984c4197SStefano Zampini 
1766984c4197SStefano Zampini   /* nonzero structure of constraint matrix */
1767984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1768984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) nnz[i]=1;
1769984c4197SStefano Zampini   j=total_primal_vertices;
1770984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
17714641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1772674ae819SStefano Zampini       nnz[j]=temp_indices[i+1]-temp_indices[i];
1773674ae819SStefano Zampini       j++;
1774674ae819SStefano Zampini     }
1775674ae819SStefano Zampini   }
1776674ae819SStefano Zampini   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
1777674ae819SStefano Zampini   ierr = PetscFree(nnz);CHKERRQ(ierr);
1778674ae819SStefano Zampini   /* set values in constraint matrix */
1779984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) {
1780984c4197SStefano Zampini     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,aux_primal_numbering[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
1781674ae819SStefano Zampini   }
1782984c4197SStefano Zampini   total_counts = total_primal_vertices;
1783984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
17844641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1785674ae819SStefano Zampini       size_of_constraint=temp_indices[i+1]-temp_indices[i];
1786674ae819SStefano 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);
1787674ae819SStefano Zampini       total_counts++;
1788674ae819SStefano Zampini     }
1789674ae819SStefano Zampini   }
1790674ae819SStefano Zampini   /* assembling */
1791674ae819SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1792674ae819SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1793984c4197SStefano Zampini   /*
179445a1bb75SStefano Zampini   ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
1795984c4197SStefano Zampini   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
1796984c4197SStefano Zampini   */
1797674ae819SStefano Zampini   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
1798674ae819SStefano Zampini   if (pcbddc->use_change_of_basis) {
1799026de310SStefano Zampini     /* dual and primal dofs on a single cc */
1800984c4197SStefano Zampini     PetscInt     dual_dofs,primal_dofs;
1801026de310SStefano Zampini     /* iterator on aux_primal_minloc (ordered as read from nearnullspace: vertices, edges and then constraints) */
1802026de310SStefano Zampini     PetscInt     primal_counter;
1803984c4197SStefano Zampini     /* working stuff for GEQRF */
1804984c4197SStefano Zampini     PetscScalar  *qr_basis,*qr_tau,*qr_work,lqr_work_t;
1805984c4197SStefano Zampini     PetscBLASInt lqr_work;
1806984c4197SStefano Zampini     /* working stuff for UNGQR */
1807984c4197SStefano Zampini     PetscScalar  *gqr_work,lgqr_work_t;
1808984c4197SStefano Zampini     PetscBLASInt lgqr_work;
1809984c4197SStefano Zampini     /* working stuff for TRTRS */
1810984c4197SStefano Zampini     PetscScalar  *trs_rhs;
18113f08241aSStefano Zampini     PetscBLASInt Blas_NRHS;
1812984c4197SStefano Zampini     /* pointers for values insertion into change of basis matrix */
1813984c4197SStefano Zampini     PetscInt     *start_rows,*start_cols;
1814984c4197SStefano Zampini     PetscScalar  *start_vals;
1815984c4197SStefano Zampini     /* working stuff for values insertion */
18164641a718SStefano Zampini     PetscBT      is_primal;
1817984c4197SStefano Zampini 
1818a717540cSStefano Zampini     /* change of basis acts on local interfaces -> dimension is n_B x n_B */
1819a717540cSStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
1820a717540cSStefano Zampini     ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr);
1821a717540cSStefano Zampini     ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr);
1822a717540cSStefano Zampini     /* work arrays */
1823a717540cSStefano Zampini     ierr = PetscMalloc(pcis->n_B*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1824a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) nnz[i]=1;
1825a717540cSStefano Zampini     /* nonzeros per row */
1826a717540cSStefano Zampini     for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1827a717540cSStefano Zampini       if (PetscBTLookup(change_basis,i)) {
1828a717540cSStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
1829a717540cSStefano Zampini         if (PetscBTLookup(qr_needed_idx,i)) {
1830a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1831a717540cSStefano Zampini         } else {
1832a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = 2;
1833a717540cSStefano Zampini           /* get local primal index on the cc */
1834a717540cSStefano Zampini           j = 0;
1835a717540cSStefano Zampini           while (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+j])) j++;
1836a717540cSStefano Zampini           nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1837a717540cSStefano Zampini         }
1838a717540cSStefano Zampini       }
1839a717540cSStefano Zampini     }
1840a717540cSStefano Zampini     ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
1841a717540cSStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
1842a717540cSStefano Zampini     /* Set initial identity in the matrix */
1843a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) {
1844a717540cSStefano Zampini       ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
1845a717540cSStefano Zampini     }
1846a717540cSStefano Zampini 
1847a717540cSStefano Zampini     if (pcbddc->dbg_flag) {
1848a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1849a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
1850a717540cSStefano Zampini     }
1851a717540cSStefano Zampini 
1852a717540cSStefano Zampini 
1853a717540cSStefano Zampini     /* Now we loop on the constraints which need a change of basis */
1854a717540cSStefano Zampini     /*
1855a717540cSStefano Zampini        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
1856a717540cSStefano Zampini        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
1857a717540cSStefano Zampini 
1858a717540cSStefano Zampini        Basic blocks of change of basis matrix T computed
1859a717540cSStefano Zampini 
1860a717540cSStefano Zampini           - Using the following block transformation if there is only a primal dof on the cc
1861a717540cSStefano Zampini             (in the example, primal dof is the last one of the edge in LOCAL ordering
1862a717540cSStefano Zampini              in this code, primal dof is the first one of the edge in GLOBAL ordering)
1863a717540cSStefano Zampini             | 1        0   ...        0     1 |
1864a717540cSStefano Zampini             | 0        1   ...        0     1 |
1865a717540cSStefano Zampini             |              ...                |
1866a717540cSStefano Zampini             | 0        ...            1     1 |
1867a717540cSStefano Zampini             | -s_1/s_n ...    -s_{n-1}/-s_n 1 |
1868a717540cSStefano Zampini 
1869a717540cSStefano Zampini           - via QR decomposition of constraints otherwise
1870a717540cSStefano Zampini     */
1871a717540cSStefano Zampini     if (qr_needed) {
1872984c4197SStefano Zampini       /* space to store Q */
1873984c4197SStefano Zampini       ierr = PetscMalloc((max_size_of_constraint)*(max_size_of_constraint)*sizeof(PetscScalar),&qr_basis);CHKERRQ(ierr);
1874984c4197SStefano Zampini       /* first we issue queries for optimal work */
18753f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
18763f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
18773f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1878984c4197SStefano Zampini       lqr_work = -1;
18793f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
1880984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
1881984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
1882984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lqr_work_t)*sizeof(*qr_work),&qr_work);CHKERRQ(ierr);
1883984c4197SStefano Zampini       lgqr_work = -1;
18843f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
18853f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
18863f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
18873f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
18883f08241aSStefano Zampini       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
18893f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
1890984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
1891984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
1892984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lgqr_work_t)*sizeof(*gqr_work),&gqr_work);CHKERRQ(ierr);
1893984c4197SStefano Zampini       /* array to store scaling factors for reflectors */
1894984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*sizeof(*qr_tau),&qr_tau);CHKERRQ(ierr);
1895984c4197SStefano Zampini       /* array to store rhs and solution of triangular solver */
1896984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*max_constraints*sizeof(*trs_rhs),&trs_rhs);CHKERRQ(ierr);
1897a717540cSStefano Zampini       /* allocating workspace for check */
1898a717540cSStefano Zampini       if (pcbddc->dbg_flag) {
1899a717540cSStefano Zampini         ierr = PetscMalloc(max_size_of_constraint*(max_constraints+max_size_of_constraint)*sizeof(*work),&work);CHKERRQ(ierr);
1900a717540cSStefano Zampini       }
1901a717540cSStefano Zampini     }
1902984c4197SStefano Zampini     /* array to store whether a node is primal or not */
19034641a718SStefano Zampini     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
1904*39e2fb2aSStefano Zampini     ierr = PetscMalloc(total_primal_vertices*sizeof(PetscInt),&aux_primal_numbering_B);CHKERRQ(ierr);
1905*39e2fb2aSStefano Zampini     ierr = ISGlobalToLocalMappingApply(pcbddc->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,aux_primal_numbering,&i,aux_primal_numbering_B);CHKERRQ(ierr);
1906*39e2fb2aSStefano Zampini     if (i != total_primal_vertices) {
1907*39e2fb2aSStefano Zampini       SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %d != %d\n",total_primal_vertices,i);
19084641a718SStefano Zampini     }
1909*39e2fb2aSStefano Zampini     for (i=0;i<total_primal_vertices;i++) {
1910*39e2fb2aSStefano Zampini       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
1911*39e2fb2aSStefano Zampini     }
1912*39e2fb2aSStefano Zampini     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
1913984c4197SStefano Zampini 
1914a717540cSStefano Zampini     /* loop on constraints and see whether or not they need a change of basis and compute it */
1915026de310SStefano Zampini     /* -> using implicit ordering contained in temp_indices data */
1916026de310SStefano Zampini     total_counts = pcbddc->n_vertices;
1917026de310SStefano Zampini     primal_counter = total_counts;
1918026de310SStefano Zampini     while (total_counts<pcbddc->local_primal_size) {
1919026de310SStefano Zampini       primal_dofs = 1;
19204641a718SStefano Zampini       if (PetscBTLookup(change_basis,total_counts)) {
1921026de310SStefano Zampini         /* get all constraints with same support: if more then one constraint is present on the cc then surely indices are stored contiguosly */
1922026de310SStefano 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]]) {
1923026de310SStefano Zampini           primal_dofs++;
1924674ae819SStefano Zampini         }
1925984c4197SStefano Zampini         /* get constraint info */
1926026de310SStefano Zampini         size_of_constraint = temp_indices[total_counts+1]-temp_indices[total_counts];
1927984c4197SStefano Zampini         dual_dofs = size_of_constraint-primal_dofs;
1928984c4197SStefano Zampini 
1929984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
1930a717540cSStefano 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);
1931674ae819SStefano Zampini         }
1932984c4197SStefano Zampini 
1933a717540cSStefano Zampini         if (primal_dofs > 1) { /* QR */
1934a717540cSStefano Zampini 
1935a717540cSStefano Zampini           /* copy quadrature constraints for change of basis check */
1936a717540cSStefano Zampini           if (pcbddc->dbg_flag) {
1937a717540cSStefano Zampini             ierr = PetscMemcpy(work,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1938a717540cSStefano Zampini           }
1939984c4197SStefano Zampini           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
1940026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1941984c4197SStefano Zampini 
1942984c4197SStefano Zampini           /* compute QR decomposition of constraints */
19433f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
19443f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
19453f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1946674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
19473f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
1948984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
1949674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1950984c4197SStefano Zampini 
1951984c4197SStefano Zampini           /* explictly compute R^-T */
1952984c4197SStefano Zampini           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
1953984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
19543f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
19553f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
19563f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
19573f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
1958984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
19593f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
1960984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
1961984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1962984c4197SStefano Zampini 
1963a717540cSStefano Zampini           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
19643f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
19653f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
19663f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
19673f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1968984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
19693f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
1970984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
1971984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1972984c4197SStefano Zampini 
1973984c4197SStefano Zampini           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
1974984c4197SStefano Zampini              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
1975984c4197SStefano Zampini              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
19763f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
19773f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
19783f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
19793f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
19803f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
19813f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1982984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1983c4303822SStefano 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));
1984984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1985026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1986984c4197SStefano Zampini 
1987984c4197SStefano Zampini           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
1988026de310SStefano Zampini           start_rows = &temp_indices_to_constraint_B[temp_indices[total_counts]];
1989984c4197SStefano Zampini           /* insert cols for primal dofs */
1990984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) {
1991984c4197SStefano Zampini             start_vals = &qr_basis[j*size_of_constraint];
1992026de310SStefano Zampini             start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter+j]];
1993984c4197SStefano Zampini             ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1994984c4197SStefano Zampini           }
1995984c4197SStefano Zampini           /* insert cols for dual dofs */
1996984c4197SStefano Zampini           for (j=0,k=0;j<dual_dofs;k++) {
19974641a718SStefano Zampini             if (!PetscBTLookup(is_primal,temp_indices_to_constraint_B[temp_indices[total_counts]+k])) {
1998984c4197SStefano Zampini               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
1999026de310SStefano Zampini               start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+k];
2000984c4197SStefano Zampini               ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
2001984c4197SStefano Zampini               j++;
2002674ae819SStefano Zampini             }
2003674ae819SStefano Zampini           }
2004984c4197SStefano Zampini 
2005984c4197SStefano Zampini           /* check change of basis */
2006984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
2007984c4197SStefano Zampini             PetscInt   ii,jj;
2008984c4197SStefano Zampini             PetscBool valid_qr=PETSC_TRUE;
2009c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
2010c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2011c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
2012c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2013c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
2014c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
2015984c4197SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2016c4303822SStefano 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));
2017984c4197SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
2018984c4197SStefano Zampini             for (jj=0;jj<size_of_constraint;jj++) {
2019984c4197SStefano Zampini               for (ii=0;ii<primal_dofs;ii++) {
2020984c4197SStefano Zampini                 if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
2021984c4197SStefano Zampini                 if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
2022674ae819SStefano Zampini               }
2023674ae819SStefano Zampini             }
2024984c4197SStefano Zampini             if (!valid_qr) {
2025984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
2026984c4197SStefano Zampini               for (jj=0;jj<size_of_constraint;jj++) {
2027984c4197SStefano Zampini                 for (ii=0;ii<primal_dofs;ii++) {
2028984c4197SStefano Zampini                   if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
2029984c4197SStefano 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]));
2030674ae819SStefano Zampini                   }
2031984c4197SStefano Zampini                   if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
2032984c4197SStefano 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]));
2033984c4197SStefano Zampini                   }
2034984c4197SStefano Zampini                 }
2035984c4197SStefano Zampini               }
2036674ae819SStefano Zampini             } else {
2037984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
2038674ae819SStefano Zampini             }
2039674ae819SStefano Zampini           }
2040a717540cSStefano Zampini         } else { /* simple transformation block */
2041a717540cSStefano Zampini           PetscInt row,col;
2042a717540cSStefano Zampini           PetscScalar val;
2043a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) {
2044a717540cSStefano Zampini             row = temp_indices_to_constraint_B[temp_indices[total_counts]+j];
2045a717540cSStefano Zampini             if (!PetscBTLookup(is_primal,row)) {
2046a717540cSStefano Zampini               col = temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
2047a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
2048a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,1.0,INSERT_VALUES);CHKERRQ(ierr);
2049a717540cSStefano Zampini             } else {
2050a717540cSStefano Zampini               for (k=0;k<size_of_constraint;k++) {
2051a717540cSStefano Zampini                 col = temp_indices_to_constraint_B[temp_indices[total_counts]+k];
2052a717540cSStefano Zampini                 if (row != col) {
2053a717540cSStefano Zampini                   val = -temp_quadrature_constraint[temp_indices[total_counts]+k]/temp_quadrature_constraint[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
2054a717540cSStefano Zampini                 } else {
2055a717540cSStefano Zampini                   val = 1.0;
2056a717540cSStefano Zampini                 }
2057a717540cSStefano Zampini                 ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
2058a717540cSStefano Zampini               }
2059a717540cSStefano Zampini             }
2060a717540cSStefano Zampini           }
2061a717540cSStefano Zampini         }
2062026de310SStefano Zampini         /* increment primal counter */
2063026de310SStefano Zampini         primal_counter += primal_dofs;
2064984c4197SStefano Zampini       } else {
2065984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
2066026de310SStefano 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);
2067674ae819SStefano Zampini         }
2068674ae819SStefano Zampini       }
2069026de310SStefano Zampini       /* increment constraint counter total_counts */
2070026de310SStefano Zampini       total_counts += primal_dofs;
2071674ae819SStefano Zampini     }
2072a717540cSStefano Zampini 
2073a717540cSStefano Zampini     /* free workspace */
2074a717540cSStefano Zampini     if (qr_needed) {
2075984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
2076984c4197SStefano Zampini         ierr = PetscFree(work);CHKERRQ(ierr);
2077984c4197SStefano Zampini       }
2078984c4197SStefano Zampini       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
2079984c4197SStefano Zampini       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
2080984c4197SStefano Zampini       ierr = PetscFree(qr_work);CHKERRQ(ierr);
2081984c4197SStefano Zampini       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
2082984c4197SStefano Zampini       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
2083674ae819SStefano Zampini     }
2084a717540cSStefano Zampini     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
2085674ae819SStefano Zampini     /* assembling */
2086674ae819SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2087674ae819SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2088984c4197SStefano Zampini     /*
208945a1bb75SStefano Zampini     ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
2090984c4197SStefano Zampini     ierr = MatView(pcbddc->ChangeOfBasisMatrix,(PetscViewer)0);CHKERRQ(ierr);
2091984c4197SStefano Zampini     */
2092674ae819SStefano Zampini   }
2093a717540cSStefano Zampini 
2094727cdba6SStefano Zampini   /* get indices in local ordering for vertices and constraints */
2095727cdba6SStefano 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 */
2096727cdba6SStefano Zampini     ierr = PetscMalloc(olocal_primal_size*sizeof(PetscInt),&oprimal_indices_local_idxs);CHKERRQ(ierr);
2097727cdba6SStefano Zampini     ierr = PetscMemcpy(oprimal_indices_local_idxs,pcbddc->primal_indices_local_idxs,olocal_primal_size*sizeof(PetscInt));CHKERRQ(ierr);
2098727cdba6SStefano Zampini   }
2099727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2100727cdba6SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
2101727cdba6SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&i,&aux_primal_numbering);CHKERRQ(ierr);
2102727cdba6SStefano Zampini   ierr = PetscMemcpy(pcbddc->primal_indices_local_idxs,aux_primal_numbering,i*sizeof(PetscInt));CHKERRQ(ierr);
2103727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2104727cdba6SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&j,&aux_primal_numbering);CHKERRQ(ierr);
2105727cdba6SStefano Zampini   ierr = PetscMemcpy(&pcbddc->primal_indices_local_idxs[i],aux_primal_numbering,j*sizeof(PetscInt));CHKERRQ(ierr);
2106727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2107727cdba6SStefano Zampini   /* check if a new primal space has been introduced */
2108727cdba6SStefano Zampini   pcbddc->new_primal_space_local = PETSC_TRUE;
2109727cdba6SStefano Zampini   if (olocal_primal_size == pcbddc->local_primal_size) {
2110727cdba6SStefano Zampini     ierr = PetscMemcmp(pcbddc->primal_indices_local_idxs,oprimal_indices_local_idxs,olocal_primal_size,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
2111727cdba6SStefano Zampini     pcbddc->new_primal_space_local = !pcbddc->new_primal_space_local;
2112727cdba6SStefano Zampini     ierr = PetscFree(oprimal_indices_local_idxs);CHKERRQ(ierr);
2113727cdba6SStefano Zampini   }
2114727cdba6SStefano Zampini   /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
2115727cdba6SStefano Zampini   ierr = MPI_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2116727cdba6SStefano Zampini 
2117a717540cSStefano Zampini   /* flush dbg viewer */
2118b8ffe317SStefano Zampini   if (pcbddc->dbg_flag) {
2119b8ffe317SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2120b8ffe317SStefano Zampini   }
2121a717540cSStefano Zampini 
2122e310c8b4SStefano Zampini   /* free workspace */
2123a717540cSStefano Zampini   ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2124a717540cSStefano Zampini   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
2125984c4197SStefano Zampini   ierr = PetscFree(aux_primal_minloc);CHKERRQ(ierr);
2126674ae819SStefano Zampini   ierr = PetscFree(temp_indices);CHKERRQ(ierr);
21274641a718SStefano Zampini   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
2128674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr);
2129674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
2130674ae819SStefano Zampini   ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr);
2131674ae819SStefano Zampini   PetscFunctionReturn(0);
2132674ae819SStefano Zampini }
2133674ae819SStefano Zampini 
2134674ae819SStefano Zampini #undef __FUNCT__
2135674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
2136674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
2137674ae819SStefano Zampini {
2138674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
2139674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
2140674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
2141674ae819SStefano Zampini   PetscInt    bs,ierr,i,vertex_size;
2142674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
2143674ae819SStefano Zampini 
2144674ae819SStefano Zampini   PetscFunctionBegin;
21458e61c736SStefano Zampini   /* Reset previously computed graph */
21468e61c736SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
2147674ae819SStefano Zampini   /* Init local Graph struct */
2148674ae819SStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr);
2149674ae819SStefano Zampini 
2150575ad6abSStefano Zampini   /* Check validity of the csr graph passed in by the user */
2151575ad6abSStefano Zampini   if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) {
2152575ad6abSStefano Zampini     ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
2153575ad6abSStefano Zampini   }
21549577ea80SStefano Zampini 
2155674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
2156674ae819SStefano Zampini   if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) {
2157674ae819SStefano Zampini     Mat mat_adj;
2158674ae819SStefano Zampini     const PetscInt *xadj,*adjncy;
2159674ae819SStefano Zampini     PetscBool flg_row=PETSC_TRUE;
2160674ae819SStefano Zampini 
2161674ae819SStefano Zampini     ierr = MatConvert(matis->A,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr);
2162674ae819SStefano Zampini     ierr = MatGetRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2163674ae819SStefano Zampini     if (!flg_row) {
2164674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ called in %s\n",__FUNCT__);
2165674ae819SStefano Zampini     }
2166674ae819SStefano Zampini     ierr = PCBDDCSetLocalAdjacencyGraph(pc,i,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
2167674ae819SStefano Zampini     ierr = MatRestoreRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2168674ae819SStefano Zampini     if (!flg_row) {
2169674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__);
2170674ae819SStefano Zampini     }
2171674ae819SStefano Zampini     ierr = MatDestroy(&mat_adj);CHKERRQ(ierr);
2172674ae819SStefano Zampini   }
2173674ae819SStefano Zampini 
2174674ae819SStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting */
2175674ae819SStefano Zampini   vertex_size = 1;
21769577ea80SStefano Zampini   if (!pcbddc->user_provided_isfordofs) {
2177674ae819SStefano Zampini     if (!pcbddc->n_ISForDofs) {
2178674ae819SStefano Zampini       IS *custom_ISForDofs;
2179674ae819SStefano Zampini 
2180674ae819SStefano Zampini       ierr = MatGetBlockSize(matis->A,&bs);CHKERRQ(ierr);
2181674ae819SStefano Zampini       ierr = PetscMalloc(bs*sizeof(IS),&custom_ISForDofs);CHKERRQ(ierr);
2182674ae819SStefano Zampini       for (i=0;i<bs;i++) {
2183674ae819SStefano Zampini         ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n/bs,i,bs,&custom_ISForDofs[i]);CHKERRQ(ierr);
2184674ae819SStefano Zampini       }
2185674ae819SStefano Zampini       ierr = PCBDDCSetDofsSplitting(pc,bs,custom_ISForDofs);CHKERRQ(ierr);
21869577ea80SStefano Zampini       pcbddc->user_provided_isfordofs = PETSC_FALSE;
2187674ae819SStefano Zampini       /* remove my references to IS objects */
2188674ae819SStefano Zampini       for (i=0;i<bs;i++) {
2189674ae819SStefano Zampini         ierr = ISDestroy(&custom_ISForDofs[i]);CHKERRQ(ierr);
2190674ae819SStefano Zampini       }
2191674ae819SStefano Zampini       ierr = PetscFree(custom_ISForDofs);CHKERRQ(ierr);
21929577ea80SStefano Zampini     }
21939577ea80SStefano Zampini   } else { /* mat block size as vertex size (used for elasticity with rigid body modes as nearnullspace) */
2194674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
2195674ae819SStefano Zampini   }
2196674ae819SStefano Zampini 
2197674ae819SStefano Zampini   /* Setup of Graph */
2198674ae819SStefano Zampini   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundaries,pcbddc->DirichletBoundaries,pcbddc->n_ISForDofs,pcbddc->ISForDofs,pcbddc->user_primal_vertices);
2199674ae819SStefano Zampini 
2200674ae819SStefano Zampini   /* Graph's connected components analysis */
2201674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
2202674ae819SStefano Zampini 
2203674ae819SStefano Zampini   /* print some info to stdout */
2204674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
2205e49050b4SStefano Zampini     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer);
2206674ae819SStefano Zampini   }
2207fb180af4SStefano Zampini 
2208fb180af4SStefano Zampini   /* mark topography has done */
2209fb180af4SStefano Zampini   pcbddc->recompute_topography = PETSC_FALSE;
2210674ae819SStefano Zampini   PetscFunctionReturn(0);
2211674ae819SStefano Zampini }
2212674ae819SStefano Zampini 
2213674ae819SStefano Zampini #undef __FUNCT__
2214674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx"
2215f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt **vertices_idx)
2216674ae819SStefano Zampini {
2217674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2218674ae819SStefano Zampini   PetscInt       *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size;
2219674ae819SStefano Zampini   PetscErrorCode ierr;
2220674ae819SStefano Zampini 
2221674ae819SStefano Zampini   PetscFunctionBegin;
2222674ae819SStefano Zampini   n = 0;
2223674ae819SStefano Zampini   vertices = 0;
2224674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2225674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr);
2226b120a5c6SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2227b120a5c6SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2228b120a5c6SStefano Zampini       if (size_of_constraint == 1) n++;
2229b120a5c6SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2230b120a5c6SStefano Zampini     }
2231811e8ca2SStefano Zampini     if (vertices_idx) {
2232b120a5c6SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&vertices);CHKERRQ(ierr);
2233b120a5c6SStefano Zampini       n = 0;
2234674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2235674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2236674ae819SStefano Zampini         if (size_of_constraint == 1) {
2237674ae819SStefano Zampini           vertices[n++]=row_cmat_indices[0];
2238674ae819SStefano Zampini         }
2239674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2240674ae819SStefano Zampini       }
2241674ae819SStefano Zampini     }
2242811e8ca2SStefano Zampini   }
2243674ae819SStefano Zampini   *n_vertices = n;
2244811e8ca2SStefano Zampini   if (vertices_idx) *vertices_idx = vertices;
2245674ae819SStefano Zampini   PetscFunctionReturn(0);
2246674ae819SStefano Zampini }
2247674ae819SStefano Zampini 
2248674ae819SStefano Zampini #undef __FUNCT__
2249674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx"
2250f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt **constraints_idx)
2251674ae819SStefano Zampini {
2252674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2253674ae819SStefano Zampini   PetscInt       *constraints_index,*row_cmat_indices,*row_cmat_global_indices;
2254674ae819SStefano Zampini   PetscInt       n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc;
22554641a718SStefano Zampini   PetscBT        touched;
2256674ae819SStefano Zampini   PetscErrorCode ierr;
2257674ae819SStefano Zampini 
2258f34684f1SStefano Zampini     /* This function assumes that the number of local constraints per connected component
2259f34684f1SStefano Zampini        is not greater than the number of nodes defined for the connected component
2260f34684f1SStefano Zampini        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
2261674ae819SStefano Zampini   PetscFunctionBegin;
2262674ae819SStefano Zampini   n = 0;
2263674ae819SStefano Zampini   constraints_index = 0;
2264674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2265674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr);
2266674ae819SStefano Zampini     max_size_of_constraint = 0;
2267674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2268674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2269674ae819SStefano Zampini       if (size_of_constraint > 1) {
2270674ae819SStefano Zampini         n++;
2271674ae819SStefano Zampini       }
2272674ae819SStefano Zampini       max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint);
2273674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2274674ae819SStefano Zampini     }
2275811e8ca2SStefano Zampini     if (constraints_idx) {
2276674ae819SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&constraints_index);CHKERRQ(ierr);
2277674ae819SStefano Zampini       ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&row_cmat_global_indices);CHKERRQ(ierr);
22784641a718SStefano Zampini       ierr = PetscBTCreate(local_size,&touched);CHKERRQ(ierr);
2279674ae819SStefano Zampini       n = 0;
2280674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2281674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2282674ae819SStefano Zampini         if (size_of_constraint > 1) {
2283674ae819SStefano Zampini           ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr);
228482d3d8afSStefano Zampini           /* find first untouched local node */
228582d3d8afSStefano Zampini           j = 0;
22864641a718SStefano Zampini           while (PetscBTLookup(touched,row_cmat_indices[j])) j++;
228782d3d8afSStefano Zampini           min_index = row_cmat_global_indices[j];
228882d3d8afSStefano Zampini           min_loc = j;
228982d3d8afSStefano Zampini           /* search the minimum among nodes not yet touched on the connected component
229082d3d8afSStefano Zampini              since there can be more than one constraint on a single cc */
2291674ae819SStefano Zampini           for (j=1;j<size_of_constraint;j++) {
22924641a718SStefano Zampini             if (!PetscBTLookup(touched,row_cmat_indices[j]) && min_index > row_cmat_global_indices[j]) {
2293674ae819SStefano Zampini               min_index = row_cmat_global_indices[j];
2294674ae819SStefano Zampini               min_loc = j;
2295674ae819SStefano Zampini             }
2296674ae819SStefano Zampini           }
22974641a718SStefano Zampini           ierr = PetscBTSet(touched,row_cmat_indices[min_loc]);CHKERRQ(ierr);
2298674ae819SStefano Zampini           constraints_index[n++] = row_cmat_indices[min_loc];
2299674ae819SStefano Zampini         }
2300674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2301674ae819SStefano Zampini       }
23024641a718SStefano Zampini       ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2303674ae819SStefano Zampini       ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr);
2304811e8ca2SStefano Zampini     }
2305811e8ca2SStefano Zampini   }
2306674ae819SStefano Zampini   *n_constraints = n;
2307811e8ca2SStefano Zampini   if (constraints_idx) *constraints_idx = constraints_index;
2308674ae819SStefano Zampini   PetscFunctionReturn(0);
2309674ae819SStefano Zampini }
2310674ae819SStefano Zampini 
2311674ae819SStefano Zampini /* the next two functions has been adapted from pcis.c */
2312674ae819SStefano Zampini #undef __FUNCT__
2313674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchur"
2314674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchur(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2315674ae819SStefano Zampini {
2316674ae819SStefano Zampini   PetscErrorCode ierr;
2317674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2318674ae819SStefano Zampini 
2319674ae819SStefano Zampini   PetscFunctionBegin;
2320674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2321674ae819SStefano Zampini   ierr = MatMult(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2322674ae819SStefano Zampini   ierr = MatMult(pcis->A_IB,v,vec1_D);CHKERRQ(ierr);
2323674ae819SStefano Zampini   ierr = KSPSolve(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2324674ae819SStefano Zampini   ierr = MatMult(pcis->A_BI,vec2_D,vec2_B);CHKERRQ(ierr);
2325674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2326674ae819SStefano Zampini   PetscFunctionReturn(0);
2327674ae819SStefano Zampini }
2328674ae819SStefano Zampini 
2329674ae819SStefano Zampini #undef __FUNCT__
2330674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchurTranspose"
2331674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchurTranspose(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2332674ae819SStefano Zampini {
2333674ae819SStefano Zampini   PetscErrorCode ierr;
2334674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2335674ae819SStefano Zampini 
2336674ae819SStefano Zampini   PetscFunctionBegin;
2337674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2338674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2339674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BI,v,vec1_D);CHKERRQ(ierr);
2340674ae819SStefano Zampini   ierr = KSPSolveTranspose(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2341674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_IB,vec2_D,vec2_B);CHKERRQ(ierr);
2342674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2343674ae819SStefano Zampini   PetscFunctionReturn(0);
2344674ae819SStefano Zampini }
2345674ae819SStefano Zampini 
2346674ae819SStefano Zampini #undef __FUNCT__
2347674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
2348674ae819SStefano 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[])
2349674ae819SStefano Zampini {
2350674ae819SStefano Zampini   Vec            local_vec,global_vec;
2351674ae819SStefano Zampini   IS             seqis,paris;
2352674ae819SStefano Zampini   VecScatter     scatter_ctx;
2353674ae819SStefano Zampini   PetscScalar    *array;
2354674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
2355674ae819SStefano Zampini   PetscScalar    globalsum;
2356674ae819SStefano Zampini   PetscInt       i,j,s;
2357674ae819SStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local;
2358674ae819SStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm,max_global;
2359674ae819SStefano Zampini   PetscMPIInt    *dof_sizes,*dof_displs;
2360674ae819SStefano Zampini   PetscBool      first_found;
2361674ae819SStefano Zampini   PetscErrorCode ierr;
2362674ae819SStefano Zampini 
2363674ae819SStefano Zampini   PetscFunctionBegin;
2364674ae819SStefano Zampini   /* mpi buffers */
2365674ae819SStefano Zampini   MPI_Comm_size(comm,&size_prec_comm);
2366674ae819SStefano Zampini   MPI_Comm_rank(comm,&rank_prec_comm);
2367674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
2368674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_sizes),&dof_sizes);CHKERRQ(ierr);
2369674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_displs),&dof_displs);CHKERRQ(ierr);
2370674ae819SStefano Zampini   /* get maximum size of subset */
2371674ae819SStefano Zampini   ierr = PetscMalloc(n_local_dofs*sizeof(PetscInt),&temp_global_dofs);CHKERRQ(ierr);
2372674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
2373674ae819SStefano Zampini   max_local = 0;
2374674ae819SStefano Zampini   if (n_local_dofs) {
2375674ae819SStefano Zampini     max_local = temp_global_dofs[0];
2376674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2377674ae819SStefano Zampini       if (max_local < temp_global_dofs[i] ) {
2378674ae819SStefano Zampini         max_local = temp_global_dofs[i];
2379674ae819SStefano Zampini       }
2380674ae819SStefano Zampini     }
2381674ae819SStefano Zampini   }
2382674ae819SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);
2383674ae819SStefano Zampini   max_global++;
2384674ae819SStefano Zampini   max_local = 0;
2385674ae819SStefano Zampini   if (n_local_dofs) {
2386674ae819SStefano Zampini     max_local = local_dofs[0];
2387674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2388674ae819SStefano Zampini       if (max_local < local_dofs[i] ) {
2389674ae819SStefano Zampini         max_local = local_dofs[i];
2390674ae819SStefano Zampini       }
2391674ae819SStefano Zampini     }
2392674ae819SStefano Zampini   }
2393674ae819SStefano Zampini   max_local++;
2394674ae819SStefano Zampini   /* allocate workspace */
2395674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
2396674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
2397674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
2398674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
2399674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
2400674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
2401674ae819SStefano Zampini   /* create scatter */
2402674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
2403674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
2404674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
2405674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
2406674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
2407674ae819SStefano Zampini   /* init array */
2408674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
2409674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2410674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2411674ae819SStefano Zampini   if (local_dofs_mult) {
2412674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2413674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
2414674ae819SStefano Zampini     }
2415674ae819SStefano Zampini   } else {
2416674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2417674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
2418674ae819SStefano Zampini     }
2419674ae819SStefano Zampini   }
2420674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2421674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
2422674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2423674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2424674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
24255b08dc53SStefano Zampini   *n_global_subset = (PetscInt)PetscRealPart(globalsum);
2426674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
2427674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
2428674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
2429674ae819SStefano Zampini   nlocals = 0;
2430674ae819SStefano Zampini   first_index = -1;
2431674ae819SStefano Zampini   first_found = PETSC_FALSE;
2432674ae819SStefano Zampini   for (i=0;i<s;i++) {
24335b08dc53SStefano Zampini     if (!first_found && PetscRealPart(array[i]) > 0.0) {
2434674ae819SStefano Zampini       first_found = PETSC_TRUE;
2435674ae819SStefano Zampini       first_index = i;
2436674ae819SStefano Zampini     }
24375b08dc53SStefano Zampini     nlocals += (PetscInt)PetscRealPart(array[i]);
2438674ae819SStefano Zampini   }
2439674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2440674ae819SStefano Zampini   if (!rank_prec_comm) {
2441674ae819SStefano Zampini     dof_displs[0]=0;
2442674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
2443674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
2444674ae819SStefano Zampini     }
2445674ae819SStefano Zampini   }
2446674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2447674ae819SStefano Zampini   if (first_found) {
2448674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
2449674ae819SStefano Zampini     old_index = first_index;
2450674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
24515b08dc53SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) {
2452674ae819SStefano Zampini         array[i] += array[old_index];
2453674ae819SStefano Zampini         old_index = i;
2454674ae819SStefano Zampini       }
2455674ae819SStefano Zampini     }
2456674ae819SStefano Zampini   }
2457674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
2458674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2459674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2460674ae819SStefano Zampini   ierr = VecScatterEnd  (scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2461674ae819SStefano Zampini   /* get global ordering of local dofs */
2462674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2463674ae819SStefano Zampini   if (local_dofs_mult) {
2464674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
24655b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i];
2466674ae819SStefano Zampini     }
2467674ae819SStefano Zampini   } else {
2468674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
24695b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1;
2470674ae819SStefano Zampini     }
2471674ae819SStefano Zampini   }
2472674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2473674ae819SStefano Zampini   /* free workspace */
2474674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
2475674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
2476674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
2477674ae819SStefano Zampini   ierr = PetscFree(dof_sizes);CHKERRQ(ierr);
2478674ae819SStefano Zampini   ierr = PetscFree(dof_displs);CHKERRQ(ierr);
2479674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
2480674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
2481674ae819SStefano Zampini   PetscFunctionReturn(0);
2482674ae819SStefano Zampini }
24839a7d3425SStefano Zampini 
24849a7d3425SStefano Zampini #undef __FUNCT__
24859a7d3425SStefano Zampini #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
24869a7d3425SStefano Zampini PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
24879a7d3425SStefano Zampini {
24889a7d3425SStefano Zampini   PetscInt       i,j;
24899a7d3425SStefano Zampini   PetscScalar    *alphas;
24909a7d3425SStefano Zampini   PetscErrorCode ierr;
24919a7d3425SStefano Zampini 
24929a7d3425SStefano Zampini   PetscFunctionBegin;
24939a7d3425SStefano Zampini   /* this implements stabilized Gram-Schmidt */
24949a7d3425SStefano Zampini   ierr = PetscMalloc(n*sizeof(PetscScalar),&alphas);CHKERRQ(ierr);
24959a7d3425SStefano Zampini   for (i=0;i<n;i++) {
24969a7d3425SStefano Zampini     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
24979a7d3425SStefano Zampini     if (i<n) { ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],&alphas[i+1]);CHKERRQ(ierr); }
24989a7d3425SStefano Zampini     for (j=i+1;j<n;j++) { ierr = VecAXPY(vecs[j],PetscConj(-alphas[j]),vecs[i]);CHKERRQ(ierr); }
24999a7d3425SStefano Zampini   }
25009a7d3425SStefano Zampini   ierr = PetscFree(alphas);CHKERRQ(ierr);
25019a7d3425SStefano Zampini   PetscFunctionReturn(0);
25029a7d3425SStefano Zampini }
25039a7d3425SStefano Zampini 
2504fa7f1dd8SStefano Zampini /* TODO
2505fa7f1dd8SStefano Zampini    - now preallocation is done assuming SEQDENSE local matrices
2506fa7f1dd8SStefano Zampini */
2507c8587f34SStefano Zampini #undef __FUNCT__
2508fa7f1dd8SStefano Zampini #define __FUNCT__ "MatISGetMPIXAIJ"
2509fa7f1dd8SStefano Zampini static PetscErrorCode MatISGetMPIXAIJ(Mat mat, MatType Mtype, MatReuse reuse, Mat *M)
2510c8587f34SStefano Zampini {
2511a57a6d2fSStefano Zampini   Mat                    new_mat;
2512a57a6d2fSStefano Zampini   Mat_IS                 *matis = (Mat_IS*)(mat->data);
2513a57a6d2fSStefano Zampini   /* info on mat */
2514fa7f1dd8SStefano Zampini   /* ISLocalToGlobalMapping rmapping,cmapping; */
2515a57a6d2fSStefano Zampini   PetscInt               bs,rows,cols;
2516a57a6d2fSStefano Zampini   PetscInt               lrows,lcols;
2517a57a6d2fSStefano Zampini   PetscInt               local_rows,local_cols;
2518fa7f1dd8SStefano Zampini   PetscBool              isdense;
2519fa7f1dd8SStefano Zampini   /* values insertion */
2520fa7f1dd8SStefano Zampini   PetscScalar            *array;
2521a57a6d2fSStefano Zampini   PetscInt               *local_indices,*global_indices;
2522a57a6d2fSStefano Zampini   /* work */
2523fa7f1dd8SStefano Zampini   PetscInt               i,j,index_row;
2524a57a6d2fSStefano Zampini   PetscErrorCode         ierr;
2525c8587f34SStefano Zampini 
2526a57a6d2fSStefano Zampini   PetscFunctionBegin;
2527fa7f1dd8SStefano Zampini   /* MISSING CHECKS
2528fa7f1dd8SStefano Zampini     - rectangular case not covered (it is not allowed by MATIS)
2529fa7f1dd8SStefano Zampini   */
2530a57a6d2fSStefano Zampini   /* get info from mat */
2531fa7f1dd8SStefano Zampini   /* ierr = MatGetLocalToGlobalMapping(mat,&rmapping,&cmapping);CHKERRQ(ierr); */
2532a57a6d2fSStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
2533a57a6d2fSStefano Zampini   ierr = MatGetBlockSize(mat,&bs);CHKERRQ(ierr);
2534a57a6d2fSStefano Zampini   ierr = MatGetSize(matis->A,&local_rows,&local_cols);CHKERRQ(ierr);
2535a57a6d2fSStefano Zampini 
2536fa7f1dd8SStefano Zampini   /* work */
2537fa7f1dd8SStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*local_indices),&local_indices);CHKERRQ(ierr);
2538fa7f1dd8SStefano Zampini   for (i=0;i<local_rows;i++) local_indices[i]=i;
2539fa7f1dd8SStefano Zampini   /* map indices of local mat to global values */
2540fa7f1dd8SStefano Zampini   ierr = PetscMalloc(PetscMax(local_cols,local_rows)*sizeof(*global_indices),&global_indices);CHKERRQ(ierr);
2541fa7f1dd8SStefano Zampini   /* ierr = ISLocalToGlobalMappingApply(rmapping,local_rows,local_indices,global_indices);CHKERRQ(ierr); */
2542fa7f1dd8SStefano Zampini   ierr = ISLocalToGlobalMappingApply(matis->mapping,local_rows,local_indices,global_indices);CHKERRQ(ierr);
2543fa7f1dd8SStefano Zampini 
2544fa7f1dd8SStefano Zampini   if (reuse==MAT_INITIAL_MATRIX) {
2545fa7f1dd8SStefano Zampini     Vec         vec_dnz,vec_onz;
2546fa7f1dd8SStefano Zampini     PetscScalar *my_dnz,*my_onz;
2547fa7f1dd8SStefano Zampini     PetscInt    *dnz,*onz,*mat_ranges,*row_ownership;
2548fa7f1dd8SStefano Zampini     PetscInt    index_col,owner;
2549fa7f1dd8SStefano Zampini     PetscMPIInt nsubdomains;
2550fa7f1dd8SStefano Zampini 
2551fa7f1dd8SStefano Zampini     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&nsubdomains);CHKERRQ(ierr);
2552a57a6d2fSStefano Zampini     ierr = MatCreate(PetscObjectComm((PetscObject)mat),&new_mat);CHKERRQ(ierr);
2553a57a6d2fSStefano Zampini     ierr = MatSetSizes(new_mat,PETSC_DECIDE,PETSC_DECIDE,rows,cols);CHKERRQ(ierr);
2554a57a6d2fSStefano Zampini     ierr = MatSetBlockSize(new_mat,bs);CHKERRQ(ierr);
2555fa7f1dd8SStefano Zampini     ierr = MatSetType(new_mat,Mtype);CHKERRQ(ierr);
2556a57a6d2fSStefano Zampini     ierr = MatSetUp(new_mat);CHKERRQ(ierr);
2557a57a6d2fSStefano Zampini     ierr = MatGetLocalSize(new_mat,&lrows,&lcols);CHKERRQ(ierr);
2558a57a6d2fSStefano Zampini 
2559a57a6d2fSStefano Zampini     /*
2560a57a6d2fSStefano Zampini       preallocation
2561a57a6d2fSStefano Zampini     */
2562a57a6d2fSStefano Zampini 
2563a57a6d2fSStefano Zampini     ierr = MatPreallocateInitialize(PetscObjectComm((PetscObject)new_mat),lrows,lcols,dnz,onz);CHKERRQ(ierr);
2564a57a6d2fSStefano Zampini     /*
2565a57a6d2fSStefano Zampini        Some vectors are needed to sum up properly on shared interface dofs.
2566fa7f1dd8SStefano Zampini        Preallocation macros cannot do the job.
2567a57a6d2fSStefano Zampini        Note that preallocation is not exact, since it overestimates nonzeros
2568a57a6d2fSStefano Zampini     */
2569a57a6d2fSStefano Zampini     ierr = MatGetVecs(new_mat,NULL,&vec_dnz);CHKERRQ(ierr);
2570fa7f1dd8SStefano Zampini     /* ierr = VecSetLocalToGlobalMapping(vec_dnz,rmapping);CHKERRQ(ierr); */
2571fa7f1dd8SStefano Zampini     ierr = VecSetLocalToGlobalMapping(vec_dnz,matis->mapping);CHKERRQ(ierr);
2572c8587f34SStefano Zampini     ierr = VecDuplicate(vec_dnz,&vec_onz);CHKERRQ(ierr);
2573e7931f94SStefano Zampini     /* All processes need to compute entire row ownership */
2574a57a6d2fSStefano Zampini     ierr = PetscMalloc(rows*sizeof(*row_ownership),&row_ownership);CHKERRQ(ierr);
2575a57a6d2fSStefano Zampini     ierr = MatGetOwnershipRanges(new_mat,(const PetscInt**)&mat_ranges);CHKERRQ(ierr);
2576a57a6d2fSStefano Zampini     for (i=0;i<nsubdomains;i++) {
2577c8587f34SStefano Zampini       for (j=mat_ranges[i];j<mat_ranges[i+1];j++) {
2578c8587f34SStefano Zampini         row_ownership[j]=i;
2579c8587f34SStefano Zampini       }
2580c8587f34SStefano Zampini     }
2581c8587f34SStefano Zampini 
2582e7931f94SStefano Zampini     /*
2583e7931f94SStefano Zampini        my_dnz and my_onz contains exact contribution to preallocation from each local mat
2584e7931f94SStefano Zampini        then, they will be summed up properly. This way, preallocation is always sufficient
2585e7931f94SStefano Zampini     */
2586a57a6d2fSStefano Zampini     ierr = PetscMalloc(local_rows*sizeof(*my_dnz),&my_dnz);CHKERRQ(ierr);
2587a57a6d2fSStefano Zampini     ierr = PetscMalloc(local_rows*sizeof(*my_onz),&my_onz);CHKERRQ(ierr);
2588a57a6d2fSStefano Zampini     ierr = PetscMemzero(my_dnz,local_rows*sizeof(*my_dnz));CHKERRQ(ierr);
2589a57a6d2fSStefano Zampini     ierr = PetscMemzero(my_onz,local_rows*sizeof(*my_onz));CHKERRQ(ierr);
2590a57a6d2fSStefano Zampini     for (i=0;i<local_rows;i++) {
2591a57a6d2fSStefano Zampini       index_row = global_indices[i];
2592a57a6d2fSStefano Zampini       for (j=i;j<local_rows;j++) {
2593a57a6d2fSStefano Zampini         owner = row_ownership[index_row];
2594a57a6d2fSStefano Zampini         index_col = global_indices[j];
2595a57a6d2fSStefano Zampini         if (index_col > mat_ranges[owner]-1 && index_col < mat_ranges[owner+1] ) { /* diag block */
2596c8587f34SStefano Zampini           my_dnz[i] += 1.0;
2597a57a6d2fSStefano Zampini         } else { /* offdiag block */
2598c8587f34SStefano Zampini           my_onz[i] += 1.0;
2599c8587f34SStefano Zampini         }
2600a57a6d2fSStefano Zampini         /* same as before, interchanging rows and cols */
2601c8587f34SStefano Zampini         if (i != j) {
2602a57a6d2fSStefano Zampini           owner = row_ownership[index_col];
2603a57a6d2fSStefano Zampini           if (index_row > mat_ranges[owner]-1 && index_row < mat_ranges[owner+1] ) {
2604c8587f34SStefano Zampini             my_dnz[j] += 1.0;
2605c8587f34SStefano Zampini           } else {
2606c8587f34SStefano Zampini             my_onz[j] += 1.0;
2607c8587f34SStefano Zampini           }
2608c8587f34SStefano Zampini         }
2609c8587f34SStefano Zampini       }
2610c8587f34SStefano Zampini     }
2611c8587f34SStefano Zampini     ierr = VecSet(vec_dnz,0.0);CHKERRQ(ierr);
2612c8587f34SStefano Zampini     ierr = VecSet(vec_onz,0.0);CHKERRQ(ierr);
261320a2ab83SStefano Zampini     if (local_rows) { /* multilevel guard */
2614fa7f1dd8SStefano Zampini       ierr = VecSetValuesLocal(vec_dnz,local_rows,local_indices,my_dnz,ADD_VALUES);CHKERRQ(ierr);
2615fa7f1dd8SStefano Zampini       ierr = VecSetValuesLocal(vec_onz,local_rows,local_indices,my_onz,ADD_VALUES);CHKERRQ(ierr);
2616c8587f34SStefano Zampini     }
2617c8587f34SStefano Zampini     ierr = VecAssemblyBegin(vec_dnz);CHKERRQ(ierr);
2618c8587f34SStefano Zampini     ierr = VecAssemblyBegin(vec_onz);CHKERRQ(ierr);
2619c8587f34SStefano Zampini     ierr = VecAssemblyEnd(vec_dnz);CHKERRQ(ierr);
2620c8587f34SStefano Zampini     ierr = VecAssemblyEnd(vec_onz);CHKERRQ(ierr);
2621c8587f34SStefano Zampini     ierr = PetscFree(my_dnz);CHKERRQ(ierr);
2622c8587f34SStefano Zampini     ierr = PetscFree(my_onz);CHKERRQ(ierr);
2623c8587f34SStefano Zampini     ierr = PetscFree(row_ownership);CHKERRQ(ierr);
2624a57a6d2fSStefano Zampini 
2625a57a6d2fSStefano Zampini     /* set computed preallocation in dnz and onz */
2626a57a6d2fSStefano Zampini     ierr = VecGetArray(vec_dnz,&array);CHKERRQ(ierr);
2627a57a6d2fSStefano Zampini     for (i=0; i<lrows; i++) dnz[i] = (PetscInt)PetscRealPart(array[i]);
2628a57a6d2fSStefano Zampini     ierr = VecRestoreArray(vec_dnz,&array);CHKERRQ(ierr);
2629a57a6d2fSStefano Zampini     ierr = VecGetArray(vec_onz,&array);CHKERRQ(ierr);
2630a57a6d2fSStefano Zampini     for (i=0;i<lrows;i++) onz[i] = (PetscInt)PetscRealPart(array[i]);
2631a57a6d2fSStefano Zampini     ierr = VecRestoreArray(vec_onz,&array);CHKERRQ(ierr);
2632c8587f34SStefano Zampini     ierr = VecDestroy(&vec_dnz);CHKERRQ(ierr);
2633c8587f34SStefano Zampini     ierr = VecDestroy(&vec_onz);CHKERRQ(ierr);
2634c8587f34SStefano Zampini 
2635e7931f94SStefano Zampini     /* Resize preallocation if overestimated */
2636c8587f34SStefano Zampini     for (i=0;i<lrows;i++) {
2637a57a6d2fSStefano Zampini       dnz[i] = PetscMin(dnz[i],lcols);
2638a57a6d2fSStefano Zampini       onz[i] = PetscMin(onz[i],cols-lcols);
2639c8587f34SStefano Zampini     }
2640fa7f1dd8SStefano Zampini     /* set preallocation */
2641a57a6d2fSStefano Zampini     ierr = MatMPIAIJSetPreallocation(new_mat,0,dnz,0,onz);CHKERRQ(ierr);
2642fa7f1dd8SStefano Zampini     for (i=0;i<lrows/bs;i++) {
2643fa7f1dd8SStefano Zampini       dnz[i] = dnz[i*bs]/bs;
2644fa7f1dd8SStefano Zampini       onz[i] = onz[i*bs]/bs;
2645fa7f1dd8SStefano Zampini     }
2646fa7f1dd8SStefano Zampini     ierr = MatMPIBAIJSetPreallocation(new_mat,bs,0,dnz,0,onz);CHKERRQ(ierr);
2647fa7f1dd8SStefano Zampini     for (i=0;i<lrows/bs;i++) {
2648fa7f1dd8SStefano Zampini       dnz[i] = dnz[i]-i;
2649fa7f1dd8SStefano Zampini     }
2650fa7f1dd8SStefano Zampini     ierr = MatMPISBAIJSetPreallocation(new_mat,bs,0,dnz,0,onz);CHKERRQ(ierr);
2651c8587f34SStefano Zampini     ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
2652fa7f1dd8SStefano Zampini     *M = new_mat;
2653fa7f1dd8SStefano Zampini   } else {
2654fa7f1dd8SStefano Zampini     PetscInt mbs,mrows,mcols;
2655fa7f1dd8SStefano Zampini     /* some checks */
2656fa7f1dd8SStefano Zampini     ierr = MatGetBlockSize(*M,&mbs);CHKERRQ(ierr);
2657fa7f1dd8SStefano Zampini     ierr = MatGetSize(*M,&mrows,&mcols);CHKERRQ(ierr);
2658fa7f1dd8SStefano Zampini     if (mrows != rows) {
2659fa7f1dd8SStefano Zampini       SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong number of rows (%d != %d)",rows,mrows);
2660fa7f1dd8SStefano Zampini     }
2661fa7f1dd8SStefano Zampini     if (mrows != rows) {
2662fa7f1dd8SStefano Zampini       SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong number of cols (%d != %d)",cols,mcols);
2663fa7f1dd8SStefano Zampini     }
2664fa7f1dd8SStefano Zampini     if (mbs != bs) {
2665fa7f1dd8SStefano Zampini       SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong block size (%d != %d)",bs,mbs);
2666fa7f1dd8SStefano Zampini     }
2667fa7f1dd8SStefano Zampini     ierr = MatZeroEntries(*M);CHKERRQ(ierr);
2668fa7f1dd8SStefano Zampini   }
2669fa7f1dd8SStefano Zampini   /* set local to global mappings */
2670fa7f1dd8SStefano Zampini   /* ierr = MatSetLocalToGlobalMapping(*M,rmapping,cmapping);CHKERRQ(ierr); */
2671fa7f1dd8SStefano Zampini   /* Set values */
2672fa7f1dd8SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQDENSE,&isdense);CHKERRQ(ierr);
2673fa7f1dd8SStefano Zampini   if (isdense) { /* special case for dense local matrices */
2674fa7f1dd8SStefano Zampini     ierr = MatSetOption(*M,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
2675fa7f1dd8SStefano Zampini     ierr = MatDenseGetArray(matis->A,&array);CHKERRQ(ierr);
2676fa7f1dd8SStefano Zampini     ierr = MatSetValues(*M,local_rows,global_indices,local_cols,global_indices,array,ADD_VALUES);CHKERRQ(ierr);
2677fa7f1dd8SStefano Zampini     ierr = MatDenseRestoreArray(matis->A,&array);CHKERRQ(ierr);
2678fa7f1dd8SStefano Zampini     ierr = PetscFree(local_indices);CHKERRQ(ierr);
2679fa7f1dd8SStefano Zampini     ierr = PetscFree(global_indices);CHKERRQ(ierr);
2680fa7f1dd8SStefano Zampini   } else { /* very basic values insertion for all other matrix types */
2681fa7f1dd8SStefano Zampini     ierr = PetscFree(local_indices);CHKERRQ(ierr);
2682fa7f1dd8SStefano Zampini     ierr = PetscFree(global_indices);CHKERRQ(ierr);
2683a57a6d2fSStefano Zampini     for (i=0;i<local_rows;i++) {
2684a57a6d2fSStefano Zampini       ierr = MatGetRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2685fa7f1dd8SStefano Zampini       /* ierr = MatSetValuesLocal(*M,1,&i,j,local_indices,array,ADD_VALUES);CHKERRQ(ierr); */
2686a57a6d2fSStefano Zampini       ierr = ISLocalToGlobalMappingApply(matis->mapping,j,local_indices,global_indices);CHKERRQ(ierr);
2687a57a6d2fSStefano Zampini       ierr = ISLocalToGlobalMappingApply(matis->mapping,1,&i,&index_row);CHKERRQ(ierr);
2688fa7f1dd8SStefano Zampini       ierr = MatSetValues(*M,1,&index_row,j,global_indices,array,ADD_VALUES);CHKERRQ(ierr);
2689a57a6d2fSStefano Zampini       ierr = MatRestoreRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2690a57a6d2fSStefano Zampini     }
2691fa7f1dd8SStefano Zampini   }
2692fa7f1dd8SStefano Zampini   ierr = MatAssemblyBegin(*M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2693fa7f1dd8SStefano Zampini   ierr = MatAssemblyEnd(*M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2694fa7f1dd8SStefano Zampini   if (isdense) {
2695fa7f1dd8SStefano Zampini     ierr = MatSetOption(*M,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
2696fa7f1dd8SStefano Zampini   }
2697a57a6d2fSStefano Zampini   PetscFunctionReturn(0);
2698a57a6d2fSStefano Zampini }
2699a57a6d2fSStefano Zampini 
2700e7931f94SStefano Zampini #undef __FUNCT__
2701e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble_Private"
2702e7931f94SStefano Zampini PetscErrorCode MatISSubassemble_Private(Mat mat, PetscInt coarsening_ratio, IS* is_sends)
2703e7931f94SStefano Zampini {
2704e7931f94SStefano Zampini   Mat             subdomain_adj;
2705e7931f94SStefano Zampini   IS              new_ranks,ranks_send_to;
2706e7931f94SStefano Zampini   MatPartitioning partitioner;
2707e7931f94SStefano Zampini   Mat_IS          *matis;
2708e7931f94SStefano Zampini   PetscInt        n_neighs,*neighs,*n_shared,**shared;
2709e7931f94SStefano Zampini   PetscInt        prank;
2710e7931f94SStefano Zampini   PetscMPIInt     size,rank,color;
2711e7931f94SStefano Zampini   PetscInt        *xadj,*adjncy,*oldranks;
2712e7931f94SStefano Zampini   PetscInt        *adjncy_wgt,*v_wgt,*is_indices,*ranks_send_to_idx;
2713e7931f94SStefano Zampini   PetscInt        i,j,n_subdomains,local_size,threshold=0;
2714e7931f94SStefano Zampini   PetscErrorCode  ierr;
27152b510759SStefano Zampini   PetscBool       use_vwgt=PETSC_FALSE,use_square=PETSC_FALSE;
2716e7931f94SStefano Zampini   PetscSubcomm    subcomm;
2717a57a6d2fSStefano Zampini 
2718e7931f94SStefano Zampini   PetscFunctionBegin;
27192b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_square",&use_square,NULL);CHKERRQ(ierr);
27202b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
27212b510759SStefano Zampini   ierr = PetscOptionsGetInt(NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
2722e7931f94SStefano Zampini 
2723e7931f94SStefano Zampini   /* Get info on mapping */
2724e7931f94SStefano Zampini   matis = (Mat_IS*)(mat->data);
2725e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&local_size);CHKERRQ(ierr);
2726e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2727e7931f94SStefano Zampini 
2728e7931f94SStefano Zampini   /* build local CSR graph of subdomains' connectivity */
2729e7931f94SStefano Zampini   ierr = PetscMalloc(2*sizeof(*xadj),&xadj);CHKERRQ(ierr);
2730e7931f94SStefano Zampini   xadj[0] = 0;
2731e7931f94SStefano Zampini   xadj[1] = PetscMax(n_neighs-1,0);
2732e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy),&adjncy);CHKERRQ(ierr);
2733e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy_wgt),&adjncy_wgt);CHKERRQ(ierr);
2734e7931f94SStefano Zampini 
27352b510759SStefano Zampini   if (threshold) {
27362b510759SStefano Zampini     PetscInt* count,min_threshold;
2737e7931f94SStefano Zampini     ierr = PetscMalloc(local_size*sizeof(PetscInt),&count);CHKERRQ(ierr);
2738e7931f94SStefano Zampini     ierr = PetscMemzero(count,local_size*sizeof(PetscInt));CHKERRQ(ierr);
2739e7931f94SStefano Zampini     for (i=1;i<n_neighs;i++) {/* i=1 so I don't count myself -> faces nodes counts to 1 */
2740e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2741e7931f94SStefano Zampini         count[shared[i][j]] += 1;
2742e7931f94SStefano Zampini       }
2743e7931f94SStefano Zampini     }
27442b510759SStefano Zampini     /* adapt threshold since we dont want to lose significant connections */
27452b510759SStefano Zampini     min_threshold = n_neighs;
27462b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
27472b510759SStefano Zampini       for (j=0;j<n_shared[i];j++) {
27482b510759SStefano Zampini         min_threshold = PetscMin(count[shared[i][j]],min_threshold);
27492b510759SStefano Zampini       }
27502b510759SStefano Zampini     }
27512b510759SStefano Zampini     threshold = PetscMax(min_threshold+1,threshold);
2752e7931f94SStefano Zampini     xadj[1] = 0;
27532b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
2754e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2755e7931f94SStefano Zampini         if (count[shared[i][j]] < threshold) {
2756e7931f94SStefano Zampini           adjncy[xadj[1]] = neighs[i];
2757e7931f94SStefano Zampini           adjncy_wgt[xadj[1]] = n_shared[i];
2758e7931f94SStefano Zampini           xadj[1]++;
2759e7931f94SStefano Zampini           break;
2760e7931f94SStefano Zampini         }
2761e7931f94SStefano Zampini       }
2762e7931f94SStefano Zampini     }
2763e7931f94SStefano Zampini     ierr = PetscFree(count);CHKERRQ(ierr);
2764c8587f34SStefano Zampini   } else {
2765e7931f94SStefano Zampini     if (xadj[1]) {
2766e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy,&neighs[1],xadj[1]*sizeof(*adjncy));CHKERRQ(ierr);
2767e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy_wgt,&n_shared[1],xadj[1]*sizeof(*adjncy_wgt));CHKERRQ(ierr);
2768c8587f34SStefano Zampini     }
2769e7931f94SStefano Zampini   }
2770e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingRestoreInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2771e7931f94SStefano Zampini   if (use_square) {
2772e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2773e7931f94SStefano Zampini       adjncy_wgt[i] = adjncy_wgt[i]*adjncy_wgt[i];
2774e7931f94SStefano Zampini     }
2775e7931f94SStefano Zampini   }
2776e7931f94SStefano Zampini   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2777e7931f94SStefano Zampini 
2778e7931f94SStefano Zampini   ierr = PetscMalloc(sizeof(PetscInt),&ranks_send_to_idx);CHKERRQ(ierr);
2779e7931f94SStefano Zampini 
2780e7931f94SStefano Zampini   /*
2781e7931f94SStefano Zampini     Restrict work on active processes only.
2782e7931f94SStefano Zampini   */
2783e7931f94SStefano Zampini   ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&subcomm);CHKERRQ(ierr);
2784e7931f94SStefano Zampini   ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
2785e7931f94SStefano Zampini   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
27862b510759SStefano Zampini   ierr = PetscMPIIntCast(!local_size,&color);CHKERRQ(ierr);
2787d3531aaaSJed Brown   ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
2788e7931f94SStefano Zampini   if (color) {
2789e7931f94SStefano Zampini     ierr = PetscFree(xadj);CHKERRQ(ierr);
2790e7931f94SStefano Zampini     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2791e7931f94SStefano Zampini     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
2792c8587f34SStefano Zampini   } else {
2793e7931f94SStefano Zampini     ierr = MPI_Comm_size(subcomm->comm,&size);CHKERRQ(ierr);
2794e7931f94SStefano Zampini     ierr = PetscMalloc(size*sizeof(*oldranks),&oldranks);CHKERRQ(ierr);
2795e7931f94SStefano Zampini     prank = rank;
2796e7931f94SStefano Zampini     ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm->comm);CHKERRQ(ierr);
2797e7931f94SStefano Zampini     for (i=0;i<size;i++) {
2798e7931f94SStefano Zampini       PetscPrintf(subcomm->comm,"oldranks[%d] = %d\n",i,oldranks[i]);
2799c8587f34SStefano Zampini     }
2800e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2801e7931f94SStefano Zampini       ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
2802c8587f34SStefano Zampini     }
2803e7931f94SStefano Zampini     ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2804e7931f94SStefano Zampini     ierr = MatCreateMPIAdj(subcomm->comm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
2805e7931f94SStefano Zampini     n_subdomains = (PetscInt)size;
2806e7931f94SStefano Zampini     ierr = MatView(subdomain_adj,0);CHKERRQ(ierr);
2807e7931f94SStefano Zampini 
2808e7931f94SStefano Zampini     /* Partition */
2809e7931f94SStefano Zampini     ierr = MatPartitioningCreate(subcomm->comm,&partitioner);CHKERRQ(ierr);
2810e7931f94SStefano Zampini     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
2811e7931f94SStefano Zampini     if (use_vwgt) {
2812e7931f94SStefano Zampini       ierr = PetscMalloc(sizeof(*v_wgt),&v_wgt);CHKERRQ(ierr);
2813e7931f94SStefano Zampini       v_wgt[0] = local_size;
2814e7931f94SStefano Zampini       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
2815c8587f34SStefano Zampini     }
2816e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)partitioner),"NPARTS %d\n",n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2817e7931f94SStefano Zampini     ierr = MatPartitioningSetNParts(partitioner,n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2818e7931f94SStefano Zampini     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
2819e7931f94SStefano Zampini     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
2820e7931f94SStefano Zampini     ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr);
2821e7931f94SStefano Zampini 
2822e7931f94SStefano Zampini     ierr = ISGetIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2823e7931f94SStefano Zampini     ranks_send_to_idx[0] = oldranks[is_indices[0]];
2824e7931f94SStefano Zampini     ierr = ISRestoreIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2825e7931f94SStefano Zampini     /* clean up */
2826e7931f94SStefano Zampini     ierr = PetscFree(oldranks);CHKERRQ(ierr);
2827e7931f94SStefano Zampini     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
2828e7931f94SStefano Zampini     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
2829e7931f94SStefano Zampini     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
2830e7931f94SStefano Zampini   }
2831e7931f94SStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
2832e7931f94SStefano Zampini 
2833e7931f94SStefano Zampini   /* assemble parallel IS for sends */
2834e7931f94SStefano Zampini   i = 1;
2835e7931f94SStefano Zampini   if (color) i=0;
2836e7931f94SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,&ranks_send_to);CHKERRQ(ierr);
2837e7931f94SStefano Zampini   ierr = ISView(ranks_send_to,0);CHKERRQ(ierr);
2838e7931f94SStefano Zampini 
2839e7931f94SStefano Zampini   /* get back IS */
2840e7931f94SStefano Zampini   *is_sends = ranks_send_to;
2841e7931f94SStefano Zampini   PetscFunctionReturn(0);
2842e7931f94SStefano Zampini }
2843e7931f94SStefano Zampini 
2844e7931f94SStefano Zampini typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
2845e7931f94SStefano Zampini 
2846e7931f94SStefano Zampini #undef __FUNCT__
2847e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble"
2848e7931f94SStefano Zampini PetscErrorCode MatISSubassemble(Mat mat, IS is_sends, PetscInt coarsening_ratio, Mat *mat_n)
2849e7931f94SStefano Zampini {
2850e7931f94SStefano Zampini   Mat                    local_mat,new_mat;
2851e7931f94SStefano Zampini   Mat_IS                 *matis;
2852e7931f94SStefano Zampini   IS                     is_sends_internal;
2853e7931f94SStefano Zampini   PetscInt               rows,cols;
2854e7931f94SStefano Zampini   PetscInt               i,bs,buf_size_idxs,buf_size_vals;
2855e7931f94SStefano Zampini   PetscBool              ismatis,isdense;
2856e7931f94SStefano Zampini   ISLocalToGlobalMapping l2gmap;
2857e7931f94SStefano Zampini   PetscInt*              l2gmap_indices;
2858e7931f94SStefano Zampini   const PetscInt*        is_indices;
2859e7931f94SStefano Zampini   MatType                new_local_type;
2860e7931f94SStefano Zampini   MatTypePrivate         new_local_type_private;
2861e7931f94SStefano Zampini   /* buffers */
2862e7931f94SStefano Zampini   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
2863e7931f94SStefano Zampini   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
2864e7931f94SStefano Zampini   /* MPI */
2865e7931f94SStefano Zampini   MPI_Comm               comm;
2866e7931f94SStefano Zampini   PetscMPIInt            n_sends,n_recvs,commsize;
2867e7931f94SStefano Zampini   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals;
2868e7931f94SStefano Zampini   PetscMPIInt            *onodes,*olengths_idxs,*olengths_vals;
2869e7931f94SStefano Zampini   PetscMPIInt            len,tag_idxs,tag_vals,source_dest;
2870e7931f94SStefano Zampini   MPI_Request            *send_req_idxs,*send_req_vals,*recv_req_idxs,*recv_req_vals;
2871e7931f94SStefano Zampini   PetscErrorCode         ierr;
2872e7931f94SStefano Zampini 
2873e7931f94SStefano Zampini   PetscFunctionBegin;
2874e7931f94SStefano Zampini   /* checks */
2875e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
2876e7931f94SStefano Zampini   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on an matrix object which is not of type MATIS",__FUNCT__);
2877e7931f94SStefano Zampini   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2878e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
2879e7931f94SStefano Zampini   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
2880e7931f94SStefano Zampini   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
2881e7931f94SStefano Zampini   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
2882e7931f94SStefano Zampini   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
2883e7931f94SStefano Zampini   PetscValidLogicalCollectiveInt(mat,bs,0);
2884e7931f94SStefano Zampini   /* prepare IS for sending if not provided */
2885e7931f94SStefano Zampini   if (!is_sends) {
2886e7931f94SStefano Zampini     if (!coarsening_ratio) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a coarsening ratio");
2887e7931f94SStefano Zampini     ierr = MatISSubassemble_Private(mat,coarsening_ratio,&is_sends_internal);CHKERRQ(ierr);
2888c8587f34SStefano Zampini   } else {
2889e7931f94SStefano Zampini     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
2890e7931f94SStefano Zampini     is_sends_internal = is_sends;
2891c8587f34SStefano Zampini   }
2892e7931f94SStefano Zampini 
2893e7931f94SStefano Zampini   /* get pointer of MATIS data */
2894e7931f94SStefano Zampini   matis = (Mat_IS*)mat->data;
2895e7931f94SStefano Zampini 
2896e7931f94SStefano Zampini   /* get comm */
2897e7931f94SStefano Zampini   comm = PetscObjectComm((PetscObject)mat);
2898e7931f94SStefano Zampini 
2899e7931f94SStefano Zampini   /* compute number of sends */
2900e7931f94SStefano Zampini   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
2901e7931f94SStefano Zampini   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
2902e7931f94SStefano Zampini 
2903e7931f94SStefano Zampini   /* compute number of receives */
2904e7931f94SStefano Zampini   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
2905e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*iflags),&iflags);CHKERRQ(ierr);
2906e7931f94SStefano Zampini   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
2907e7931f94SStefano Zampini   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2908e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
2909e7931f94SStefano Zampini   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
2910e7931f94SStefano Zampini   ierr = PetscFree(iflags);CHKERRQ(ierr);
2911e7931f94SStefano Zampini 
2912e7931f94SStefano Zampini   /* prepare send/receive buffers */
2913e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_idxs),&ilengths_idxs);CHKERRQ(ierr);
2914e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
2915e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_vals),&ilengths_vals);CHKERRQ(ierr);
2916e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
2917e7931f94SStefano Zampini 
2918e7931f94SStefano Zampini   /* Get data from local mat */
2919e7931f94SStefano Zampini   if (!isdense) {
2920e7931f94SStefano Zampini     /* TODO: See below some guidelines on how to prepare the local buffers */
2921e7931f94SStefano Zampini     /*
2922e7931f94SStefano Zampini        send_buffer_vals should contain the raw values of the local matrix
2923e7931f94SStefano Zampini        send_buffer_idxs should contain:
2924e7931f94SStefano Zampini        - MatType_PRIVATE type
2925e7931f94SStefano Zampini        - PetscInt        size_of_l2gmap
2926e7931f94SStefano Zampini        - PetscInt        global_row_indices[size_of_l2gmap]
2927e7931f94SStefano Zampini        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
2928e7931f94SStefano Zampini     */
2929e7931f94SStefano Zampini   } else {
2930e7931f94SStefano Zampini     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
2931e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&i);CHKERRQ(ierr);
2932e7931f94SStefano Zampini     ierr = PetscMalloc((i+2)*sizeof(PetscInt),&send_buffer_idxs);CHKERRQ(ierr);
2933e7931f94SStefano Zampini     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
2934e7931f94SStefano Zampini     send_buffer_idxs[1] = i;
2935e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2936e7931f94SStefano Zampini     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
2937e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingRestoreIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2938e7931f94SStefano Zampini     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
2939e7931f94SStefano Zampini     for (i=0;i<n_sends;i++) {
2940e7931f94SStefano Zampini       ilengths_vals[is_indices[i]] = len*len;
2941e7931f94SStefano Zampini       ilengths_idxs[is_indices[i]] = len+2;
2942c8587f34SStefano Zampini     }
2943c8587f34SStefano Zampini   }
2944e7931f94SStefano Zampini   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
2945e7931f94SStefano Zampini   buf_size_idxs = 0;
2946e7931f94SStefano Zampini   buf_size_vals = 0;
2947e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2948e7931f94SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
2949e7931f94SStefano Zampini     buf_size_vals += (PetscInt)olengths_vals[i];
2950e7931f94SStefano Zampini   }
2951e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&recv_buffer_idxs);CHKERRQ(ierr);
2952e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_vals*sizeof(PetscScalar),&recv_buffer_vals);CHKERRQ(ierr);
2953e7931f94SStefano Zampini 
2954e7931f94SStefano Zampini   /* get new tags for clean communications */
2955e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
2956e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
2957e7931f94SStefano Zampini 
2958e7931f94SStefano Zampini   /* allocate for requests */
2959e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_idxs);CHKERRQ(ierr);
2960e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_vals);CHKERRQ(ierr);
2961e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_idxs);CHKERRQ(ierr);
2962e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_vals);CHKERRQ(ierr);
2963e7931f94SStefano Zampini 
2964e7931f94SStefano Zampini   /* communications */
2965e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2966e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
2967e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2968e7931f94SStefano Zampini     source_dest = onodes[i];
2969e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
2970e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
2971e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2972e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
2973e7931f94SStefano Zampini   }
2974e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) {
2975e7931f94SStefano Zampini     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
2976e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
2977e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
2978e7931f94SStefano Zampini   }
2979e7931f94SStefano Zampini   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2980e7931f94SStefano Zampini   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
2981e7931f94SStefano Zampini 
2982e7931f94SStefano Zampini   /* assemble new l2g map */
2983e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2984e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2985e7931f94SStefano Zampini   buf_size_idxs = 0;
2986e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2987e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
2988e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2989e7931f94SStefano Zampini   }
2990e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&l2gmap_indices);CHKERRQ(ierr);
2991e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2992e7931f94SStefano Zampini   buf_size_idxs = 0;
2993e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2994e7931f94SStefano Zampini     ierr = PetscMemcpy(&l2gmap_indices[buf_size_idxs],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
2995e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
2996e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2997e7931f94SStefano Zampini   }
2998e7931f94SStefano Zampini   ierr = PetscSortRemoveDupsInt(&buf_size_idxs,l2gmap_indices);CHKERRQ(ierr);
2999e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingCreate(comm,buf_size_idxs,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
3000e7931f94SStefano Zampini   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
3001e7931f94SStefano Zampini 
3002e7931f94SStefano Zampini   /* infer new local matrix type from received local matrices type */
3003e7931f94SStefano Zampini   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
3004e7931f94SStefano 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) */
3005e7931f94SStefano Zampini   new_local_type_private = MATAIJ_PRIVATE;
3006e7931f94SStefano Zampini   new_local_type = MATSEQAIJ;
3007e7931f94SStefano Zampini   if (n_recvs) {
3008be4bc593SStefano Zampini     new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
3009e7931f94SStefano Zampini     ptr_idxs = recv_buffer_idxs;
3010e7931f94SStefano Zampini     for (i=0;i<n_recvs;i++) {
3011e7931f94SStefano Zampini       if ((PetscInt)new_local_type_private != *ptr_idxs) {
3012e7931f94SStefano Zampini         new_local_type_private = MATAIJ_PRIVATE;
3013e7931f94SStefano Zampini         break;
3014e7931f94SStefano Zampini       }
3015e7931f94SStefano Zampini       ptr_idxs += olengths_idxs[i];
3016e7931f94SStefano Zampini     }
3017e7931f94SStefano Zampini     switch (new_local_type_private) {
3018e7931f94SStefano Zampini       case MATDENSE_PRIVATE: /* subassembling of dense matrices does not give a dense matrix! */
3019e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
3020e7931f94SStefano Zampini         bs = 1;
3021e7931f94SStefano Zampini         break;
3022e7931f94SStefano Zampini       case MATAIJ_PRIVATE:
3023e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
3024e7931f94SStefano Zampini         bs = 1;
3025e7931f94SStefano Zampini         break;
3026e7931f94SStefano Zampini       case MATBAIJ_PRIVATE:
3027e7931f94SStefano Zampini         new_local_type = MATSEQBAIJ;
3028e7931f94SStefano Zampini         break;
3029e7931f94SStefano Zampini       case MATSBAIJ_PRIVATE:
3030e7931f94SStefano Zampini         new_local_type = MATSEQSBAIJ;
3031e7931f94SStefano Zampini         break;
3032e7931f94SStefano Zampini       default:
3033e7931f94SStefano Zampini         SETERRQ2(comm,PETSC_ERR_LIB,"Unkwown private type %d in %s",new_local_type_private,__FUNCT__);
3034e7931f94SStefano Zampini         break;
3035e7931f94SStefano Zampini     }
3036e7931f94SStefano Zampini   }
3037e7931f94SStefano Zampini 
3038e7931f94SStefano Zampini   /* create MATIS object */
3039e7931f94SStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
3040e7931f94SStefano Zampini   ierr = MatCreateIS(comm,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,&new_mat);CHKERRQ(ierr);
3041e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
3042e7931f94SStefano Zampini   ierr = MatISGetLocalMat(new_mat,&local_mat);CHKERRQ(ierr);
3043e7931f94SStefano Zampini   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
3044e7931f94SStefano Zampini   ierr = MatSetUp(local_mat);CHKERRQ(ierr); /* WARNING -> no preallocation yet */
3045e7931f94SStefano Zampini 
3046e7931f94SStefano Zampini   /* set values */
3047e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3048e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
3049e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
3050e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3051e7931f94SStefano Zampini     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
3052e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
3053e7931f94SStefano Zampini       ierr = MatSetValues(new_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
3054e7931f94SStefano Zampini       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3055e7931f94SStefano Zampini       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3056e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
3057e7931f94SStefano Zampini     }
3058e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3059e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
3060e7931f94SStefano Zampini   }
3061e7931f94SStefano Zampini   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3062e7931f94SStefano Zampini   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3063e7931f94SStefano Zampini   ierr = MatAssemblyBegin(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3064e7931f94SStefano Zampini   ierr = MatAssemblyEnd(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3065e7931f94SStefano Zampini 
3066e7931f94SStefano Zampini   { /* check */
3067e7931f94SStefano Zampini     Vec       lvec,rvec;
3068e7931f94SStefano Zampini     PetscReal infty_error;
3069e7931f94SStefano Zampini 
3070e7931f94SStefano Zampini     ierr = MatGetVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
3071e7931f94SStefano Zampini     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
3072e7931f94SStefano Zampini     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
3073e7931f94SStefano Zampini     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
3074e7931f94SStefano Zampini     ierr = MatMultAdd(new_mat,rvec,lvec,lvec);CHKERRQ(ierr);
3075e7931f94SStefano Zampini     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3076e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
3077e7931f94SStefano Zampini     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
3078e7931f94SStefano Zampini     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
3079e7931f94SStefano Zampini   }
3080e7931f94SStefano Zampini 
3081e7931f94SStefano Zampini   /* free workspace */
3082e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
3083e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
3084e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3085e7931f94SStefano Zampini   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
3086e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3087e7931f94SStefano Zampini   if (isdense) {
3088e7931f94SStefano Zampini     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
3089e7931f94SStefano Zampini     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
3090e7931f94SStefano Zampini   } else {
3091e7931f94SStefano Zampini     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
3092e7931f94SStefano Zampini   }
3093e7931f94SStefano Zampini   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
3094e7931f94SStefano Zampini   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
3095e7931f94SStefano Zampini   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
3096e7931f94SStefano Zampini   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
3097e7931f94SStefano Zampini   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
3098e7931f94SStefano Zampini   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
3099e7931f94SStefano Zampini   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
3100e7931f94SStefano Zampini   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
3101e7931f94SStefano Zampini   ierr = PetscFree(onodes);CHKERRQ(ierr);
3102e7931f94SStefano Zampini   /* get back new mat */
3103e7931f94SStefano Zampini   *mat_n = new_mat;
3104e7931f94SStefano Zampini   PetscFunctionReturn(0);
3105e7931f94SStefano Zampini }
3106a57a6d2fSStefano Zampini 
3107c8587f34SStefano Zampini #undef __FUNCT__
3108c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
3109c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
3110c8587f34SStefano Zampini {
3111c8587f34SStefano Zampini   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
3112c8587f34SStefano Zampini   PC_IS                  *pcis = (PC_IS*)pc->data;
311320a2ab83SStefano Zampini   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
31149881197aSStefano Zampini   MatNullSpace           CoarseNullSpace=NULL;
311520a2ab83SStefano Zampini   ISLocalToGlobalMapping coarse_islg;
311620a2ab83SStefano Zampini   IS                     coarse_is;
3117f4ddd8eeSStefano Zampini   PetscInt               max_it;
3118f9eb5b7dSStefano Zampini   PetscInt               im_active=-1,active_procs=-1;
3119f9eb5b7dSStefano Zampini   PC                     pc_temp;
3120c8587f34SStefano Zampini   PCType                 coarse_pc_type;
3121c8587f34SStefano Zampini   KSPType                coarse_ksp_type;
3122f9eb5b7dSStefano Zampini   PetscBool              multilevel_requested,multilevel_allowed;
3123fa7f1dd8SStefano Zampini   PetscBool              setsym,issym,isbddc,isnn,coarse_reuse;
3124f9eb5b7dSStefano Zampini   MatStructure           matstruct;
31259881197aSStefano Zampini   PetscErrorCode         ierr;
3126fdc09c96SStefano Zampini 
3127c8587f34SStefano Zampini   PetscFunctionBegin;
3128c8587f34SStefano Zampini   /* Assign global numbering to coarse dofs */
3129fa7f1dd8SStefano Zampini   if (pcbddc->new_primal_space) { /* a new primal space is present, so recompute global numbering */
3130fa7f1dd8SStefano Zampini     PetscInt ocoarse_size;
3131fa7f1dd8SStefano Zampini     ocoarse_size = pcbddc->coarse_size;
3132f4ddd8eeSStefano Zampini     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3133f4ddd8eeSStefano Zampini     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
3134f4ddd8eeSStefano Zampini     /* see if we can avoid some work */
3135fa7f1dd8SStefano Zampini     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
3136fa7f1dd8SStefano Zampini       if (ocoarse_size != pcbddc->coarse_size) { /* ...but with different size, so reset it and set reuse flag to false */
3137727cdba6SStefano Zampini         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3138fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_FALSE;
3139fa7f1dd8SStefano Zampini       } else { /* we can safely reuse already computed coarse matrix */
3140fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_TRUE;
3141f4ddd8eeSStefano Zampini       }
3142fa7f1dd8SStefano Zampini     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
3143fa7f1dd8SStefano Zampini       coarse_reuse = PETSC_FALSE;
3144f4ddd8eeSStefano Zampini     }
3145fa7f1dd8SStefano Zampini   } else { /* primal space has not been changed, so we can reuse coarse matrix */
3146fa7f1dd8SStefano Zampini     coarse_reuse = PETSC_TRUE;
3147f4ddd8eeSStefano Zampini   }
3148c8587f34SStefano Zampini 
3149f9eb5b7dSStefano Zampini   /* infer some info from user */
3150f9eb5b7dSStefano Zampini   issym = PETSC_FALSE;
3151f9eb5b7dSStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
3152f9eb5b7dSStefano Zampini   multilevel_allowed = PETSC_FALSE;
3153f9eb5b7dSStefano Zampini   multilevel_requested = PETSC_FALSE;
3154f9eb5b7dSStefano Zampini   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
3155f9eb5b7dSStefano Zampini   if (multilevel_requested) {
31562b510759SStefano Zampini     /* count "active processes" */
31572b510759SStefano Zampini     im_active = !!(pcis->n);
31582b510759SStefano Zampini     ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
31592b510759SStefano Zampini     if (active_procs/pcbddc->coarsening_ratio < 2) {
3160f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_FALSE;
31612b510759SStefano Zampini     } else {
3162f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_TRUE;
3163c8587f34SStefano Zampini     }
3164c8587f34SStefano Zampini   }
3165e7931f94SStefano Zampini 
3166f9eb5b7dSStefano Zampini   /* set defaults for coarse KSP and PC */
3167f9eb5b7dSStefano Zampini   if (multilevel_allowed) {
3168c8587f34SStefano Zampini     if (issym) {
3169f9eb5b7dSStefano Zampini       coarse_ksp_type = KSPRICHARDSON;
3170f9eb5b7dSStefano Zampini     } else {
3171f9eb5b7dSStefano Zampini       coarse_ksp_type = KSPCHEBYSHEV;
3172c8587f34SStefano Zampini     }
3173f9eb5b7dSStefano Zampini     coarse_pc_type = PCBDDC;
3174f9eb5b7dSStefano Zampini   } else {
3175f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPPREONLY;
3176f9eb5b7dSStefano Zampini     coarse_pc_type = PCREDUNDANT;
3177c8587f34SStefano Zampini   }
3178c8587f34SStefano Zampini 
3179f9eb5b7dSStefano Zampini   /* create the coarse KSP object only once with defaults */
3180f9eb5b7dSStefano Zampini   if (!pcbddc->coarse_ksp) {
3181e604994aSStefano Zampini     char prefix[256],str_level[3];
3182e604994aSStefano Zampini     size_t len;
3183f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_ksp);CHKERRQ(ierr);
3184c8587f34SStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
3185f9eb5b7dSStefano Zampini     ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
3186c8587f34SStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
3187c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3188c8587f34SStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
3189e604994aSStefano Zampini     /* prefix */
3190e604994aSStefano Zampini     ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
3191e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
3192e604994aSStefano Zampini     if (!pcbddc->current_level) {
3193e604994aSStefano Zampini       ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
3194e604994aSStefano Zampini       ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
3195c8587f34SStefano Zampini     } else {
3196e604994aSStefano Zampini       ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
3197e604994aSStefano Zampini       if (pcbddc->current_level>1) len -= 2;
3198e604994aSStefano Zampini       ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
3199e604994aSStefano Zampini       *(prefix+len)='\0';
3200e604994aSStefano Zampini       sprintf(str_level,"%d_",(int)(pcbddc->current_level));
3201e604994aSStefano Zampini       ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
3202e604994aSStefano Zampini     }
3203e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
3204f9eb5b7dSStefano Zampini   }
3205f9eb5b7dSStefano Zampini   /* allow user customization */
320685c4d303SStefano 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); */
3207f9eb5b7dSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
320885c4d303SStefano 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); */
3209f9eb5b7dSStefano Zampini 
3210f9eb5b7dSStefano Zampini   /* get some info after set from options */
3211f9eb5b7dSStefano Zampini   ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3212f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
3213f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
3214f9eb5b7dSStefano Zampini   if (isbddc && !multilevel_allowed) { /* prevent from infinite loop if user as requested bddc pc for coarse solver */
3215f9eb5b7dSStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
3216f9eb5b7dSStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
3217f9eb5b7dSStefano Zampini     isbddc = PETSC_FALSE;
3218f9eb5b7dSStefano Zampini   }
3219f9eb5b7dSStefano Zampini 
3220f9eb5b7dSStefano Zampini   /* propagate BDDC info to the next level */
3221f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
3222f9eb5b7dSStefano Zampini   ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
3223f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
3224f9eb5b7dSStefano Zampini 
3225f9eb5b7dSStefano Zampini   /* creates temporary MATIS object for coarse matrix */
3226f4ddd8eeSStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
3227a57a6d2fSStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
3228a57a6d2fSStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
3229f4ddd8eeSStefano Zampini   ierr = MatCreateIS(PetscObjectComm((PetscObject)pc),1,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size,coarse_islg,&coarse_mat_is);CHKERRQ(ierr);
3230a57a6d2fSStefano Zampini   ierr = MatISSetLocalMat(coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
3231e7931f94SStefano Zampini   ierr = MatAssemblyBegin(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3232e7931f94SStefano Zampini   ierr = MatAssemblyEnd(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
323320a2ab83SStefano Zampini   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
323420a2ab83SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
3235fdc09c96SStefano Zampini 
3236f9eb5b7dSStefano Zampini   /* assemble coarse matrix */
3237f9eb5b7dSStefano Zampini   if (isbddc || isnn) {
3238f9eb5b7dSStefano Zampini     ierr = MatISSubassemble(coarse_mat_is,NULL,pcbddc->coarsening_ratio,&coarse_mat);CHKERRQ(ierr);
3239fa7f1dd8SStefano Zampini   } else {
3240fa7f1dd8SStefano Zampini     if (coarse_reuse) {
3241fa7f1dd8SStefano Zampini       ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL,NULL);CHKERRQ(ierr);
3242fa7f1dd8SStefano Zampini       ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
3243fa7f1dd8SStefano Zampini       ierr = MatISGetMPIXAIJ(coarse_mat_is,MATMPIAIJ,MAT_REUSE_MATRIX,&coarse_mat);CHKERRQ(ierr);
3244fa7f1dd8SStefano Zampini     } else {
3245fa7f1dd8SStefano Zampini       ierr = MatISGetMPIXAIJ(coarse_mat_is,MATMPIAIJ,MAT_INITIAL_MATRIX,&coarse_mat);CHKERRQ(ierr);
3246fa7f1dd8SStefano Zampini     }
3247c8587f34SStefano Zampini   }
32482b510759SStefano Zampini   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
32499881197aSStefano Zampini 
3250f9eb5b7dSStefano Zampini   /* create local to global scatters for coarse problem */
3251f4ddd8eeSStefano Zampini   if (pcbddc->new_primal_space) {
3252f4ddd8eeSStefano Zampini     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3253f4ddd8eeSStefano Zampini     ierr = VecDestroy(&pcbddc->coarse_rhs);CHKERRQ(ierr);
3254f4ddd8eeSStefano Zampini     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3255f9eb5b7dSStefano Zampini     ierr = MatGetVecs(coarse_mat,&pcbddc->coarse_vec,&pcbddc->coarse_rhs);CHKERRQ(ierr);
3256f9eb5b7dSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3257f4ddd8eeSStefano Zampini   }
3258f9eb5b7dSStefano Zampini   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
3259f9eb5b7dSStefano Zampini 
3260f9eb5b7dSStefano Zampini   /* propagate symmetry info to coarse matrix */
3261f9eb5b7dSStefano Zampini   ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,issym);CHKERRQ(ierr);
3262f9eb5b7dSStefano Zampini 
3263b8ffe317SStefano Zampini   /* Compute coarse null space (special handling by BDDC only) */
3264b8ffe317SStefano Zampini   if (pcbddc->NullSpace) {
3265b8ffe317SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCoarse(pc,coarse_mat,&CoarseNullSpace);CHKERRQ(ierr);
3266b8ffe317SStefano Zampini     if (isbddc) {
3267b8ffe317SStefano Zampini       ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
3268b8ffe317SStefano Zampini     } else {
3269c8587f34SStefano Zampini       ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
3270c8587f34SStefano Zampini     }
3271c8587f34SStefano Zampini   }
3272c8587f34SStefano Zampini 
3273f9eb5b7dSStefano Zampini   /* set operators */
3274f9eb5b7dSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
3275f9eb5b7dSStefano Zampini   ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat,matstruct);CHKERRQ(ierr);
3276f9eb5b7dSStefano Zampini 
3277f9eb5b7dSStefano Zampini   /* additional KSP customization */
3278f9eb5b7dSStefano Zampini   ierr = KSPGetTolerances(pcbddc->coarse_ksp,NULL,NULL,NULL,&max_it);CHKERRQ(ierr);
3279f9eb5b7dSStefano Zampini   if (max_it < 5) {
3280c8587f34SStefano Zampini     ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
3281f9eb5b7dSStefano Zampini   }
3282b8ffe317SStefano Zampini   /* ierr = KSPChebyshevSetEstimateEigenvalues(pcbddc->coarse_ksp,1.0,0.0,0.0,1.1);CHKERRQ(ierr); */
3283f9eb5b7dSStefano Zampini 
3284f9eb5b7dSStefano Zampini 
3285f9eb5b7dSStefano Zampini   /* print some info if requested */
3286f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
3287f9eb5b7dSStefano Zampini     ierr = KSPGetType(pcbddc->coarse_ksp,&coarse_ksp_type);CHKERRQ(ierr);
3288f9eb5b7dSStefano Zampini     ierr = PCGetType(pc_temp,&coarse_pc_type);CHKERRQ(ierr);
3289f9eb5b7dSStefano Zampini     if (!multilevel_allowed) {
3290f9eb5b7dSStefano Zampini       if (multilevel_requested) {
3291f9eb5b7dSStefano 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);
3292f9eb5b7dSStefano Zampini       } else if (pcbddc->max_levels) {
3293f9eb5b7dSStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
3294c8587f34SStefano Zampini       }
3295c8587f34SStefano Zampini     }
3296e604994aSStefano 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);
3297f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3298c8587f34SStefano Zampini   }
3299f9eb5b7dSStefano Zampini 
3300f9eb5b7dSStefano Zampini   /* setup coarse ksp */
3301f9eb5b7dSStefano Zampini   ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
3302f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
3303f9eb5b7dSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
3304f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3305f9eb5b7dSStefano Zampini     ierr = KSPView(pcbddc->coarse_ksp,pcbddc->dbg_viewer);CHKERRQ(ierr);
3306f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3307f9eb5b7dSStefano Zampini   }
3308f9eb5b7dSStefano Zampini 
3309c8587f34SStefano Zampini   /* Check coarse problem if requested */
331020a2ab83SStefano Zampini   if (pcbddc->dbg_flag) {
3311c8587f34SStefano Zampini     KSP       check_ksp;
33122b510759SStefano Zampini     KSPType   check_ksp_type;
3313c8587f34SStefano Zampini     PC        check_pc;
3314c8587f34SStefano Zampini     Vec       check_vec;
3315c8587f34SStefano Zampini     PetscReal abs_infty_error,infty_error,lambda_min,lambda_max;
33162b510759SStefano Zampini     PetscInt  its;
3317f9eb5b7dSStefano Zampini     PetscBool ispreonly,compute;
3318c8587f34SStefano Zampini 
33192b510759SStefano Zampini     /* Create ksp object suitable for estimation of extreme eigenvalues */
3320f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&check_ksp);CHKERRQ(ierr);
3321fdc635d7SStefano Zampini     ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
3322f4ddd8eeSStefano Zampini     ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
33232b510759SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
33242b510759SStefano Zampini     if (ispreonly) {
33252b510759SStefano Zampini       check_ksp_type = KSPPREONLY;
3326f9eb5b7dSStefano Zampini       compute = PETSC_FALSE;
33272b510759SStefano Zampini     } else {
3328c8587f34SStefano Zampini       if (issym) check_ksp_type = KSPCG;
3329c8587f34SStefano Zampini       else check_ksp_type = KSPGMRES;
3330f9eb5b7dSStefano Zampini       compute = PETSC_TRUE;
3331c8587f34SStefano Zampini     }
3332c8587f34SStefano Zampini     ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
3333f9eb5b7dSStefano Zampini     ierr = KSPSetComputeSingularValues(check_ksp,compute);CHKERRQ(ierr);
3334c8587f34SStefano Zampini     ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
3335c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
3336c8587f34SStefano Zampini     ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
3337c8587f34SStefano Zampini     /* create random vec */
3338c8587f34SStefano Zampini     ierr = VecDuplicate(pcbddc->coarse_vec,&check_vec);CHKERRQ(ierr);
3339c8587f34SStefano Zampini     ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
3340c8587f34SStefano Zampini     if (CoarseNullSpace) {
3341c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec);CHKERRQ(ierr);
3342c8587f34SStefano Zampini     }
3343fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3344c8587f34SStefano Zampini     /* solve coarse problem */
3345c8587f34SStefano Zampini     ierr = KSPSolve(check_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
3346c8587f34SStefano Zampini     if (CoarseNullSpace) {
3347c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,pcbddc->coarse_vec);CHKERRQ(ierr);
3348c8587f34SStefano Zampini     }
3349c8587f34SStefano Zampini     /* check coarse problem residual error */
3350c8587f34SStefano Zampini     ierr = VecAXPY(check_vec,-1.0,pcbddc->coarse_vec);CHKERRQ(ierr);
3351c8587f34SStefano Zampini     ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3352fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3353c8587f34SStefano Zampini     ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
3354c8587f34SStefano Zampini     ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
3355e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem (%s) details\n",((PetscObject)(pcbddc->coarse_ksp))->prefix);CHKERRQ(ierr);
3356e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
3357e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
3358f9eb5b7dSStefano Zampini     /* get eigenvalue estimation if preonly has not been requested */
33592b510759SStefano Zampini     if (!ispreonly) {
3360c8587f34SStefano Zampini       ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
336120a2ab83SStefano Zampini       ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
3362f9eb5b7dSStefano 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);
3363c8587f34SStefano Zampini     }
33642b510759SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3365c8587f34SStefano Zampini     ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
3366c8587f34SStefano Zampini   }
33672b510759SStefano Zampini   /* free memory */
3368c8587f34SStefano Zampini   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
3369fdc635d7SStefano Zampini   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
3370c8587f34SStefano Zampini   PetscFunctionReturn(0);
3371c8587f34SStefano Zampini }
3372674ae819SStefano Zampini 
3373f34684f1SStefano Zampini #undef __FUNCT__
3374f34684f1SStefano Zampini #define __FUNCT__ "PCBDDCComputePrimalNumbering"
3375f34684f1SStefano Zampini PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
3376f34684f1SStefano Zampini {
3377f34684f1SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3378f34684f1SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
3379f34684f1SStefano Zampini   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
3380727cdba6SStefano Zampini   PetscInt       i,coarse_size;
3381727cdba6SStefano Zampini   PetscInt       *local_primal_indices;
3382f34684f1SStefano Zampini   PetscErrorCode ierr;
3383f34684f1SStefano Zampini 
3384f34684f1SStefano Zampini   PetscFunctionBegin;
3385f34684f1SStefano Zampini   /* Compute global number of coarse dofs */
3386727cdba6SStefano Zampini   if (!pcbddc->primal_indices_local_idxs) {
3387727cdba6SStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Constraint matrix has not been created");
3388727cdba6SStefano Zampini   }
3389727cdba6SStefano 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);
3390f34684f1SStefano Zampini 
3391f34684f1SStefano Zampini   /* check numbering */
3392f34684f1SStefano Zampini   if (pcbddc->dbg_flag) {
3393f34684f1SStefano Zampini     PetscScalar coarsesum,*array;
3394f34684f1SStefano Zampini 
3395f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3396f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3397f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
33980fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
3399f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
3400f34684f1SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
3401727cdba6SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
3402f34684f1SStefano Zampini     }
3403f34684f1SStefano Zampini     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
3404f34684f1SStefano Zampini     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
3405f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3406f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3407f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3408f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3409f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3410f34684f1SStefano Zampini     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3411f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3412f34684f1SStefano Zampini       if (array[i] == 1.0) {
3413f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %d owned by a single process!\n",PetscGlobalRank,i);CHKERRQ(ierr);
3414f34684f1SStefano Zampini       }
3415f34684f1SStefano Zampini     }
3416f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3417f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3418f34684f1SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
3419f34684f1SStefano Zampini     }
3420f34684f1SStefano Zampini     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3421f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3422f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3423f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3424f34684f1SStefano Zampini     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
3425f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
3426f34684f1SStefano Zampini     if (pcbddc->dbg_flag > 1) {
3427f34684f1SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
3428f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3429f34684f1SStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
3430f34684f1SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
3431727cdba6SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_primal_indices[%d]=%d (%d)\n",i,local_primal_indices[i],pcbddc->primal_indices_local_idxs[i]);
3432f34684f1SStefano Zampini       }
3433f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3434f34684f1SStefano Zampini     }
3435f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3436f34684f1SStefano Zampini   }
3437f34684f1SStefano Zampini   /* get back data */
3438f34684f1SStefano Zampini   *coarse_size_n = coarse_size;
3439f34684f1SStefano Zampini   *local_primal_indices_n = local_primal_indices;
3440674ae819SStefano Zampini   PetscFunctionReturn(0);
3441674ae819SStefano Zampini }
3442674ae819SStefano Zampini 
3443