xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 0fccc4e98666fc3c2e77ab3ab9d22451f3cfa808)
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 */
22*0fccc4e9SStefano 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;
19088ebb749SStefano Zampini   ISLocalToGlobalMapping BtoNmap;
19125084f0cSStefano Zampini   PetscScalar            *coarse_submat_vals; /* TODO: use a PETSc matrix */
19225084f0cSStefano Zampini   const PetscScalar      *array,*row_cmat_values;
19325084f0cSStefano Zampini   const PetscInt         *row_cmat_indices,*idx_R_local;
19425084f0cSStefano Zampini   PetscInt               *vertices,*idx_V_B,*auxindices;
19525084f0cSStefano Zampini   PetscInt               n_vertices,n_constraints,size_of_constraint;
19625084f0cSStefano Zampini   PetscInt               i,j,n_R,n_D,n_B;
19788ebb749SStefano Zampini   PetscBool              setsym=PETSC_FALSE,issym=PETSC_FALSE;
19845a1bb75SStefano Zampini   /* matrix type (vector type propagated downstream from vec1_C and local matrix type) */
19988ebb749SStefano Zampini   MatType                impMatType;
20025084f0cSStefano Zampini   /* some shortcuts to scalars */
20125084f0cSStefano Zampini   PetscScalar            zero=0.0,one=1.0,m_one=-1.0;
20225084f0cSStefano Zampini   /* for debugging purposes */
20388ebb749SStefano Zampini   PetscReal              *coarsefunctions_errors,*constraints_errors;
20488ebb749SStefano Zampini 
20588ebb749SStefano Zampini   PetscFunctionBegin;
20625084f0cSStefano Zampini   /* get number of vertices and their local indices */
20725084f0cSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
20888ebb749SStefano Zampini   n_constraints = pcbddc->local_primal_size-n_vertices;
20988ebb749SStefano Zampini   /* Set Non-overlapping dimensions */
21088ebb749SStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
21188ebb749SStefano Zampini   n_R = pcis->n-n_vertices;
21288ebb749SStefano Zampini 
21388ebb749SStefano Zampini   /* Set types for local objects needed by BDDC precondtioner */
21488ebb749SStefano Zampini   impMatType = MATSEQDENSE;
21588ebb749SStefano Zampini 
21688ebb749SStefano Zampini   /* Allocating some extra storage just to be safe */
21788ebb749SStefano Zampini   ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&auxindices);CHKERRQ(ierr);
21888ebb749SStefano Zampini   for (i=0;i<pcis->n;i++) auxindices[i]=i;
21988ebb749SStefano Zampini 
22088ebb749SStefano Zampini   /* vertices in boundary numbering */
22188ebb749SStefano Zampini   ierr = PetscMalloc(n_vertices*sizeof(PetscInt),&idx_V_B);CHKERRQ(ierr);
22288ebb749SStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(pcis->is_B_local,&BtoNmap);CHKERRQ(ierr);
22388ebb749SStefano Zampini   ierr = ISGlobalToLocalMappingApply(BtoNmap,IS_GTOLM_DROP,n_vertices,vertices,&i,idx_V_B);CHKERRQ(ierr);
22488ebb749SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&BtoNmap);CHKERRQ(ierr);
22588ebb749SStefano Zampini   if (i != n_vertices) {
22688ebb749SStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %d != %d\n",n_vertices,i);
22788ebb749SStefano Zampini   }
22888ebb749SStefano Zampini 
22988ebb749SStefano Zampini   /* Precompute stuffs needed for preprocessing and application of BDDC*/
23088ebb749SStefano Zampini   if (n_constraints) {
231f4ddd8eeSStefano Zampini     /* see if we can save some allocations */
232f4ddd8eeSStefano Zampini     if (pcbddc->local_auxmat2) {
233f4ddd8eeSStefano Zampini       PetscInt on_R,on_constraints;
234f4ddd8eeSStefano Zampini       ierr = MatGetSize(pcbddc->local_auxmat2,&on_R,&on_constraints);CHKERRQ(ierr);
235f4ddd8eeSStefano Zampini       if (on_R != n_R || on_constraints != n_constraints) {
236f4ddd8eeSStefano Zampini         ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
237f4ddd8eeSStefano Zampini         ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
238f4ddd8eeSStefano Zampini       }
239f4ddd8eeSStefano Zampini     }
24045a1bb75SStefano Zampini     /* work vectors */
24145a1bb75SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec1_C);CHKERRQ(ierr);
24245a1bb75SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec2_C);CHKERRQ(ierr);
24345a1bb75SStefano Zampini     /* auxiliary matrices */
244f4ddd8eeSStefano Zampini     if (!pcbddc->local_auxmat2) {
24588ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->local_auxmat2);CHKERRQ(ierr);
24625084f0cSStefano Zampini       ierr = MatSetSizes(pcbddc->local_auxmat2,n_R,n_constraints,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
24788ebb749SStefano Zampini       ierr = MatSetType(pcbddc->local_auxmat2,impMatType);CHKERRQ(ierr);
24825084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->local_auxmat2);CHKERRQ(ierr);
249f4ddd8eeSStefano Zampini     }
25088ebb749SStefano Zampini 
25125084f0cSStefano Zampini     /* Extract constraints on R nodes: C_{CR}  */
25225084f0cSStefano Zampini     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
2538ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
25425084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
25588ebb749SStefano Zampini 
25688ebb749SStefano Zampini     /* Assemble local_auxmat2 = - A_{RR}^{-1} C^T_{CR} needed by BDDC application */
25788ebb749SStefano Zampini     for (i=0;i<n_constraints;i++) {
25888ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
25988ebb749SStefano Zampini       /* Get row of constraint matrix in R numbering */
26025084f0cSStefano Zampini       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
26125084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_R,size_of_constraint,row_cmat_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
26225084f0cSStefano Zampini       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
26325084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_R);CHKERRQ(ierr);
26425084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_R);CHKERRQ(ierr);
26588ebb749SStefano Zampini       /* Solve for row of constraint matrix in R numbering */
26688ebb749SStefano Zampini       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
26725084f0cSStefano Zampini       /* Set values in local_auxmat2 */
26825084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
26988ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->local_auxmat2,n_R,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
27025084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
27188ebb749SStefano Zampini     }
27288ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
27388ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
27425084f0cSStefano Zampini     ierr = MatScale(pcbddc->local_auxmat2,m_one);CHKERRQ(ierr);
27588ebb749SStefano Zampini 
27688ebb749SStefano Zampini     /* Assemble explicitly M1 = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1} needed in preproc  */
27725084f0cSStefano Zampini     ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
27825084f0cSStefano Zampini     ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
27988ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&M1);CHKERRQ(ierr);
28088ebb749SStefano Zampini     ierr = MatSetSizes(M1,n_constraints,n_constraints,n_constraints,n_constraints);CHKERRQ(ierr);
28188ebb749SStefano Zampini     ierr = MatSetType(M1,impMatType);CHKERRQ(ierr);
28225084f0cSStefano Zampini     ierr = MatSetUp(M1);CHKERRQ(ierr);
28325084f0cSStefano Zampini     ierr = MatDuplicate(M1,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
28425084f0cSStefano Zampini     ierr = MatZeroEntries(M2);CHKERRQ(ierr);
28525084f0cSStefano Zampini     ierr = VecSet(vec1_C,m_one);CHKERRQ(ierr);
28625084f0cSStefano Zampini     ierr = MatDiagonalSet(M2,vec1_C,INSERT_VALUES);CHKERRQ(ierr);
28725084f0cSStefano Zampini     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
28825084f0cSStefano Zampini     ierr = MatDestroy(&M2);CHKERRQ(ierr);
28925084f0cSStefano Zampini     ierr = MatDestroy(&M3);CHKERRQ(ierr);
29088ebb749SStefano Zampini     /* Assemble local_auxmat1 = M1*C_{CR} needed by BDDC application in KSP and in preproc */
291f4ddd8eeSStefano Zampini     if (!pcbddc->local_auxmat1) {
29288ebb749SStefano Zampini       ierr = MatMatMult(M1,C_CR,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
293f4ddd8eeSStefano Zampini     } else {
294f4ddd8eeSStefano Zampini       ierr = MatMatMult(M1,C_CR,MAT_REUSE_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
295f4ddd8eeSStefano Zampini     }
29688ebb749SStefano Zampini   }
29788ebb749SStefano Zampini 
29888ebb749SStefano Zampini   /* Get submatrices from subdomain matrix */
29988ebb749SStefano Zampini   if (n_vertices) {
3003a50541eSStefano Zampini     PetscInt ibs,mbs;
3013a50541eSStefano Zampini     PetscBool issbaij;
302af732b37SStefano Zampini     Mat newmat;
3033a50541eSStefano Zampini 
3043a50541eSStefano Zampini     ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
3059577ea80SStefano Zampini     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
3069577ea80SStefano Zampini     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
3073a50541eSStefano Zampini     if (ibs != mbs) { /* need to convert to SEQAIJ */
3089577ea80SStefano Zampini       ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
3099577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3109577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3119577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3129577ea80SStefano Zampini       ierr = MatDestroy(&newmat);CHKERRQ(ierr);
3139577ea80SStefano Zampini     } else {
3143a50541eSStefano Zampini       /* this is safe */
3159577ea80SStefano Zampini       ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3163a50541eSStefano Zampini       ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
3173a50541eSStefano Zampini       if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
3183a50541eSStefano Zampini         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
31945a1bb75SStefano Zampini         /* which of the two approaches is faster? */
3203a50541eSStefano Zampini         /* ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3213a50541eSStefano Zampini         ierr = MatCreateTranspose(A_RV,&A_VR);CHKERRQ(ierr);*/
3223a50541eSStefano Zampini         ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3233a50541eSStefano Zampini         ierr = MatCreateTranspose(A_VR,&A_RV);CHKERRQ(ierr);
3243a50541eSStefano Zampini         ierr = MatDestroy(&newmat);CHKERRQ(ierr);
3253a50541eSStefano Zampini       } else {
3269577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3279577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3289577ea80SStefano Zampini       }
3293a50541eSStefano Zampini     }
33045a1bb75SStefano Zampini     ierr = MatGetVecs(A_RV,&vec1_V,NULL);CHKERRQ(ierr);
33145a1bb75SStefano Zampini     ierr = VecDuplicate(vec1_V,&vec2_V);CHKERRQ(ierr);
33225084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
33388ebb749SStefano Zampini   }
33488ebb749SStefano Zampini 
33588ebb749SStefano Zampini   /* Matrix of coarse basis functions (local) */
336f4ddd8eeSStefano Zampini   if (pcbddc->coarse_phi_B) {
337f4ddd8eeSStefano Zampini     PetscInt on_B,on_primal;
338f4ddd8eeSStefano Zampini     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
339f4ddd8eeSStefano Zampini     if (on_B != n_B || on_primal != pcbddc->local_primal_size) {
340f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
341f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
342f4ddd8eeSStefano Zampini     }
343f4ddd8eeSStefano Zampini   }
344f4ddd8eeSStefano Zampini   if (pcbddc->coarse_phi_D) {
345f4ddd8eeSStefano Zampini     PetscInt on_D,on_primal;
346f4ddd8eeSStefano Zampini     ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,&on_primal);CHKERRQ(ierr);
347f4ddd8eeSStefano Zampini     if (on_D != n_D || on_primal != pcbddc->local_primal_size) {
348f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
349f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
350f4ddd8eeSStefano Zampini     }
351f4ddd8eeSStefano Zampini   }
352f4ddd8eeSStefano Zampini   if (!pcbddc->coarse_phi_B) {
35388ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
35488ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_phi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
35588ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_phi_B,impMatType);CHKERRQ(ierr);
35625084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_phi_B);CHKERRQ(ierr);
357f4ddd8eeSStefano Zampini   }
358f4ddd8eeSStefano Zampini   if ( (pcbddc->switch_static || pcbddc->dbg_flag) && !pcbddc->coarse_phi_D ) {
35988ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
36088ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_phi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
36188ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_phi_D,impMatType);CHKERRQ(ierr);
36225084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_phi_D);CHKERRQ(ierr);
36388ebb749SStefano Zampini   }
36488ebb749SStefano Zampini 
36525084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
3668ce42a96SStefano Zampini     ierr = ISGetIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
36788ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*coarsefunctions_errors),&coarsefunctions_errors);CHKERRQ(ierr);
36888ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*constraints_errors),&constraints_errors);CHKERRQ(ierr);
36988ebb749SStefano Zampini   }
37088ebb749SStefano Zampini   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
37188ebb749SStefano Zampini   ierr = PetscMalloc((pcbddc->local_primal_size)*(pcbddc->local_primal_size)*sizeof(PetscScalar),&coarse_submat_vals);CHKERRQ(ierr);
37288ebb749SStefano Zampini 
37388ebb749SStefano Zampini   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
37425084f0cSStefano Zampini 
37525084f0cSStefano Zampini   /* vertices */
37688ebb749SStefano Zampini   for (i=0;i<n_vertices;i++) {
37745a1bb75SStefano Zampini     /* this should not be needed, but MatMult_BAIJ is broken when using compressed row routines */
378f4ddd8eeSStefano Zampini     ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr); /* TODO: REMOVE IT */
37988ebb749SStefano Zampini     ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
38088ebb749SStefano Zampini     ierr = VecSetValue(vec1_V,i,one,INSERT_VALUES);CHKERRQ(ierr);
38188ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
38288ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
38325084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on constraints multipliers */
38488ebb749SStefano Zampini     ierr = MatMult(A_RV,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
38588ebb749SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
38688ebb749SStefano Zampini     ierr = VecScale(pcbddc->vec1_R,m_one);CHKERRQ(ierr);
38788ebb749SStefano Zampini     if (n_constraints) {
38888ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec1_R,vec1_C);CHKERRQ(ierr);
38988ebb749SStefano Zampini       ierr = MatMultAdd(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
39088ebb749SStefano Zampini       ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
39188ebb749SStefano Zampini     }
39288ebb749SStefano Zampini     ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
39388ebb749SStefano Zampini     ierr = MatMultAdd(A_VV,vec1_V,vec2_V,vec2_V);CHKERRQ(ierr);
39488ebb749SStefano Zampini 
39588ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
39688ebb749SStefano Zampini     /* coarse basis functions */
39788ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
39888ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
39988ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40025084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
40188ebb749SStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
40225084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
40388ebb749SStefano Zampini     ierr = MatSetValue(pcbddc->coarse_phi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
4048eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
40588ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40688ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40725084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
40888ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
40925084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
41088ebb749SStefano Zampini     }
41125084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
41225084f0cSStefano Zampini     ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
41325084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
41425084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
41588ebb749SStefano Zampini     if (n_constraints) {
41625084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
41725084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
41825084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
41988ebb749SStefano Zampini     }
42088ebb749SStefano Zampini 
42125084f0cSStefano Zampini     /* check */
42225084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
42325084f0cSStefano Zampini       /* assemble subdomain vector on local nodes */
42488ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
42525084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
42625084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
42725084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
42825084f0cSStefano Zampini       ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
42925084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
43025084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
43188ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers (i.e. primal nodes) */
43288ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
43325084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
43425084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
43525084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
43688ebb749SStefano Zampini       if (n_constraints) {
43725084f0cSStefano Zampini         ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
43825084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
43925084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
44088ebb749SStefano Zampini       }
44125084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
44225084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
44388ebb749SStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
44488ebb749SStefano Zampini       /* check saddle point solution */
44588ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
44688ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
44788ebb749SStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i]);CHKERRQ(ierr);
44888ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
44925084f0cSStefano Zampini       /* shift by the identity matrix */
45025084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
45125084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
45225084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
45388ebb749SStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i]);CHKERRQ(ierr);
45488ebb749SStefano Zampini     }
45588ebb749SStefano Zampini   }
45688ebb749SStefano Zampini 
45725084f0cSStefano Zampini   /* constraints */
45888ebb749SStefano Zampini   for (i=0;i<n_constraints;i++) {
45988ebb749SStefano Zampini     ierr = VecSet(vec2_C,zero);CHKERRQ(ierr);
46088ebb749SStefano Zampini     ierr = VecSetValue(vec2_C,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
46188ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec2_C);CHKERRQ(ierr);
46288ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec2_C);CHKERRQ(ierr);
46325084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on vertices multipliers */
46488ebb749SStefano Zampini     ierr = MatMult(M1,vec2_C,vec1_C);CHKERRQ(ierr);
46588ebb749SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
46688ebb749SStefano Zampini     ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
46725084f0cSStefano Zampini     if (n_vertices) {
46825084f0cSStefano Zampini       ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
46925084f0cSStefano Zampini     }
47088ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
47188ebb749SStefano Zampini     /* coarse basis functions */
47225084f0cSStefano Zampini     j = i+n_vertices; /* don't touch this! */
47388ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
47488ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
47588ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
47625084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
47725084f0cSStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
47825084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
4798eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
48088ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
48188ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
48225084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
48325084f0cSStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
48425084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
48588ebb749SStefano Zampini     }
48625084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
48788ebb749SStefano Zampini     if (n_vertices) {
48825084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
48925084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
49025084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
49188ebb749SStefano Zampini     }
49225084f0cSStefano Zampini     ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
49325084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
49425084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
49588ebb749SStefano Zampini 
49625084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
49788ebb749SStefano Zampini       /* assemble subdomain vector on nodes */
49888ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
49925084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
50025084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
50125084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
50225084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
50325084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
50488ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers */
50588ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
50688ebb749SStefano Zampini       if (n_vertices) {
50725084f0cSStefano Zampini         ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
50825084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
50925084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
51088ebb749SStefano Zampini       }
51125084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
51225084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
51325084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
51425084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
51525084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
51625084f0cSStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
51788ebb749SStefano Zampini       /* check saddle point solution */
51888ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
51988ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
52025084f0cSStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[j]);CHKERRQ(ierr);
52188ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
52225084f0cSStefano Zampini       /* shift by the identity matrix */
52325084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,j,m_one,ADD_VALUES);CHKERRQ(ierr);
52425084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
52525084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
52625084f0cSStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[j]);CHKERRQ(ierr);
52788ebb749SStefano Zampini     }
52888ebb749SStefano Zampini   }
52925084f0cSStefano Zampini   /* call assembling routines for local coarse basis */
53088ebb749SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
53188ebb749SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5328eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
53388ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
53488ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
53588ebb749SStefano Zampini   }
53625084f0cSStefano Zampini 
53788ebb749SStefano Zampini   /* compute other basis functions for non-symmetric problems */
53888ebb749SStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
53988ebb749SStefano Zampini   if (!setsym || (setsym && !issym)) {
540f4ddd8eeSStefano Zampini     if (!pcbddc->coarse_psi_B) {
54188ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
54288ebb749SStefano Zampini       ierr = MatSetSizes(pcbddc->coarse_psi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
54388ebb749SStefano Zampini       ierr = MatSetType(pcbddc->coarse_psi_B,impMatType);CHKERRQ(ierr);
54425084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->coarse_psi_B);CHKERRQ(ierr);
545f4ddd8eeSStefano Zampini     }
546f4ddd8eeSStefano Zampini     if ( (pcbddc->switch_static || pcbddc->dbg_flag) && !pcbddc->coarse_psi_D) {
54788ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
54888ebb749SStefano Zampini       ierr = MatSetSizes(pcbddc->coarse_psi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
54988ebb749SStefano Zampini       ierr = MatSetType(pcbddc->coarse_psi_D,impMatType);CHKERRQ(ierr);
55025084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->coarse_psi_D);CHKERRQ(ierr);
55188ebb749SStefano Zampini     }
55288ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
55388ebb749SStefano Zampini       if (n_constraints) {
55488ebb749SStefano Zampini         ierr = VecSet(vec1_C,zero);CHKERRQ(ierr);
55588ebb749SStefano Zampini         for (j=0;j<n_constraints;j++) {
55625084f0cSStefano Zampini           ierr = VecSetValue(vec1_C,j,coarse_submat_vals[(j+n_vertices)*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
55788ebb749SStefano Zampini         }
55825084f0cSStefano Zampini         ierr = VecAssemblyBegin(vec1_C);CHKERRQ(ierr);
55925084f0cSStefano Zampini         ierr = VecAssemblyEnd(vec1_C);CHKERRQ(ierr);
56088ebb749SStefano Zampini       }
56188ebb749SStefano Zampini       if (i<n_vertices) {
56288ebb749SStefano Zampini         ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
56388ebb749SStefano Zampini         ierr = VecSetValue(vec1_V,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
56488ebb749SStefano Zampini         ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
56588ebb749SStefano Zampini         ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
56688ebb749SStefano Zampini         ierr = MatMultTranspose(A_VR,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
56788ebb749SStefano Zampini         if (n_constraints) {
56888ebb749SStefano Zampini           ierr = MatMultTransposeAdd(C_CR,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
56988ebb749SStefano Zampini         }
57088ebb749SStefano Zampini       } else {
57188ebb749SStefano Zampini         ierr = MatMultTranspose(C_CR,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
57288ebb749SStefano Zampini       }
57388ebb749SStefano Zampini       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
57488ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
57588ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
57688ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
57725084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
57888ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_psi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
57925084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
58088ebb749SStefano Zampini       if (i<n_vertices) {
58188ebb749SStefano Zampini         ierr = MatSetValue(pcbddc->coarse_psi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
58288ebb749SStefano Zampini       }
5838eeda7d8SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
58488ebb749SStefano Zampini         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
58588ebb749SStefano Zampini         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
58625084f0cSStefano Zampini         ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
58788ebb749SStefano Zampini         ierr = MatSetValues(pcbddc->coarse_psi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
58825084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
58988ebb749SStefano Zampini       }
59088ebb749SStefano Zampini 
59125084f0cSStefano Zampini       if (pcbddc->dbg_flag) {
59288ebb749SStefano Zampini         /* assemble subdomain vector on nodes */
59388ebb749SStefano Zampini         ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
59425084f0cSStefano Zampini         ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
59525084f0cSStefano Zampini         ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
59625084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
59725084f0cSStefano Zampini         if (i<n_vertices) {
59825084f0cSStefano Zampini           ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
59988ebb749SStefano Zampini         }
60025084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
60125084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
60225084f0cSStefano Zampini         /* assemble subdomain vector of lagrange multipliers */
60325084f0cSStefano Zampini         for (j=0;j<pcbddc->local_primal_size;j++) {
60425084f0cSStefano Zampini           ierr = VecSetValue(pcbddc->vec1_P,j,-coarse_submat_vals[j*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
60525084f0cSStefano Zampini         }
60625084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
60725084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
60888ebb749SStefano Zampini         /* check saddle point solution */
60988ebb749SStefano Zampini         ierr = MatMultTranspose(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
61088ebb749SStefano Zampini         ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
61188ebb749SStefano Zampini         ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
61288ebb749SStefano Zampini         ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
61325084f0cSStefano Zampini         /* shift by the identity matrix */
61425084f0cSStefano Zampini         ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
61525084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
61625084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
61788ebb749SStefano Zampini         ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
61888ebb749SStefano Zampini       }
61988ebb749SStefano Zampini     }
62088ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
62188ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6228eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
62388ebb749SStefano Zampini       ierr = MatAssemblyBegin(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
62488ebb749SStefano Zampini       ierr = MatAssemblyEnd(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
62588ebb749SStefano Zampini     }
62688ebb749SStefano Zampini   }
62788ebb749SStefano Zampini   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
62888ebb749SStefano Zampini   /* Checking coarse_sub_mat and coarse basis functios */
62988ebb749SStefano Zampini   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
63088ebb749SStefano Zampini   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
63125084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
63288ebb749SStefano Zampini     Mat         coarse_sub_mat;
63325084f0cSStefano Zampini     Mat         AUXMAT,TM1,TM2,TM3,TM4;
63488ebb749SStefano Zampini     Mat         coarse_phi_D,coarse_phi_B;
63588ebb749SStefano Zampini     Mat         coarse_psi_D,coarse_psi_B;
63688ebb749SStefano Zampini     Mat         A_II,A_BB,A_IB,A_BI;
63788ebb749SStefano Zampini     MatType     checkmattype=MATSEQAIJ;
63888ebb749SStefano Zampini     PetscReal   real_value;
63988ebb749SStefano Zampini 
64088ebb749SStefano Zampini     ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
64188ebb749SStefano Zampini     ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
64288ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
64388ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
64488ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
64588ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
64688ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
64788ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
64888ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
64988ebb749SStefano Zampini     }
65088ebb749SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
65188ebb749SStefano Zampini 
65225084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
65325084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat and local basis functions\n");CHKERRQ(ierr);
65425084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
65588ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
65688ebb749SStefano Zampini       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
65788ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
65888ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
65988ebb749SStefano Zampini       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
66088ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
66188ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
66288ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
66388ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
66488ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
66588ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
66688ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
66788ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
66888ebb749SStefano Zampini     } else {
66988ebb749SStefano Zampini       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
67088ebb749SStefano Zampini       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
67188ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
67288ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
67388ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
67488ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
67588ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
67688ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
67788ebb749SStefano Zampini     }
67888ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
67988ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
68088ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
68188ebb749SStefano Zampini     ierr = MatConvert(TM1,MATSEQDENSE,MAT_REUSE_MATRIX,&TM1);CHKERRQ(ierr);
68288ebb749SStefano Zampini     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
68388ebb749SStefano Zampini     ierr = MatNorm(TM1,NORM_INFINITY,&real_value);CHKERRQ(ierr);
684*0fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
68525084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"----------------------------------\n");CHKERRQ(ierr);
68625084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d \n",PetscGlobalRank);CHKERRQ(ierr);
68725084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"matrix error = % 1.14e\n",real_value);CHKERRQ(ierr);
68825084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (phi) errors\n");CHKERRQ(ierr);
68988ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
69025084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,coarsefunctions_errors[i]);CHKERRQ(ierr);
69188ebb749SStefano Zampini     }
69225084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (phi) errors\n");CHKERRQ(ierr);
69388ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
69425084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,constraints_errors[i]);CHKERRQ(ierr);
69588ebb749SStefano Zampini     }
69688ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
69725084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (psi) errors\n");CHKERRQ(ierr);
69888ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
69925084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,coarsefunctions_errors[i]);CHKERRQ(ierr);
70088ebb749SStefano Zampini       }
70125084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (psi) errors\n");CHKERRQ(ierr);
70288ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
70325084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,constraints_errors[i]);CHKERRQ(ierr);
70488ebb749SStefano Zampini       }
70588ebb749SStefano Zampini     }
70625084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
70788ebb749SStefano Zampini     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
70888ebb749SStefano Zampini     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
70988ebb749SStefano Zampini     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
71088ebb749SStefano Zampini     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
71188ebb749SStefano Zampini     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
71288ebb749SStefano Zampini     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
71388ebb749SStefano Zampini     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
71488ebb749SStefano Zampini     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
71588ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
71688ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
71788ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
71888ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
71988ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
72088ebb749SStefano Zampini     }
72188ebb749SStefano Zampini     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
7228ce42a96SStefano Zampini     ierr = ISRestoreIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
72388ebb749SStefano Zampini     ierr = PetscFree(coarsefunctions_errors);CHKERRQ(ierr);
72488ebb749SStefano Zampini     ierr = PetscFree(constraints_errors);CHKERRQ(ierr);
72588ebb749SStefano Zampini   }
72688ebb749SStefano Zampini   /* free memory */
72788ebb749SStefano Zampini   if (n_vertices) {
72888ebb749SStefano Zampini     ierr = PetscFree(vertices);CHKERRQ(ierr);
72988ebb749SStefano Zampini     ierr = VecDestroy(&vec1_V);CHKERRQ(ierr);
73088ebb749SStefano Zampini     ierr = VecDestroy(&vec2_V);CHKERRQ(ierr);
73188ebb749SStefano Zampini     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
73288ebb749SStefano Zampini     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
73388ebb749SStefano Zampini     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
73488ebb749SStefano Zampini   }
73588ebb749SStefano Zampini   if (n_constraints) {
73688ebb749SStefano Zampini     ierr = VecDestroy(&vec1_C);CHKERRQ(ierr);
73788ebb749SStefano Zampini     ierr = VecDestroy(&vec2_C);CHKERRQ(ierr);
73888ebb749SStefano Zampini     ierr = MatDestroy(&M1);CHKERRQ(ierr);
73988ebb749SStefano Zampini     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
74088ebb749SStefano Zampini   }
74188ebb749SStefano Zampini   ierr = PetscFree(auxindices);CHKERRQ(ierr);
7428629588bSStefano Zampini   /* get back data */
7438629588bSStefano Zampini   *coarse_submat_vals_n = coarse_submat_vals;
74488ebb749SStefano Zampini   PetscFunctionReturn(0);
74588ebb749SStefano Zampini }
74688ebb749SStefano Zampini 
74788ebb749SStefano Zampini #undef __FUNCT__
748aa0d41d4SStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalMatrices"
749aa0d41d4SStefano Zampini PetscErrorCode PCBDDCSetUpLocalMatrices(PC pc)
750aa0d41d4SStefano Zampini {
751aa0d41d4SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
752aa0d41d4SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
753aa0d41d4SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
7549577ea80SStefano Zampini   PetscBool         issbaij,isbaij;
755aa0d41d4SStefano Zampini   /* manage repeated solves */
756aa0d41d4SStefano Zampini   MatReuse          reuse;
757aa0d41d4SStefano Zampini   MatStructure      matstruct;
758aa0d41d4SStefano Zampini   PetscErrorCode    ierr;
759aa0d41d4SStefano Zampini 
760aa0d41d4SStefano Zampini   PetscFunctionBegin;
761f4ddd8eeSStefano Zampini   if (pcbddc->use_change_of_basis && !pcbddc->ChangeOfBasisMatrix) {
762f4ddd8eeSStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Change of basis matrix has not been created");
763f4ddd8eeSStefano Zampini   }
764aa0d41d4SStefano Zampini   /* get mat flags */
765aa0d41d4SStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
766aa0d41d4SStefano Zampini   reuse = MAT_INITIAL_MATRIX;
767aa0d41d4SStefano Zampini   if (pc->setupcalled) {
768aa0d41d4SStefano Zampini     /* when matstruct is SAME_PRECONDITIONER, we shouldn't be here */
769aa0d41d4SStefano Zampini     if (matstruct == SAME_PRECONDITIONER) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen");
770aa0d41d4SStefano Zampini     if (matstruct == SAME_NONZERO_PATTERN) {
771aa0d41d4SStefano Zampini       reuse = MAT_REUSE_MATRIX;
772aa0d41d4SStefano Zampini     } else {
773aa0d41d4SStefano Zampini       reuse = MAT_INITIAL_MATRIX;
774aa0d41d4SStefano Zampini     }
775aa0d41d4SStefano Zampini   }
776aa0d41d4SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
777aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
778aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
779aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
780aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BB);CHKERRQ(ierr);
781aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
782aa0d41d4SStefano Zampini   }
783aa0d41d4SStefano Zampini 
784aa0d41d4SStefano Zampini   /* transform local matrices if needed */
785aa0d41d4SStefano Zampini   if (pcbddc->use_change_of_basis) {
786aa0d41d4SStefano Zampini     Mat         change_mat_all;
787aa0d41d4SStefano Zampini     PetscScalar *row_cmat_values;
788aa0d41d4SStefano Zampini     PetscInt    *row_cmat_indices;
789aa0d41d4SStefano Zampini     PetscInt    *nnz,*is_indices,*temp_indices;
790aa0d41d4SStefano Zampini     PetscInt    i,j,k,n_D,n_B;
791aa0d41d4SStefano Zampini 
792aa0d41d4SStefano Zampini     /* Get Non-overlapping dimensions */
793aa0d41d4SStefano Zampini     n_B = pcis->n_B;
794aa0d41d4SStefano Zampini     n_D = pcis->n-n_B;
795aa0d41d4SStefano Zampini 
796aa0d41d4SStefano Zampini     /* compute nonzero structure of change of basis on all local nodes */
797aa0d41d4SStefano Zampini     ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
798aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
799aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) nnz[is_indices[i]] = 1;
800aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
801aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
802aa0d41d4SStefano Zampini     k=1;
803aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
804aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
805aa0d41d4SStefano Zampini       nnz[is_indices[i]]=j;
806aa0d41d4SStefano Zampini       if (k < j) k = j;
807aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
808aa0d41d4SStefano Zampini     }
809aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
810aa0d41d4SStefano Zampini     /* assemble change of basis matrix on the whole set of local dofs */
811aa0d41d4SStefano Zampini     ierr = PetscMalloc(k*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
812aa0d41d4SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&change_mat_all);CHKERRQ(ierr);
813aa0d41d4SStefano Zampini     ierr = MatSetSizes(change_mat_all,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
814aa0d41d4SStefano Zampini     ierr = MatSetType(change_mat_all,MATSEQAIJ);CHKERRQ(ierr);
815aa0d41d4SStefano Zampini     ierr = MatSeqAIJSetPreallocation(change_mat_all,0,nnz);CHKERRQ(ierr);
816aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
817aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) {
818aa0d41d4SStefano Zampini       ierr = MatSetValue(change_mat_all,is_indices[i],is_indices[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
819aa0d41d4SStefano Zampini     }
820aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
821aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
822aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
823aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
824aa0d41d4SStefano Zampini       for (k=0; k<j; k++) temp_indices[k]=is_indices[row_cmat_indices[k]];
825aa0d41d4SStefano Zampini       ierr = MatSetValues(change_mat_all,1,&is_indices[i],j,temp_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
826aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
827aa0d41d4SStefano Zampini     }
828aa0d41d4SStefano Zampini     ierr = MatAssemblyBegin(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
829aa0d41d4SStefano Zampini     ierr = MatAssemblyEnd(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8309577ea80SStefano Zampini     /* TODO: HOW TO WORK WITH BAIJ and SBAIJ? PtAP not provided */
8319577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
8329577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQBAIJ,&isbaij);CHKERRQ(ierr);
8339577ea80SStefano Zampini     if (!issbaij && !isbaij) {
834aa0d41d4SStefano Zampini       ierr = MatPtAP(matis->A,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
835aa0d41d4SStefano Zampini     } else {
836aa0d41d4SStefano Zampini       Mat work_mat;
837aa0d41d4SStefano Zampini       ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
838aa0d41d4SStefano Zampini       ierr = MatPtAP(work_mat,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
839aa0d41d4SStefano Zampini       ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
840aa0d41d4SStefano Zampini     }
84145a1bb75SStefano Zampini     /*
84245a1bb75SStefano Zampini     ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
84345a1bb75SStefano Zampini     ierr = MatView(change_mat_all,(PetscViewer)0);CHKERRQ(ierr);
84445a1bb75SStefano Zampini     */
845aa0d41d4SStefano Zampini     ierr = MatDestroy(&change_mat_all);CHKERRQ(ierr);
846aa0d41d4SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
847aa0d41d4SStefano Zampini     ierr = PetscFree(temp_indices);CHKERRQ(ierr);
848aa0d41d4SStefano Zampini   } else {
849aa0d41d4SStefano Zampini     /* without change of basis, the local matrix is unchanged */
850aa0d41d4SStefano Zampini     if (!pcbddc->local_mat) {
851aa0d41d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)matis->A);CHKERRQ(ierr);
852aa0d41d4SStefano Zampini       pcbddc->local_mat = matis->A;
853aa0d41d4SStefano Zampini     }
854aa0d41d4SStefano Zampini   }
855aa0d41d4SStefano Zampini 
856aa0d41d4SStefano Zampini   /* get submatrices */
857aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_I_local,reuse,&pcis->A_II);CHKERRQ(ierr);
8589577ea80SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_B_local,reuse,&pcis->A_BB);CHKERRQ(ierr);
8599577ea80SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
8609577ea80SStefano Zampini   if (!issbaij) {
861aa0d41d4SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
862aa0d41d4SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
8639577ea80SStefano Zampini   } else {
8649577ea80SStefano Zampini     Mat newmat;
8659577ea80SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
8669577ea80SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
8679577ea80SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
8689577ea80SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
8699577ea80SStefano Zampini   }
870aa0d41d4SStefano Zampini   PetscFunctionReturn(0);
871aa0d41d4SStefano Zampini }
872aa0d41d4SStefano Zampini 
873aa0d41d4SStefano Zampini #undef __FUNCT__
874a64d13efSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalScatters"
8758ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
876a64d13efSStefano Zampini {
877a64d13efSStefano Zampini   PC_IS*         pcis = (PC_IS*)(pc->data);
878a64d13efSStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8798ce42a96SStefano Zampini   IS             is_aux1,is_aux2;
880a64d13efSStefano Zampini   PetscInt       *vertices,*aux_array1,*aux_array2,*is_indices,*idx_R_local;
8813a50541eSStefano Zampini   PetscInt       n_vertices,i,j,n_R,n_D,n_B;
8823a50541eSStefano Zampini   PetscInt       vbs,bs;
8834641a718SStefano Zampini   PetscBT        bitmask;
884a64d13efSStefano Zampini   PetscErrorCode ierr;
885a64d13efSStefano Zampini 
886a64d13efSStefano Zampini   PetscFunctionBegin;
887f4ddd8eeSStefano Zampini   /* No need to setup local scatters if primal space is unchanged */
888727cdba6SStefano Zampini   if (!pcbddc->new_primal_space_local) {
889f4ddd8eeSStefano Zampini     PetscFunctionReturn(0);
890f4ddd8eeSStefano Zampini   }
891f4ddd8eeSStefano Zampini   /* destroy old objects */
892f4ddd8eeSStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
893f4ddd8eeSStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
894f4ddd8eeSStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
895a64d13efSStefano Zampini   /* Set Non-overlapping dimensions */
896a64d13efSStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
897a64d13efSStefano Zampini   /* get vertex indices from constraint matrix */
898a64d13efSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
8993a50541eSStefano Zampini 
9004641a718SStefano Zampini   /* create auxiliary bitmask */
9014641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
9024641a718SStefano Zampini   for (i=0;i<n_vertices;i++) {
9034641a718SStefano Zampini     ierr = PetscBTSet(bitmask,vertices[i]);CHKERRQ(ierr);
9044641a718SStefano Zampini   }
9053a50541eSStefano Zampini 
906a64d13efSStefano Zampini   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
907a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n-n_vertices)*sizeof(PetscInt),&idx_R_local);CHKERRQ(ierr);
908a64d13efSStefano Zampini   for (i=0, n_R=0; i<pcis->n; i++) {
9094641a718SStefano Zampini     if (!PetscBTLookup(bitmask,i)) {
910a64d13efSStefano Zampini       idx_R_local[n_R] = i;
911a64d13efSStefano Zampini       n_R++;
912a64d13efSStefano Zampini     }
913a64d13efSStefano Zampini   }
9143a50541eSStefano Zampini 
9153a50541eSStefano Zampini   /* Block code */
9163a50541eSStefano Zampini   vbs = 1;
9173a50541eSStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
9183a50541eSStefano Zampini   if (bs>1 && !(n_vertices%bs)) {
9193a50541eSStefano Zampini     PetscBool is_blocked = PETSC_TRUE;
9203a50541eSStefano Zampini     PetscInt  *vary;
9213a50541eSStefano Zampini     /* Verify if the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
9223a50541eSStefano Zampini     ierr = PetscMalloc(pcis->n/bs*sizeof(PetscInt),&vary);CHKERRQ(ierr);
9233a50541eSStefano Zampini     ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
9243a50541eSStefano Zampini     for (i=0; i<n_vertices; i++) vary[vertices[i]/bs]++;
9253a50541eSStefano Zampini     for (i=0; i<n_vertices; i++) {
9263a50541eSStefano Zampini       if (vary[i]!=0 && vary[i]!=bs) {
9273a50541eSStefano Zampini         is_blocked = PETSC_FALSE;
9283a50541eSStefano Zampini         break;
9293a50541eSStefano Zampini       }
9303a50541eSStefano Zampini     }
9313a50541eSStefano Zampini     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
9323a50541eSStefano Zampini       vbs = bs;
9333a50541eSStefano Zampini       for (i=0;i<n_R/vbs;i++) {
9343a50541eSStefano Zampini         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
9353a50541eSStefano Zampini       }
9363a50541eSStefano Zampini     }
9373a50541eSStefano Zampini     ierr = PetscFree(vary);CHKERRQ(ierr);
9383a50541eSStefano Zampini   }
939a64d13efSStefano Zampini   ierr = PetscFree(vertices);CHKERRQ(ierr);
9403a50541eSStefano Zampini   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
9413a50541eSStefano Zampini   ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
942a64d13efSStefano Zampini 
943a64d13efSStefano Zampini   /* print some info if requested */
944a64d13efSStefano Zampini   if (pcbddc->dbg_flag) {
945a64d13efSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
946a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
947*0fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
948a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
949a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
9503a50541eSStefano 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);
951a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr);
952a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
953a64d13efSStefano Zampini   }
954a64d13efSStefano Zampini 
955a64d13efSStefano Zampini   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
9563a50541eSStefano Zampini   ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
957a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
958a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array2);CHKERRQ(ierr);
959a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
9604641a718SStefano Zampini   for (i=0; i<n_D; i++) {
9614641a718SStefano Zampini     ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
9624641a718SStefano Zampini   }
963a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
964a64d13efSStefano Zampini   for (i=0, j=0; i<n_R; i++) {
9654641a718SStefano Zampini     if (!PetscBTLookup(bitmask,idx_R_local[i])) {
9664641a718SStefano Zampini       aux_array1[j++] = i;
967a64d13efSStefano Zampini     }
968a64d13efSStefano Zampini   }
969a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
970a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
971a64d13efSStefano Zampini   for (i=0, j=0; i<n_B; i++) {
9724641a718SStefano Zampini     if (!PetscBTLookup(bitmask,is_indices[i])) {
9734641a718SStefano Zampini       aux_array2[j++] = i;
974a64d13efSStefano Zampini     }
975a64d13efSStefano Zampini   }
976a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
977a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
978a64d13efSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
979a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
980a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
981a64d13efSStefano Zampini 
9828eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
983a64d13efSStefano Zampini     ierr = PetscMalloc(n_D*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
984a64d13efSStefano Zampini     for (i=0, j=0; i<n_R; i++) {
9854641a718SStefano Zampini       if (PetscBTLookup(bitmask,idx_R_local[i])) {
9864641a718SStefano Zampini         aux_array1[j++] = i;
987a64d13efSStefano Zampini       }
988a64d13efSStefano Zampini     }
989a64d13efSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
990a64d13efSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
991a64d13efSStefano Zampini     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
992a64d13efSStefano Zampini   }
9934641a718SStefano Zampini   ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
9943a50541eSStefano Zampini   ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
995a64d13efSStefano Zampini   PetscFunctionReturn(0);
996a64d13efSStefano Zampini }
997a64d13efSStefano Zampini 
998304d26faSStefano Zampini 
999304d26faSStefano Zampini #undef __FUNCT__
1000304d26faSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
10018ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc)
1002304d26faSStefano Zampini {
1003304d26faSStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1004304d26faSStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
1005304d26faSStefano Zampini   PC             pc_temp;
1006304d26faSStefano Zampini   Mat            A_RR;
1007304d26faSStefano Zampini   MatStructure   matstruct;
1008f4ddd8eeSStefano Zampini   MatReuse       reuse;
1009304d26faSStefano Zampini   PetscScalar    m_one = -1.0;
1010304d26faSStefano Zampini   PetscReal      value;
1011af732b37SStefano Zampini   PetscInt       n_D,n_R,ibs,mbs;
10129577ea80SStefano Zampini   PetscBool      use_exact,use_exact_reduced,issbaij;
1013304d26faSStefano Zampini   PetscErrorCode ierr;
1014e604994aSStefano Zampini   /* prefixes stuff */
1015e604994aSStefano Zampini   char           dir_prefix[256],neu_prefix[256],str_level[3];
1016e604994aSStefano Zampini   size_t         len;
1017304d26faSStefano Zampini 
1018304d26faSStefano Zampini   PetscFunctionBegin;
1019304d26faSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
1020304d26faSStefano Zampini 
1021e604994aSStefano Zampini   /* compute prefixes */
1022e604994aSStefano Zampini   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
1023e604994aSStefano Zampini   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
1024e604994aSStefano Zampini   if (!pcbddc->current_level) {
1025e604994aSStefano Zampini     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
1026e604994aSStefano Zampini     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
1027e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
1028e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
1029e604994aSStefano Zampini   } else {
1030e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
1031e604994aSStefano Zampini     sprintf(str_level,"%d_",(int)(pcbddc->current_level));
1032e604994aSStefano Zampini     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
1033e604994aSStefano Zampini     len -= 15; /* remove "pc_bddc_coarse_" */
1034e604994aSStefano Zampini     if (pcbddc->current_level>1) len -= 2; /* remove "X_" with X level number (works with 9 levels max) */
1035e604994aSStefano Zampini     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
1036e604994aSStefano Zampini     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
1037e604994aSStefano Zampini     *(dir_prefix+len)='\0';
1038e604994aSStefano Zampini     *(neu_prefix+len)='\0';
1039e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
1040e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
1041e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
1042e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
1043e604994aSStefano Zampini   }
1044e604994aSStefano Zampini 
1045304d26faSStefano Zampini   /* DIRICHLET PROBLEM */
1046ac78edfcSStefano Zampini   /* Matrix for Dirichlet problem is pcis->A_II */
10478ce42a96SStefano Zampini   ierr = ISGetSize(pcis->is_I_local,&n_D);CHKERRQ(ierr);
1048304d26faSStefano Zampini   if (!pcbddc->ksp_D) { /* create object if not yet build */
1049304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
1050304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
1051304d26faSStefano Zampini     /* default */
1052304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
1053e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
10549577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
1055304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
10569577ea80SStefano Zampini     if (issbaij) {
10579577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
10589577ea80SStefano Zampini     } else {
1059304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
10609577ea80SStefano Zampini     }
1061304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1062304d26faSStefano Zampini   }
1063304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II,matstruct);CHKERRQ(ierr);
1064304d26faSStefano Zampini   /* Allow user's customization */
1065304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
1066304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1067304d26faSStefano Zampini   if (!n_D) {
1068304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
1069304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1070304d26faSStefano Zampini   }
1071304d26faSStefano Zampini   /* Set Up KSP for Dirichlet problem of BDDC */
1072304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
1073304d26faSStefano Zampini   /* set ksp_D into pcis data */
1074304d26faSStefano Zampini   ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
1075304d26faSStefano Zampini   ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
1076304d26faSStefano Zampini   pcis->ksp_D = pcbddc->ksp_D;
1077304d26faSStefano Zampini 
1078304d26faSStefano Zampini   /* NEUMANN PROBLEM */
1079f4ddd8eeSStefano Zampini   /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
10808ce42a96SStefano Zampini   ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
1081f4ddd8eeSStefano Zampini   if (pcbddc->ksp_R) { /* already created ksp */
1082f4ddd8eeSStefano Zampini     PetscInt nn_R;
1083f4ddd8eeSStefano Zampini     ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR,NULL);CHKERRQ(ierr);
1084f4ddd8eeSStefano Zampini     ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
1085f4ddd8eeSStefano Zampini     ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
1086f4ddd8eeSStefano Zampini     if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
1087f4ddd8eeSStefano Zampini       ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
1088f4ddd8eeSStefano Zampini       ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1089f4ddd8eeSStefano Zampini       reuse = MAT_INITIAL_MATRIX;
1090f4ddd8eeSStefano Zampini     } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
1091727cdba6SStefano Zampini       if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
1092f4ddd8eeSStefano Zampini         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1093f4ddd8eeSStefano Zampini         reuse = MAT_INITIAL_MATRIX;
1094f4ddd8eeSStefano Zampini       } else { /* safe to reuse the matrix */
1095f4ddd8eeSStefano Zampini         reuse = MAT_REUSE_MATRIX;
1096f4ddd8eeSStefano Zampini       }
1097f4ddd8eeSStefano Zampini     }
1098f4ddd8eeSStefano Zampini     /* last check */
1099f4ddd8eeSStefano Zampini     if (matstruct == DIFFERENT_NONZERO_PATTERN) {
1100f4ddd8eeSStefano Zampini       ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1101f4ddd8eeSStefano Zampini       reuse = MAT_INITIAL_MATRIX;
1102f4ddd8eeSStefano Zampini     }
1103f4ddd8eeSStefano Zampini   } else { /* first time, so we need to create the matrix */
1104f4ddd8eeSStefano Zampini     reuse = MAT_INITIAL_MATRIX;
1105f4ddd8eeSStefano Zampini   }
1106f4ddd8eeSStefano Zampini   /* extract A_RR */
1107af732b37SStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
1108af732b37SStefano Zampini   ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
11093a50541eSStefano Zampini   if (ibs != mbs) {
1110af732b37SStefano Zampini     Mat newmat;
1111af732b37SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
1112f4ddd8eeSStefano Zampini     ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
1113af732b37SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
1114af732b37SStefano Zampini   } else {
1115f4ddd8eeSStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
1116af732b37SStefano Zampini   }
1117f4ddd8eeSStefano Zampini   if (!pcbddc->ksp_R) { /* create object if not present */
1118304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
1119304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
1120304d26faSStefano Zampini     /* default */
1121304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
1122e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
1123304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
11249577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
11259577ea80SStefano Zampini     if (issbaij) {
11269577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
11279577ea80SStefano Zampini     } else {
1128304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
11299577ea80SStefano Zampini     }
1130304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1131304d26faSStefano Zampini   }
1132304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR,matstruct);CHKERRQ(ierr);
1133304d26faSStefano Zampini   /* Allow user's customization */
1134304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
1135304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1136304d26faSStefano Zampini   if (!n_R) {
1137304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
1138304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1139304d26faSStefano Zampini   }
1140304d26faSStefano Zampini   /* Set Up KSP for Neumann problem of BDDC */
1141304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
1142304d26faSStefano Zampini 
1143304d26faSStefano Zampini   /* check Dirichlet and Neumann solvers and adapt them if a nullspace correction is needed */
1144*0fccc4e9SStefano Zampini   if (pcbddc->NullSpace || pcbddc->dbg_flag) {
1145304d26faSStefano Zampini     /* Dirichlet */
1146*0fccc4e9SStefano Zampini     ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
1147*0fccc4e9SStefano Zampini     ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1148*0fccc4e9SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
1149*0fccc4e9SStefano Zampini     ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
1150*0fccc4e9SStefano Zampini     ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
1151304d26faSStefano Zampini     /* need to be adapted? */
1152b8ffe317SStefano Zampini     use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1153b8ffe317SStefano Zampini     ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1154b8ffe317SStefano Zampini     ierr = PCBDDCSetUseExactDirichlet(pc,use_exact_reduced);CHKERRQ(ierr);
1155304d26faSStefano Zampini     /* print info */
1156304d26faSStefano Zampini     if (pcbddc->dbg_flag) {
1157304d26faSStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1158*0fccc4e9SStefano Zampini       ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
1159304d26faSStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
1160304d26faSStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Checking solution of Dirichlet and Neumann problems\n");CHKERRQ(ierr);
1161e604994aSStefano 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);
1162304d26faSStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1163304d26faSStefano Zampini     }
1164b8ffe317SStefano Zampini     if (pcbddc->NullSpace && !use_exact_reduced && !pcbddc->switch_static) {
11658ce42a96SStefano Zampini       ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcis->is_I_local);CHKERRQ(ierr);
1166304d26faSStefano Zampini     }
1167304d26faSStefano Zampini 
1168304d26faSStefano Zampini     /* Neumann */
1169*0fccc4e9SStefano Zampini     ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
1170*0fccc4e9SStefano Zampini     ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
1171*0fccc4e9SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
1172*0fccc4e9SStefano Zampini     ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
1173*0fccc4e9SStefano Zampini     ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
1174304d26faSStefano Zampini     /* need to be adapted? */
1175b8ffe317SStefano Zampini     use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1176b8ffe317SStefano Zampini     ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1177304d26faSStefano Zampini     /* print info */
1178304d26faSStefano Zampini     if (pcbddc->dbg_flag) {
1179e604994aSStefano 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);
1180304d26faSStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1181304d26faSStefano Zampini     }
1182b8ffe317SStefano Zampini     if (pcbddc->NullSpace && !use_exact_reduced) { /* is it the right logic? */
11838ce42a96SStefano Zampini       ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcbddc->is_R_local);CHKERRQ(ierr);
1184304d26faSStefano Zampini     }
1185*0fccc4e9SStefano Zampini   }
1186304d26faSStefano Zampini   /* free Neumann problem's matrix */
1187304d26faSStefano Zampini   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1188304d26faSStefano Zampini   PetscFunctionReturn(0);
1189304d26faSStefano Zampini }
1190304d26faSStefano Zampini 
1191304d26faSStefano Zampini #undef __FUNCT__
1192674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSolveSaddlePoint"
1193674ae819SStefano Zampini static PetscErrorCode  PCBDDCSolveSaddlePoint(PC pc)
1194674ae819SStefano Zampini {
1195674ae819SStefano Zampini   PetscErrorCode ierr;
1196674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1197674ae819SStefano Zampini 
1198674ae819SStefano Zampini   PetscFunctionBegin;
1199674ae819SStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
1200674ae819SStefano Zampini   if (pcbddc->local_auxmat1) {
1201674ae819SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec2_R,pcbddc->vec1_C);CHKERRQ(ierr);
1202674ae819SStefano Zampini     ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
1203674ae819SStefano Zampini   }
1204674ae819SStefano Zampini   PetscFunctionReturn(0);
1205674ae819SStefano Zampini }
1206674ae819SStefano Zampini 
1207674ae819SStefano Zampini #undef __FUNCT__
1208674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
1209674ae819SStefano Zampini PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc)
1210674ae819SStefano Zampini {
1211674ae819SStefano Zampini   PetscErrorCode ierr;
1212674ae819SStefano Zampini   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
1213674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)  (pc->data);
1214674ae819SStefano Zampini   const PetscScalar zero = 0.0;
1215674ae819SStefano Zampini 
1216674ae819SStefano Zampini   PetscFunctionBegin;
121715aaf578SStefano Zampini   /* Application of PHI^T (or PSI^T)  */
121815aaf578SStefano Zampini   if (pcbddc->coarse_psi_B) {
121915aaf578SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
12208eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
122115aaf578SStefano Zampini   } else {
1222674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
12238eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
122415aaf578SStefano Zampini   }
1225674ae819SStefano Zampini   /* Scatter data of coarse_rhs */
1226674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { ierr = VecSet(pcbddc->coarse_rhs,zero);CHKERRQ(ierr); }
1227674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1228674ae819SStefano Zampini 
1229674ae819SStefano Zampini   /* Local solution on R nodes */
1230674ae819SStefano Zampini   ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
1231674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1232674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
12338eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1234674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1235674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1236674ae819SStefano Zampini   }
1237674ae819SStefano Zampini   ierr = PCBDDCSolveSaddlePoint(pc);CHKERRQ(ierr);
1238674ae819SStefano Zampini   ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1239674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1240674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
12418eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1242674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1243674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1244674ae819SStefano Zampini   }
1245674ae819SStefano Zampini 
1246674ae819SStefano Zampini   /* Coarse solution */
1247674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1248674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { /* TODO remove null space when doing multilevel */
1249674ae819SStefano Zampini     ierr = KSPSolve(pcbddc->coarse_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
1250674ae819SStefano Zampini   }
1251674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1252674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd  (pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1253674ae819SStefano Zampini 
1254674ae819SStefano Zampini   /* Sum contributions from two levels */
1255674ae819SStefano Zampini   ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
12568eeda7d8SStefano Zampini   if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1257674ae819SStefano Zampini   PetscFunctionReturn(0);
1258674ae819SStefano Zampini }
1259674ae819SStefano Zampini 
1260674ae819SStefano Zampini #undef __FUNCT__
1261674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
1262674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1263674ae819SStefano Zampini {
1264674ae819SStefano Zampini   PetscErrorCode ierr;
1265674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1266674ae819SStefano Zampini 
1267674ae819SStefano Zampini   PetscFunctionBegin;
1268674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1269674ae819SStefano Zampini   PetscFunctionReturn(0);
1270674ae819SStefano Zampini }
1271674ae819SStefano Zampini 
1272674ae819SStefano Zampini #undef __FUNCT__
1273674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
1274674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1275674ae819SStefano Zampini {
1276674ae819SStefano Zampini   PetscErrorCode ierr;
1277674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1278674ae819SStefano Zampini 
1279674ae819SStefano Zampini   PetscFunctionBegin;
1280674ae819SStefano Zampini   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1281674ae819SStefano Zampini   PetscFunctionReturn(0);
1282674ae819SStefano Zampini }
1283674ae819SStefano Zampini 
1284984c4197SStefano Zampini /* uncomment for testing purposes */
1285984c4197SStefano Zampini /* #define PETSC_MISSING_LAPACK_GESVD 1 */
1286674ae819SStefano Zampini #undef __FUNCT__
1287674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp"
1288674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
1289674ae819SStefano Zampini {
1290674ae819SStefano Zampini   PetscErrorCode    ierr;
1291674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
1292674ae819SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
1293674ae819SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
1294984c4197SStefano Zampini   /* constraint and (optionally) change of basis matrix implemented as SeqAIJ */
1295674ae819SStefano Zampini   MatType           impMatType=MATSEQAIJ;
1296984c4197SStefano Zampini   /* one and zero */
1297984c4197SStefano Zampini   PetscScalar       one=1.0,zero=0.0;
1298984c4197SStefano Zampini   /* space to store constraints and their local indices */
1299984c4197SStefano Zampini   PetscScalar       *temp_quadrature_constraint;
1300984c4197SStefano Zampini   PetscInt          *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B;
1301984c4197SStefano Zampini   /* iterators */
1302984c4197SStefano Zampini   PetscInt          i,j,k,total_counts,temp_start_ptr;
1303984c4197SStefano Zampini   /* stuff to store connected components stored in pcbddc->mat_graph */
1304984c4197SStefano Zampini   IS                ISForVertices,*ISForFaces,*ISForEdges,*used_IS;
1305984c4197SStefano Zampini   PetscInt          n_ISForFaces,n_ISForEdges;
1306984c4197SStefano Zampini   /* near null space stuff */
1307674ae819SStefano Zampini   MatNullSpace      nearnullsp;
1308674ae819SStefano Zampini   const Vec         *nearnullvecs;
1309674ae819SStefano Zampini   Vec               *localnearnullsp;
1310984c4197SStefano Zampini   PetscBool         nnsp_has_cnst;
1311984c4197SStefano Zampini   PetscInt          nnsp_size;
1312984c4197SStefano Zampini   PetscScalar       *array;
1313984c4197SStefano Zampini   /* BLAS integers */
1314e310c8b4SStefano Zampini   PetscBLASInt      lwork,lierr;
1315e310c8b4SStefano Zampini   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
1316c4303822SStefano Zampini   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
1317984c4197SStefano Zampini   /* LAPACK working arrays for SVD or POD */
1318242a89d7SStefano Zampini   PetscBool         skip_lapack;
1319984c4197SStefano Zampini   PetscScalar       *work;
1320984c4197SStefano Zampini   PetscReal         *singular_vals;
1321984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1322984c4197SStefano Zampini   PetscReal         *rwork;
1323674ae819SStefano Zampini #endif
1324984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1325e310c8b4SStefano Zampini   PetscBLASInt      Blas_one_2=1;
1326984c4197SStefano Zampini   PetscScalar       *temp_basis,*correlation_mat;
1327b7d8b9f8SStefano Zampini #else
1328b7d8b9f8SStefano Zampini   PetscBLASInt      dummy_int_1=1,dummy_int_2=1;
1329b7d8b9f8SStefano Zampini   PetscScalar       dummy_scalar_1=0.0,dummy_scalar_2=0.0;
1330984c4197SStefano Zampini #endif
1331727cdba6SStefano Zampini   /* reuse */
1332727cdba6SStefano Zampini   PetscInt          olocal_primal_size;
1333727cdba6SStefano Zampini   PetscInt          *oprimal_indices_local_idxs;
1334984c4197SStefano Zampini   /* change of basis */
1335984c4197SStefano Zampini   PetscInt          *aux_primal_numbering,*aux_primal_minloc,*global_indices;
1336a717540cSStefano Zampini   PetscBool         boolforchange,qr_needed;
1337a717540cSStefano Zampini   PetscBT           touched,change_basis,qr_needed_idx;
1338984c4197SStefano Zampini   /* auxiliary stuff */
1339984c4197SStefano Zampini   PetscInt          *nnz,*is_indices,*local_to_B;
1340984c4197SStefano Zampini   /* some quantities */
134145a1bb75SStefano Zampini   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
1342984c4197SStefano Zampini   PetscInt          size_of_constraint,max_size_of_constraint,max_constraints,temp_constraints;
1343984c4197SStefano Zampini 
1344674ae819SStefano Zampini 
1345674ae819SStefano Zampini   PetscFunctionBegin;
13468e61c736SStefano Zampini   /* Destroy Mat objects computed previously */
13478e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
13488e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1349674ae819SStefano Zampini   /* Get index sets for faces, edges and vertices from graph */
13508eeda7d8SStefano Zampini   if (!pcbddc->use_faces && !pcbddc->use_edges && !pcbddc->use_vertices) {
13518eeda7d8SStefano Zampini     pcbddc->use_vertices = PETSC_TRUE;
1352674ae819SStefano Zampini   }
13538eeda7d8SStefano Zampini   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,pcbddc->use_faces,pcbddc->use_edges,pcbddc->use_vertices,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);
1354b8ffe317SStefano Zampini   /* HACK: provide functions to set change of basis */
1355b8ffe317SStefano Zampini   if (!ISForVertices && pcbddc->NullSpace) {
1356b8ffe317SStefano Zampini     pcbddc->use_change_of_basis = PETSC_TRUE;
1357b8ffe317SStefano Zampini     pcbddc->use_change_on_faces = PETSC_FALSE;
1358b8ffe317SStefano Zampini   }
1359984c4197SStefano Zampini   /* print some info */
1360674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
1361*0fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
1362674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1363674ae819SStefano Zampini     i = 0;
1364674ae819SStefano Zampini     if (ISForVertices) {
1365674ae819SStefano Zampini       ierr = ISGetSize(ISForVertices,&i);CHKERRQ(ierr);
1366674ae819SStefano Zampini     }
1367674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices\n",PetscGlobalRank,i);CHKERRQ(ierr);
1368674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges\n",PetscGlobalRank,n_ISForEdges);CHKERRQ(ierr);
136915aaf578SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces\n",PetscGlobalRank,n_ISForFaces);CHKERRQ(ierr);
1370674ae819SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1371674ae819SStefano Zampini   }
1372674ae819SStefano Zampini   /* check if near null space is attached to global mat */
1373674ae819SStefano Zampini   ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
1374674ae819SStefano Zampini   if (nearnullsp) {
1375674ae819SStefano Zampini     ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
1376f4ddd8eeSStefano Zampini     /* remove any stored info */
1377f4ddd8eeSStefano Zampini     ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
1378f4ddd8eeSStefano Zampini     ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1379f4ddd8eeSStefano Zampini     /* store information for BDDC solver reuse */
1380f4ddd8eeSStefano Zampini     ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
1381f4ddd8eeSStefano Zampini     pcbddc->onearnullspace = nearnullsp;
1382f4ddd8eeSStefano Zampini     ierr = PetscMalloc(nnsp_size*sizeof(PetscObjectState),&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1383f4ddd8eeSStefano Zampini     for (i=0;i<nnsp_size;i++) {
1384f4ddd8eeSStefano Zampini       ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
1385f4ddd8eeSStefano Zampini     }
1386984c4197SStefano Zampini   } else { /* if near null space is not provided BDDC uses constants by default */
1387984c4197SStefano Zampini     nnsp_size = 0;
1388674ae819SStefano Zampini     nnsp_has_cnst = PETSC_TRUE;
1389674ae819SStefano Zampini   }
1390984c4197SStefano Zampini   /* get max number of constraints on a single cc */
1391984c4197SStefano Zampini   max_constraints = nnsp_size;
1392984c4197SStefano Zampini   if (nnsp_has_cnst) max_constraints++;
1393984c4197SStefano Zampini 
1394674ae819SStefano Zampini   /*
1395674ae819SStefano Zampini        Evaluate maximum storage size needed by the procedure
1396674ae819SStefano Zampini        - temp_indices will contain start index of each constraint stored as follows
1397674ae819SStefano 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
1398674ae819SStefano 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
1399674ae819SStefano Zampini        - temp_quadrature_constraint  [temp_indices[i],...,temp[indices[i+1]-1] will contain the scalars representing the constraint itself
1400674ae819SStefano Zampini                                                                                                                                                          */
1401674ae819SStefano Zampini   total_counts = n_ISForFaces+n_ISForEdges;
1402984c4197SStefano Zampini   total_counts *= max_constraints;
1403674ae819SStefano Zampini   n_vertices = 0;
1404674ae819SStefano Zampini   if (ISForVertices) {
1405674ae819SStefano Zampini     ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
1406674ae819SStefano Zampini   }
1407674ae819SStefano Zampini   total_counts += n_vertices;
1408674ae819SStefano Zampini   ierr = PetscMalloc((total_counts+1)*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
14094641a718SStefano Zampini   ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
1410674ae819SStefano Zampini   total_counts = 0;
1411674ae819SStefano Zampini   max_size_of_constraint = 0;
1412674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1413674ae819SStefano Zampini     if (i<n_ISForEdges) {
1414674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1415674ae819SStefano Zampini     } else {
1416674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1417674ae819SStefano Zampini     }
1418674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
1419674ae819SStefano Zampini     total_counts += j;
1420674ae819SStefano Zampini     max_size_of_constraint = PetscMax(j,max_size_of_constraint);
1421674ae819SStefano Zampini   }
1422984c4197SStefano Zampini   total_counts *= max_constraints;
1423674ae819SStefano Zampini   total_counts += n_vertices;
1424674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&temp_quadrature_constraint);CHKERRQ(ierr);
1425674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint);CHKERRQ(ierr);
1426674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint_B);CHKERRQ(ierr);
1427984c4197SStefano Zampini   /* local to boundary numbering */
1428674ae819SStefano Zampini   ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&local_to_B);CHKERRQ(ierr);
1429674ae819SStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1430984c4197SStefano Zampini   for (i=0;i<pcis->n;i++) local_to_B[i]=-1;
1431984c4197SStefano Zampini   for (i=0;i<pcis->n_B;i++) local_to_B[is_indices[i]]=i;
1432674ae819SStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1433984c4197SStefano Zampini   /* get local part of global near null space vectors */
1434984c4197SStefano Zampini   ierr = PetscMalloc(nnsp_size*sizeof(Vec),&localnearnullsp);CHKERRQ(ierr);
1435984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1436984c4197SStefano Zampini     ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
1437984c4197SStefano Zampini     ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1438984c4197SStefano Zampini     ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1439984c4197SStefano Zampini   }
1440674ae819SStefano Zampini 
1441242a89d7SStefano Zampini   /* whether or not to skip lapack calls */
1442242a89d7SStefano Zampini   skip_lapack = PETSC_TRUE;
1443242a89d7SStefano Zampini   if (n_ISForFaces+n_ISForEdges) skip_lapack = PETSC_FALSE;
1444242a89d7SStefano Zampini 
1445984c4197SStefano Zampini   /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
1446242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1447674ae819SStefano Zampini     PetscScalar temp_work;
1448674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1449984c4197SStefano Zampini     /* Proper Orthogonal Decomposition (POD) using the snapshot method */
1450984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*max_constraints*sizeof(PetscScalar),&correlation_mat);CHKERRQ(ierr);
1451984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1452984c4197SStefano Zampini     ierr = PetscMalloc(max_size_of_constraint*max_constraints*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr);
1453674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1454984c4197SStefano Zampini     ierr = PetscMalloc(3*max_constraints*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1455674ae819SStefano Zampini #endif
1456674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1457c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
1458c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
1459674ae819SStefano Zampini     lwork = -1;
1460674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1461674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1462c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
1463674ae819SStefano Zampini #else
1464c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
1465674ae819SStefano Zampini #endif
1466674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1467984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
1468674ae819SStefano Zampini #else /* on missing GESVD */
1469674ae819SStefano Zampini     /* SVD */
1470674ae819SStefano Zampini     PetscInt max_n,min_n;
1471674ae819SStefano Zampini     max_n = max_size_of_constraint;
1472984c4197SStefano Zampini     min_n = max_constraints;
1473984c4197SStefano Zampini     if (max_size_of_constraint < max_constraints) {
1474674ae819SStefano Zampini       min_n = max_size_of_constraint;
1475984c4197SStefano Zampini       max_n = max_constraints;
1476674ae819SStefano Zampini     }
1477674ae819SStefano Zampini     ierr = PetscMalloc(min_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1478674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1479674ae819SStefano Zampini     ierr = PetscMalloc(5*min_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1480674ae819SStefano Zampini #endif
1481674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1482674ae819SStefano Zampini     lwork = -1;
1483e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
1484e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
1485b7d8b9f8SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
1486674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1487674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1488e310c8b4SStefano 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));
1489674ae819SStefano Zampini #else
1490e310c8b4SStefano 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));
1491674ae819SStefano Zampini #endif
1492674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1493984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
1494984c4197SStefano Zampini #endif /* on missing GESVD */
1495674ae819SStefano Zampini     /* Allocate optimal workspace */
1496674ae819SStefano Zampini     ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
1497984c4197SStefano Zampini     ierr = PetscMalloc((PetscInt)lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
1498674ae819SStefano Zampini   }
1499674ae819SStefano Zampini   /* Now we can loop on constraining sets */
1500674ae819SStefano Zampini   total_counts = 0;
1501674ae819SStefano Zampini   temp_indices[0] = 0;
1502674ae819SStefano Zampini   /* vertices */
1503674ae819SStefano Zampini   if (ISForVertices) {
1504674ae819SStefano Zampini     ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1505674ae819SStefano Zampini     if (nnsp_has_cnst) { /* consider all vertices */
1506674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1507674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1508674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
1509674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1510674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1511674ae819SStefano Zampini         total_counts++;
1512674ae819SStefano Zampini       }
1513674ae819SStefano Zampini     } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
1514984c4197SStefano Zampini       PetscBool used_vertex;
1515674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1516674ae819SStefano Zampini         used_vertex = PETSC_FALSE;
1517674ae819SStefano Zampini         k = 0;
1518674ae819SStefano Zampini         while (!used_vertex && k<nnsp_size) {
1519984c4197SStefano Zampini           ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1520984c4197SStefano Zampini           if (PetscAbsScalar(array[is_indices[i]])>0.0) {
1521674ae819SStefano Zampini             temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1522674ae819SStefano Zampini             temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
1523674ae819SStefano Zampini             temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1524674ae819SStefano Zampini             temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1525674ae819SStefano Zampini             total_counts++;
1526674ae819SStefano Zampini             used_vertex = PETSC_TRUE;
1527674ae819SStefano Zampini           }
1528984c4197SStefano Zampini           ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1529674ae819SStefano Zampini           k++;
1530674ae819SStefano Zampini         }
1531674ae819SStefano Zampini       }
1532674ae819SStefano Zampini     }
1533674ae819SStefano Zampini     ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1534674ae819SStefano Zampini     n_vertices = total_counts;
1535674ae819SStefano Zampini   }
1536984c4197SStefano Zampini 
1537674ae819SStefano Zampini   /* edges and faces */
1538674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1539674ae819SStefano Zampini     if (i<n_ISForEdges) {
1540674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1541984c4197SStefano Zampini       boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
1542674ae819SStefano Zampini     } else {
1543674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1544984c4197SStefano Zampini       boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
1545674ae819SStefano Zampini     }
1546674ae819SStefano Zampini     temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
1547674ae819SStefano Zampini     temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
1548674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
1549674ae819SStefano Zampini     ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1550984c4197SStefano Zampini     /* change of basis should not be performed on local periodic nodes */
1551984c4197SStefano Zampini     if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
1552674ae819SStefano Zampini     if (nnsp_has_cnst) {
15535b08dc53SStefano Zampini       PetscScalar quad_value;
1554674ae819SStefano Zampini       temp_constraints++;
1555674ae819SStefano Zampini       quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
1556674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1557674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
1558674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
1559674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
1560674ae819SStefano Zampini       }
1561674ae819SStefano Zampini       temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
1562674ae819SStefano Zampini       total_counts++;
1563674ae819SStefano Zampini     }
1564674ae819SStefano Zampini     for (k=0;k<nnsp_size;k++) {
1565984c4197SStefano Zampini       PetscReal real_value;
1566984c4197SStefano Zampini       ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1567674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1568674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
1569674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
1570984c4197SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=array[is_indices[j]];
1571674ae819SStefano Zampini       }
1572984c4197SStefano Zampini       ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1573984c4197SStefano Zampini       /* check if array is null on the connected component */
1574e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1575e310c8b4SStefano Zampini       PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_one));
15765b08dc53SStefano Zampini       if (real_value > 0.0) { /* keep indices and values */
1577674ae819SStefano Zampini         temp_constraints++;
1578674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
1579674ae819SStefano Zampini         total_counts++;
1580674ae819SStefano Zampini       }
1581674ae819SStefano Zampini     }
1582674ae819SStefano Zampini     ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
158345a1bb75SStefano Zampini     valid_constraints = temp_constraints;
1584eb97c9d2SStefano 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 */
1585eb97c9d2SStefano Zampini     if (!pcbddc->use_nnsp_true && temp_constraints) {
1586984c4197SStefano Zampini       PetscReal tol = 1.0e-8; /* tolerance for retaining eigenmodes */
1587674ae819SStefano Zampini 
1588674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1589984c4197SStefano Zampini       /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
1590984c4197SStefano Zampini          POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
1591984c4197SStefano Zampini          -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
1592984c4197SStefano Zampini             the constraints basis will differ (by a complex factor with absolute value equal to 1)
1593984c4197SStefano Zampini             from that computed using LAPACKgesvd
1594984c4197SStefano Zampini          -> This is due to a different computation of eigenvectors in LAPACKheev
1595984c4197SStefano Zampini          -> The quality of the POD-computed basis will be the same */
1596984c4197SStefano Zampini       ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
1597674ae819SStefano Zampini       /* Store upper triangular part of correlation matrix */
1598e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1599984c4197SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1600674ae819SStefano Zampini       for (j=0;j<temp_constraints;j++) {
1601674ae819SStefano Zampini         for (k=0;k<j+1;k++) {
1602e310c8b4SStefano 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));
1603674ae819SStefano Zampini         }
1604674ae819SStefano Zampini       }
1605e310c8b4SStefano Zampini       /* compute eigenvalues and eigenvectors of correlation matrix */
1606e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1607e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
1608674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1609c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
1610674ae819SStefano Zampini #else
1611c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
1612674ae819SStefano Zampini #endif
1613674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1614984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
1615984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
1616674ae819SStefano Zampini       j=0;
1617984c4197SStefano Zampini       while (j < temp_constraints && singular_vals[j] < tol) j++;
1618674ae819SStefano Zampini       total_counts=total_counts-j;
161945a1bb75SStefano Zampini       valid_constraints = temp_constraints-j;
1620e310c8b4SStefano Zampini       /* scale and copy POD basis into used quadrature memory */
1621c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1622c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1623c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
1624c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1625c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
1626c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1627674ae819SStefano Zampini       if (j<temp_constraints) {
1628984c4197SStefano Zampini         PetscInt ii;
1629984c4197SStefano Zampini         for (k=j;k<temp_constraints;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]);
1630674ae819SStefano Zampini         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1631c4303822SStefano 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));
1632674ae819SStefano Zampini         ierr = PetscFPTrapPop();CHKERRQ(ierr);
1633984c4197SStefano Zampini         for (k=0;k<temp_constraints-j;k++) {
1634674ae819SStefano Zampini           for (ii=0;ii<size_of_constraint;ii++) {
1635984c4197SStefano 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];
1636674ae819SStefano Zampini           }
1637674ae819SStefano Zampini         }
1638674ae819SStefano Zampini       }
1639674ae819SStefano Zampini #else  /* on missing GESVD */
1640e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1641e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1642b7d8b9f8SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1643674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1644674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1645e310c8b4SStefano 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));
1646674ae819SStefano Zampini #else
1647e310c8b4SStefano 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));
1648674ae819SStefano Zampini #endif
1649984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
1650674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1651984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
1652e310c8b4SStefano Zampini       k = temp_constraints;
1653e310c8b4SStefano Zampini       if (k > size_of_constraint) k = size_of_constraint;
1654674ae819SStefano Zampini       j = 0;
1655e310c8b4SStefano Zampini       while (j < k && singular_vals[k-j-1] < tol) j++;
1656e310c8b4SStefano Zampini       total_counts = total_counts-temp_constraints+k-j;
165745a1bb75SStefano Zampini       valid_constraints = k-j;
1658984c4197SStefano Zampini #endif /* on missing GESVD */
1659674ae819SStefano Zampini     }
166045a1bb75SStefano Zampini     /* setting change_of_basis flag is safe now */
166145a1bb75SStefano Zampini     if (boolforchange) {
166245a1bb75SStefano Zampini       for (j=0;j<valid_constraints;j++) {
166345a1bb75SStefano Zampini         PetscBTSet(change_basis,total_counts-j-1);
166445a1bb75SStefano Zampini       }
166545a1bb75SStefano Zampini     }
1666674ae819SStefano Zampini   }
1667674ae819SStefano Zampini   /* free index sets of faces, edges and vertices */
1668674ae819SStefano Zampini   for (i=0;i<n_ISForFaces;i++) {
1669674ae819SStefano Zampini     ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
1670674ae819SStefano Zampini   }
1671674ae819SStefano Zampini   ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
1672674ae819SStefano Zampini   for (i=0;i<n_ISForEdges;i++) {
1673674ae819SStefano Zampini     ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
1674674ae819SStefano Zampini   }
1675674ae819SStefano Zampini   ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
1676674ae819SStefano Zampini   ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
1677674ae819SStefano Zampini 
1678984c4197SStefano Zampini   /* free workspace */
1679242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1680984c4197SStefano Zampini     ierr = PetscFree(work);CHKERRQ(ierr);
1681984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1682984c4197SStefano Zampini     ierr = PetscFree(rwork);CHKERRQ(ierr);
1683984c4197SStefano Zampini #endif
1684984c4197SStefano Zampini     ierr = PetscFree(singular_vals);CHKERRQ(ierr);
1685984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1686984c4197SStefano Zampini     ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
1687984c4197SStefano Zampini     ierr = PetscFree(temp_basis);CHKERRQ(ierr);
1688984c4197SStefano Zampini #endif
1689984c4197SStefano Zampini   }
1690984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1691984c4197SStefano Zampini     ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
1692984c4197SStefano Zampini   }
1693984c4197SStefano Zampini   ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
1694984c4197SStefano Zampini 
1695727cdba6SStefano Zampini   /* set quantities in pcbddc data structure and store previous primal size */
1696984c4197SStefano Zampini   /* n_vertices defines the number of subdomain corners in the primal space */
1697674ae819SStefano Zampini   /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */
1698727cdba6SStefano Zampini   olocal_primal_size = pcbddc->local_primal_size;
1699984c4197SStefano Zampini   pcbddc->local_primal_size = total_counts;
1700674ae819SStefano Zampini   pcbddc->n_vertices = n_vertices;
1701984c4197SStefano Zampini   pcbddc->n_constraints = pcbddc->local_primal_size-pcbddc->n_vertices;
1702674ae819SStefano Zampini 
1703674ae819SStefano Zampini   /* Create constraint matrix */
1704674ae819SStefano Zampini   /* The constraint matrix is used to compute the l2g map of primal dofs */
1705674ae819SStefano Zampini   /* so we need to set it up properly either with or without change of basis */
1706674ae819SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1707674ae819SStefano Zampini   ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr);
1708984c4197SStefano Zampini   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
1709984c4197SStefano Zampini   /* array to compute a local numbering of constraints : vertices first then constraints */
1710984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_numbering);CHKERRQ(ierr);
1711984c4197SStefano Zampini   /* array to select the proper local node (of minimum index with respect to global ordering) when changing the basis */
1712984c4197SStefano 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 */
1713984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_minloc);CHKERRQ(ierr);
1714984c4197SStefano Zampini   /* auxiliary stuff for basis change */
1715984c4197SStefano Zampini   ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&global_indices);CHKERRQ(ierr);
17164641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n_B,&touched);CHKERRQ(ierr);
1717984c4197SStefano Zampini 
1718984c4197SStefano Zampini   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
1719984c4197SStefano Zampini   total_primal_vertices=0;
1720984c4197SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
1721674ae819SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
1722984c4197SStefano Zampini     if (size_of_constraint == 1) {
17234641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]]);CHKERRQ(ierr);
1724984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]];
1725984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=0;
1726984c4197SStefano Zampini       total_primal_vertices++;
17274641a718SStefano Zampini     } else if (PetscBTLookup(change_basis,i)) { /* Same procedure used in PCBDDCGetPrimalConstraintsLocalIdx */
1728984c4197SStefano Zampini       PetscInt min_loc,min_index;
1729984c4197SStefano Zampini       ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],global_indices);CHKERRQ(ierr);
1730984c4197SStefano Zampini       /* find first untouched local node */
1731674ae819SStefano Zampini       k = 0;
17324641a718SStefano Zampini       while (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) k++;
1733984c4197SStefano Zampini       min_index = global_indices[k];
1734984c4197SStefano Zampini       min_loc = k;
1735984c4197SStefano Zampini       /* search the minimum among global nodes already untouched on the cc */
1736984c4197SStefano Zampini       for (k=1;k<size_of_constraint;k++) {
1737984c4197SStefano Zampini         /* there can be more than one constraint on a single connected component */
17384641a718SStefano Zampini         if (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k]) && min_index > global_indices[k]) {
1739984c4197SStefano Zampini           min_index = global_indices[k];
1740984c4197SStefano Zampini           min_loc = k;
1741674ae819SStefano Zampini         }
1742674ae819SStefano Zampini       }
17434641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]+min_loc]);CHKERRQ(ierr);
1744984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]+min_loc];
1745984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=min_loc;
1746984c4197SStefano Zampini       total_primal_vertices++;
1747984c4197SStefano Zampini     }
1748984c4197SStefano Zampini   }
1749a717540cSStefano Zampini   /* determine if a QR strategy is needed for change of basis */
1750a717540cSStefano Zampini   qr_needed = PETSC_FALSE;
1751a717540cSStefano Zampini   ierr = PetscBTCreate(pcbddc->local_primal_size,&qr_needed_idx);CHKERRQ(ierr);
1752a717540cSStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1753a717540cSStefano Zampini     if (PetscBTLookup(change_basis,i)) {
1754a717540cSStefano Zampini       size_of_constraint = temp_indices[i+1]-temp_indices[i];
1755a717540cSStefano Zampini       j = 0;
1756a717540cSStefano Zampini       for (k=0;k<size_of_constraint;k++) {
1757a717540cSStefano Zampini         if (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) {
1758a717540cSStefano Zampini           j++;
1759a717540cSStefano Zampini         }
1760a717540cSStefano Zampini       }
1761a717540cSStefano Zampini       /* found more than one primal dof on the cc */
1762a717540cSStefano Zampini       if (j > 1) {
1763a717540cSStefano Zampini         PetscBTSet(qr_needed_idx,i);
1764a717540cSStefano Zampini         qr_needed = PETSC_TRUE;
1765a717540cSStefano Zampini       }
1766a717540cSStefano Zampini     }
1767a717540cSStefano Zampini   }
1768984c4197SStefano Zampini   /* free workspace */
1769984c4197SStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
177045a1bb75SStefano Zampini 
1771674ae819SStefano Zampini   /* permute indices in order to have a sorted set of vertices */
1772a717540cSStefano Zampini   ierr = PetscSortInt(total_primal_vertices,aux_primal_numbering);CHKERRQ(ierr);
1773984c4197SStefano Zampini 
1774984c4197SStefano Zampini   /* nonzero structure of constraint matrix */
1775984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1776984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) nnz[i]=1;
1777984c4197SStefano Zampini   j=total_primal_vertices;
1778984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
17794641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1780674ae819SStefano Zampini       nnz[j]=temp_indices[i+1]-temp_indices[i];
1781674ae819SStefano Zampini       j++;
1782674ae819SStefano Zampini     }
1783674ae819SStefano Zampini   }
1784674ae819SStefano Zampini   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
1785674ae819SStefano Zampini   ierr = PetscFree(nnz);CHKERRQ(ierr);
1786674ae819SStefano Zampini   /* set values in constraint matrix */
1787984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) {
1788984c4197SStefano Zampini     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,aux_primal_numbering[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
1789674ae819SStefano Zampini   }
1790984c4197SStefano Zampini   total_counts = total_primal_vertices;
1791984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
17924641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1793674ae819SStefano Zampini       size_of_constraint=temp_indices[i+1]-temp_indices[i];
1794674ae819SStefano 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);
1795674ae819SStefano Zampini       total_counts++;
1796674ae819SStefano Zampini     }
1797674ae819SStefano Zampini   }
1798674ae819SStefano Zampini   /* assembling */
1799674ae819SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1800674ae819SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1801984c4197SStefano Zampini   /*
180245a1bb75SStefano Zampini   ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
1803984c4197SStefano Zampini   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
1804984c4197SStefano Zampini   */
1805674ae819SStefano Zampini   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
1806674ae819SStefano Zampini   if (pcbddc->use_change_of_basis) {
1807026de310SStefano Zampini     /* dual and primal dofs on a single cc */
1808984c4197SStefano Zampini     PetscInt     dual_dofs,primal_dofs;
1809026de310SStefano Zampini     /* iterator on aux_primal_minloc (ordered as read from nearnullspace: vertices, edges and then constraints) */
1810026de310SStefano Zampini     PetscInt     primal_counter;
1811984c4197SStefano Zampini     /* working stuff for GEQRF */
1812984c4197SStefano Zampini     PetscScalar  *qr_basis,*qr_tau,*qr_work,lqr_work_t;
1813984c4197SStefano Zampini     PetscBLASInt lqr_work;
1814984c4197SStefano Zampini     /* working stuff for UNGQR */
1815984c4197SStefano Zampini     PetscScalar  *gqr_work,lgqr_work_t;
1816984c4197SStefano Zampini     PetscBLASInt lgqr_work;
1817984c4197SStefano Zampini     /* working stuff for TRTRS */
1818984c4197SStefano Zampini     PetscScalar  *trs_rhs;
18193f08241aSStefano Zampini     PetscBLASInt Blas_NRHS;
1820984c4197SStefano Zampini     /* pointers for values insertion into change of basis matrix */
1821984c4197SStefano Zampini     PetscInt     *start_rows,*start_cols;
1822984c4197SStefano Zampini     PetscScalar  *start_vals;
1823984c4197SStefano Zampini     /* working stuff for values insertion */
18244641a718SStefano Zampini     PetscBT      is_primal;
1825984c4197SStefano Zampini 
1826a717540cSStefano Zampini     /* change of basis acts on local interfaces -> dimension is n_B x n_B */
1827a717540cSStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
1828a717540cSStefano Zampini     ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr);
1829a717540cSStefano Zampini     ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr);
1830a717540cSStefano Zampini     /* work arrays */
1831a717540cSStefano Zampini     ierr = PetscMalloc(pcis->n_B*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1832a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) nnz[i]=1;
1833a717540cSStefano Zampini     /* nonzeros per row */
1834a717540cSStefano Zampini     for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1835a717540cSStefano Zampini       if (PetscBTLookup(change_basis,i)) {
1836a717540cSStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
1837a717540cSStefano Zampini         if (PetscBTLookup(qr_needed_idx,i)) {
1838a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1839a717540cSStefano Zampini         } else {
1840a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = 2;
1841a717540cSStefano Zampini           /* get local primal index on the cc */
1842a717540cSStefano Zampini           j = 0;
1843a717540cSStefano Zampini           while (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+j])) j++;
1844a717540cSStefano Zampini           nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1845a717540cSStefano Zampini         }
1846a717540cSStefano Zampini       }
1847a717540cSStefano Zampini     }
1848a717540cSStefano Zampini     ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
1849a717540cSStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
1850a717540cSStefano Zampini     /* Set initial identity in the matrix */
1851a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) {
1852a717540cSStefano Zampini       ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
1853a717540cSStefano Zampini     }
1854a717540cSStefano Zampini 
1855a717540cSStefano Zampini     if (pcbddc->dbg_flag) {
1856a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1857a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
1858a717540cSStefano Zampini     }
1859a717540cSStefano Zampini 
1860a717540cSStefano Zampini 
1861a717540cSStefano Zampini     /* Now we loop on the constraints which need a change of basis */
1862a717540cSStefano Zampini     /*
1863a717540cSStefano Zampini        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
1864a717540cSStefano Zampini        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
1865a717540cSStefano Zampini 
1866a717540cSStefano Zampini        Basic blocks of change of basis matrix T computed
1867a717540cSStefano Zampini 
1868a717540cSStefano Zampini           - Using the following block transformation if there is only a primal dof on the cc
1869a717540cSStefano Zampini             (in the example, primal dof is the last one of the edge in LOCAL ordering
1870a717540cSStefano Zampini              in this code, primal dof is the first one of the edge in GLOBAL ordering)
1871a717540cSStefano Zampini             | 1        0   ...        0     1 |
1872a717540cSStefano Zampini             | 0        1   ...        0     1 |
1873a717540cSStefano Zampini             |              ...                |
1874a717540cSStefano Zampini             | 0        ...            1     1 |
1875a717540cSStefano Zampini             | -s_1/s_n ...    -s_{n-1}/-s_n 1 |
1876a717540cSStefano Zampini 
1877a717540cSStefano Zampini           - via QR decomposition of constraints otherwise
1878a717540cSStefano Zampini     */
1879a717540cSStefano Zampini     if (qr_needed) {
1880984c4197SStefano Zampini       /* space to store Q */
1881984c4197SStefano Zampini       ierr = PetscMalloc((max_size_of_constraint)*(max_size_of_constraint)*sizeof(PetscScalar),&qr_basis);CHKERRQ(ierr);
1882984c4197SStefano Zampini       /* first we issue queries for optimal work */
18833f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
18843f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
18853f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1886984c4197SStefano Zampini       lqr_work = -1;
18873f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
1888984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
1889984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
1890984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lqr_work_t)*sizeof(*qr_work),&qr_work);CHKERRQ(ierr);
1891984c4197SStefano Zampini       lgqr_work = -1;
18923f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
18933f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
18943f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
18953f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
18963f08241aSStefano Zampini       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
18973f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
1898984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
1899984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
1900984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lgqr_work_t)*sizeof(*gqr_work),&gqr_work);CHKERRQ(ierr);
1901984c4197SStefano Zampini       /* array to store scaling factors for reflectors */
1902984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*sizeof(*qr_tau),&qr_tau);CHKERRQ(ierr);
1903984c4197SStefano Zampini       /* array to store rhs and solution of triangular solver */
1904984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*max_constraints*sizeof(*trs_rhs),&trs_rhs);CHKERRQ(ierr);
1905a717540cSStefano Zampini       /* allocating workspace for check */
1906a717540cSStefano Zampini       if (pcbddc->dbg_flag) {
1907a717540cSStefano Zampini         ierr = PetscMalloc(max_size_of_constraint*(max_constraints+max_size_of_constraint)*sizeof(*work),&work);CHKERRQ(ierr);
1908a717540cSStefano Zampini       }
1909a717540cSStefano Zampini     }
1910984c4197SStefano Zampini     /* array to store whether a node is primal or not */
19114641a718SStefano Zampini     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
19124641a718SStefano Zampini     for (i=0;i<total_primal_vertices;i++) {
19134641a718SStefano Zampini       ierr = PetscBTSet(is_primal,local_to_B[aux_primal_numbering[i]]);CHKERRQ(ierr);
19144641a718SStefano Zampini     }
1915984c4197SStefano Zampini 
1916a717540cSStefano Zampini     /* loop on constraints and see whether or not they need a change of basis and compute it */
1917026de310SStefano Zampini     /* -> using implicit ordering contained in temp_indices data */
1918026de310SStefano Zampini     total_counts = pcbddc->n_vertices;
1919026de310SStefano Zampini     primal_counter = total_counts;
1920026de310SStefano Zampini     while (total_counts<pcbddc->local_primal_size) {
1921026de310SStefano Zampini       primal_dofs = 1;
19224641a718SStefano Zampini       if (PetscBTLookup(change_basis,total_counts)) {
1923026de310SStefano Zampini         /* get all constraints with same support: if more then one constraint is present on the cc then surely indices are stored contiguosly */
1924026de310SStefano 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]]) {
1925026de310SStefano Zampini           primal_dofs++;
1926674ae819SStefano Zampini         }
1927984c4197SStefano Zampini         /* get constraint info */
1928026de310SStefano Zampini         size_of_constraint = temp_indices[total_counts+1]-temp_indices[total_counts];
1929984c4197SStefano Zampini         dual_dofs = size_of_constraint-primal_dofs;
1930984c4197SStefano Zampini 
1931984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
1932a717540cSStefano 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);
1933674ae819SStefano Zampini         }
1934984c4197SStefano Zampini 
1935a717540cSStefano Zampini         if (primal_dofs > 1) { /* QR */
1936a717540cSStefano Zampini 
1937a717540cSStefano Zampini           /* copy quadrature constraints for change of basis check */
1938a717540cSStefano Zampini           if (pcbddc->dbg_flag) {
1939a717540cSStefano Zampini             ierr = PetscMemcpy(work,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1940a717540cSStefano Zampini           }
1941984c4197SStefano Zampini           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
1942026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1943984c4197SStefano Zampini 
1944984c4197SStefano Zampini           /* compute QR decomposition of constraints */
19453f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
19463f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
19473f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1948674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
19493f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
1950984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
1951674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1952984c4197SStefano Zampini 
1953984c4197SStefano Zampini           /* explictly compute R^-T */
1954984c4197SStefano Zampini           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
1955984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
19563f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
19573f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
19583f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
19593f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
1960984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
19613f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
1962984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
1963984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1964984c4197SStefano Zampini 
1965a717540cSStefano Zampini           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
19663f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
19673f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
19683f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
19693f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1970984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
19713f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
1972984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
1973984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1974984c4197SStefano Zampini 
1975984c4197SStefano Zampini           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
1976984c4197SStefano Zampini              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
1977984c4197SStefano Zampini              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
19783f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
19793f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
19803f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
19813f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
19823f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
19833f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1984984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1985c4303822SStefano 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));
1986984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1987026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1988984c4197SStefano Zampini 
1989984c4197SStefano Zampini           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
1990026de310SStefano Zampini           start_rows = &temp_indices_to_constraint_B[temp_indices[total_counts]];
1991984c4197SStefano Zampini           /* insert cols for primal dofs */
1992984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) {
1993984c4197SStefano Zampini             start_vals = &qr_basis[j*size_of_constraint];
1994026de310SStefano Zampini             start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter+j]];
1995984c4197SStefano Zampini             ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1996984c4197SStefano Zampini           }
1997984c4197SStefano Zampini           /* insert cols for dual dofs */
1998984c4197SStefano Zampini           for (j=0,k=0;j<dual_dofs;k++) {
19994641a718SStefano Zampini             if (!PetscBTLookup(is_primal,temp_indices_to_constraint_B[temp_indices[total_counts]+k])) {
2000984c4197SStefano Zampini               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
2001026de310SStefano Zampini               start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+k];
2002984c4197SStefano Zampini               ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
2003984c4197SStefano Zampini               j++;
2004674ae819SStefano Zampini             }
2005674ae819SStefano Zampini           }
2006984c4197SStefano Zampini 
2007984c4197SStefano Zampini           /* check change of basis */
2008984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
2009984c4197SStefano Zampini             PetscInt   ii,jj;
2010984c4197SStefano Zampini             PetscBool valid_qr=PETSC_TRUE;
2011c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
2012c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2013c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
2014c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2015c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
2016c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
2017984c4197SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2018c4303822SStefano 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));
2019984c4197SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
2020984c4197SStefano Zampini             for (jj=0;jj<size_of_constraint;jj++) {
2021984c4197SStefano Zampini               for (ii=0;ii<primal_dofs;ii++) {
2022984c4197SStefano Zampini                 if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
2023984c4197SStefano Zampini                 if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
2024674ae819SStefano Zampini               }
2025674ae819SStefano Zampini             }
2026984c4197SStefano Zampini             if (!valid_qr) {
2027984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
2028984c4197SStefano Zampini               for (jj=0;jj<size_of_constraint;jj++) {
2029984c4197SStefano Zampini                 for (ii=0;ii<primal_dofs;ii++) {
2030984c4197SStefano Zampini                   if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
2031984c4197SStefano 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]));
2032674ae819SStefano Zampini                   }
2033984c4197SStefano Zampini                   if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
2034984c4197SStefano 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]));
2035984c4197SStefano Zampini                   }
2036984c4197SStefano Zampini                 }
2037984c4197SStefano Zampini               }
2038674ae819SStefano Zampini             } else {
2039984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
2040674ae819SStefano Zampini             }
2041674ae819SStefano Zampini           }
2042a717540cSStefano Zampini         } else { /* simple transformation block */
2043a717540cSStefano Zampini           PetscInt row,col;
2044a717540cSStefano Zampini           PetscScalar val;
2045a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) {
2046a717540cSStefano Zampini             row = temp_indices_to_constraint_B[temp_indices[total_counts]+j];
2047a717540cSStefano Zampini             if (!PetscBTLookup(is_primal,row)) {
2048a717540cSStefano Zampini               col = temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
2049a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
2050a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,1.0,INSERT_VALUES);CHKERRQ(ierr);
2051a717540cSStefano Zampini             } else {
2052a717540cSStefano Zampini               for (k=0;k<size_of_constraint;k++) {
2053a717540cSStefano Zampini                 col = temp_indices_to_constraint_B[temp_indices[total_counts]+k];
2054a717540cSStefano Zampini                 if (row != col) {
2055a717540cSStefano Zampini                   val = -temp_quadrature_constraint[temp_indices[total_counts]+k]/temp_quadrature_constraint[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
2056a717540cSStefano Zampini                 } else {
2057a717540cSStefano Zampini                   val = 1.0;
2058a717540cSStefano Zampini                 }
2059a717540cSStefano Zampini                 ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
2060a717540cSStefano Zampini               }
2061a717540cSStefano Zampini             }
2062a717540cSStefano Zampini           }
2063a717540cSStefano Zampini         }
2064026de310SStefano Zampini         /* increment primal counter */
2065026de310SStefano Zampini         primal_counter += primal_dofs;
2066984c4197SStefano Zampini       } else {
2067984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
2068026de310SStefano 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);
2069674ae819SStefano Zampini         }
2070674ae819SStefano Zampini       }
2071026de310SStefano Zampini       /* increment constraint counter total_counts */
2072026de310SStefano Zampini       total_counts += primal_dofs;
2073674ae819SStefano Zampini     }
2074a717540cSStefano Zampini 
2075a717540cSStefano Zampini     /* free workspace */
2076a717540cSStefano Zampini     if (qr_needed) {
2077984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
2078984c4197SStefano Zampini         ierr = PetscFree(work);CHKERRQ(ierr);
2079984c4197SStefano Zampini       }
2080984c4197SStefano Zampini       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
2081984c4197SStefano Zampini       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
2082984c4197SStefano Zampini       ierr = PetscFree(qr_work);CHKERRQ(ierr);
2083984c4197SStefano Zampini       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
2084984c4197SStefano Zampini       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
2085674ae819SStefano Zampini     }
2086a717540cSStefano Zampini     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
2087674ae819SStefano Zampini     /* assembling */
2088674ae819SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2089674ae819SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2090984c4197SStefano Zampini     /*
209145a1bb75SStefano Zampini     ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
2092984c4197SStefano Zampini     ierr = MatView(pcbddc->ChangeOfBasisMatrix,(PetscViewer)0);CHKERRQ(ierr);
2093984c4197SStefano Zampini     */
2094674ae819SStefano Zampini   }
2095a717540cSStefano Zampini 
2096727cdba6SStefano Zampini   /* get indices in local ordering for vertices and constraints */
2097727cdba6SStefano 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 */
2098727cdba6SStefano Zampini     ierr = PetscMalloc(olocal_primal_size*sizeof(PetscInt),&oprimal_indices_local_idxs);CHKERRQ(ierr);
2099727cdba6SStefano Zampini     ierr = PetscMemcpy(oprimal_indices_local_idxs,pcbddc->primal_indices_local_idxs,olocal_primal_size*sizeof(PetscInt));CHKERRQ(ierr);
2100727cdba6SStefano Zampini   }
2101727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2102727cdba6SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
2103727cdba6SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&i,&aux_primal_numbering);CHKERRQ(ierr);
2104727cdba6SStefano Zampini   ierr = PetscMemcpy(pcbddc->primal_indices_local_idxs,aux_primal_numbering,i*sizeof(PetscInt));CHKERRQ(ierr);
2105727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2106727cdba6SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&j,&aux_primal_numbering);CHKERRQ(ierr);
2107727cdba6SStefano Zampini   ierr = PetscMemcpy(&pcbddc->primal_indices_local_idxs[i],aux_primal_numbering,j*sizeof(PetscInt));CHKERRQ(ierr);
2108727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2109727cdba6SStefano Zampini   /* check if a new primal space has been introduced */
2110727cdba6SStefano Zampini   pcbddc->new_primal_space_local = PETSC_TRUE;
2111727cdba6SStefano Zampini   if (olocal_primal_size == pcbddc->local_primal_size) {
2112727cdba6SStefano Zampini     ierr = PetscMemcmp(pcbddc->primal_indices_local_idxs,oprimal_indices_local_idxs,olocal_primal_size,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
2113727cdba6SStefano Zampini     pcbddc->new_primal_space_local = !pcbddc->new_primal_space_local;
2114727cdba6SStefano Zampini     ierr = PetscFree(oprimal_indices_local_idxs);CHKERRQ(ierr);
2115727cdba6SStefano Zampini   }
2116727cdba6SStefano Zampini   /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
2117727cdba6SStefano Zampini   ierr = MPI_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2118727cdba6SStefano Zampini 
2119a717540cSStefano Zampini   /* flush dbg viewer */
2120b8ffe317SStefano Zampini   if (pcbddc->dbg_flag) {
2121b8ffe317SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2122b8ffe317SStefano Zampini   }
2123a717540cSStefano Zampini 
2124e310c8b4SStefano Zampini   /* free workspace */
2125a717540cSStefano Zampini   ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2126a717540cSStefano Zampini   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
2127984c4197SStefano Zampini   ierr = PetscFree(aux_primal_minloc);CHKERRQ(ierr);
2128674ae819SStefano Zampini   ierr = PetscFree(temp_indices);CHKERRQ(ierr);
21294641a718SStefano Zampini   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
2130674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr);
2131674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
2132674ae819SStefano Zampini   ierr = PetscFree(local_to_B);CHKERRQ(ierr);
2133674ae819SStefano Zampini   ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr);
2134674ae819SStefano Zampini   PetscFunctionReturn(0);
2135674ae819SStefano Zampini }
2136674ae819SStefano Zampini 
2137674ae819SStefano Zampini #undef __FUNCT__
2138674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
2139674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
2140674ae819SStefano Zampini {
2141674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
2142674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
2143674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
2144674ae819SStefano Zampini   PetscInt    bs,ierr,i,vertex_size;
2145674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
2146674ae819SStefano Zampini 
2147674ae819SStefano Zampini   PetscFunctionBegin;
21488e61c736SStefano Zampini   /* Reset previously computed graph */
21498e61c736SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
2150674ae819SStefano Zampini   /* Init local Graph struct */
2151674ae819SStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr);
2152674ae819SStefano Zampini 
2153575ad6abSStefano Zampini   /* Check validity of the csr graph passed in by the user */
2154575ad6abSStefano Zampini   if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) {
2155575ad6abSStefano Zampini     ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
2156575ad6abSStefano Zampini   }
21579577ea80SStefano Zampini 
2158674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
2159674ae819SStefano Zampini   if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) {
2160674ae819SStefano Zampini     Mat mat_adj;
2161674ae819SStefano Zampini     const PetscInt *xadj,*adjncy;
2162674ae819SStefano Zampini     PetscBool flg_row=PETSC_TRUE;
2163674ae819SStefano Zampini 
2164674ae819SStefano Zampini     ierr = MatConvert(matis->A,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr);
2165674ae819SStefano Zampini     ierr = MatGetRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2166674ae819SStefano Zampini     if (!flg_row) {
2167674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ called in %s\n",__FUNCT__);
2168674ae819SStefano Zampini     }
2169674ae819SStefano Zampini     ierr = PCBDDCSetLocalAdjacencyGraph(pc,i,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
2170674ae819SStefano Zampini     ierr = MatRestoreRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2171674ae819SStefano Zampini     if (!flg_row) {
2172674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__);
2173674ae819SStefano Zampini     }
2174674ae819SStefano Zampini     ierr = MatDestroy(&mat_adj);CHKERRQ(ierr);
2175674ae819SStefano Zampini   }
2176674ae819SStefano Zampini 
2177674ae819SStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting */
2178674ae819SStefano Zampini   vertex_size = 1;
21799577ea80SStefano Zampini   if (!pcbddc->user_provided_isfordofs) {
2180674ae819SStefano Zampini     if (!pcbddc->n_ISForDofs) {
2181674ae819SStefano Zampini       IS *custom_ISForDofs;
2182674ae819SStefano Zampini 
2183674ae819SStefano Zampini       ierr = MatGetBlockSize(matis->A,&bs);CHKERRQ(ierr);
2184674ae819SStefano Zampini       ierr = PetscMalloc(bs*sizeof(IS),&custom_ISForDofs);CHKERRQ(ierr);
2185674ae819SStefano Zampini       for (i=0;i<bs;i++) {
2186674ae819SStefano Zampini         ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n/bs,i,bs,&custom_ISForDofs[i]);CHKERRQ(ierr);
2187674ae819SStefano Zampini       }
2188674ae819SStefano Zampini       ierr = PCBDDCSetDofsSplitting(pc,bs,custom_ISForDofs);CHKERRQ(ierr);
21899577ea80SStefano Zampini       pcbddc->user_provided_isfordofs = PETSC_FALSE;
2190674ae819SStefano Zampini       /* remove my references to IS objects */
2191674ae819SStefano Zampini       for (i=0;i<bs;i++) {
2192674ae819SStefano Zampini         ierr = ISDestroy(&custom_ISForDofs[i]);CHKERRQ(ierr);
2193674ae819SStefano Zampini       }
2194674ae819SStefano Zampini       ierr = PetscFree(custom_ISForDofs);CHKERRQ(ierr);
21959577ea80SStefano Zampini     }
21969577ea80SStefano Zampini   } else { /* mat block size as vertex size (used for elasticity with rigid body modes as nearnullspace) */
2197674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
2198674ae819SStefano Zampini   }
2199674ae819SStefano Zampini 
2200674ae819SStefano Zampini   /* Setup of Graph */
2201674ae819SStefano Zampini   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundaries,pcbddc->DirichletBoundaries,pcbddc->n_ISForDofs,pcbddc->ISForDofs,pcbddc->user_primal_vertices);
2202674ae819SStefano Zampini 
2203674ae819SStefano Zampini   /* Graph's connected components analysis */
2204674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
2205674ae819SStefano Zampini 
2206674ae819SStefano Zampini   /* print some info to stdout */
2207674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
2208e49050b4SStefano Zampini     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer);
2209674ae819SStefano Zampini   }
2210fb180af4SStefano Zampini 
2211fb180af4SStefano Zampini   /* mark topography has done */
2212fb180af4SStefano Zampini   pcbddc->recompute_topography = PETSC_FALSE;
2213674ae819SStefano Zampini   PetscFunctionReturn(0);
2214674ae819SStefano Zampini }
2215674ae819SStefano Zampini 
2216674ae819SStefano Zampini #undef __FUNCT__
2217674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx"
2218f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt **vertices_idx)
2219674ae819SStefano Zampini {
2220674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2221674ae819SStefano Zampini   PetscInt       *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size;
2222674ae819SStefano Zampini   PetscErrorCode ierr;
2223674ae819SStefano Zampini 
2224674ae819SStefano Zampini   PetscFunctionBegin;
2225674ae819SStefano Zampini   n = 0;
2226674ae819SStefano Zampini   vertices = 0;
2227674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2228674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr);
2229b120a5c6SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2230b120a5c6SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2231b120a5c6SStefano Zampini       if (size_of_constraint == 1) n++;
2232b120a5c6SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2233b120a5c6SStefano Zampini     }
2234811e8ca2SStefano Zampini     if (vertices_idx) {
2235b120a5c6SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&vertices);CHKERRQ(ierr);
2236b120a5c6SStefano Zampini       n = 0;
2237674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2238674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2239674ae819SStefano Zampini         if (size_of_constraint == 1) {
2240674ae819SStefano Zampini           vertices[n++]=row_cmat_indices[0];
2241674ae819SStefano Zampini         }
2242674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2243674ae819SStefano Zampini       }
2244674ae819SStefano Zampini     }
2245811e8ca2SStefano Zampini   }
2246674ae819SStefano Zampini   *n_vertices = n;
2247811e8ca2SStefano Zampini   if (vertices_idx) *vertices_idx = vertices;
2248674ae819SStefano Zampini   PetscFunctionReturn(0);
2249674ae819SStefano Zampini }
2250674ae819SStefano Zampini 
2251674ae819SStefano Zampini #undef __FUNCT__
2252674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx"
2253f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt **constraints_idx)
2254674ae819SStefano Zampini {
2255674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2256674ae819SStefano Zampini   PetscInt       *constraints_index,*row_cmat_indices,*row_cmat_global_indices;
2257674ae819SStefano Zampini   PetscInt       n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc;
22584641a718SStefano Zampini   PetscBT        touched;
2259674ae819SStefano Zampini   PetscErrorCode ierr;
2260674ae819SStefano Zampini 
2261f34684f1SStefano Zampini     /* This function assumes that the number of local constraints per connected component
2262f34684f1SStefano Zampini        is not greater than the number of nodes defined for the connected component
2263f34684f1SStefano Zampini        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
2264674ae819SStefano Zampini   PetscFunctionBegin;
2265674ae819SStefano Zampini   n = 0;
2266674ae819SStefano Zampini   constraints_index = 0;
2267674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2268674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr);
2269674ae819SStefano Zampini     max_size_of_constraint = 0;
2270674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2271674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2272674ae819SStefano Zampini       if (size_of_constraint > 1) {
2273674ae819SStefano Zampini         n++;
2274674ae819SStefano Zampini       }
2275674ae819SStefano Zampini       max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint);
2276674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2277674ae819SStefano Zampini     }
2278811e8ca2SStefano Zampini     if (constraints_idx) {
2279674ae819SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&constraints_index);CHKERRQ(ierr);
2280674ae819SStefano Zampini       ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&row_cmat_global_indices);CHKERRQ(ierr);
22814641a718SStefano Zampini       ierr = PetscBTCreate(local_size,&touched);CHKERRQ(ierr);
2282674ae819SStefano Zampini       n = 0;
2283674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2284674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2285674ae819SStefano Zampini         if (size_of_constraint > 1) {
2286674ae819SStefano Zampini           ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr);
228782d3d8afSStefano Zampini           /* find first untouched local node */
228882d3d8afSStefano Zampini           j = 0;
22894641a718SStefano Zampini           while (PetscBTLookup(touched,row_cmat_indices[j])) j++;
229082d3d8afSStefano Zampini           min_index = row_cmat_global_indices[j];
229182d3d8afSStefano Zampini           min_loc = j;
229282d3d8afSStefano Zampini           /* search the minimum among nodes not yet touched on the connected component
229382d3d8afSStefano Zampini              since there can be more than one constraint on a single cc */
2294674ae819SStefano Zampini           for (j=1;j<size_of_constraint;j++) {
22954641a718SStefano Zampini             if (!PetscBTLookup(touched,row_cmat_indices[j]) && min_index > row_cmat_global_indices[j]) {
2296674ae819SStefano Zampini               min_index = row_cmat_global_indices[j];
2297674ae819SStefano Zampini               min_loc = j;
2298674ae819SStefano Zampini             }
2299674ae819SStefano Zampini           }
23004641a718SStefano Zampini           ierr = PetscBTSet(touched,row_cmat_indices[min_loc]);CHKERRQ(ierr);
2301674ae819SStefano Zampini           constraints_index[n++] = row_cmat_indices[min_loc];
2302674ae819SStefano Zampini         }
2303674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2304674ae819SStefano Zampini       }
23054641a718SStefano Zampini       ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2306674ae819SStefano Zampini       ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr);
2307811e8ca2SStefano Zampini     }
2308811e8ca2SStefano Zampini   }
2309674ae819SStefano Zampini   *n_constraints = n;
2310811e8ca2SStefano Zampini   if (constraints_idx) *constraints_idx = constraints_index;
2311674ae819SStefano Zampini   PetscFunctionReturn(0);
2312674ae819SStefano Zampini }
2313674ae819SStefano Zampini 
2314674ae819SStefano Zampini /* the next two functions has been adapted from pcis.c */
2315674ae819SStefano Zampini #undef __FUNCT__
2316674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchur"
2317674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchur(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2318674ae819SStefano Zampini {
2319674ae819SStefano Zampini   PetscErrorCode ierr;
2320674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2321674ae819SStefano Zampini 
2322674ae819SStefano Zampini   PetscFunctionBegin;
2323674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2324674ae819SStefano Zampini   ierr = MatMult(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2325674ae819SStefano Zampini   ierr = MatMult(pcis->A_IB,v,vec1_D);CHKERRQ(ierr);
2326674ae819SStefano Zampini   ierr = KSPSolve(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2327674ae819SStefano Zampini   ierr = MatMult(pcis->A_BI,vec2_D,vec2_B);CHKERRQ(ierr);
2328674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2329674ae819SStefano Zampini   PetscFunctionReturn(0);
2330674ae819SStefano Zampini }
2331674ae819SStefano Zampini 
2332674ae819SStefano Zampini #undef __FUNCT__
2333674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchurTranspose"
2334674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchurTranspose(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2335674ae819SStefano Zampini {
2336674ae819SStefano Zampini   PetscErrorCode ierr;
2337674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2338674ae819SStefano Zampini 
2339674ae819SStefano Zampini   PetscFunctionBegin;
2340674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2341674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2342674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BI,v,vec1_D);CHKERRQ(ierr);
2343674ae819SStefano Zampini   ierr = KSPSolveTranspose(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2344674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_IB,vec2_D,vec2_B);CHKERRQ(ierr);
2345674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2346674ae819SStefano Zampini   PetscFunctionReturn(0);
2347674ae819SStefano Zampini }
2348674ae819SStefano Zampini 
2349674ae819SStefano Zampini #undef __FUNCT__
2350674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
2351674ae819SStefano 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[])
2352674ae819SStefano Zampini {
2353674ae819SStefano Zampini   Vec            local_vec,global_vec;
2354674ae819SStefano Zampini   IS             seqis,paris;
2355674ae819SStefano Zampini   VecScatter     scatter_ctx;
2356674ae819SStefano Zampini   PetscScalar    *array;
2357674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
2358674ae819SStefano Zampini   PetscScalar    globalsum;
2359674ae819SStefano Zampini   PetscInt       i,j,s;
2360674ae819SStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local;
2361674ae819SStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm,max_global;
2362674ae819SStefano Zampini   PetscMPIInt    *dof_sizes,*dof_displs;
2363674ae819SStefano Zampini   PetscBool      first_found;
2364674ae819SStefano Zampini   PetscErrorCode ierr;
2365674ae819SStefano Zampini 
2366674ae819SStefano Zampini   PetscFunctionBegin;
2367674ae819SStefano Zampini   /* mpi buffers */
2368674ae819SStefano Zampini   MPI_Comm_size(comm,&size_prec_comm);
2369674ae819SStefano Zampini   MPI_Comm_rank(comm,&rank_prec_comm);
2370674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
2371674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_sizes),&dof_sizes);CHKERRQ(ierr);
2372674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_displs),&dof_displs);CHKERRQ(ierr);
2373674ae819SStefano Zampini   /* get maximum size of subset */
2374674ae819SStefano Zampini   ierr = PetscMalloc(n_local_dofs*sizeof(PetscInt),&temp_global_dofs);CHKERRQ(ierr);
2375674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
2376674ae819SStefano Zampini   max_local = 0;
2377674ae819SStefano Zampini   if (n_local_dofs) {
2378674ae819SStefano Zampini     max_local = temp_global_dofs[0];
2379674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2380674ae819SStefano Zampini       if (max_local < temp_global_dofs[i] ) {
2381674ae819SStefano Zampini         max_local = temp_global_dofs[i];
2382674ae819SStefano Zampini       }
2383674ae819SStefano Zampini     }
2384674ae819SStefano Zampini   }
2385674ae819SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);
2386674ae819SStefano Zampini   max_global++;
2387674ae819SStefano Zampini   max_local = 0;
2388674ae819SStefano Zampini   if (n_local_dofs) {
2389674ae819SStefano Zampini     max_local = local_dofs[0];
2390674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2391674ae819SStefano Zampini       if (max_local < local_dofs[i] ) {
2392674ae819SStefano Zampini         max_local = local_dofs[i];
2393674ae819SStefano Zampini       }
2394674ae819SStefano Zampini     }
2395674ae819SStefano Zampini   }
2396674ae819SStefano Zampini   max_local++;
2397674ae819SStefano Zampini   /* allocate workspace */
2398674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
2399674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
2400674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
2401674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
2402674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
2403674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
2404674ae819SStefano Zampini   /* create scatter */
2405674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
2406674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
2407674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
2408674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
2409674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
2410674ae819SStefano Zampini   /* init array */
2411674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
2412674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2413674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2414674ae819SStefano Zampini   if (local_dofs_mult) {
2415674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2416674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
2417674ae819SStefano Zampini     }
2418674ae819SStefano Zampini   } else {
2419674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2420674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
2421674ae819SStefano Zampini     }
2422674ae819SStefano Zampini   }
2423674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2424674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
2425674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2426674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2427674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
24285b08dc53SStefano Zampini   *n_global_subset = (PetscInt)PetscRealPart(globalsum);
2429674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
2430674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
2431674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
2432674ae819SStefano Zampini   nlocals = 0;
2433674ae819SStefano Zampini   first_index = -1;
2434674ae819SStefano Zampini   first_found = PETSC_FALSE;
2435674ae819SStefano Zampini   for (i=0;i<s;i++) {
24365b08dc53SStefano Zampini     if (!first_found && PetscRealPart(array[i]) > 0.0) {
2437674ae819SStefano Zampini       first_found = PETSC_TRUE;
2438674ae819SStefano Zampini       first_index = i;
2439674ae819SStefano Zampini     }
24405b08dc53SStefano Zampini     nlocals += (PetscInt)PetscRealPart(array[i]);
2441674ae819SStefano Zampini   }
2442674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2443674ae819SStefano Zampini   if (!rank_prec_comm) {
2444674ae819SStefano Zampini     dof_displs[0]=0;
2445674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
2446674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
2447674ae819SStefano Zampini     }
2448674ae819SStefano Zampini   }
2449674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2450674ae819SStefano Zampini   if (first_found) {
2451674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
2452674ae819SStefano Zampini     old_index = first_index;
2453674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
24545b08dc53SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) {
2455674ae819SStefano Zampini         array[i] += array[old_index];
2456674ae819SStefano Zampini         old_index = i;
2457674ae819SStefano Zampini       }
2458674ae819SStefano Zampini     }
2459674ae819SStefano Zampini   }
2460674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
2461674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2462674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2463674ae819SStefano Zampini   ierr = VecScatterEnd  (scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2464674ae819SStefano Zampini   /* get global ordering of local dofs */
2465674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2466674ae819SStefano Zampini   if (local_dofs_mult) {
2467674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
24685b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i];
2469674ae819SStefano Zampini     }
2470674ae819SStefano Zampini   } else {
2471674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
24725b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1;
2473674ae819SStefano Zampini     }
2474674ae819SStefano Zampini   }
2475674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2476674ae819SStefano Zampini   /* free workspace */
2477674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
2478674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
2479674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
2480674ae819SStefano Zampini   ierr = PetscFree(dof_sizes);CHKERRQ(ierr);
2481674ae819SStefano Zampini   ierr = PetscFree(dof_displs);CHKERRQ(ierr);
2482674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
2483674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
2484674ae819SStefano Zampini   PetscFunctionReturn(0);
2485674ae819SStefano Zampini }
24869a7d3425SStefano Zampini 
24879a7d3425SStefano Zampini #undef __FUNCT__
24889a7d3425SStefano Zampini #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
24899a7d3425SStefano Zampini PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
24909a7d3425SStefano Zampini {
24919a7d3425SStefano Zampini   PetscInt       i,j;
24929a7d3425SStefano Zampini   PetscScalar    *alphas;
24939a7d3425SStefano Zampini   PetscErrorCode ierr;
24949a7d3425SStefano Zampini 
24959a7d3425SStefano Zampini   PetscFunctionBegin;
24969a7d3425SStefano Zampini   /* this implements stabilized Gram-Schmidt */
24979a7d3425SStefano Zampini   ierr = PetscMalloc(n*sizeof(PetscScalar),&alphas);CHKERRQ(ierr);
24989a7d3425SStefano Zampini   for (i=0;i<n;i++) {
24999a7d3425SStefano Zampini     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
25009a7d3425SStefano Zampini     if (i<n) { ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],&alphas[i+1]);CHKERRQ(ierr); }
25019a7d3425SStefano Zampini     for (j=i+1;j<n;j++) { ierr = VecAXPY(vecs[j],PetscConj(-alphas[j]),vecs[i]);CHKERRQ(ierr); }
25029a7d3425SStefano Zampini   }
25039a7d3425SStefano Zampini   ierr = PetscFree(alphas);CHKERRQ(ierr);
25049a7d3425SStefano Zampini   PetscFunctionReturn(0);
25059a7d3425SStefano Zampini }
25069a7d3425SStefano Zampini 
2507fa7f1dd8SStefano Zampini /* TODO
2508fa7f1dd8SStefano Zampini    - now preallocation is done assuming SEQDENSE local matrices
2509fa7f1dd8SStefano Zampini */
2510c8587f34SStefano Zampini #undef __FUNCT__
2511fa7f1dd8SStefano Zampini #define __FUNCT__ "MatISGetMPIXAIJ"
2512fa7f1dd8SStefano Zampini static PetscErrorCode MatISGetMPIXAIJ(Mat mat, MatType Mtype, MatReuse reuse, Mat *M)
2513c8587f34SStefano Zampini {
2514a57a6d2fSStefano Zampini   Mat                    new_mat;
2515a57a6d2fSStefano Zampini   Mat_IS                 *matis = (Mat_IS*)(mat->data);
2516a57a6d2fSStefano Zampini   /* info on mat */
2517fa7f1dd8SStefano Zampini   /* ISLocalToGlobalMapping rmapping,cmapping; */
2518a57a6d2fSStefano Zampini   PetscInt               bs,rows,cols;
2519a57a6d2fSStefano Zampini   PetscInt               lrows,lcols;
2520a57a6d2fSStefano Zampini   PetscInt               local_rows,local_cols;
2521fa7f1dd8SStefano Zampini   PetscBool              isdense;
2522fa7f1dd8SStefano Zampini   /* values insertion */
2523fa7f1dd8SStefano Zampini   PetscScalar            *array;
2524a57a6d2fSStefano Zampini   PetscInt               *local_indices,*global_indices;
2525a57a6d2fSStefano Zampini   /* work */
2526fa7f1dd8SStefano Zampini   PetscInt               i,j,index_row;
2527a57a6d2fSStefano Zampini   PetscErrorCode         ierr;
2528c8587f34SStefano Zampini 
2529a57a6d2fSStefano Zampini   PetscFunctionBegin;
2530fa7f1dd8SStefano Zampini   /* MISSING CHECKS
2531fa7f1dd8SStefano Zampini     - rectangular case not covered (it is not allowed by MATIS)
2532fa7f1dd8SStefano Zampini   */
2533a57a6d2fSStefano Zampini   /* get info from mat */
2534fa7f1dd8SStefano Zampini   /* ierr = MatGetLocalToGlobalMapping(mat,&rmapping,&cmapping);CHKERRQ(ierr); */
2535a57a6d2fSStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
2536a57a6d2fSStefano Zampini   ierr = MatGetBlockSize(mat,&bs);CHKERRQ(ierr);
2537a57a6d2fSStefano Zampini   ierr = MatGetSize(matis->A,&local_rows,&local_cols);CHKERRQ(ierr);
2538a57a6d2fSStefano Zampini 
2539fa7f1dd8SStefano Zampini   /* work */
2540fa7f1dd8SStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*local_indices),&local_indices);CHKERRQ(ierr);
2541fa7f1dd8SStefano Zampini   for (i=0;i<local_rows;i++) local_indices[i]=i;
2542fa7f1dd8SStefano Zampini   /* map indices of local mat to global values */
2543fa7f1dd8SStefano Zampini   ierr = PetscMalloc(PetscMax(local_cols,local_rows)*sizeof(*global_indices),&global_indices);CHKERRQ(ierr);
2544fa7f1dd8SStefano Zampini   /* ierr = ISLocalToGlobalMappingApply(rmapping,local_rows,local_indices,global_indices);CHKERRQ(ierr); */
2545fa7f1dd8SStefano Zampini   ierr = ISLocalToGlobalMappingApply(matis->mapping,local_rows,local_indices,global_indices);CHKERRQ(ierr);
2546fa7f1dd8SStefano Zampini 
2547fa7f1dd8SStefano Zampini   if (reuse==MAT_INITIAL_MATRIX) {
2548fa7f1dd8SStefano Zampini     Vec         vec_dnz,vec_onz;
2549fa7f1dd8SStefano Zampini     PetscScalar *my_dnz,*my_onz;
2550fa7f1dd8SStefano Zampini     PetscInt    *dnz,*onz,*mat_ranges,*row_ownership;
2551fa7f1dd8SStefano Zampini     PetscInt    index_col,owner;
2552fa7f1dd8SStefano Zampini     PetscMPIInt nsubdomains;
2553fa7f1dd8SStefano Zampini 
2554fa7f1dd8SStefano Zampini     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&nsubdomains);CHKERRQ(ierr);
2555a57a6d2fSStefano Zampini     ierr = MatCreate(PetscObjectComm((PetscObject)mat),&new_mat);CHKERRQ(ierr);
2556a57a6d2fSStefano Zampini     ierr = MatSetSizes(new_mat,PETSC_DECIDE,PETSC_DECIDE,rows,cols);CHKERRQ(ierr);
2557a57a6d2fSStefano Zampini     ierr = MatSetBlockSize(new_mat,bs);CHKERRQ(ierr);
2558fa7f1dd8SStefano Zampini     ierr = MatSetType(new_mat,Mtype);CHKERRQ(ierr);
2559a57a6d2fSStefano Zampini     ierr = MatSetUp(new_mat);CHKERRQ(ierr);
2560a57a6d2fSStefano Zampini     ierr = MatGetLocalSize(new_mat,&lrows,&lcols);CHKERRQ(ierr);
2561a57a6d2fSStefano Zampini 
2562a57a6d2fSStefano Zampini     /*
2563a57a6d2fSStefano Zampini       preallocation
2564a57a6d2fSStefano Zampini     */
2565a57a6d2fSStefano Zampini 
2566a57a6d2fSStefano Zampini     ierr = MatPreallocateInitialize(PetscObjectComm((PetscObject)new_mat),lrows,lcols,dnz,onz);CHKERRQ(ierr);
2567a57a6d2fSStefano Zampini     /*
2568a57a6d2fSStefano Zampini        Some vectors are needed to sum up properly on shared interface dofs.
2569fa7f1dd8SStefano Zampini        Preallocation macros cannot do the job.
2570a57a6d2fSStefano Zampini        Note that preallocation is not exact, since it overestimates nonzeros
2571a57a6d2fSStefano Zampini     */
2572a57a6d2fSStefano Zampini     ierr = MatGetVecs(new_mat,NULL,&vec_dnz);CHKERRQ(ierr);
2573fa7f1dd8SStefano Zampini     /* ierr = VecSetLocalToGlobalMapping(vec_dnz,rmapping);CHKERRQ(ierr); */
2574fa7f1dd8SStefano Zampini     ierr = VecSetLocalToGlobalMapping(vec_dnz,matis->mapping);CHKERRQ(ierr);
2575c8587f34SStefano Zampini     ierr = VecDuplicate(vec_dnz,&vec_onz);CHKERRQ(ierr);
2576e7931f94SStefano Zampini     /* All processes need to compute entire row ownership */
2577a57a6d2fSStefano Zampini     ierr = PetscMalloc(rows*sizeof(*row_ownership),&row_ownership);CHKERRQ(ierr);
2578a57a6d2fSStefano Zampini     ierr = MatGetOwnershipRanges(new_mat,(const PetscInt**)&mat_ranges);CHKERRQ(ierr);
2579a57a6d2fSStefano Zampini     for (i=0;i<nsubdomains;i++) {
2580c8587f34SStefano Zampini       for (j=mat_ranges[i];j<mat_ranges[i+1];j++) {
2581c8587f34SStefano Zampini         row_ownership[j]=i;
2582c8587f34SStefano Zampini       }
2583c8587f34SStefano Zampini     }
2584c8587f34SStefano Zampini 
2585e7931f94SStefano Zampini     /*
2586e7931f94SStefano Zampini        my_dnz and my_onz contains exact contribution to preallocation from each local mat
2587e7931f94SStefano Zampini        then, they will be summed up properly. This way, preallocation is always sufficient
2588e7931f94SStefano Zampini     */
2589a57a6d2fSStefano Zampini     ierr = PetscMalloc(local_rows*sizeof(*my_dnz),&my_dnz);CHKERRQ(ierr);
2590a57a6d2fSStefano Zampini     ierr = PetscMalloc(local_rows*sizeof(*my_onz),&my_onz);CHKERRQ(ierr);
2591a57a6d2fSStefano Zampini     ierr = PetscMemzero(my_dnz,local_rows*sizeof(*my_dnz));CHKERRQ(ierr);
2592a57a6d2fSStefano Zampini     ierr = PetscMemzero(my_onz,local_rows*sizeof(*my_onz));CHKERRQ(ierr);
2593a57a6d2fSStefano Zampini     for (i=0;i<local_rows;i++) {
2594a57a6d2fSStefano Zampini       index_row = global_indices[i];
2595a57a6d2fSStefano Zampini       for (j=i;j<local_rows;j++) {
2596a57a6d2fSStefano Zampini         owner = row_ownership[index_row];
2597a57a6d2fSStefano Zampini         index_col = global_indices[j];
2598a57a6d2fSStefano Zampini         if (index_col > mat_ranges[owner]-1 && index_col < mat_ranges[owner+1] ) { /* diag block */
2599c8587f34SStefano Zampini           my_dnz[i] += 1.0;
2600a57a6d2fSStefano Zampini         } else { /* offdiag block */
2601c8587f34SStefano Zampini           my_onz[i] += 1.0;
2602c8587f34SStefano Zampini         }
2603a57a6d2fSStefano Zampini         /* same as before, interchanging rows and cols */
2604c8587f34SStefano Zampini         if (i != j) {
2605a57a6d2fSStefano Zampini           owner = row_ownership[index_col];
2606a57a6d2fSStefano Zampini           if (index_row > mat_ranges[owner]-1 && index_row < mat_ranges[owner+1] ) {
2607c8587f34SStefano Zampini             my_dnz[j] += 1.0;
2608c8587f34SStefano Zampini           } else {
2609c8587f34SStefano Zampini             my_onz[j] += 1.0;
2610c8587f34SStefano Zampini           }
2611c8587f34SStefano Zampini         }
2612c8587f34SStefano Zampini       }
2613c8587f34SStefano Zampini     }
2614c8587f34SStefano Zampini     ierr = VecSet(vec_dnz,0.0);CHKERRQ(ierr);
2615c8587f34SStefano Zampini     ierr = VecSet(vec_onz,0.0);CHKERRQ(ierr);
261620a2ab83SStefano Zampini     if (local_rows) { /* multilevel guard */
2617fa7f1dd8SStefano Zampini       ierr = VecSetValuesLocal(vec_dnz,local_rows,local_indices,my_dnz,ADD_VALUES);CHKERRQ(ierr);
2618fa7f1dd8SStefano Zampini       ierr = VecSetValuesLocal(vec_onz,local_rows,local_indices,my_onz,ADD_VALUES);CHKERRQ(ierr);
2619c8587f34SStefano Zampini     }
2620c8587f34SStefano Zampini     ierr = VecAssemblyBegin(vec_dnz);CHKERRQ(ierr);
2621c8587f34SStefano Zampini     ierr = VecAssemblyBegin(vec_onz);CHKERRQ(ierr);
2622c8587f34SStefano Zampini     ierr = VecAssemblyEnd(vec_dnz);CHKERRQ(ierr);
2623c8587f34SStefano Zampini     ierr = VecAssemblyEnd(vec_onz);CHKERRQ(ierr);
2624c8587f34SStefano Zampini     ierr = PetscFree(my_dnz);CHKERRQ(ierr);
2625c8587f34SStefano Zampini     ierr = PetscFree(my_onz);CHKERRQ(ierr);
2626c8587f34SStefano Zampini     ierr = PetscFree(row_ownership);CHKERRQ(ierr);
2627a57a6d2fSStefano Zampini 
2628a57a6d2fSStefano Zampini     /* set computed preallocation in dnz and onz */
2629a57a6d2fSStefano Zampini     ierr = VecGetArray(vec_dnz,&array);CHKERRQ(ierr);
2630a57a6d2fSStefano Zampini     for (i=0; i<lrows; i++) dnz[i] = (PetscInt)PetscRealPart(array[i]);
2631a57a6d2fSStefano Zampini     ierr = VecRestoreArray(vec_dnz,&array);CHKERRQ(ierr);
2632a57a6d2fSStefano Zampini     ierr = VecGetArray(vec_onz,&array);CHKERRQ(ierr);
2633a57a6d2fSStefano Zampini     for (i=0;i<lrows;i++) onz[i] = (PetscInt)PetscRealPart(array[i]);
2634a57a6d2fSStefano Zampini     ierr = VecRestoreArray(vec_onz,&array);CHKERRQ(ierr);
2635c8587f34SStefano Zampini     ierr = VecDestroy(&vec_dnz);CHKERRQ(ierr);
2636c8587f34SStefano Zampini     ierr = VecDestroy(&vec_onz);CHKERRQ(ierr);
2637c8587f34SStefano Zampini 
2638e7931f94SStefano Zampini     /* Resize preallocation if overestimated */
2639c8587f34SStefano Zampini     for (i=0;i<lrows;i++) {
2640a57a6d2fSStefano Zampini       dnz[i] = PetscMin(dnz[i],lcols);
2641a57a6d2fSStefano Zampini       onz[i] = PetscMin(onz[i],cols-lcols);
2642c8587f34SStefano Zampini     }
2643fa7f1dd8SStefano Zampini     /* set preallocation */
2644a57a6d2fSStefano Zampini     ierr = MatMPIAIJSetPreallocation(new_mat,0,dnz,0,onz);CHKERRQ(ierr);
2645fa7f1dd8SStefano Zampini     for (i=0;i<lrows/bs;i++) {
2646fa7f1dd8SStefano Zampini       dnz[i] = dnz[i*bs]/bs;
2647fa7f1dd8SStefano Zampini       onz[i] = onz[i*bs]/bs;
2648fa7f1dd8SStefano Zampini     }
2649fa7f1dd8SStefano Zampini     ierr = MatMPIBAIJSetPreallocation(new_mat,bs,0,dnz,0,onz);CHKERRQ(ierr);
2650fa7f1dd8SStefano Zampini     for (i=0;i<lrows/bs;i++) {
2651fa7f1dd8SStefano Zampini       dnz[i] = dnz[i]-i;
2652fa7f1dd8SStefano Zampini     }
2653fa7f1dd8SStefano Zampini     ierr = MatMPISBAIJSetPreallocation(new_mat,bs,0,dnz,0,onz);CHKERRQ(ierr);
2654c8587f34SStefano Zampini     ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
2655fa7f1dd8SStefano Zampini     *M = new_mat;
2656fa7f1dd8SStefano Zampini   } else {
2657fa7f1dd8SStefano Zampini     PetscInt mbs,mrows,mcols;
2658fa7f1dd8SStefano Zampini     /* some checks */
2659fa7f1dd8SStefano Zampini     ierr = MatGetBlockSize(*M,&mbs);CHKERRQ(ierr);
2660fa7f1dd8SStefano Zampini     ierr = MatGetSize(*M,&mrows,&mcols);CHKERRQ(ierr);
2661fa7f1dd8SStefano Zampini     if (mrows != rows) {
2662fa7f1dd8SStefano Zampini       SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong number of rows (%d != %d)",rows,mrows);
2663fa7f1dd8SStefano Zampini     }
2664fa7f1dd8SStefano Zampini     if (mrows != rows) {
2665fa7f1dd8SStefano Zampini       SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong number of cols (%d != %d)",cols,mcols);
2666fa7f1dd8SStefano Zampini     }
2667fa7f1dd8SStefano Zampini     if (mbs != bs) {
2668fa7f1dd8SStefano Zampini       SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong block size (%d != %d)",bs,mbs);
2669fa7f1dd8SStefano Zampini     }
2670fa7f1dd8SStefano Zampini     ierr = MatZeroEntries(*M);CHKERRQ(ierr);
2671fa7f1dd8SStefano Zampini   }
2672fa7f1dd8SStefano Zampini   /* set local to global mappings */
2673fa7f1dd8SStefano Zampini   /* ierr = MatSetLocalToGlobalMapping(*M,rmapping,cmapping);CHKERRQ(ierr); */
2674fa7f1dd8SStefano Zampini   /* Set values */
2675fa7f1dd8SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQDENSE,&isdense);CHKERRQ(ierr);
2676fa7f1dd8SStefano Zampini   if (isdense) { /* special case for dense local matrices */
2677fa7f1dd8SStefano Zampini     ierr = MatSetOption(*M,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
2678fa7f1dd8SStefano Zampini     ierr = MatDenseGetArray(matis->A,&array);CHKERRQ(ierr);
2679fa7f1dd8SStefano Zampini     ierr = MatSetValues(*M,local_rows,global_indices,local_cols,global_indices,array,ADD_VALUES);CHKERRQ(ierr);
2680fa7f1dd8SStefano Zampini     ierr = MatDenseRestoreArray(matis->A,&array);CHKERRQ(ierr);
2681fa7f1dd8SStefano Zampini     ierr = PetscFree(local_indices);CHKERRQ(ierr);
2682fa7f1dd8SStefano Zampini     ierr = PetscFree(global_indices);CHKERRQ(ierr);
2683fa7f1dd8SStefano Zampini   } else { /* very basic values insertion for all other matrix types */
2684fa7f1dd8SStefano Zampini     ierr = PetscFree(local_indices);CHKERRQ(ierr);
2685fa7f1dd8SStefano Zampini     ierr = PetscFree(global_indices);CHKERRQ(ierr);
2686a57a6d2fSStefano Zampini     for (i=0;i<local_rows;i++) {
2687a57a6d2fSStefano Zampini       ierr = MatGetRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2688fa7f1dd8SStefano Zampini       /* ierr = MatSetValuesLocal(*M,1,&i,j,local_indices,array,ADD_VALUES);CHKERRQ(ierr); */
2689a57a6d2fSStefano Zampini       ierr = ISLocalToGlobalMappingApply(matis->mapping,j,local_indices,global_indices);CHKERRQ(ierr);
2690a57a6d2fSStefano Zampini       ierr = ISLocalToGlobalMappingApply(matis->mapping,1,&i,&index_row);CHKERRQ(ierr);
2691fa7f1dd8SStefano Zampini       ierr = MatSetValues(*M,1,&index_row,j,global_indices,array,ADD_VALUES);CHKERRQ(ierr);
2692a57a6d2fSStefano Zampini       ierr = MatRestoreRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2693a57a6d2fSStefano Zampini     }
2694fa7f1dd8SStefano Zampini   }
2695fa7f1dd8SStefano Zampini   ierr = MatAssemblyBegin(*M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2696fa7f1dd8SStefano Zampini   ierr = MatAssemblyEnd(*M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2697fa7f1dd8SStefano Zampini   if (isdense) {
2698fa7f1dd8SStefano Zampini     ierr = MatSetOption(*M,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
2699fa7f1dd8SStefano Zampini   }
2700a57a6d2fSStefano Zampini   PetscFunctionReturn(0);
2701a57a6d2fSStefano Zampini }
2702a57a6d2fSStefano Zampini 
2703e7931f94SStefano Zampini #undef __FUNCT__
2704e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble_Private"
2705e7931f94SStefano Zampini PetscErrorCode MatISSubassemble_Private(Mat mat, PetscInt coarsening_ratio, IS* is_sends)
2706e7931f94SStefano Zampini {
2707e7931f94SStefano Zampini   Mat             subdomain_adj;
2708e7931f94SStefano Zampini   IS              new_ranks,ranks_send_to;
2709e7931f94SStefano Zampini   MatPartitioning partitioner;
2710e7931f94SStefano Zampini   Mat_IS          *matis;
2711e7931f94SStefano Zampini   PetscInt        n_neighs,*neighs,*n_shared,**shared;
2712e7931f94SStefano Zampini   PetscInt        prank;
2713e7931f94SStefano Zampini   PetscMPIInt     size,rank,color;
2714e7931f94SStefano Zampini   PetscInt        *xadj,*adjncy,*oldranks;
2715e7931f94SStefano Zampini   PetscInt        *adjncy_wgt,*v_wgt,*is_indices,*ranks_send_to_idx;
2716e7931f94SStefano Zampini   PetscInt        i,j,n_subdomains,local_size,threshold=0;
2717e7931f94SStefano Zampini   PetscErrorCode  ierr;
27182b510759SStefano Zampini   PetscBool       use_vwgt=PETSC_FALSE,use_square=PETSC_FALSE;
2719e7931f94SStefano Zampini   PetscSubcomm    subcomm;
2720a57a6d2fSStefano Zampini 
2721e7931f94SStefano Zampini   PetscFunctionBegin;
27222b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_square",&use_square,NULL);CHKERRQ(ierr);
27232b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
27242b510759SStefano Zampini   ierr = PetscOptionsGetInt(NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
2725e7931f94SStefano Zampini 
2726e7931f94SStefano Zampini   /* Get info on mapping */
2727e7931f94SStefano Zampini   matis = (Mat_IS*)(mat->data);
2728e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&local_size);CHKERRQ(ierr);
2729e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2730e7931f94SStefano Zampini 
2731e7931f94SStefano Zampini   /* build local CSR graph of subdomains' connectivity */
2732e7931f94SStefano Zampini   ierr = PetscMalloc(2*sizeof(*xadj),&xadj);CHKERRQ(ierr);
2733e7931f94SStefano Zampini   xadj[0] = 0;
2734e7931f94SStefano Zampini   xadj[1] = PetscMax(n_neighs-1,0);
2735e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy),&adjncy);CHKERRQ(ierr);
2736e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy_wgt),&adjncy_wgt);CHKERRQ(ierr);
2737e7931f94SStefano Zampini 
27382b510759SStefano Zampini   if (threshold) {
27392b510759SStefano Zampini     PetscInt* count,min_threshold;
2740e7931f94SStefano Zampini     ierr = PetscMalloc(local_size*sizeof(PetscInt),&count);CHKERRQ(ierr);
2741e7931f94SStefano Zampini     ierr = PetscMemzero(count,local_size*sizeof(PetscInt));CHKERRQ(ierr);
2742e7931f94SStefano Zampini     for (i=1;i<n_neighs;i++) {/* i=1 so I don't count myself -> faces nodes counts to 1 */
2743e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2744e7931f94SStefano Zampini         count[shared[i][j]] += 1;
2745e7931f94SStefano Zampini       }
2746e7931f94SStefano Zampini     }
27472b510759SStefano Zampini     /* adapt threshold since we dont want to lose significant connections */
27482b510759SStefano Zampini     min_threshold = n_neighs;
27492b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
27502b510759SStefano Zampini       for (j=0;j<n_shared[i];j++) {
27512b510759SStefano Zampini         min_threshold = PetscMin(count[shared[i][j]],min_threshold);
27522b510759SStefano Zampini       }
27532b510759SStefano Zampini     }
27542b510759SStefano Zampini     threshold = PetscMax(min_threshold+1,threshold);
2755e7931f94SStefano Zampini     xadj[1] = 0;
27562b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
2757e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2758e7931f94SStefano Zampini         if (count[shared[i][j]] < threshold) {
2759e7931f94SStefano Zampini           adjncy[xadj[1]] = neighs[i];
2760e7931f94SStefano Zampini           adjncy_wgt[xadj[1]] = n_shared[i];
2761e7931f94SStefano Zampini           xadj[1]++;
2762e7931f94SStefano Zampini           break;
2763e7931f94SStefano Zampini         }
2764e7931f94SStefano Zampini       }
2765e7931f94SStefano Zampini     }
2766e7931f94SStefano Zampini     ierr = PetscFree(count);CHKERRQ(ierr);
2767c8587f34SStefano Zampini   } else {
2768e7931f94SStefano Zampini     if (xadj[1]) {
2769e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy,&neighs[1],xadj[1]*sizeof(*adjncy));CHKERRQ(ierr);
2770e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy_wgt,&n_shared[1],xadj[1]*sizeof(*adjncy_wgt));CHKERRQ(ierr);
2771c8587f34SStefano Zampini     }
2772e7931f94SStefano Zampini   }
2773e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingRestoreInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2774e7931f94SStefano Zampini   if (use_square) {
2775e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2776e7931f94SStefano Zampini       adjncy_wgt[i] = adjncy_wgt[i]*adjncy_wgt[i];
2777e7931f94SStefano Zampini     }
2778e7931f94SStefano Zampini   }
2779e7931f94SStefano Zampini   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2780e7931f94SStefano Zampini 
2781e7931f94SStefano Zampini   ierr = PetscMalloc(sizeof(PetscInt),&ranks_send_to_idx);CHKERRQ(ierr);
2782e7931f94SStefano Zampini 
2783e7931f94SStefano Zampini   /*
2784e7931f94SStefano Zampini     Restrict work on active processes only.
2785e7931f94SStefano Zampini   */
2786e7931f94SStefano Zampini   ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&subcomm);CHKERRQ(ierr);
2787e7931f94SStefano Zampini   ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
2788e7931f94SStefano Zampini   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
27892b510759SStefano Zampini   ierr = PetscMPIIntCast(!local_size,&color);CHKERRQ(ierr);
2790d3531aaaSJed Brown   ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
2791e7931f94SStefano Zampini   if (color) {
2792e7931f94SStefano Zampini     ierr = PetscFree(xadj);CHKERRQ(ierr);
2793e7931f94SStefano Zampini     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2794e7931f94SStefano Zampini     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
2795c8587f34SStefano Zampini   } else {
2796e7931f94SStefano Zampini     ierr = MPI_Comm_size(subcomm->comm,&size);CHKERRQ(ierr);
2797e7931f94SStefano Zampini     ierr = PetscMalloc(size*sizeof(*oldranks),&oldranks);CHKERRQ(ierr);
2798e7931f94SStefano Zampini     prank = rank;
2799e7931f94SStefano Zampini     ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm->comm);CHKERRQ(ierr);
2800e7931f94SStefano Zampini     for (i=0;i<size;i++) {
2801e7931f94SStefano Zampini       PetscPrintf(subcomm->comm,"oldranks[%d] = %d\n",i,oldranks[i]);
2802c8587f34SStefano Zampini     }
2803e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2804e7931f94SStefano Zampini       ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
2805c8587f34SStefano Zampini     }
2806e7931f94SStefano Zampini     ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2807e7931f94SStefano Zampini     ierr = MatCreateMPIAdj(subcomm->comm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
2808e7931f94SStefano Zampini     n_subdomains = (PetscInt)size;
2809e7931f94SStefano Zampini     ierr = MatView(subdomain_adj,0);CHKERRQ(ierr);
2810e7931f94SStefano Zampini 
2811e7931f94SStefano Zampini     /* Partition */
2812e7931f94SStefano Zampini     ierr = MatPartitioningCreate(subcomm->comm,&partitioner);CHKERRQ(ierr);
2813e7931f94SStefano Zampini     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
2814e7931f94SStefano Zampini     if (use_vwgt) {
2815e7931f94SStefano Zampini       ierr = PetscMalloc(sizeof(*v_wgt),&v_wgt);CHKERRQ(ierr);
2816e7931f94SStefano Zampini       v_wgt[0] = local_size;
2817e7931f94SStefano Zampini       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
2818c8587f34SStefano Zampini     }
2819e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)partitioner),"NPARTS %d\n",n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2820e7931f94SStefano Zampini     ierr = MatPartitioningSetNParts(partitioner,n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2821e7931f94SStefano Zampini     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
2822e7931f94SStefano Zampini     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
2823e7931f94SStefano Zampini     ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr);
2824e7931f94SStefano Zampini 
2825e7931f94SStefano Zampini     ierr = ISGetIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2826e7931f94SStefano Zampini     ranks_send_to_idx[0] = oldranks[is_indices[0]];
2827e7931f94SStefano Zampini     ierr = ISRestoreIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2828e7931f94SStefano Zampini     /* clean up */
2829e7931f94SStefano Zampini     ierr = PetscFree(oldranks);CHKERRQ(ierr);
2830e7931f94SStefano Zampini     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
2831e7931f94SStefano Zampini     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
2832e7931f94SStefano Zampini     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
2833e7931f94SStefano Zampini   }
2834e7931f94SStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
2835e7931f94SStefano Zampini 
2836e7931f94SStefano Zampini   /* assemble parallel IS for sends */
2837e7931f94SStefano Zampini   i = 1;
2838e7931f94SStefano Zampini   if (color) i=0;
2839e7931f94SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,&ranks_send_to);CHKERRQ(ierr);
2840e7931f94SStefano Zampini   ierr = ISView(ranks_send_to,0);CHKERRQ(ierr);
2841e7931f94SStefano Zampini 
2842e7931f94SStefano Zampini   /* get back IS */
2843e7931f94SStefano Zampini   *is_sends = ranks_send_to;
2844e7931f94SStefano Zampini   PetscFunctionReturn(0);
2845e7931f94SStefano Zampini }
2846e7931f94SStefano Zampini 
2847e7931f94SStefano Zampini typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
2848e7931f94SStefano Zampini 
2849e7931f94SStefano Zampini #undef __FUNCT__
2850e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble"
2851e7931f94SStefano Zampini PetscErrorCode MatISSubassemble(Mat mat, IS is_sends, PetscInt coarsening_ratio, Mat *mat_n)
2852e7931f94SStefano Zampini {
2853e7931f94SStefano Zampini   Mat                    local_mat,new_mat;
2854e7931f94SStefano Zampini   Mat_IS                 *matis;
2855e7931f94SStefano Zampini   IS                     is_sends_internal;
2856e7931f94SStefano Zampini   PetscInt               rows,cols;
2857e7931f94SStefano Zampini   PetscInt               i,bs,buf_size_idxs,buf_size_vals;
2858e7931f94SStefano Zampini   PetscBool              ismatis,isdense;
2859e7931f94SStefano Zampini   ISLocalToGlobalMapping l2gmap;
2860e7931f94SStefano Zampini   PetscInt*              l2gmap_indices;
2861e7931f94SStefano Zampini   const PetscInt*        is_indices;
2862e7931f94SStefano Zampini   MatType                new_local_type;
2863e7931f94SStefano Zampini   MatTypePrivate         new_local_type_private;
2864e7931f94SStefano Zampini   /* buffers */
2865e7931f94SStefano Zampini   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
2866e7931f94SStefano Zampini   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
2867e7931f94SStefano Zampini   /* MPI */
2868e7931f94SStefano Zampini   MPI_Comm               comm;
2869e7931f94SStefano Zampini   PetscMPIInt            n_sends,n_recvs,commsize;
2870e7931f94SStefano Zampini   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals;
2871e7931f94SStefano Zampini   PetscMPIInt            *onodes,*olengths_idxs,*olengths_vals;
2872e7931f94SStefano Zampini   PetscMPIInt            len,tag_idxs,tag_vals,source_dest;
2873e7931f94SStefano Zampini   MPI_Request            *send_req_idxs,*send_req_vals,*recv_req_idxs,*recv_req_vals;
2874e7931f94SStefano Zampini   PetscErrorCode         ierr;
2875e7931f94SStefano Zampini 
2876e7931f94SStefano Zampini   PetscFunctionBegin;
2877e7931f94SStefano Zampini   /* checks */
2878e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
2879e7931f94SStefano Zampini   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on an matrix object which is not of type MATIS",__FUNCT__);
2880e7931f94SStefano Zampini   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2881e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
2882e7931f94SStefano Zampini   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
2883e7931f94SStefano Zampini   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
2884e7931f94SStefano Zampini   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
2885e7931f94SStefano Zampini   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
2886e7931f94SStefano Zampini   PetscValidLogicalCollectiveInt(mat,bs,0);
2887e7931f94SStefano Zampini   /* prepare IS for sending if not provided */
2888e7931f94SStefano Zampini   if (!is_sends) {
2889e7931f94SStefano Zampini     if (!coarsening_ratio) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a coarsening ratio");
2890e7931f94SStefano Zampini     ierr = MatISSubassemble_Private(mat,coarsening_ratio,&is_sends_internal);CHKERRQ(ierr);
2891c8587f34SStefano Zampini   } else {
2892e7931f94SStefano Zampini     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
2893e7931f94SStefano Zampini     is_sends_internal = is_sends;
2894c8587f34SStefano Zampini   }
2895e7931f94SStefano Zampini 
2896e7931f94SStefano Zampini   /* get pointer of MATIS data */
2897e7931f94SStefano Zampini   matis = (Mat_IS*)mat->data;
2898e7931f94SStefano Zampini 
2899e7931f94SStefano Zampini   /* get comm */
2900e7931f94SStefano Zampini   comm = PetscObjectComm((PetscObject)mat);
2901e7931f94SStefano Zampini 
2902e7931f94SStefano Zampini   /* compute number of sends */
2903e7931f94SStefano Zampini   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
2904e7931f94SStefano Zampini   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
2905e7931f94SStefano Zampini 
2906e7931f94SStefano Zampini   /* compute number of receives */
2907e7931f94SStefano Zampini   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
2908e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*iflags),&iflags);CHKERRQ(ierr);
2909e7931f94SStefano Zampini   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
2910e7931f94SStefano Zampini   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2911e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
2912e7931f94SStefano Zampini   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
2913e7931f94SStefano Zampini   ierr = PetscFree(iflags);CHKERRQ(ierr);
2914e7931f94SStefano Zampini 
2915e7931f94SStefano Zampini   /* prepare send/receive buffers */
2916e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_idxs),&ilengths_idxs);CHKERRQ(ierr);
2917e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
2918e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_vals),&ilengths_vals);CHKERRQ(ierr);
2919e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
2920e7931f94SStefano Zampini 
2921e7931f94SStefano Zampini   /* Get data from local mat */
2922e7931f94SStefano Zampini   if (!isdense) {
2923e7931f94SStefano Zampini     /* TODO: See below some guidelines on how to prepare the local buffers */
2924e7931f94SStefano Zampini     /*
2925e7931f94SStefano Zampini        send_buffer_vals should contain the raw values of the local matrix
2926e7931f94SStefano Zampini        send_buffer_idxs should contain:
2927e7931f94SStefano Zampini        - MatType_PRIVATE type
2928e7931f94SStefano Zampini        - PetscInt        size_of_l2gmap
2929e7931f94SStefano Zampini        - PetscInt        global_row_indices[size_of_l2gmap]
2930e7931f94SStefano Zampini        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
2931e7931f94SStefano Zampini     */
2932e7931f94SStefano Zampini   } else {
2933e7931f94SStefano Zampini     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
2934e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&i);CHKERRQ(ierr);
2935e7931f94SStefano Zampini     ierr = PetscMalloc((i+2)*sizeof(PetscInt),&send_buffer_idxs);CHKERRQ(ierr);
2936e7931f94SStefano Zampini     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
2937e7931f94SStefano Zampini     send_buffer_idxs[1] = i;
2938e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2939e7931f94SStefano Zampini     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
2940e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingRestoreIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2941e7931f94SStefano Zampini     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
2942e7931f94SStefano Zampini     for (i=0;i<n_sends;i++) {
2943e7931f94SStefano Zampini       ilengths_vals[is_indices[i]] = len*len;
2944e7931f94SStefano Zampini       ilengths_idxs[is_indices[i]] = len+2;
2945c8587f34SStefano Zampini     }
2946c8587f34SStefano Zampini   }
2947e7931f94SStefano Zampini   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
2948e7931f94SStefano Zampini   buf_size_idxs = 0;
2949e7931f94SStefano Zampini   buf_size_vals = 0;
2950e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2951e7931f94SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
2952e7931f94SStefano Zampini     buf_size_vals += (PetscInt)olengths_vals[i];
2953e7931f94SStefano Zampini   }
2954e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&recv_buffer_idxs);CHKERRQ(ierr);
2955e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_vals*sizeof(PetscScalar),&recv_buffer_vals);CHKERRQ(ierr);
2956e7931f94SStefano Zampini 
2957e7931f94SStefano Zampini   /* get new tags for clean communications */
2958e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
2959e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
2960e7931f94SStefano Zampini 
2961e7931f94SStefano Zampini   /* allocate for requests */
2962e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_idxs);CHKERRQ(ierr);
2963e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_vals);CHKERRQ(ierr);
2964e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_idxs);CHKERRQ(ierr);
2965e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_vals);CHKERRQ(ierr);
2966e7931f94SStefano Zampini 
2967e7931f94SStefano Zampini   /* communications */
2968e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2969e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
2970e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2971e7931f94SStefano Zampini     source_dest = onodes[i];
2972e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
2973e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
2974e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2975e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
2976e7931f94SStefano Zampini   }
2977e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) {
2978e7931f94SStefano Zampini     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
2979e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
2980e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
2981e7931f94SStefano Zampini   }
2982e7931f94SStefano Zampini   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2983e7931f94SStefano Zampini   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
2984e7931f94SStefano Zampini 
2985e7931f94SStefano Zampini   /* assemble new l2g map */
2986e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2987e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2988e7931f94SStefano Zampini   buf_size_idxs = 0;
2989e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2990e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
2991e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2992e7931f94SStefano Zampini   }
2993e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&l2gmap_indices);CHKERRQ(ierr);
2994e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2995e7931f94SStefano Zampini   buf_size_idxs = 0;
2996e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2997e7931f94SStefano Zampini     ierr = PetscMemcpy(&l2gmap_indices[buf_size_idxs],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
2998e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
2999e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3000e7931f94SStefano Zampini   }
3001e7931f94SStefano Zampini   ierr = PetscSortRemoveDupsInt(&buf_size_idxs,l2gmap_indices);CHKERRQ(ierr);
3002e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingCreate(comm,buf_size_idxs,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
3003e7931f94SStefano Zampini   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
3004e7931f94SStefano Zampini 
3005e7931f94SStefano Zampini   /* infer new local matrix type from received local matrices type */
3006e7931f94SStefano Zampini   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
3007e7931f94SStefano 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) */
3008e7931f94SStefano Zampini   new_local_type_private = MATAIJ_PRIVATE;
3009e7931f94SStefano Zampini   new_local_type = MATSEQAIJ;
3010e7931f94SStefano Zampini   if (n_recvs) {
3011be4bc593SStefano Zampini     new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
3012e7931f94SStefano Zampini     ptr_idxs = recv_buffer_idxs;
3013e7931f94SStefano Zampini     for (i=0;i<n_recvs;i++) {
3014e7931f94SStefano Zampini       if ((PetscInt)new_local_type_private != *ptr_idxs) {
3015e7931f94SStefano Zampini         new_local_type_private = MATAIJ_PRIVATE;
3016e7931f94SStefano Zampini         break;
3017e7931f94SStefano Zampini       }
3018e7931f94SStefano Zampini       ptr_idxs += olengths_idxs[i];
3019e7931f94SStefano Zampini     }
3020e7931f94SStefano Zampini     switch (new_local_type_private) {
3021e7931f94SStefano Zampini       case MATDENSE_PRIVATE: /* subassembling of dense matrices does not give a dense matrix! */
3022e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
3023e7931f94SStefano Zampini         bs = 1;
3024e7931f94SStefano Zampini         break;
3025e7931f94SStefano Zampini       case MATAIJ_PRIVATE:
3026e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
3027e7931f94SStefano Zampini         bs = 1;
3028e7931f94SStefano Zampini         break;
3029e7931f94SStefano Zampini       case MATBAIJ_PRIVATE:
3030e7931f94SStefano Zampini         new_local_type = MATSEQBAIJ;
3031e7931f94SStefano Zampini         break;
3032e7931f94SStefano Zampini       case MATSBAIJ_PRIVATE:
3033e7931f94SStefano Zampini         new_local_type = MATSEQSBAIJ;
3034e7931f94SStefano Zampini         break;
3035e7931f94SStefano Zampini       default:
3036e7931f94SStefano Zampini         SETERRQ2(comm,PETSC_ERR_LIB,"Unkwown private type %d in %s",new_local_type_private,__FUNCT__);
3037e7931f94SStefano Zampini         break;
3038e7931f94SStefano Zampini     }
3039e7931f94SStefano Zampini   }
3040e7931f94SStefano Zampini 
3041e7931f94SStefano Zampini   /* create MATIS object */
3042e7931f94SStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
3043e7931f94SStefano Zampini   ierr = MatCreateIS(comm,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,&new_mat);CHKERRQ(ierr);
3044e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
3045e7931f94SStefano Zampini   ierr = MatISGetLocalMat(new_mat,&local_mat);CHKERRQ(ierr);
3046e7931f94SStefano Zampini   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
3047e7931f94SStefano Zampini   ierr = MatSetUp(local_mat);CHKERRQ(ierr); /* WARNING -> no preallocation yet */
3048e7931f94SStefano Zampini 
3049e7931f94SStefano Zampini   /* set values */
3050e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3051e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
3052e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
3053e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3054e7931f94SStefano Zampini     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
3055e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
3056e7931f94SStefano Zampini       ierr = MatSetValues(new_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
3057e7931f94SStefano Zampini       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3058e7931f94SStefano Zampini       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3059e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
3060e7931f94SStefano Zampini     }
3061e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3062e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
3063e7931f94SStefano Zampini   }
3064e7931f94SStefano Zampini   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3065e7931f94SStefano Zampini   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3066e7931f94SStefano Zampini   ierr = MatAssemblyBegin(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3067e7931f94SStefano Zampini   ierr = MatAssemblyEnd(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3068e7931f94SStefano Zampini 
3069e7931f94SStefano Zampini   { /* check */
3070e7931f94SStefano Zampini     Vec       lvec,rvec;
3071e7931f94SStefano Zampini     PetscReal infty_error;
3072e7931f94SStefano Zampini 
3073e7931f94SStefano Zampini     ierr = MatGetVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
3074e7931f94SStefano Zampini     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
3075e7931f94SStefano Zampini     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
3076e7931f94SStefano Zampini     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
3077e7931f94SStefano Zampini     ierr = MatMultAdd(new_mat,rvec,lvec,lvec);CHKERRQ(ierr);
3078e7931f94SStefano Zampini     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3079e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
3080e7931f94SStefano Zampini     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
3081e7931f94SStefano Zampini     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
3082e7931f94SStefano Zampini   }
3083e7931f94SStefano Zampini 
3084e7931f94SStefano Zampini   /* free workspace */
3085e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
3086e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
3087e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3088e7931f94SStefano Zampini   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
3089e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3090e7931f94SStefano Zampini   if (isdense) {
3091e7931f94SStefano Zampini     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
3092e7931f94SStefano Zampini     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
3093e7931f94SStefano Zampini   } else {
3094e7931f94SStefano Zampini     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
3095e7931f94SStefano Zampini   }
3096e7931f94SStefano Zampini   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
3097e7931f94SStefano Zampini   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
3098e7931f94SStefano Zampini   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
3099e7931f94SStefano Zampini   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
3100e7931f94SStefano Zampini   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
3101e7931f94SStefano Zampini   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
3102e7931f94SStefano Zampini   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
3103e7931f94SStefano Zampini   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
3104e7931f94SStefano Zampini   ierr = PetscFree(onodes);CHKERRQ(ierr);
3105e7931f94SStefano Zampini   /* get back new mat */
3106e7931f94SStefano Zampini   *mat_n = new_mat;
3107e7931f94SStefano Zampini   PetscFunctionReturn(0);
3108e7931f94SStefano Zampini }
3109a57a6d2fSStefano Zampini 
3110c8587f34SStefano Zampini #undef __FUNCT__
3111c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
3112c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
3113c8587f34SStefano Zampini {
3114c8587f34SStefano Zampini   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
3115c8587f34SStefano Zampini   PC_IS                  *pcis = (PC_IS*)pc->data;
311620a2ab83SStefano Zampini   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
31179881197aSStefano Zampini   MatNullSpace           CoarseNullSpace=NULL;
311820a2ab83SStefano Zampini   ISLocalToGlobalMapping coarse_islg;
311920a2ab83SStefano Zampini   IS                     coarse_is;
3120f4ddd8eeSStefano Zampini   PetscInt               max_it;
3121f9eb5b7dSStefano Zampini   PetscInt               im_active=-1,active_procs=-1;
3122f9eb5b7dSStefano Zampini   PC                     pc_temp;
3123c8587f34SStefano Zampini   PCType                 coarse_pc_type;
3124c8587f34SStefano Zampini   KSPType                coarse_ksp_type;
3125f9eb5b7dSStefano Zampini   PetscBool              multilevel_requested,multilevel_allowed;
3126fa7f1dd8SStefano Zampini   PetscBool              setsym,issym,isbddc,isnn,coarse_reuse;
3127f9eb5b7dSStefano Zampini   MatStructure           matstruct;
31289881197aSStefano Zampini   PetscErrorCode         ierr;
3129fdc09c96SStefano Zampini 
3130c8587f34SStefano Zampini   PetscFunctionBegin;
3131c8587f34SStefano Zampini   /* Assign global numbering to coarse dofs */
3132fa7f1dd8SStefano Zampini   if (pcbddc->new_primal_space) { /* a new primal space is present, so recompute global numbering */
3133fa7f1dd8SStefano Zampini     PetscInt ocoarse_size;
3134fa7f1dd8SStefano Zampini     ocoarse_size = pcbddc->coarse_size;
3135f4ddd8eeSStefano Zampini     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3136f4ddd8eeSStefano Zampini     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
3137f4ddd8eeSStefano Zampini     /* see if we can avoid some work */
3138fa7f1dd8SStefano Zampini     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
3139fa7f1dd8SStefano Zampini       if (ocoarse_size != pcbddc->coarse_size) { /* ...but with different size, so reset it and set reuse flag to false */
3140727cdba6SStefano Zampini         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3141fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_FALSE;
3142fa7f1dd8SStefano Zampini       } else { /* we can safely reuse already computed coarse matrix */
3143fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_TRUE;
3144f4ddd8eeSStefano Zampini       }
3145fa7f1dd8SStefano Zampini     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
3146fa7f1dd8SStefano Zampini       coarse_reuse = PETSC_FALSE;
3147f4ddd8eeSStefano Zampini     }
3148fa7f1dd8SStefano Zampini   } else { /* primal space has not been changed, so we can reuse coarse matrix */
3149fa7f1dd8SStefano Zampini     coarse_reuse = PETSC_TRUE;
3150f4ddd8eeSStefano Zampini   }
3151c8587f34SStefano Zampini 
3152f9eb5b7dSStefano Zampini   /* infer some info from user */
3153f9eb5b7dSStefano Zampini   issym = PETSC_FALSE;
3154f9eb5b7dSStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
3155f9eb5b7dSStefano Zampini   multilevel_allowed = PETSC_FALSE;
3156f9eb5b7dSStefano Zampini   multilevel_requested = PETSC_FALSE;
3157f9eb5b7dSStefano Zampini   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
3158f9eb5b7dSStefano Zampini   if (multilevel_requested) {
31592b510759SStefano Zampini     /* count "active processes" */
31602b510759SStefano Zampini     im_active = !!(pcis->n);
31612b510759SStefano Zampini     ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
31622b510759SStefano Zampini     if (active_procs/pcbddc->coarsening_ratio < 2) {
3163f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_FALSE;
31642b510759SStefano Zampini     } else {
3165f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_TRUE;
3166c8587f34SStefano Zampini     }
3167c8587f34SStefano Zampini   }
3168e7931f94SStefano Zampini 
3169f9eb5b7dSStefano Zampini   /* set defaults for coarse KSP and PC */
3170f9eb5b7dSStefano Zampini   if (multilevel_allowed) {
3171c8587f34SStefano Zampini     if (issym) {
3172f9eb5b7dSStefano Zampini       coarse_ksp_type = KSPRICHARDSON;
3173f9eb5b7dSStefano Zampini     } else {
3174f9eb5b7dSStefano Zampini       coarse_ksp_type = KSPCHEBYSHEV;
3175c8587f34SStefano Zampini     }
3176f9eb5b7dSStefano Zampini     coarse_pc_type = PCBDDC;
3177f9eb5b7dSStefano Zampini   } else {
3178f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPPREONLY;
3179f9eb5b7dSStefano Zampini     coarse_pc_type = PCREDUNDANT;
3180c8587f34SStefano Zampini   }
3181c8587f34SStefano Zampini 
3182f9eb5b7dSStefano Zampini   /* create the coarse KSP object only once with defaults */
3183f9eb5b7dSStefano Zampini   if (!pcbddc->coarse_ksp) {
3184e604994aSStefano Zampini     char prefix[256],str_level[3];
3185e604994aSStefano Zampini     size_t len;
3186f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_ksp);CHKERRQ(ierr);
3187c8587f34SStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
3188f9eb5b7dSStefano Zampini     ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
3189c8587f34SStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
3190c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3191c8587f34SStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
3192e604994aSStefano Zampini     /* prefix */
3193e604994aSStefano Zampini     ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
3194e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
3195e604994aSStefano Zampini     if (!pcbddc->current_level) {
3196e604994aSStefano Zampini       ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
3197e604994aSStefano Zampini       ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
3198c8587f34SStefano Zampini     } else {
3199e604994aSStefano Zampini       ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
3200e604994aSStefano Zampini       if (pcbddc->current_level>1) len -= 2;
3201e604994aSStefano Zampini       ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
3202e604994aSStefano Zampini       *(prefix+len)='\0';
3203e604994aSStefano Zampini       sprintf(str_level,"%d_",(int)(pcbddc->current_level));
3204e604994aSStefano Zampini       ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
3205e604994aSStefano Zampini     }
3206e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
3207f9eb5b7dSStefano Zampini   }
3208f9eb5b7dSStefano Zampini   /* allow user customization */
320985c4d303SStefano 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); */
3210f9eb5b7dSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
321185c4d303SStefano 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); */
3212f9eb5b7dSStefano Zampini 
3213f9eb5b7dSStefano Zampini   /* get some info after set from options */
3214f9eb5b7dSStefano Zampini   ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3215f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
3216f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
3217f9eb5b7dSStefano Zampini   if (isbddc && !multilevel_allowed) { /* prevent from infinite loop if user as requested bddc pc for coarse solver */
3218f9eb5b7dSStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
3219f9eb5b7dSStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
3220f9eb5b7dSStefano Zampini     isbddc = PETSC_FALSE;
3221f9eb5b7dSStefano Zampini   }
3222f9eb5b7dSStefano Zampini 
3223f9eb5b7dSStefano Zampini   /* propagate BDDC info to the next level */
3224f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
3225f9eb5b7dSStefano Zampini   ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
3226f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
3227f9eb5b7dSStefano Zampini 
3228f9eb5b7dSStefano Zampini   /* creates temporary MATIS object for coarse matrix */
3229f4ddd8eeSStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
3230a57a6d2fSStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
3231a57a6d2fSStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
3232f4ddd8eeSStefano Zampini   ierr = MatCreateIS(PetscObjectComm((PetscObject)pc),1,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size,coarse_islg,&coarse_mat_is);CHKERRQ(ierr);
3233a57a6d2fSStefano Zampini   ierr = MatISSetLocalMat(coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
3234e7931f94SStefano Zampini   ierr = MatAssemblyBegin(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3235e7931f94SStefano Zampini   ierr = MatAssemblyEnd(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
323620a2ab83SStefano Zampini   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
323720a2ab83SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
3238fdc09c96SStefano Zampini 
3239f9eb5b7dSStefano Zampini   /* assemble coarse matrix */
3240f9eb5b7dSStefano Zampini   if (isbddc || isnn) {
3241f9eb5b7dSStefano Zampini     ierr = MatISSubassemble(coarse_mat_is,NULL,pcbddc->coarsening_ratio,&coarse_mat);CHKERRQ(ierr);
3242fa7f1dd8SStefano Zampini   } else {
3243fa7f1dd8SStefano Zampini     if (coarse_reuse) {
3244fa7f1dd8SStefano Zampini       ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL,NULL);CHKERRQ(ierr);
3245fa7f1dd8SStefano Zampini       ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
3246fa7f1dd8SStefano Zampini       ierr = MatISGetMPIXAIJ(coarse_mat_is,MATMPIAIJ,MAT_REUSE_MATRIX,&coarse_mat);CHKERRQ(ierr);
3247fa7f1dd8SStefano Zampini     } else {
3248fa7f1dd8SStefano Zampini       ierr = MatISGetMPIXAIJ(coarse_mat_is,MATMPIAIJ,MAT_INITIAL_MATRIX,&coarse_mat);CHKERRQ(ierr);
3249fa7f1dd8SStefano Zampini     }
3250c8587f34SStefano Zampini   }
32512b510759SStefano Zampini   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
32529881197aSStefano Zampini 
3253f9eb5b7dSStefano Zampini   /* create local to global scatters for coarse problem */
3254f4ddd8eeSStefano Zampini   if (pcbddc->new_primal_space) {
3255f4ddd8eeSStefano Zampini     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3256f4ddd8eeSStefano Zampini     ierr = VecDestroy(&pcbddc->coarse_rhs);CHKERRQ(ierr);
3257f4ddd8eeSStefano Zampini     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3258f9eb5b7dSStefano Zampini     ierr = MatGetVecs(coarse_mat,&pcbddc->coarse_vec,&pcbddc->coarse_rhs);CHKERRQ(ierr);
3259f9eb5b7dSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3260f4ddd8eeSStefano Zampini   }
3261f9eb5b7dSStefano Zampini   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
3262f9eb5b7dSStefano Zampini 
3263f9eb5b7dSStefano Zampini   /* propagate symmetry info to coarse matrix */
3264f9eb5b7dSStefano Zampini   ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,issym);CHKERRQ(ierr);
3265f9eb5b7dSStefano Zampini 
3266b8ffe317SStefano Zampini   /* Compute coarse null space (special handling by BDDC only) */
3267b8ffe317SStefano Zampini   if (pcbddc->NullSpace) {
3268b8ffe317SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCoarse(pc,coarse_mat,&CoarseNullSpace);CHKERRQ(ierr);
3269b8ffe317SStefano Zampini     if (isbddc) {
3270b8ffe317SStefano Zampini       ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
3271b8ffe317SStefano Zampini     } else {
3272c8587f34SStefano Zampini       ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
3273c8587f34SStefano Zampini     }
3274c8587f34SStefano Zampini   }
3275c8587f34SStefano Zampini 
3276f9eb5b7dSStefano Zampini   /* set operators */
3277f9eb5b7dSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
3278f9eb5b7dSStefano Zampini   ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat,matstruct);CHKERRQ(ierr);
3279f9eb5b7dSStefano Zampini 
3280f9eb5b7dSStefano Zampini   /* additional KSP customization */
3281f9eb5b7dSStefano Zampini   ierr = KSPGetTolerances(pcbddc->coarse_ksp,NULL,NULL,NULL,&max_it);CHKERRQ(ierr);
3282f9eb5b7dSStefano Zampini   if (max_it < 5) {
3283c8587f34SStefano Zampini     ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
3284f9eb5b7dSStefano Zampini   }
3285b8ffe317SStefano Zampini   /* ierr = KSPChebyshevSetEstimateEigenvalues(pcbddc->coarse_ksp,1.0,0.0,0.0,1.1);CHKERRQ(ierr); */
3286f9eb5b7dSStefano Zampini 
3287f9eb5b7dSStefano Zampini 
3288f9eb5b7dSStefano Zampini   /* print some info if requested */
3289f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
3290f9eb5b7dSStefano Zampini     ierr = KSPGetType(pcbddc->coarse_ksp,&coarse_ksp_type);CHKERRQ(ierr);
3291f9eb5b7dSStefano Zampini     ierr = PCGetType(pc_temp,&coarse_pc_type);CHKERRQ(ierr);
3292f9eb5b7dSStefano Zampini     if (!multilevel_allowed) {
3293f9eb5b7dSStefano Zampini       if (multilevel_requested) {
3294f9eb5b7dSStefano 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);
3295f9eb5b7dSStefano Zampini       } else if (pcbddc->max_levels) {
3296f9eb5b7dSStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
3297c8587f34SStefano Zampini       }
3298c8587f34SStefano Zampini     }
3299e604994aSStefano 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);
3300f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3301c8587f34SStefano Zampini   }
3302f9eb5b7dSStefano Zampini 
3303f9eb5b7dSStefano Zampini   /* setup coarse ksp */
3304f9eb5b7dSStefano Zampini   ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
3305f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
3306f9eb5b7dSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
3307f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3308f9eb5b7dSStefano Zampini     ierr = KSPView(pcbddc->coarse_ksp,pcbddc->dbg_viewer);CHKERRQ(ierr);
3309f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3310f9eb5b7dSStefano Zampini   }
3311f9eb5b7dSStefano Zampini 
3312c8587f34SStefano Zampini   /* Check coarse problem if requested */
331320a2ab83SStefano Zampini   if (pcbddc->dbg_flag) {
3314c8587f34SStefano Zampini     KSP       check_ksp;
33152b510759SStefano Zampini     KSPType   check_ksp_type;
3316c8587f34SStefano Zampini     PC        check_pc;
3317c8587f34SStefano Zampini     Vec       check_vec;
3318c8587f34SStefano Zampini     PetscReal abs_infty_error,infty_error,lambda_min,lambda_max;
33192b510759SStefano Zampini     PetscInt  its;
3320f9eb5b7dSStefano Zampini     PetscBool ispreonly,compute;
3321c8587f34SStefano Zampini 
33222b510759SStefano Zampini     /* Create ksp object suitable for estimation of extreme eigenvalues */
3323f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&check_ksp);CHKERRQ(ierr);
3324fdc635d7SStefano Zampini     ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
3325f4ddd8eeSStefano Zampini     ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
33262b510759SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
33272b510759SStefano Zampini     if (ispreonly) {
33282b510759SStefano Zampini       check_ksp_type = KSPPREONLY;
3329f9eb5b7dSStefano Zampini       compute = PETSC_FALSE;
33302b510759SStefano Zampini     } else {
3331c8587f34SStefano Zampini       if (issym) check_ksp_type = KSPCG;
3332c8587f34SStefano Zampini       else check_ksp_type = KSPGMRES;
3333f9eb5b7dSStefano Zampini       compute = PETSC_TRUE;
3334c8587f34SStefano Zampini     }
3335c8587f34SStefano Zampini     ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
3336f9eb5b7dSStefano Zampini     ierr = KSPSetComputeSingularValues(check_ksp,compute);CHKERRQ(ierr);
3337c8587f34SStefano Zampini     ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
3338c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
3339c8587f34SStefano Zampini     ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
3340c8587f34SStefano Zampini     /* create random vec */
3341c8587f34SStefano Zampini     ierr = VecDuplicate(pcbddc->coarse_vec,&check_vec);CHKERRQ(ierr);
3342c8587f34SStefano Zampini     ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
3343c8587f34SStefano Zampini     if (CoarseNullSpace) {
3344c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec);CHKERRQ(ierr);
3345c8587f34SStefano Zampini     }
3346fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3347c8587f34SStefano Zampini     /* solve coarse problem */
3348c8587f34SStefano Zampini     ierr = KSPSolve(check_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
3349c8587f34SStefano Zampini     if (CoarseNullSpace) {
3350c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,pcbddc->coarse_vec);CHKERRQ(ierr);
3351c8587f34SStefano Zampini     }
3352c8587f34SStefano Zampini     /* check coarse problem residual error */
3353c8587f34SStefano Zampini     ierr = VecAXPY(check_vec,-1.0,pcbddc->coarse_vec);CHKERRQ(ierr);
3354c8587f34SStefano Zampini     ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3355fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3356c8587f34SStefano Zampini     ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
3357c8587f34SStefano Zampini     ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
3358e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem (%s) details\n",((PetscObject)(pcbddc->coarse_ksp))->prefix);CHKERRQ(ierr);
3359e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
3360e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
3361f9eb5b7dSStefano Zampini     /* get eigenvalue estimation if preonly has not been requested */
33622b510759SStefano Zampini     if (!ispreonly) {
3363c8587f34SStefano Zampini       ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
336420a2ab83SStefano Zampini       ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
3365f9eb5b7dSStefano 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);
3366c8587f34SStefano Zampini     }
33672b510759SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3368c8587f34SStefano Zampini     ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
3369c8587f34SStefano Zampini   }
33702b510759SStefano Zampini   /* free memory */
3371c8587f34SStefano Zampini   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
3372fdc635d7SStefano Zampini   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
3373c8587f34SStefano Zampini   PetscFunctionReturn(0);
3374c8587f34SStefano Zampini }
3375674ae819SStefano Zampini 
3376f34684f1SStefano Zampini #undef __FUNCT__
3377f34684f1SStefano Zampini #define __FUNCT__ "PCBDDCComputePrimalNumbering"
3378f34684f1SStefano Zampini PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
3379f34684f1SStefano Zampini {
3380f34684f1SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3381f34684f1SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
3382f34684f1SStefano Zampini   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
3383727cdba6SStefano Zampini   PetscInt       i,coarse_size;
3384727cdba6SStefano Zampini   PetscInt       *local_primal_indices;
3385f34684f1SStefano Zampini   PetscErrorCode ierr;
3386f34684f1SStefano Zampini 
3387f34684f1SStefano Zampini   PetscFunctionBegin;
3388f34684f1SStefano Zampini   /* Compute global number of coarse dofs */
3389727cdba6SStefano Zampini   if (!pcbddc->primal_indices_local_idxs) {
3390727cdba6SStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Constraint matrix has not been created");
3391727cdba6SStefano Zampini   }
3392727cdba6SStefano 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);
3393f34684f1SStefano Zampini 
3394f34684f1SStefano Zampini   /* check numbering */
3395f34684f1SStefano Zampini   if (pcbddc->dbg_flag) {
3396f34684f1SStefano Zampini     PetscScalar coarsesum,*array;
3397f34684f1SStefano Zampini 
3398f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3399f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3400f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
3401*0fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
3402f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
3403f34684f1SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
3404727cdba6SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
3405f34684f1SStefano Zampini     }
3406f34684f1SStefano Zampini     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
3407f34684f1SStefano Zampini     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
3408f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3409f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3410f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3411f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3412f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3413f34684f1SStefano Zampini     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3414f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3415f34684f1SStefano Zampini       if (array[i] == 1.0) {
3416f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %d owned by a single process!\n",PetscGlobalRank,i);CHKERRQ(ierr);
3417f34684f1SStefano Zampini       }
3418f34684f1SStefano Zampini     }
3419f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3420f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3421f34684f1SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
3422f34684f1SStefano Zampini     }
3423f34684f1SStefano Zampini     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3424f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3425f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3426f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3427f34684f1SStefano Zampini     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
3428f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
3429f34684f1SStefano Zampini     if (pcbddc->dbg_flag > 1) {
3430f34684f1SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
3431f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3432f34684f1SStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
3433f34684f1SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
3434727cdba6SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_primal_indices[%d]=%d (%d)\n",i,local_primal_indices[i],pcbddc->primal_indices_local_idxs[i]);
3435f34684f1SStefano Zampini       }
3436f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3437f34684f1SStefano Zampini     }
3438f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3439f34684f1SStefano Zampini   }
3440f34684f1SStefano Zampini   /* get back data */
3441f34684f1SStefano Zampini   *coarse_size_n = coarse_size;
3442f34684f1SStefano Zampini   *local_primal_indices_n = local_primal_indices;
3443674ae819SStefano Zampini   PetscFunctionReturn(0);
3444674ae819SStefano Zampini }
3445674ae819SStefano Zampini 
3446