xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision d06fc5fdc14868351a0b98e4bca8d71e559dfa1f)
1ab5c6b0cSJed Brown #include <../src/ksp/pc/impls/bddc/bddc.h>
2ab5c6b0cSJed Brown #include <../src/ksp/pc/impls/bddc/bddcprivate.h>
3674ae819SStefano Zampini #include <petscblaslapack.h>
4674ae819SStefano Zampini 
5674ae819SStefano Zampini #undef __FUNCT__
6c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpSolvers"
7c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpSolvers(PC pc)
8c8587f34SStefano Zampini {
9c8587f34SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
108629588bSStefano Zampini   PetscScalar    *coarse_submat_vals;
11c8587f34SStefano Zampini   PetscErrorCode ierr;
12c8587f34SStefano Zampini 
13c8587f34SStefano Zampini   PetscFunctionBegin;
14c8587f34SStefano Zampini   /* Compute matrix after change of basis and extract local submatrices */
15c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalMatrices(pc);CHKERRQ(ierr);
16c8587f34SStefano Zampini 
17f4ddd8eeSStefano Zampini   /* Setup local scatters R_to_B and (optionally) R_to_D */
18f4ddd8eeSStefano Zampini   /* PCBDDCSetUpLocalWorkVectors and PCBDDCSetUpLocalMatrices should be called first! */
19c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
20c8587f34SStefano Zampini 
21c8587f34SStefano Zampini   /* Setup local solvers ksp_D and ksp_R */
220fccc4e9SStefano Zampini   /* PCBDDCSetUpLocalScatters should be called first! */
23c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalSolvers(pc);CHKERRQ(ierr);
24c8587f34SStefano Zampini 
25c8587f34SStefano Zampini   /* Change global null space passed in by the user if change of basis has been requested */
26b9b85e73SStefano Zampini   if (pcbddc->NullSpace && pcbddc->ChangeOfBasisMatrix) {
27c8587f34SStefano Zampini     ierr = PCBDDCNullSpaceAdaptGlobal(pc);CHKERRQ(ierr);
28c8587f34SStefano Zampini   }
29c8587f34SStefano Zampini 
308629588bSStefano Zampini   /*
318629588bSStefano Zampini      Setup local correction and local part of coarse basis.
328629588bSStefano Zampini      Gives back the dense local part of the coarse matrix in column major ordering
338629588bSStefano Zampini   */
3447f4ddc3SStefano Zampini   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
358629588bSStefano Zampini 
368629588bSStefano Zampini   /* Compute total number of coarse nodes and setup coarse solver */
378629588bSStefano Zampini   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
388629588bSStefano Zampini 
398629588bSStefano Zampini   /* free */
408629588bSStefano Zampini   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
41c8587f34SStefano Zampini   PetscFunctionReturn(0);
42c8587f34SStefano Zampini }
43c8587f34SStefano Zampini 
44c8587f34SStefano Zampini #undef __FUNCT__
45674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetCustomization"
46674ae819SStefano Zampini PetscErrorCode PCBDDCResetCustomization(PC pc)
47674ae819SStefano Zampini {
48674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
49674ae819SStefano Zampini   PetscErrorCode ierr;
50674ae819SStefano Zampini 
51674ae819SStefano Zampini   PetscFunctionBegin;
52674ae819SStefano Zampini   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
53674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
54674ae819SStefano Zampini   ierr = MatNullSpaceDestroy(&pcbddc->NullSpace);CHKERRQ(ierr);
55674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
56785d1243SStefano Zampini   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
57674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
58f4ddd8eeSStefano Zampini   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
59f4ddd8eeSStefano Zampini   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
60785d1243SStefano Zampini   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
6163602bcaSStefano Zampini   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
6263602bcaSStefano Zampini   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
63674ae819SStefano Zampini   PetscFunctionReturn(0);
64674ae819SStefano Zampini }
65674ae819SStefano Zampini 
66674ae819SStefano Zampini #undef __FUNCT__
67674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetTopography"
68674ae819SStefano Zampini PetscErrorCode PCBDDCResetTopography(PC pc)
69674ae819SStefano Zampini {
70674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
71674ae819SStefano Zampini   PetscErrorCode ierr;
72674ae819SStefano Zampini 
73674ae819SStefano Zampini   PetscFunctionBegin;
74b9b85e73SStefano Zampini   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
75674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
76674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
77674ae819SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
78674ae819SStefano Zampini   PetscFunctionReturn(0);
79674ae819SStefano Zampini }
80674ae819SStefano Zampini 
81674ae819SStefano Zampini #undef __FUNCT__
82674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetSolvers"
83674ae819SStefano Zampini PetscErrorCode PCBDDCResetSolvers(PC pc)
84674ae819SStefano Zampini {
85674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
86674ae819SStefano Zampini   PetscErrorCode ierr;
87674ae819SStefano Zampini 
88674ae819SStefano Zampini   PetscFunctionBegin;
89674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
90674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_rhs);CHKERRQ(ierr);
91674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
92674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
9315aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
9415aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
95674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
96674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
97674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
98674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
99674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
100674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
1018ce42a96SStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
102674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
103674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
104674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
105f4ddd8eeSStefano Zampini   ierr = KSPDestroy(&pcbddc->ksp_D);CHKERRQ(ierr);
106f4ddd8eeSStefano Zampini   ierr = KSPDestroy(&pcbddc->ksp_R);CHKERRQ(ierr);
107f4ddd8eeSStefano Zampini   ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
108f4ddd8eeSStefano Zampini   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
109727cdba6SStefano Zampini   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
110f4ddd8eeSStefano Zampini   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
11170cf5478SStefano Zampini   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
1126e683305SStefano Zampini   ierr = ISDestroy(&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
113674ae819SStefano Zampini   PetscFunctionReturn(0);
114674ae819SStefano Zampini }
115674ae819SStefano Zampini 
116674ae819SStefano Zampini #undef __FUNCT__
117f4ddd8eeSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalWorkVectors"
118f4ddd8eeSStefano Zampini PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
1196bfb1811SStefano Zampini {
1206bfb1811SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1216bfb1811SStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
1226bfb1811SStefano Zampini   VecType        impVecType;
123e9189074SStefano Zampini   PetscInt       n_constraints,n_R,old_size;
1246bfb1811SStefano Zampini   PetscErrorCode ierr;
1256bfb1811SStefano Zampini 
1266bfb1811SStefano Zampini   PetscFunctionBegin;
127f4ddd8eeSStefano Zampini   if (!pcbddc->ConstraintMatrix) {
128f4ddd8eeSStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Constraint matrix has not been created");
129f4ddd8eeSStefano Zampini   }
130e7b262bdSStefano Zampini   /* get sizes */
131e9189074SStefano Zampini   n_constraints = pcbddc->local_primal_size - pcbddc->n_actual_vertices;
132e9189074SStefano Zampini   n_R = pcis->n-pcbddc->n_actual_vertices;
1336bfb1811SStefano Zampini   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
134e7b262bdSStefano Zampini   /* local work vectors (try to avoid unneeded work)*/
135e7b262bdSStefano Zampini   /* R nodes */
136e7b262bdSStefano Zampini   old_size = -1;
137e7b262bdSStefano Zampini   if (pcbddc->vec1_R) {
138e7b262bdSStefano Zampini     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
139e7b262bdSStefano Zampini   }
140e7b262bdSStefano Zampini   if (n_R != old_size) {
141e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
142e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
1436bfb1811SStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
1446bfb1811SStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
1456bfb1811SStefano Zampini     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
1466bfb1811SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
147e7b262bdSStefano Zampini   }
148e7b262bdSStefano Zampini   /* local primal dofs */
149e7b262bdSStefano Zampini   old_size = -1;
150e7b262bdSStefano Zampini   if (pcbddc->vec1_P) {
151e7b262bdSStefano Zampini     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
152e7b262bdSStefano Zampini   }
153e9189074SStefano Zampini   if (pcbddc->local_primal_size != old_size) {
154e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
15583b7ccabSStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
156e9189074SStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
1576bfb1811SStefano Zampini     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
158e7b262bdSStefano Zampini   }
159e7b262bdSStefano Zampini   /* local explicit constraints */
160e7b262bdSStefano Zampini   old_size = -1;
161e7b262bdSStefano Zampini   if (pcbddc->vec1_C) {
162e7b262bdSStefano Zampini     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
163e7b262bdSStefano Zampini   }
164e7b262bdSStefano Zampini   if (n_constraints && n_constraints != old_size) {
165e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
16683b7ccabSStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
16783b7ccabSStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
16883b7ccabSStefano Zampini     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
16983b7ccabSStefano Zampini   }
1706bfb1811SStefano Zampini   PetscFunctionReturn(0);
1716bfb1811SStefano Zampini }
1726bfb1811SStefano Zampini 
1736bfb1811SStefano Zampini #undef __FUNCT__
17447f4ddc3SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCorrection"
17547f4ddc3SStefano Zampini PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
17688ebb749SStefano Zampini {
17725084f0cSStefano Zampini   PetscErrorCode         ierr;
17825084f0cSStefano Zampini   /* pointers to pcis and pcbddc */
17988ebb749SStefano Zampini   PC_IS*                 pcis = (PC_IS*)pc->data;
18088ebb749SStefano Zampini   PC_BDDC*               pcbddc = (PC_BDDC*)pc->data;
18125084f0cSStefano Zampini   /* submatrices of local problem */
18288ebb749SStefano Zampini   Mat                    A_RV,A_VR,A_VV;
18325084f0cSStefano Zampini   /* working matrices */
18425084f0cSStefano Zampini   Mat                    M1,M2,M3,C_CR;
18525084f0cSStefano Zampini   /* working vectors */
18625084f0cSStefano Zampini   Vec                    vec1_C,vec2_C,vec1_V,vec2_V;
18725084f0cSStefano Zampini   /* additional working stuff */
18825084f0cSStefano Zampini   IS                     is_aux;
18925084f0cSStefano Zampini   PetscScalar            *coarse_submat_vals; /* TODO: use a PETSc matrix */
19025084f0cSStefano Zampini   const PetscScalar      *array,*row_cmat_values;
19125084f0cSStefano Zampini   const PetscInt         *row_cmat_indices,*idx_R_local;
192e9189074SStefano Zampini   PetscInt               *idx_V_B,*auxindices;
19325084f0cSStefano Zampini   PetscInt               n_vertices,n_constraints,size_of_constraint;
19425084f0cSStefano Zampini   PetscInt               i,j,n_R,n_D,n_B;
195b9d89cd5SStefano Zampini   PetscBool              unsymmetric_check;
19645a1bb75SStefano Zampini   /* matrix type (vector type propagated downstream from vec1_C and local matrix type) */
19788ebb749SStefano Zampini   MatType                impMatType;
19825084f0cSStefano Zampini   /* some shortcuts to scalars */
19925084f0cSStefano Zampini   PetscScalar            zero=0.0,one=1.0,m_one=-1.0;
20025084f0cSStefano Zampini   /* for debugging purposes */
20188ebb749SStefano Zampini   PetscReal              *coarsefunctions_errors,*constraints_errors;
20288ebb749SStefano Zampini 
20388ebb749SStefano Zampini   PetscFunctionBegin;
204e9189074SStefano Zampini   /* get number of vertices (corners plus constraints with change of basis)
205e9189074SStefano Zampini      pcbddc->n_actual_vertices stores the actual number of vertices, pcbddc->n_vertices the number of corners computed */
206e9189074SStefano Zampini   n_vertices = pcbddc->n_actual_vertices;
20788ebb749SStefano Zampini   n_constraints = pcbddc->local_primal_size-n_vertices;
20888ebb749SStefano Zampini   /* Set Non-overlapping dimensions */
20988ebb749SStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
21088ebb749SStefano Zampini   n_R = pcis->n-n_vertices;
21188ebb749SStefano Zampini 
21288ebb749SStefano Zampini   /* Set types for local objects needed by BDDC precondtioner */
21388ebb749SStefano Zampini   impMatType = MATSEQDENSE;
21488ebb749SStefano Zampini 
21588ebb749SStefano Zampini   /* Allocating some extra storage just to be safe */
21688ebb749SStefano Zampini   ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&auxindices);CHKERRQ(ierr);
21788ebb749SStefano Zampini   for (i=0;i<pcis->n;i++) auxindices[i]=i;
21888ebb749SStefano Zampini 
21988ebb749SStefano Zampini   /* vertices in boundary numbering */
220785e854fSJed Brown   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
221e9189074SStefano Zampini   ierr = ISGlobalToLocalMappingApply(pcbddc->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->primal_indices_local_idxs,&i,idx_V_B);CHKERRQ(ierr);
22288ebb749SStefano Zampini   if (i != n_vertices) {
22322d5777bSStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %d != %d\n",n_vertices,i);
22488ebb749SStefano Zampini   }
22588ebb749SStefano Zampini 
22688ebb749SStefano Zampini   /* Precompute stuffs needed for preprocessing and application of BDDC*/
22788ebb749SStefano Zampini   if (n_constraints) {
228f4ddd8eeSStefano Zampini     /* see if we can save some allocations */
229f4ddd8eeSStefano Zampini     if (pcbddc->local_auxmat2) {
230f4ddd8eeSStefano Zampini       PetscInt on_R,on_constraints;
231f4ddd8eeSStefano Zampini       ierr = MatGetSize(pcbddc->local_auxmat2,&on_R,&on_constraints);CHKERRQ(ierr);
232f4ddd8eeSStefano Zampini       if (on_R != n_R || on_constraints != n_constraints) {
233f4ddd8eeSStefano Zampini         ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
234f4ddd8eeSStefano Zampini         ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
235f4ddd8eeSStefano Zampini       }
236f4ddd8eeSStefano Zampini     }
23745a1bb75SStefano Zampini     /* work vectors */
23845a1bb75SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec1_C);CHKERRQ(ierr);
23945a1bb75SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec2_C);CHKERRQ(ierr);
24045a1bb75SStefano Zampini     /* auxiliary matrices */
241f4ddd8eeSStefano Zampini     if (!pcbddc->local_auxmat2) {
24288ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->local_auxmat2);CHKERRQ(ierr);
24325084f0cSStefano Zampini       ierr = MatSetSizes(pcbddc->local_auxmat2,n_R,n_constraints,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
24488ebb749SStefano Zampini       ierr = MatSetType(pcbddc->local_auxmat2,impMatType);CHKERRQ(ierr);
24525084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->local_auxmat2);CHKERRQ(ierr);
246f4ddd8eeSStefano Zampini     }
24788ebb749SStefano Zampini 
24825084f0cSStefano Zampini     /* Extract constraints on R nodes: C_{CR}  */
24925084f0cSStefano Zampini     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
2508ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
25125084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
25288ebb749SStefano Zampini 
25388ebb749SStefano Zampini     /* Assemble local_auxmat2 = - A_{RR}^{-1} C^T_{CR} needed by BDDC application */
25488ebb749SStefano Zampini     for (i=0;i<n_constraints;i++) {
25588ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
25688ebb749SStefano Zampini       /* Get row of constraint matrix in R numbering */
25725084f0cSStefano Zampini       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
25825084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_R,size_of_constraint,row_cmat_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
25925084f0cSStefano Zampini       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
26025084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_R);CHKERRQ(ierr);
26125084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_R);CHKERRQ(ierr);
26288ebb749SStefano Zampini       /* Solve for row of constraint matrix in R numbering */
26388ebb749SStefano Zampini       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
26425084f0cSStefano Zampini       /* Set values in local_auxmat2 */
26525084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
26688ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->local_auxmat2,n_R,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
26725084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
26888ebb749SStefano Zampini     }
26988ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
27088ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
27125084f0cSStefano Zampini     ierr = MatScale(pcbddc->local_auxmat2,m_one);CHKERRQ(ierr);
27288ebb749SStefano Zampini 
27388ebb749SStefano Zampini     /* Assemble explicitly M1 = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1} needed in preproc  */
27425084f0cSStefano Zampini     ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
27525084f0cSStefano Zampini     ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
27688ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&M1);CHKERRQ(ierr);
27788ebb749SStefano Zampini     ierr = MatSetSizes(M1,n_constraints,n_constraints,n_constraints,n_constraints);CHKERRQ(ierr);
27888ebb749SStefano Zampini     ierr = MatSetType(M1,impMatType);CHKERRQ(ierr);
27925084f0cSStefano Zampini     ierr = MatSetUp(M1);CHKERRQ(ierr);
28025084f0cSStefano Zampini     ierr = MatDuplicate(M1,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
28125084f0cSStefano Zampini     ierr = MatZeroEntries(M2);CHKERRQ(ierr);
28225084f0cSStefano Zampini     ierr = VecSet(vec1_C,m_one);CHKERRQ(ierr);
28325084f0cSStefano Zampini     ierr = MatDiagonalSet(M2,vec1_C,INSERT_VALUES);CHKERRQ(ierr);
28425084f0cSStefano Zampini     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
28525084f0cSStefano Zampini     ierr = MatDestroy(&M2);CHKERRQ(ierr);
28625084f0cSStefano Zampini     ierr = MatDestroy(&M3);CHKERRQ(ierr);
28788ebb749SStefano Zampini     /* Assemble local_auxmat1 = M1*C_{CR} needed by BDDC application in KSP and in preproc */
288f4ddd8eeSStefano Zampini     if (!pcbddc->local_auxmat1) {
28988ebb749SStefano Zampini       ierr = MatMatMult(M1,C_CR,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
290f4ddd8eeSStefano Zampini     } else {
291f4ddd8eeSStefano Zampini       ierr = MatMatMult(M1,C_CR,MAT_REUSE_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
292f4ddd8eeSStefano Zampini     }
29388ebb749SStefano Zampini   }
29488ebb749SStefano Zampini 
29588ebb749SStefano Zampini   /* Get submatrices from subdomain matrix */
29688ebb749SStefano Zampini   if (n_vertices) {
2973a50541eSStefano Zampini     PetscInt ibs,mbs;
2983a50541eSStefano Zampini     PetscBool issbaij;
299af732b37SStefano Zampini     Mat newmat;
3003a50541eSStefano Zampini 
3013a50541eSStefano Zampini     ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
3029577ea80SStefano Zampini     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
3039577ea80SStefano Zampini     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
3043a50541eSStefano Zampini     if (ibs != mbs) { /* need to convert to SEQAIJ */
3059577ea80SStefano Zampini       ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
3069577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3079577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3089577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3099577ea80SStefano Zampini       ierr = MatDestroy(&newmat);CHKERRQ(ierr);
3109577ea80SStefano Zampini     } else {
3113a50541eSStefano Zampini       /* this is safe */
3129577ea80SStefano Zampini       ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3133a50541eSStefano Zampini       ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
3143a50541eSStefano Zampini       if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
3153a50541eSStefano Zampini         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
31645a1bb75SStefano Zampini         /* which of the two approaches is faster? */
3173a50541eSStefano Zampini         /* ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3183a50541eSStefano Zampini         ierr = MatCreateTranspose(A_RV,&A_VR);CHKERRQ(ierr);*/
3193a50541eSStefano Zampini         ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3203a50541eSStefano Zampini         ierr = MatCreateTranspose(A_VR,&A_RV);CHKERRQ(ierr);
3213a50541eSStefano Zampini         ierr = MatDestroy(&newmat);CHKERRQ(ierr);
3223a50541eSStefano Zampini       } else {
3239577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3249577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3259577ea80SStefano Zampini       }
3263a50541eSStefano Zampini     }
32745a1bb75SStefano Zampini     ierr = MatGetVecs(A_RV,&vec1_V,NULL);CHKERRQ(ierr);
32845a1bb75SStefano Zampini     ierr = VecDuplicate(vec1_V,&vec2_V);CHKERRQ(ierr);
32925084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
33088ebb749SStefano Zampini   }
33188ebb749SStefano Zampini 
33288ebb749SStefano Zampini   /* Matrix of coarse basis functions (local) */
333f4ddd8eeSStefano Zampini   if (pcbddc->coarse_phi_B) {
334f4ddd8eeSStefano Zampini     PetscInt on_B,on_primal;
335f4ddd8eeSStefano Zampini     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
336f4ddd8eeSStefano Zampini     if (on_B != n_B || on_primal != pcbddc->local_primal_size) {
337f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
338f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
339f4ddd8eeSStefano Zampini     }
340f4ddd8eeSStefano Zampini   }
341f4ddd8eeSStefano Zampini   if (pcbddc->coarse_phi_D) {
342f4ddd8eeSStefano Zampini     PetscInt on_D,on_primal;
343f4ddd8eeSStefano Zampini     ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,&on_primal);CHKERRQ(ierr);
344f4ddd8eeSStefano Zampini     if (on_D != n_D || on_primal != pcbddc->local_primal_size) {
345f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
346f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
347f4ddd8eeSStefano Zampini     }
348f4ddd8eeSStefano Zampini   }
349f4ddd8eeSStefano Zampini   if (!pcbddc->coarse_phi_B) {
35088ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
35188ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_phi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
35288ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_phi_B,impMatType);CHKERRQ(ierr);
35325084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_phi_B);CHKERRQ(ierr);
354f4ddd8eeSStefano Zampini   }
355f4ddd8eeSStefano Zampini   if ( (pcbddc->switch_static || pcbddc->dbg_flag) && !pcbddc->coarse_phi_D ) {
35688ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
35788ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_phi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
35888ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_phi_D,impMatType);CHKERRQ(ierr);
35925084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_phi_D);CHKERRQ(ierr);
36088ebb749SStefano Zampini   }
36188ebb749SStefano Zampini 
36225084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
3638ce42a96SStefano Zampini     ierr = ISGetIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
364785e854fSJed Brown     ierr = PetscMalloc1(2*pcbddc->local_primal_size,&coarsefunctions_errors);CHKERRQ(ierr);
365785e854fSJed Brown     ierr = PetscMalloc1(2*pcbddc->local_primal_size,&constraints_errors);CHKERRQ(ierr);
36688ebb749SStefano Zampini   }
36788ebb749SStefano Zampini   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
368785e854fSJed Brown   ierr = PetscMalloc1((pcbddc->local_primal_size)*(pcbddc->local_primal_size),&coarse_submat_vals);CHKERRQ(ierr);
36988ebb749SStefano Zampini 
37088ebb749SStefano Zampini   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
37125084f0cSStefano Zampini 
37225084f0cSStefano Zampini   /* vertices */
37388ebb749SStefano Zampini   for (i=0;i<n_vertices;i++) {
37445a1bb75SStefano Zampini     /* this should not be needed, but MatMult_BAIJ is broken when using compressed row routines */
375f4ddd8eeSStefano Zampini     ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr); /* TODO: REMOVE IT */
37688ebb749SStefano Zampini     ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
37788ebb749SStefano Zampini     ierr = VecSetValue(vec1_V,i,one,INSERT_VALUES);CHKERRQ(ierr);
37888ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
37988ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
38025084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on constraints multipliers */
38188ebb749SStefano Zampini     ierr = MatMult(A_RV,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
38288ebb749SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
38388ebb749SStefano Zampini     ierr = VecScale(pcbddc->vec1_R,m_one);CHKERRQ(ierr);
38488ebb749SStefano Zampini     if (n_constraints) {
38588ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec1_R,vec1_C);CHKERRQ(ierr);
38688ebb749SStefano Zampini       ierr = MatMultAdd(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
38788ebb749SStefano Zampini       ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
38888ebb749SStefano Zampini     }
38988ebb749SStefano Zampini     ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
39088ebb749SStefano Zampini     ierr = MatMultAdd(A_VV,vec1_V,vec2_V,vec2_V);CHKERRQ(ierr);
39188ebb749SStefano Zampini 
39288ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
39388ebb749SStefano Zampini     /* coarse basis functions */
39488ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
39588ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
39688ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
39725084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
39888ebb749SStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
39925084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
40088ebb749SStefano Zampini     ierr = MatSetValue(pcbddc->coarse_phi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
4018eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
40288ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40388ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40425084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
40588ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
40625084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
40788ebb749SStefano Zampini     }
40825084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
40925084f0cSStefano Zampini     ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
41025084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
41125084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
41288ebb749SStefano Zampini     if (n_constraints) {
41325084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
41425084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
41525084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
41688ebb749SStefano Zampini     }
41788ebb749SStefano Zampini 
41825084f0cSStefano Zampini     /* check */
41925084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
42025084f0cSStefano Zampini       /* assemble subdomain vector on local nodes */
42188ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
42225084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
42325084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
42425084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
425e9189074SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],one,INSERT_VALUES);CHKERRQ(ierr);
42625084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
42725084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
42888ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers (i.e. primal nodes) */
42988ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
43025084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
43125084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
43225084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
43388ebb749SStefano Zampini       if (n_constraints) {
43425084f0cSStefano Zampini         ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
43525084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
43625084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
43788ebb749SStefano Zampini       }
43825084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
43925084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
44088ebb749SStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
44188ebb749SStefano Zampini       /* check saddle point solution */
44288ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
44388ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
44488ebb749SStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i]);CHKERRQ(ierr);
44588ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
44625084f0cSStefano Zampini       /* shift by the identity matrix */
44725084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
44825084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
44925084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
45088ebb749SStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i]);CHKERRQ(ierr);
45188ebb749SStefano Zampini     }
45288ebb749SStefano Zampini   }
45388ebb749SStefano Zampini 
45425084f0cSStefano Zampini   /* constraints */
45588ebb749SStefano Zampini   for (i=0;i<n_constraints;i++) {
45688ebb749SStefano Zampini     ierr = VecSet(vec2_C,zero);CHKERRQ(ierr);
45788ebb749SStefano Zampini     ierr = VecSetValue(vec2_C,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
45888ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec2_C);CHKERRQ(ierr);
45988ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec2_C);CHKERRQ(ierr);
46025084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on vertices multipliers */
46188ebb749SStefano Zampini     ierr = MatMult(M1,vec2_C,vec1_C);CHKERRQ(ierr);
46288ebb749SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
46388ebb749SStefano Zampini     ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
46425084f0cSStefano Zampini     if (n_vertices) {
46525084f0cSStefano Zampini       ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
46625084f0cSStefano Zampini     }
46788ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
46888ebb749SStefano Zampini     /* coarse basis functions */
46925084f0cSStefano Zampini     j = i+n_vertices; /* don't touch this! */
47088ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
47188ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
47288ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
47325084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
47425084f0cSStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
47525084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
4768eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
47788ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
47888ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
47925084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
48025084f0cSStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
48125084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
48288ebb749SStefano Zampini     }
48325084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
48488ebb749SStefano Zampini     if (n_vertices) {
48525084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
48625084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
48725084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
48888ebb749SStefano Zampini     }
48925084f0cSStefano Zampini     ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
49025084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
49125084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
49288ebb749SStefano Zampini 
49325084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
49488ebb749SStefano Zampini       /* assemble subdomain vector on nodes */
49588ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
49625084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
49725084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
49825084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
49925084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
50025084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
50188ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers */
50288ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
50388ebb749SStefano Zampini       if (n_vertices) {
50425084f0cSStefano Zampini         ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
50525084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
50625084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
50788ebb749SStefano Zampini       }
50825084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
50925084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
51025084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
51125084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
51225084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
51325084f0cSStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
51488ebb749SStefano Zampini       /* check saddle point solution */
51588ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
51688ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
51725084f0cSStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[j]);CHKERRQ(ierr);
51888ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
51925084f0cSStefano Zampini       /* shift by the identity matrix */
52025084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,j,m_one,ADD_VALUES);CHKERRQ(ierr);
52125084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
52225084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
52325084f0cSStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[j]);CHKERRQ(ierr);
52488ebb749SStefano Zampini     }
52588ebb749SStefano Zampini   }
52625084f0cSStefano Zampini   /* call assembling routines for local coarse basis */
52788ebb749SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
52888ebb749SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5298eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
53088ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
53188ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
53288ebb749SStefano Zampini   }
53325084f0cSStefano Zampini 
53488ebb749SStefano Zampini   /* compute other basis functions for non-symmetric problems */
535b9d89cd5SStefano Zampini   ierr = MatIsSymmetric(pc->pmat,1.e-4,&pcbddc->issym);CHKERRQ(ierr);
536b9d89cd5SStefano Zampini   if (!pcbddc->issym) {
537f4ddd8eeSStefano Zampini     if (!pcbddc->coarse_psi_B) {
53888ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
53988ebb749SStefano Zampini       ierr = MatSetSizes(pcbddc->coarse_psi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
54088ebb749SStefano Zampini       ierr = MatSetType(pcbddc->coarse_psi_B,impMatType);CHKERRQ(ierr);
54125084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->coarse_psi_B);CHKERRQ(ierr);
542f4ddd8eeSStefano Zampini     }
543f4ddd8eeSStefano Zampini     if ( (pcbddc->switch_static || pcbddc->dbg_flag) && !pcbddc->coarse_psi_D) {
54488ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
54588ebb749SStefano Zampini       ierr = MatSetSizes(pcbddc->coarse_psi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
54688ebb749SStefano Zampini       ierr = MatSetType(pcbddc->coarse_psi_D,impMatType);CHKERRQ(ierr);
54725084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->coarse_psi_D);CHKERRQ(ierr);
54888ebb749SStefano Zampini     }
54988ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
55088ebb749SStefano Zampini       if (n_constraints) {
55188ebb749SStefano Zampini         ierr = VecSet(vec1_C,zero);CHKERRQ(ierr);
55288ebb749SStefano Zampini         for (j=0;j<n_constraints;j++) {
55325084f0cSStefano Zampini           ierr = VecSetValue(vec1_C,j,coarse_submat_vals[(j+n_vertices)*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
55488ebb749SStefano Zampini         }
55525084f0cSStefano Zampini         ierr = VecAssemblyBegin(vec1_C);CHKERRQ(ierr);
55625084f0cSStefano Zampini         ierr = VecAssemblyEnd(vec1_C);CHKERRQ(ierr);
55788ebb749SStefano Zampini       }
55888ebb749SStefano Zampini       if (i<n_vertices) {
55988ebb749SStefano Zampini         ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
56088ebb749SStefano Zampini         ierr = VecSetValue(vec1_V,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
56188ebb749SStefano Zampini         ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
56288ebb749SStefano Zampini         ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
56388ebb749SStefano Zampini         ierr = MatMultTranspose(A_VR,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
56488ebb749SStefano Zampini         if (n_constraints) {
56588ebb749SStefano Zampini           ierr = MatMultTransposeAdd(C_CR,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
56688ebb749SStefano Zampini         }
56788ebb749SStefano Zampini       } else {
56888ebb749SStefano Zampini         ierr = MatMultTranspose(C_CR,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
56988ebb749SStefano Zampini       }
57088ebb749SStefano Zampini       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
57188ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
57288ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
57388ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
57425084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
57588ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_psi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
57625084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
57788ebb749SStefano Zampini       if (i<n_vertices) {
57888ebb749SStefano Zampini         ierr = MatSetValue(pcbddc->coarse_psi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
57988ebb749SStefano Zampini       }
5808eeda7d8SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
58188ebb749SStefano Zampini         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
58288ebb749SStefano Zampini         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
58325084f0cSStefano Zampini         ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
58488ebb749SStefano Zampini         ierr = MatSetValues(pcbddc->coarse_psi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
58525084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
58688ebb749SStefano Zampini       }
58788ebb749SStefano Zampini 
58825084f0cSStefano Zampini       if (pcbddc->dbg_flag) {
58988ebb749SStefano Zampini         /* assemble subdomain vector on nodes */
59088ebb749SStefano Zampini         ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
59125084f0cSStefano Zampini         ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
59225084f0cSStefano Zampini         ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
59325084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
59425084f0cSStefano Zampini         if (i<n_vertices) {
595e9189074SStefano Zampini           ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],one,INSERT_VALUES);CHKERRQ(ierr);
59688ebb749SStefano Zampini         }
59725084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
59825084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
59925084f0cSStefano Zampini         /* assemble subdomain vector of lagrange multipliers */
60025084f0cSStefano Zampini         for (j=0;j<pcbddc->local_primal_size;j++) {
60125084f0cSStefano Zampini           ierr = VecSetValue(pcbddc->vec1_P,j,-coarse_submat_vals[j*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
60225084f0cSStefano Zampini         }
60325084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
60425084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
60588ebb749SStefano Zampini         /* check saddle point solution */
60688ebb749SStefano Zampini         ierr = MatMultTranspose(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
60788ebb749SStefano Zampini         ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
60888ebb749SStefano Zampini         ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
60988ebb749SStefano Zampini         ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
61025084f0cSStefano Zampini         /* shift by the identity matrix */
61125084f0cSStefano Zampini         ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
61225084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
61325084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
61488ebb749SStefano Zampini         ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
61588ebb749SStefano Zampini       }
61688ebb749SStefano Zampini     }
61788ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
61888ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6198eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
62088ebb749SStefano Zampini       ierr = MatAssemblyBegin(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
62188ebb749SStefano Zampini       ierr = MatAssemblyEnd(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
62288ebb749SStefano Zampini     }
623c0553b1fSStefano Zampini     unsymmetric_check = PETSC_TRUE;
624c0553b1fSStefano Zampini   } else { /* take references to already computed coarse basis */
625c0553b1fSStefano Zampini     unsymmetric_check = PETSC_FALSE;
626c0553b1fSStefano Zampini     ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
627c0553b1fSStefano Zampini     pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
628c0553b1fSStefano Zampini     if (pcbddc->coarse_phi_D) {
629c0553b1fSStefano Zampini       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
630c0553b1fSStefano Zampini       pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
631c0553b1fSStefano Zampini     }
63288ebb749SStefano Zampini   }
63388ebb749SStefano Zampini   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
63488ebb749SStefano Zampini   /* Checking coarse_sub_mat and coarse basis functios */
63588ebb749SStefano Zampini   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
63688ebb749SStefano Zampini   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
63725084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
63888ebb749SStefano Zampini     Mat         coarse_sub_mat;
63925084f0cSStefano Zampini     Mat         AUXMAT,TM1,TM2,TM3,TM4;
64088ebb749SStefano Zampini     Mat         coarse_phi_D,coarse_phi_B;
64188ebb749SStefano Zampini     Mat         coarse_psi_D,coarse_psi_B;
64288ebb749SStefano Zampini     Mat         A_II,A_BB,A_IB,A_BI;
64388ebb749SStefano Zampini     MatType     checkmattype=MATSEQAIJ;
64488ebb749SStefano Zampini     PetscReal   real_value;
64588ebb749SStefano Zampini 
64688ebb749SStefano Zampini     ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
64788ebb749SStefano Zampini     ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
64888ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
64988ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
65088ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
65188ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
652c0553b1fSStefano Zampini     if (unsymmetric_check) {
65388ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
65488ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
65588ebb749SStefano Zampini     }
65688ebb749SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
65788ebb749SStefano Zampini 
65825084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
65925084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat and local basis functions\n");CHKERRQ(ierr);
66025084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
661c0553b1fSStefano Zampini     if (unsymmetric_check) {
66288ebb749SStefano Zampini       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
66388ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
66488ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
66588ebb749SStefano Zampini       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
66688ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
66788ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
66888ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
66988ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
67088ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
67188ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
67288ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
67388ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
67488ebb749SStefano Zampini     } else {
67588ebb749SStefano Zampini       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
67688ebb749SStefano Zampini       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
67788ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
67888ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
67988ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
68088ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
68188ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
68288ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
68388ebb749SStefano Zampini     }
68488ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
68588ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
68688ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
68788ebb749SStefano Zampini     ierr = MatConvert(TM1,MATSEQDENSE,MAT_REUSE_MATRIX,&TM1);CHKERRQ(ierr);
68881d9aea3SBarry Smith     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
68988ebb749SStefano Zampini     ierr = MatNorm(TM1,NORM_INFINITY,&real_value);CHKERRQ(ierr);
6900fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
69125084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"----------------------------------\n");CHKERRQ(ierr);
69225084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d \n",PetscGlobalRank);CHKERRQ(ierr);
69325084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"matrix error = % 1.14e\n",real_value);CHKERRQ(ierr);
69425084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (phi) errors\n");CHKERRQ(ierr);
69588ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
69625084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,coarsefunctions_errors[i]);CHKERRQ(ierr);
69788ebb749SStefano Zampini     }
69825084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (phi) errors\n");CHKERRQ(ierr);
69988ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
70025084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,constraints_errors[i]);CHKERRQ(ierr);
70188ebb749SStefano Zampini     }
702c0553b1fSStefano Zampini     if (unsymmetric_check) {
70325084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (psi) errors\n");CHKERRQ(ierr);
70488ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
70525084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,coarsefunctions_errors[i]);CHKERRQ(ierr);
70688ebb749SStefano Zampini       }
70725084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (psi) errors\n");CHKERRQ(ierr);
70888ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
70925084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,constraints_errors[i]);CHKERRQ(ierr);
71088ebb749SStefano Zampini       }
71188ebb749SStefano Zampini     }
71225084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
71388ebb749SStefano Zampini     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
71488ebb749SStefano Zampini     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
71588ebb749SStefano Zampini     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
71688ebb749SStefano Zampini     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
71788ebb749SStefano Zampini     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
71888ebb749SStefano Zampini     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
71988ebb749SStefano Zampini     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
72088ebb749SStefano Zampini     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
72188ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
72288ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
723c0553b1fSStefano Zampini     if (unsymmetric_check) {
72488ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
72588ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
72688ebb749SStefano Zampini     }
72788ebb749SStefano Zampini     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
7288ce42a96SStefano Zampini     ierr = ISRestoreIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
72988ebb749SStefano Zampini     ierr = PetscFree(coarsefunctions_errors);CHKERRQ(ierr);
73088ebb749SStefano Zampini     ierr = PetscFree(constraints_errors);CHKERRQ(ierr);
73188ebb749SStefano Zampini   }
73288ebb749SStefano Zampini   /* free memory */
73388ebb749SStefano Zampini   if (n_vertices) {
73488ebb749SStefano Zampini     ierr = VecDestroy(&vec1_V);CHKERRQ(ierr);
73588ebb749SStefano Zampini     ierr = VecDestroy(&vec2_V);CHKERRQ(ierr);
73688ebb749SStefano Zampini     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
73788ebb749SStefano Zampini     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
73888ebb749SStefano Zampini     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
73988ebb749SStefano Zampini   }
74088ebb749SStefano Zampini   if (n_constraints) {
74188ebb749SStefano Zampini     ierr = VecDestroy(&vec1_C);CHKERRQ(ierr);
74288ebb749SStefano Zampini     ierr = VecDestroy(&vec2_C);CHKERRQ(ierr);
74388ebb749SStefano Zampini     ierr = MatDestroy(&M1);CHKERRQ(ierr);
74488ebb749SStefano Zampini     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
74588ebb749SStefano Zampini   }
74688ebb749SStefano Zampini   ierr = PetscFree(auxindices);CHKERRQ(ierr);
7478629588bSStefano Zampini   /* get back data */
7488629588bSStefano Zampini   *coarse_submat_vals_n = coarse_submat_vals;
74988ebb749SStefano Zampini   PetscFunctionReturn(0);
75088ebb749SStefano Zampini }
75188ebb749SStefano Zampini 
75288ebb749SStefano Zampini #undef __FUNCT__
753aa0d41d4SStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalMatrices"
754aa0d41d4SStefano Zampini PetscErrorCode PCBDDCSetUpLocalMatrices(PC pc)
755aa0d41d4SStefano Zampini {
756aa0d41d4SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
757aa0d41d4SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
758aa0d41d4SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
75922d5777bSStefano Zampini   PetscBool         issbaij,isseqaij;
760aa0d41d4SStefano Zampini   /* manage repeated solves */
761aa0d41d4SStefano Zampini   MatReuse          reuse;
762aa0d41d4SStefano Zampini   PetscErrorCode    ierr;
763aa0d41d4SStefano Zampini 
764aa0d41d4SStefano Zampini   PetscFunctionBegin;
765b9b85e73SStefano Zampini   if ( (pcbddc->use_change_of_basis && !pcbddc->ChangeOfBasisMatrix) || (pcbddc->user_ChangeOfBasisMatrix && !pcbddc->ChangeOfBasisMatrix) ) {
766f4ddd8eeSStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Change of basis matrix has not been created");
767f4ddd8eeSStefano Zampini   }
768aa0d41d4SStefano Zampini   /* get mat flags */
769aa0d41d4SStefano Zampini   reuse = MAT_INITIAL_MATRIX;
770aa0d41d4SStefano Zampini   if (pc->setupcalled) {
771d1e9a80fSBarry Smith     if (pc->flag == SAME_NONZERO_PATTERN) {
772aa0d41d4SStefano Zampini       reuse = MAT_REUSE_MATRIX;
773aa0d41d4SStefano Zampini     } else {
774aa0d41d4SStefano Zampini       reuse = MAT_INITIAL_MATRIX;
775aa0d41d4SStefano Zampini     }
776aa0d41d4SStefano Zampini   }
777aa0d41d4SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
778aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
779aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
780aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
781aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BB);CHKERRQ(ierr);
782aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
783aa0d41d4SStefano Zampini   }
784aa0d41d4SStefano Zampini 
785aa0d41d4SStefano Zampini   /* transform local matrices if needed */
786b9b85e73SStefano Zampini   if (pcbddc->ChangeOfBasisMatrix) {
787aa0d41d4SStefano Zampini     Mat         change_mat_all;
788aa0d41d4SStefano Zampini     PetscScalar *row_cmat_values;
789aa0d41d4SStefano Zampini     PetscInt    *row_cmat_indices;
790aa0d41d4SStefano Zampini     PetscInt    *nnz,*is_indices,*temp_indices;
791aa0d41d4SStefano Zampini     PetscInt    i,j,k,n_D,n_B;
792aa0d41d4SStefano Zampini 
793aa0d41d4SStefano Zampini     /* Get Non-overlapping dimensions */
794aa0d41d4SStefano Zampini     n_B = pcis->n_B;
795aa0d41d4SStefano Zampini     n_D = pcis->n-n_B;
796aa0d41d4SStefano Zampini 
797aa0d41d4SStefano Zampini     /* compute nonzero structure of change of basis on all local nodes */
798785e854fSJed Brown     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
799aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
800aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) nnz[is_indices[i]] = 1;
801aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
802aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
803aa0d41d4SStefano Zampini     k=1;
804aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
805aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
806aa0d41d4SStefano Zampini       nnz[is_indices[i]]=j;
807aa0d41d4SStefano Zampini       if (k < j) k = j;
808aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
809aa0d41d4SStefano Zampini     }
810aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
811aa0d41d4SStefano Zampini     /* assemble change of basis matrix on the whole set of local dofs */
812785e854fSJed Brown     ierr = PetscMalloc1(k,&temp_indices);CHKERRQ(ierr);
813aa0d41d4SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&change_mat_all);CHKERRQ(ierr);
814aa0d41d4SStefano Zampini     ierr = MatSetSizes(change_mat_all,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
815aa0d41d4SStefano Zampini     ierr = MatSetType(change_mat_all,MATSEQAIJ);CHKERRQ(ierr);
816aa0d41d4SStefano Zampini     ierr = MatSeqAIJSetPreallocation(change_mat_all,0,nnz);CHKERRQ(ierr);
817aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
818aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) {
819aa0d41d4SStefano Zampini       ierr = MatSetValue(change_mat_all,is_indices[i],is_indices[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
820aa0d41d4SStefano Zampini     }
821aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
822aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
823aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
824aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
825aa0d41d4SStefano Zampini       for (k=0; k<j; k++) temp_indices[k]=is_indices[row_cmat_indices[k]];
826aa0d41d4SStefano Zampini       ierr = MatSetValues(change_mat_all,1,&is_indices[i],j,temp_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
827aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
828aa0d41d4SStefano Zampini     }
829aa0d41d4SStefano Zampini     ierr = MatAssemblyBegin(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
830aa0d41d4SStefano Zampini     ierr = MatAssemblyEnd(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
83122d5777bSStefano Zampini     /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
83222d5777bSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQBAIJ,&isseqaij);CHKERRQ(ierr);
83322d5777bSStefano Zampini     if (isseqaij) {
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;
880e9189074SStefano Zampini   PetscInt       *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;
887b23d619eSStefano Zampini   /*
888b23d619eSStefano Zampini     No need to setup local scatters if
889b23d619eSStefano Zampini       - primal space is unchanged
890b23d619eSStefano Zampini         AND
891b23d619eSStefano Zampini       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
892b23d619eSStefano Zampini         AND
893b23d619eSStefano Zampini       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
894b23d619eSStefano Zampini   */
895b23d619eSStefano Zampini   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
896f4ddd8eeSStefano Zampini     PetscFunctionReturn(0);
897f4ddd8eeSStefano Zampini   }
898f4ddd8eeSStefano Zampini   /* destroy old objects */
899f4ddd8eeSStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
900f4ddd8eeSStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
901f4ddd8eeSStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
902a64d13efSStefano Zampini   /* Set Non-overlapping dimensions */
903a64d13efSStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
904e9189074SStefano Zampini   n_vertices = pcbddc->n_actual_vertices;
9054641a718SStefano Zampini   /* create auxiliary bitmask */
9064641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
9074641a718SStefano Zampini   for (i=0;i<n_vertices;i++) {
908e9189074SStefano Zampini     ierr = PetscBTSet(bitmask,pcbddc->primal_indices_local_idxs[i]);CHKERRQ(ierr);
9094641a718SStefano Zampini   }
9103a50541eSStefano Zampini 
911a64d13efSStefano Zampini   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
912785e854fSJed Brown   ierr = PetscMalloc1((pcis->n-n_vertices),&idx_R_local);CHKERRQ(ierr);
913a64d13efSStefano Zampini   for (i=0, n_R=0; i<pcis->n; i++) {
9144641a718SStefano Zampini     if (!PetscBTLookup(bitmask,i)) {
915a64d13efSStefano Zampini       idx_R_local[n_R] = i;
916a64d13efSStefano Zampini       n_R++;
917a64d13efSStefano Zampini     }
918a64d13efSStefano Zampini   }
9193a50541eSStefano Zampini 
9203a50541eSStefano Zampini   /* Block code */
9213a50541eSStefano Zampini   vbs = 1;
9223a50541eSStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
9233a50541eSStefano Zampini   if (bs>1 && !(n_vertices%bs)) {
9243a50541eSStefano Zampini     PetscBool is_blocked = PETSC_TRUE;
9253a50541eSStefano Zampini     PetscInt  *vary;
9263a50541eSStefano Zampini     /* Verify if the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
927785e854fSJed Brown     ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
9283a50541eSStefano Zampini     ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
929e9189074SStefano Zampini     for (i=0; i<n_vertices; i++) vary[pcbddc->primal_indices_local_idxs[i]/bs]++;
9303a50541eSStefano Zampini     for (i=0; i<n_vertices; i++) {
9313a50541eSStefano Zampini       if (vary[i]!=0 && vary[i]!=bs) {
9323a50541eSStefano Zampini         is_blocked = PETSC_FALSE;
9333a50541eSStefano Zampini         break;
9343a50541eSStefano Zampini       }
9353a50541eSStefano Zampini     }
9363a50541eSStefano Zampini     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
9373a50541eSStefano Zampini       vbs = bs;
9383a50541eSStefano Zampini       for (i=0;i<n_R/vbs;i++) {
9393a50541eSStefano Zampini         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
9403a50541eSStefano Zampini       }
9413a50541eSStefano Zampini     }
9423a50541eSStefano Zampini     ierr = PetscFree(vary);CHKERRQ(ierr);
9433a50541eSStefano Zampini   }
9443a50541eSStefano Zampini   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
9453a50541eSStefano Zampini   ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
946a64d13efSStefano Zampini 
947a64d13efSStefano Zampini   /* print some info if requested */
948a64d13efSStefano Zampini   if (pcbddc->dbg_flag) {
949a64d13efSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
950a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
9510fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
952a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
953a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
9543a50541eSStefano 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);
955a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr);
956a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
957a64d13efSStefano Zampini   }
958a64d13efSStefano Zampini 
959a64d13efSStefano Zampini   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
9603a50541eSStefano Zampini   ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
961785e854fSJed Brown   ierr = PetscMalloc1((pcis->n_B-n_vertices),&aux_array1);CHKERRQ(ierr);
962785e854fSJed Brown   ierr = PetscMalloc1((pcis->n_B-n_vertices),&aux_array2);CHKERRQ(ierr);
963a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
9644641a718SStefano Zampini   for (i=0; i<n_D; i++) {
9654641a718SStefano Zampini     ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
9664641a718SStefano Zampini   }
967a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
968a64d13efSStefano Zampini   for (i=0, j=0; i<n_R; i++) {
9694641a718SStefano Zampini     if (!PetscBTLookup(bitmask,idx_R_local[i])) {
9704641a718SStefano Zampini       aux_array1[j++] = i;
971a64d13efSStefano Zampini     }
972a64d13efSStefano Zampini   }
973a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
974a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
975a64d13efSStefano Zampini   for (i=0, j=0; i<n_B; i++) {
9764641a718SStefano Zampini     if (!PetscBTLookup(bitmask,is_indices[i])) {
9774641a718SStefano Zampini       aux_array2[j++] = i;
978a64d13efSStefano Zampini     }
979a64d13efSStefano Zampini   }
980a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
981a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
982a64d13efSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
983a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
984a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
985a64d13efSStefano Zampini 
9868eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
987785e854fSJed Brown     ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
988a64d13efSStefano Zampini     for (i=0, j=0; i<n_R; i++) {
9894641a718SStefano Zampini       if (PetscBTLookup(bitmask,idx_R_local[i])) {
9904641a718SStefano Zampini         aux_array1[j++] = i;
991a64d13efSStefano Zampini       }
992a64d13efSStefano Zampini     }
993a64d13efSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
994a64d13efSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
995a64d13efSStefano Zampini     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
996a64d13efSStefano Zampini   }
9974641a718SStefano Zampini   ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
9983a50541eSStefano Zampini   ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
999a64d13efSStefano Zampini   PetscFunctionReturn(0);
1000a64d13efSStefano Zampini }
1001a64d13efSStefano Zampini 
1002304d26faSStefano Zampini 
1003304d26faSStefano Zampini #undef __FUNCT__
1004304d26faSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
10058ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc)
1006304d26faSStefano Zampini {
1007304d26faSStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1008304d26faSStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
1009304d26faSStefano Zampini   PC             pc_temp;
1010304d26faSStefano Zampini   Mat            A_RR;
1011f4ddd8eeSStefano Zampini   MatReuse       reuse;
1012304d26faSStefano Zampini   PetscScalar    m_one = -1.0;
1013304d26faSStefano Zampini   PetscReal      value;
1014af732b37SStefano Zampini   PetscInt       n_D,n_R,ibs,mbs;
10159577ea80SStefano Zampini   PetscBool      use_exact,use_exact_reduced,issbaij;
1016304d26faSStefano Zampini   PetscErrorCode ierr;
1017e604994aSStefano Zampini   /* prefixes stuff */
1018312be037SStefano Zampini   char           dir_prefix[256],neu_prefix[256],str_level[16];
1019e604994aSStefano Zampini   size_t         len;
1020304d26faSStefano Zampini 
1021304d26faSStefano Zampini   PetscFunctionBegin;
1022304d26faSStefano Zampini 
1023e604994aSStefano Zampini   /* compute prefixes */
1024e604994aSStefano Zampini   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
1025e604994aSStefano Zampini   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
1026e604994aSStefano Zampini   if (!pcbddc->current_level) {
1027e604994aSStefano Zampini     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
1028e604994aSStefano Zampini     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
1029e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
1030e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
1031e604994aSStefano Zampini   } else {
1032e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
1033312be037SStefano Zampini     sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
1034e604994aSStefano Zampini     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
1035e604994aSStefano Zampini     len -= 15; /* remove "pc_bddc_coarse_" */
1036312be037SStefano Zampini     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
1037312be037SStefano Zampini     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
103834d6797cSStefano Zampini     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
103934d6797cSStefano Zampini     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
1040e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
1041e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
1042e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
1043e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
1044e604994aSStefano Zampini   }
1045e604994aSStefano Zampini 
1046304d26faSStefano Zampini   /* DIRICHLET PROBLEM */
1047ac78edfcSStefano Zampini   /* Matrix for Dirichlet problem is pcis->A_II */
10488ce42a96SStefano Zampini   ierr = ISGetSize(pcis->is_I_local,&n_D);CHKERRQ(ierr);
1049304d26faSStefano Zampini   if (!pcbddc->ksp_D) { /* create object if not yet build */
1050304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
1051304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
1052304d26faSStefano Zampini     /* default */
1053304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
1054e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
10559577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
1056304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
10579577ea80SStefano Zampini     if (issbaij) {
10589577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
10599577ea80SStefano Zampini     } else {
1060304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
10619577ea80SStefano Zampini     }
1062304d26faSStefano Zampini     /* Allow user's customization */
1063304d26faSStefano Zampini     ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
1064304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1065304d26faSStefano Zampini   }
1066d1e9a80fSBarry Smith   ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
1067304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1068304d26faSStefano Zampini   if (!n_D) {
1069304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
1070304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1071304d26faSStefano Zampini   }
1072304d26faSStefano Zampini   /* Set Up KSP for Dirichlet problem of BDDC */
1073304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
1074304d26faSStefano Zampini   /* set ksp_D into pcis data */
1075304d26faSStefano Zampini   ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
1076304d26faSStefano Zampini   ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
1077304d26faSStefano Zampini   pcis->ksp_D = pcbddc->ksp_D;
1078304d26faSStefano Zampini 
1079304d26faSStefano Zampini   /* NEUMANN PROBLEM */
1080f4ddd8eeSStefano Zampini   /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
10818ce42a96SStefano Zampini   ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
1082f4ddd8eeSStefano Zampini   if (pcbddc->ksp_R) { /* already created ksp */
1083f4ddd8eeSStefano Zampini     PetscInt nn_R;
108481d9aea3SBarry Smith     ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
1085f4ddd8eeSStefano Zampini     ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
1086f4ddd8eeSStefano Zampini     ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
1087f4ddd8eeSStefano Zampini     if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
1088f4ddd8eeSStefano Zampini       ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
1089f4ddd8eeSStefano Zampini       ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1090f4ddd8eeSStefano Zampini       reuse = MAT_INITIAL_MATRIX;
1091f4ddd8eeSStefano Zampini     } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
1092727cdba6SStefano Zampini       if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
1093f4ddd8eeSStefano Zampini         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1094f4ddd8eeSStefano Zampini         reuse = MAT_INITIAL_MATRIX;
1095f4ddd8eeSStefano Zampini       } else { /* safe to reuse the matrix */
1096f4ddd8eeSStefano Zampini         reuse = MAT_REUSE_MATRIX;
1097f4ddd8eeSStefano Zampini       }
1098f4ddd8eeSStefano Zampini     }
1099f4ddd8eeSStefano Zampini     /* last check */
1100d1e9a80fSBarry Smith     if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
1101f4ddd8eeSStefano Zampini       ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1102f4ddd8eeSStefano Zampini       reuse = MAT_INITIAL_MATRIX;
1103f4ddd8eeSStefano Zampini     }
1104f4ddd8eeSStefano Zampini   } else { /* first time, so we need to create the matrix */
1105f4ddd8eeSStefano Zampini     reuse = MAT_INITIAL_MATRIX;
1106f4ddd8eeSStefano Zampini   }
1107f4ddd8eeSStefano Zampini   /* extract A_RR */
1108af732b37SStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
1109af732b37SStefano Zampini   ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
11103a50541eSStefano Zampini   if (ibs != mbs) {
1111af732b37SStefano Zampini     Mat newmat;
1112af732b37SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
1113f4ddd8eeSStefano Zampini     ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
1114af732b37SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
1115af732b37SStefano Zampini   } else {
1116f4ddd8eeSStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
1117af732b37SStefano Zampini   }
1118f4ddd8eeSStefano Zampini   if (!pcbddc->ksp_R) { /* create object if not present */
1119304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
1120304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
1121304d26faSStefano Zampini     /* default */
1122304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
1123e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
1124304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
11259577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
11269577ea80SStefano Zampini     if (issbaij) {
11279577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
11289577ea80SStefano Zampini     } else {
1129304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
11309577ea80SStefano Zampini     }
1131304d26faSStefano Zampini     /* Allow user's customization */
1132304d26faSStefano Zampini     ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
1133304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1134304d26faSStefano Zampini   }
1135d1e9a80fSBarry Smith   ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
1136304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1137304d26faSStefano Zampini   if (!n_R) {
1138304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
1139304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1140304d26faSStefano Zampini   }
1141304d26faSStefano Zampini   /* Set Up KSP for Neumann problem of BDDC */
1142304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
1143304d26faSStefano Zampini 
1144304d26faSStefano Zampini   /* check Dirichlet and Neumann solvers and adapt them if a nullspace correction is needed */
11450fccc4e9SStefano Zampini   if (pcbddc->NullSpace || pcbddc->dbg_flag) {
1146304d26faSStefano Zampini     /* Dirichlet */
11470fccc4e9SStefano Zampini     ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
11480fccc4e9SStefano Zampini     ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
11490fccc4e9SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
11500fccc4e9SStefano Zampini     ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
11510fccc4e9SStefano Zampini     ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
1152304d26faSStefano Zampini     /* need to be adapted? */
1153b8ffe317SStefano Zampini     use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1154b8ffe317SStefano Zampini     ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1155b8ffe317SStefano Zampini     ierr = PCBDDCSetUseExactDirichlet(pc,use_exact_reduced);CHKERRQ(ierr);
1156304d26faSStefano Zampini     /* print info */
1157304d26faSStefano Zampini     if (pcbddc->dbg_flag) {
1158304d26faSStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
11590fccc4e9SStefano Zampini       ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
1160304d26faSStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
1161304d26faSStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Checking solution of Dirichlet and Neumann problems\n");CHKERRQ(ierr);
1162e604994aSStefano 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);
1163304d26faSStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1164304d26faSStefano Zampini     }
1165b8ffe317SStefano Zampini     if (pcbddc->NullSpace && !use_exact_reduced && !pcbddc->switch_static) {
11668ce42a96SStefano Zampini       ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcis->is_I_local);CHKERRQ(ierr);
1167304d26faSStefano Zampini     }
1168304d26faSStefano Zampini 
1169304d26faSStefano Zampini     /* Neumann */
11700fccc4e9SStefano Zampini     ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
11710fccc4e9SStefano Zampini     ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
11720fccc4e9SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
11730fccc4e9SStefano Zampini     ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
11740fccc4e9SStefano Zampini     ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
1175304d26faSStefano Zampini     /* need to be adapted? */
1176b8ffe317SStefano Zampini     use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1177b8ffe317SStefano Zampini     ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1178304d26faSStefano Zampini     /* print info */
1179304d26faSStefano Zampini     if (pcbddc->dbg_flag) {
1180e604994aSStefano 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);
1181304d26faSStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1182304d26faSStefano Zampini     }
1183b8ffe317SStefano Zampini     if (pcbddc->NullSpace && !use_exact_reduced) { /* is it the right logic? */
11848ce42a96SStefano Zampini       ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcbddc->is_R_local);CHKERRQ(ierr);
1185304d26faSStefano Zampini     }
11860fccc4e9SStefano Zampini   }
1187304d26faSStefano Zampini   /* free Neumann problem's matrix */
1188304d26faSStefano Zampini   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1189304d26faSStefano Zampini   PetscFunctionReturn(0);
1190304d26faSStefano Zampini }
1191304d26faSStefano Zampini 
1192304d26faSStefano Zampini #undef __FUNCT__
1193ba15a52eSStefano Zampini #define __FUNCT__ "PCBDDCSolveSubstructureCorrection"
119420c7b377SStefano Zampini static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec rhs, Vec sol, Vec work, PetscBool applytranspose)
1195674ae819SStefano Zampini {
1196674ae819SStefano Zampini   PetscErrorCode ierr;
1197674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1198674ae819SStefano Zampini 
1199674ae819SStefano Zampini   PetscFunctionBegin;
120020c7b377SStefano Zampini   if (applytranspose) {
1201674ae819SStefano Zampini     if (pcbddc->local_auxmat1) {
120220c7b377SStefano Zampini       ierr = MatMultTranspose(pcbddc->local_auxmat2,rhs,work);CHKERRQ(ierr);
120320c7b377SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,work,rhs,rhs);CHKERRQ(ierr);
120420c7b377SStefano Zampini     }
120520c7b377SStefano Zampini     ierr = KSPSolveTranspose(pcbddc->ksp_R,rhs,sol);CHKERRQ(ierr);
120620c7b377SStefano Zampini   } else {
120720c7b377SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,rhs,sol);CHKERRQ(ierr);
120820c7b377SStefano Zampini     if (pcbddc->local_auxmat1) {
120920c7b377SStefano Zampini       ierr = MatMult(pcbddc->local_auxmat1,sol,work);CHKERRQ(ierr);
121020c7b377SStefano Zampini       ierr = MatMultAdd(pcbddc->local_auxmat2,work,sol,sol);CHKERRQ(ierr);
121120c7b377SStefano Zampini     }
1212674ae819SStefano Zampini   }
1213674ae819SStefano Zampini   PetscFunctionReturn(0);
1214674ae819SStefano Zampini }
1215674ae819SStefano Zampini 
1216dc359a40SStefano Zampini /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
1217674ae819SStefano Zampini #undef __FUNCT__
1218674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
1219dc359a40SStefano Zampini PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
1220674ae819SStefano Zampini {
1221674ae819SStefano Zampini   PetscErrorCode ierr;
1222674ae819SStefano Zampini   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
1223674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)  (pc->data);
1224674ae819SStefano Zampini   const PetscScalar zero = 0.0;
1225674ae819SStefano Zampini 
1226674ae819SStefano Zampini   PetscFunctionBegin;
1227dc359a40SStefano Zampini   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
1228dc359a40SStefano Zampini   if (applytranspose) {
1229674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
12308eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
1231dc359a40SStefano Zampini   } else {
1232674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
1233674ae819SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
123415aaf578SStefano Zampini   }
123512edc857SStefano Zampini   /* start communications from local primal nodes to rhs of coarse solver */
123612edc857SStefano Zampini   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
123712edc857SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
123812edc857SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
123912edc857SStefano Zampini 
124012edc857SStefano Zampini   /* Coarse solution -> rhs and sol updated in PCBDDCScattarCoarseDataBegin/End */
124112edc857SStefano Zampini   /* TODO remove null space when doing multilevel */
124212edc857SStefano Zampini   if (pcbddc->coarse_ksp) {
124312edc857SStefano Zampini     if (applytranspose) {
124412edc857SStefano Zampini       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,NULL,NULL);CHKERRQ(ierr);
124512edc857SStefano Zampini     } else {
124612edc857SStefano Zampini       ierr = KSPSolve(pcbddc->coarse_ksp,NULL,NULL);CHKERRQ(ierr);
124712edc857SStefano Zampini     }
124812edc857SStefano Zampini   }
124912edc857SStefano Zampini   /* start communications from coarse solver solution to local primal nodes */
125012edc857SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1251674ae819SStefano Zampini 
1252674ae819SStefano Zampini   /* Local solution on R nodes */
1253674ae819SStefano Zampini   ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
1254674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1255674ae819SStefano Zampini   ierr = VecScatterEnd(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
12568eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1257674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1258674ae819SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1259674ae819SStefano Zampini   }
126020c7b377SStefano Zampini   ierr = PCBDDCSolveSubstructureCorrection(pc,pcbddc->vec1_R,pcbddc->vec2_R,pcbddc->vec1_C,applytranspose);CHKERRQ(ierr);
1261674ae819SStefano Zampini   ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1262674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1263674ae819SStefano Zampini   ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
12648eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1265674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1266674ae819SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1267674ae819SStefano Zampini   }
1268674ae819SStefano Zampini 
126912edc857SStefano Zampini   /* complete communications from coarse sol to local primal nodes */
127012edc857SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1271674ae819SStefano Zampini 
1272674ae819SStefano Zampini   /* Sum contributions from two levels */
1273dc359a40SStefano Zampini   if (applytranspose) {
1274dc359a40SStefano Zampini     ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
1275dc359a40SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1276dc359a40SStefano Zampini   } else {
1277674ae819SStefano Zampini     ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
12788eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1279dc359a40SStefano Zampini   }
1280674ae819SStefano Zampini   PetscFunctionReturn(0);
1281674ae819SStefano Zampini }
1282674ae819SStefano Zampini 
128312edc857SStefano Zampini /* TODO: the following two function can be optimized using VecPlaceArray whenever possible and using overlap flag */
1284674ae819SStefano Zampini #undef __FUNCT__
1285674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
128612edc857SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
1287674ae819SStefano Zampini {
1288674ae819SStefano Zampini   PetscErrorCode ierr;
1289674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
129012edc857SStefano Zampini   PetscScalar    *array,*array2;
129112edc857SStefano Zampini   Vec            from,to;
1292674ae819SStefano Zampini 
1293674ae819SStefano Zampini   PetscFunctionBegin;
129412edc857SStefano Zampini   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
129512edc857SStefano Zampini     from = pcbddc->coarse_vec;
129612edc857SStefano Zampini     to = pcbddc->vec1_P;
129712edc857SStefano Zampini     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
129812edc857SStefano Zampini       Vec tvec;
129912edc857SStefano Zampini       PetscInt lsize;
130012edc857SStefano Zampini       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
130112edc857SStefano Zampini       ierr = VecGetLocalSize(tvec,&lsize);CHKERRQ(ierr);
130212edc857SStefano Zampini       ierr = VecGetArrayRead(tvec,(const PetscScalar**)&array);CHKERRQ(ierr);
130312edc857SStefano Zampini       ierr = VecGetArray(from,&array2);CHKERRQ(ierr);
130412edc857SStefano Zampini       ierr = PetscMemcpy(array2,array,lsize*sizeof(PetscScalar));CHKERRQ(ierr);
130512edc857SStefano Zampini       ierr = VecRestoreArrayRead(tvec,(const PetscScalar**)&array);CHKERRQ(ierr);
130612edc857SStefano Zampini       ierr = VecRestoreArray(from,&array2);CHKERRQ(ierr);
130712edc857SStefano Zampini     }
130812edc857SStefano Zampini   } else { /* from local to global -> put data in coarse right hand side */
130912edc857SStefano Zampini     from = pcbddc->vec1_P;
131012edc857SStefano Zampini     to = pcbddc->coarse_vec;
131112edc857SStefano Zampini   }
131212edc857SStefano Zampini   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
1313674ae819SStefano Zampini   PetscFunctionReturn(0);
1314674ae819SStefano Zampini }
1315674ae819SStefano Zampini 
1316674ae819SStefano Zampini #undef __FUNCT__
1317674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
131812edc857SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
1319674ae819SStefano Zampini {
1320674ae819SStefano Zampini   PetscErrorCode ierr;
1321674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
132212edc857SStefano Zampini   PetscScalar    *array,*array2;
132312edc857SStefano Zampini   Vec            from,to;
1324674ae819SStefano Zampini 
1325674ae819SStefano Zampini   PetscFunctionBegin;
132612edc857SStefano Zampini   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
132712edc857SStefano Zampini     from = pcbddc->coarse_vec;
132812edc857SStefano Zampini     to = pcbddc->vec1_P;
132912edc857SStefano Zampini   } else { /* from local to global -> put data in coarse right hand side */
133012edc857SStefano Zampini     from = pcbddc->vec1_P;
133112edc857SStefano Zampini     to = pcbddc->coarse_vec;
133212edc857SStefano Zampini   }
133312edc857SStefano Zampini   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
133412edc857SStefano Zampini   if (smode == SCATTER_FORWARD) {
133512edc857SStefano Zampini     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
133612edc857SStefano Zampini       Vec tvec;
133712edc857SStefano Zampini       PetscInt lsize;
133812edc857SStefano Zampini       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
133912edc857SStefano Zampini       ierr = VecGetLocalSize(tvec,&lsize);CHKERRQ(ierr);
134012edc857SStefano Zampini       ierr = VecGetArrayRead(to,(const PetscScalar**)&array);CHKERRQ(ierr);
134112edc857SStefano Zampini       ierr = VecGetArray(tvec,&array2);CHKERRQ(ierr);
134212edc857SStefano Zampini       ierr = PetscMemcpy(array2,array,lsize*sizeof(PetscScalar));CHKERRQ(ierr);
134312edc857SStefano Zampini       ierr = VecRestoreArrayRead(to,(const PetscScalar**)&array);CHKERRQ(ierr);
134412edc857SStefano Zampini       ierr = VecRestoreArray(tvec,&array2);CHKERRQ(ierr);
134512edc857SStefano Zampini     }
134612edc857SStefano Zampini   }
1347674ae819SStefano Zampini   PetscFunctionReturn(0);
1348674ae819SStefano Zampini }
1349674ae819SStefano Zampini 
1350984c4197SStefano Zampini /* uncomment for testing purposes */
1351984c4197SStefano Zampini /* #define PETSC_MISSING_LAPACK_GESVD 1 */
1352674ae819SStefano Zampini #undef __FUNCT__
1353674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp"
1354674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
1355674ae819SStefano Zampini {
1356674ae819SStefano Zampini   PetscErrorCode    ierr;
1357674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
1358674ae819SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
1359674ae819SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
1360984c4197SStefano Zampini   /* constraint and (optionally) change of basis matrix implemented as SeqAIJ */
1361674ae819SStefano Zampini   MatType           impMatType=MATSEQAIJ;
1362984c4197SStefano Zampini   /* one and zero */
1363984c4197SStefano Zampini   PetscScalar       one=1.0,zero=0.0;
1364984c4197SStefano Zampini   /* space to store constraints and their local indices */
1365984c4197SStefano Zampini   PetscScalar       *temp_quadrature_constraint;
1366984c4197SStefano Zampini   PetscInt          *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B;
1367984c4197SStefano Zampini   /* iterators */
1368984c4197SStefano Zampini   PetscInt          i,j,k,total_counts,temp_start_ptr;
1369984c4197SStefano Zampini   /* stuff to store connected components stored in pcbddc->mat_graph */
1370984c4197SStefano Zampini   IS                ISForVertices,*ISForFaces,*ISForEdges,*used_IS;
1371984c4197SStefano Zampini   PetscInt          n_ISForFaces,n_ISForEdges;
1372984c4197SStefano Zampini   /* near null space stuff */
1373674ae819SStefano Zampini   MatNullSpace      nearnullsp;
1374674ae819SStefano Zampini   const Vec         *nearnullvecs;
1375674ae819SStefano Zampini   Vec               *localnearnullsp;
1376984c4197SStefano Zampini   PetscBool         nnsp_has_cnst;
1377984c4197SStefano Zampini   PetscInt          nnsp_size;
1378984c4197SStefano Zampini   PetscScalar       *array;
1379984c4197SStefano Zampini   /* BLAS integers */
1380e310c8b4SStefano Zampini   PetscBLASInt      lwork,lierr;
1381e310c8b4SStefano Zampini   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
1382c4303822SStefano Zampini   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
1383984c4197SStefano Zampini   /* LAPACK working arrays for SVD or POD */
1384242a89d7SStefano Zampini   PetscBool         skip_lapack;
1385984c4197SStefano Zampini   PetscScalar       *work;
1386984c4197SStefano Zampini   PetscReal         *singular_vals;
1387984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1388984c4197SStefano Zampini   PetscReal         *rwork;
1389674ae819SStefano Zampini #endif
1390984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1391e310c8b4SStefano Zampini   PetscBLASInt      Blas_one_2=1;
1392984c4197SStefano Zampini   PetscScalar       *temp_basis,*correlation_mat;
1393b7d8b9f8SStefano Zampini #else
1394b7d8b9f8SStefano Zampini   PetscBLASInt      dummy_int_1=1,dummy_int_2=1;
1395b7d8b9f8SStefano Zampini   PetscScalar       dummy_scalar_1=0.0,dummy_scalar_2=0.0;
1396984c4197SStefano Zampini #endif
1397727cdba6SStefano Zampini   /* reuse */
1398727cdba6SStefano Zampini   PetscInt          olocal_primal_size;
1399727cdba6SStefano Zampini   PetscInt          *oprimal_indices_local_idxs;
1400984c4197SStefano Zampini   /* change of basis */
1401984c4197SStefano Zampini   PetscInt          *aux_primal_numbering,*aux_primal_minloc,*global_indices;
1402a717540cSStefano Zampini   PetscBool         boolforchange,qr_needed;
1403a717540cSStefano Zampini   PetscBT           touched,change_basis,qr_needed_idx;
1404984c4197SStefano Zampini   /* auxiliary stuff */
140539e2fb2aSStefano Zampini   PetscInt          *nnz,*is_indices,*aux_primal_numbering_B;
1406984c4197SStefano Zampini   /* some quantities */
140745a1bb75SStefano Zampini   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
1408984c4197SStefano Zampini   PetscInt          size_of_constraint,max_size_of_constraint,max_constraints,temp_constraints;
1409984c4197SStefano Zampini 
1410674ae819SStefano Zampini 
1411674ae819SStefano Zampini   PetscFunctionBegin;
14128e61c736SStefano Zampini   /* Destroy Mat objects computed previously */
14138e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
14148e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1415674ae819SStefano Zampini   /* Get index sets for faces, edges and vertices from graph */
1416*d06fc5fdSStefano Zampini   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
1417*d06fc5fdSStefano Zampini   /* free unneeded index sets */
1418*d06fc5fdSStefano Zampini   if (!pcbddc->use_vertices) {
1419*d06fc5fdSStefano Zampini     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
1420674ae819SStefano Zampini   }
1421*d06fc5fdSStefano Zampini   if (!pcbddc->use_edges) {
1422*d06fc5fdSStefano Zampini     for (i=0;i<n_ISForEdges;i++) {
1423*d06fc5fdSStefano Zampini       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
1424*d06fc5fdSStefano Zampini     }
1425*d06fc5fdSStefano Zampini     ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
1426*d06fc5fdSStefano Zampini     n_ISForEdges = 0;
1427*d06fc5fdSStefano Zampini   }
1428*d06fc5fdSStefano Zampini   if (!pcbddc->use_faces) {
1429*d06fc5fdSStefano Zampini     for (i=0;i<n_ISForFaces;i++) {
1430*d06fc5fdSStefano Zampini       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
1431*d06fc5fdSStefano Zampini     }
1432*d06fc5fdSStefano Zampini     ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
1433*d06fc5fdSStefano Zampini     n_ISForFaces = 0;
1434*d06fc5fdSStefano Zampini   }
1435*d06fc5fdSStefano Zampini   /* HACKS (the following two blocks of code) */
1436b9b85e73SStefano Zampini   if (!ISForVertices && pcbddc->NullSpace && !pcbddc->user_ChangeOfBasisMatrix) {
1437b8ffe317SStefano Zampini     pcbddc->use_change_of_basis = PETSC_TRUE;
1438*d06fc5fdSStefano Zampini     if (!ISForEdges) {
1439*d06fc5fdSStefano Zampini       pcbddc->use_change_on_faces = PETSC_TRUE;
1440*d06fc5fdSStefano Zampini     }
1441b8ffe317SStefano Zampini   }
144298a51de6SStefano Zampini   if (pcbddc->NullSpace) {
144398a51de6SStefano Zampini     /* use_change_of_basis should be consistent among processors */
1444*d06fc5fdSStefano Zampini     PetscBool tbool[2],gbool[2];
1445*d06fc5fdSStefano Zampini     tbool [0] = pcbddc->use_change_of_basis;
1446*d06fc5fdSStefano Zampini     tbool [1] = pcbddc->use_change_on_faces;
1447*d06fc5fdSStefano Zampini     ierr = MPI_Allreduce(tbool,gbool,2,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1448*d06fc5fdSStefano Zampini     pcbddc->use_change_of_basis = gbool[0];
1449*d06fc5fdSStefano Zampini     pcbddc->use_change_on_faces = gbool[1];
145098a51de6SStefano Zampini   }
1451984c4197SStefano Zampini   /* print some info */
1452674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
14530fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
1454674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1455674ae819SStefano Zampini     i = 0;
1456674ae819SStefano Zampini     if (ISForVertices) {
1457674ae819SStefano Zampini       ierr = ISGetSize(ISForVertices,&i);CHKERRQ(ierr);
1458674ae819SStefano Zampini     }
1459674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices\n",PetscGlobalRank,i);CHKERRQ(ierr);
1460674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges\n",PetscGlobalRank,n_ISForEdges);CHKERRQ(ierr);
146115aaf578SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces\n",PetscGlobalRank,n_ISForFaces);CHKERRQ(ierr);
1462674ae819SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1463674ae819SStefano Zampini   }
1464674ae819SStefano Zampini   /* check if near null space is attached to global mat */
1465674ae819SStefano Zampini   ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
1466674ae819SStefano Zampini   if (nearnullsp) {
1467674ae819SStefano Zampini     ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
1468f4ddd8eeSStefano Zampini     /* remove any stored info */
1469f4ddd8eeSStefano Zampini     ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
1470f4ddd8eeSStefano Zampini     ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1471f4ddd8eeSStefano Zampini     /* store information for BDDC solver reuse */
1472f4ddd8eeSStefano Zampini     ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
1473f4ddd8eeSStefano Zampini     pcbddc->onearnullspace = nearnullsp;
1474473ba861SJed Brown     ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1475f4ddd8eeSStefano Zampini     for (i=0;i<nnsp_size;i++) {
1476f4ddd8eeSStefano Zampini       ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
1477f4ddd8eeSStefano Zampini     }
1478984c4197SStefano Zampini   } else { /* if near null space is not provided BDDC uses constants by default */
1479984c4197SStefano Zampini     nnsp_size = 0;
1480674ae819SStefano Zampini     nnsp_has_cnst = PETSC_TRUE;
1481674ae819SStefano Zampini   }
1482984c4197SStefano Zampini   /* get max number of constraints on a single cc */
1483984c4197SStefano Zampini   max_constraints = nnsp_size;
1484984c4197SStefano Zampini   if (nnsp_has_cnst) max_constraints++;
1485984c4197SStefano Zampini 
1486674ae819SStefano Zampini   /*
1487674ae819SStefano Zampini        Evaluate maximum storage size needed by the procedure
1488674ae819SStefano Zampini        - temp_indices will contain start index of each constraint stored as follows
1489674ae819SStefano 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
1490674ae819SStefano 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
1491674ae819SStefano Zampini        - temp_quadrature_constraint  [temp_indices[i],...,temp[indices[i+1]-1] will contain the scalars representing the constraint itself
1492674ae819SStefano Zampini                                                                                                                                                          */
1493674ae819SStefano Zampini   total_counts = n_ISForFaces+n_ISForEdges;
1494984c4197SStefano Zampini   total_counts *= max_constraints;
1495674ae819SStefano Zampini   n_vertices = 0;
1496674ae819SStefano Zampini   if (ISForVertices) {
1497674ae819SStefano Zampini     ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
1498674ae819SStefano Zampini   }
1499674ae819SStefano Zampini   total_counts += n_vertices;
1500785e854fSJed Brown   ierr = PetscMalloc1((total_counts+1),&temp_indices);CHKERRQ(ierr);
15014641a718SStefano Zampini   ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
1502674ae819SStefano Zampini   total_counts = 0;
1503674ae819SStefano Zampini   max_size_of_constraint = 0;
1504674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1505674ae819SStefano Zampini     if (i<n_ISForEdges) {
1506674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1507674ae819SStefano Zampini     } else {
1508674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1509674ae819SStefano Zampini     }
1510674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
1511674ae819SStefano Zampini     total_counts += j;
1512674ae819SStefano Zampini     max_size_of_constraint = PetscMax(j,max_size_of_constraint);
1513674ae819SStefano Zampini   }
1514984c4197SStefano Zampini   total_counts *= max_constraints;
1515674ae819SStefano Zampini   total_counts += n_vertices;
1516785e854fSJed Brown   ierr = PetscMalloc1(total_counts,&temp_quadrature_constraint);CHKERRQ(ierr);
1517785e854fSJed Brown   ierr = PetscMalloc1(total_counts,&temp_indices_to_constraint);CHKERRQ(ierr);
1518785e854fSJed Brown   ierr = PetscMalloc1(total_counts,&temp_indices_to_constraint_B);CHKERRQ(ierr);
1519984c4197SStefano Zampini   /* get local part of global near null space vectors */
1520785e854fSJed Brown   ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
1521984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1522984c4197SStefano Zampini     ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
1523984c4197SStefano Zampini     ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1524984c4197SStefano Zampini     ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1525984c4197SStefano Zampini   }
1526674ae819SStefano Zampini 
1527242a89d7SStefano Zampini   /* whether or not to skip lapack calls */
1528242a89d7SStefano Zampini   skip_lapack = PETSC_TRUE;
1529242a89d7SStefano Zampini   if (n_ISForFaces+n_ISForEdges) skip_lapack = PETSC_FALSE;
1530242a89d7SStefano Zampini 
1531984c4197SStefano Zampini   /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
1532242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1533674ae819SStefano Zampini     PetscScalar temp_work;
1534674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1535984c4197SStefano Zampini     /* Proper Orthogonal Decomposition (POD) using the snapshot method */
1536785e854fSJed Brown     ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
1537785e854fSJed Brown     ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
1538785e854fSJed Brown     ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
1539674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1540785e854fSJed Brown     ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
1541674ae819SStefano Zampini #endif
1542674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1543c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
1544c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
1545674ae819SStefano Zampini     lwork = -1;
1546674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1547674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1548c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
1549674ae819SStefano Zampini #else
1550c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
1551674ae819SStefano Zampini #endif
1552674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1553984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
1554674ae819SStefano Zampini #else /* on missing GESVD */
1555674ae819SStefano Zampini     /* SVD */
1556674ae819SStefano Zampini     PetscInt max_n,min_n;
1557674ae819SStefano Zampini     max_n = max_size_of_constraint;
1558984c4197SStefano Zampini     min_n = max_constraints;
1559984c4197SStefano Zampini     if (max_size_of_constraint < max_constraints) {
1560674ae819SStefano Zampini       min_n = max_size_of_constraint;
1561984c4197SStefano Zampini       max_n = max_constraints;
1562674ae819SStefano Zampini     }
1563785e854fSJed Brown     ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
1564674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1565785e854fSJed Brown     ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
1566674ae819SStefano Zampini #endif
1567674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1568674ae819SStefano Zampini     lwork = -1;
1569e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
1570e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
1571b7d8b9f8SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
1572674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1573674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1574e310c8b4SStefano 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));
1575674ae819SStefano Zampini #else
1576e310c8b4SStefano 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));
1577674ae819SStefano Zampini #endif
1578674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1579984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
1580984c4197SStefano Zampini #endif /* on missing GESVD */
1581674ae819SStefano Zampini     /* Allocate optimal workspace */
1582674ae819SStefano Zampini     ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
1583785e854fSJed Brown     ierr = PetscMalloc1((PetscInt)lwork,&work);CHKERRQ(ierr);
1584674ae819SStefano Zampini   }
1585674ae819SStefano Zampini   /* Now we can loop on constraining sets */
1586674ae819SStefano Zampini   total_counts = 0;
1587674ae819SStefano Zampini   temp_indices[0] = 0;
1588674ae819SStefano Zampini   /* vertices */
1589674ae819SStefano Zampini   if (ISForVertices) {
1590674ae819SStefano Zampini     ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1591674ae819SStefano Zampini     if (nnsp_has_cnst) { /* consider all vertices */
159239e2fb2aSStefano Zampini       ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
1593674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1594674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1595674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1596674ae819SStefano Zampini         total_counts++;
1597674ae819SStefano Zampini       }
1598674ae819SStefano Zampini     } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
1599984c4197SStefano Zampini       PetscBool used_vertex;
1600674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1601674ae819SStefano Zampini         used_vertex = PETSC_FALSE;
1602674ae819SStefano Zampini         k = 0;
1603674ae819SStefano Zampini         while (!used_vertex && k<nnsp_size) {
1604984c4197SStefano Zampini           ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1605984c4197SStefano Zampini           if (PetscAbsScalar(array[is_indices[i]])>0.0) {
1606674ae819SStefano Zampini             temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1607674ae819SStefano Zampini             temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1608674ae819SStefano Zampini             temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1609674ae819SStefano Zampini             total_counts++;
1610674ae819SStefano Zampini             used_vertex = PETSC_TRUE;
1611674ae819SStefano Zampini           }
1612984c4197SStefano Zampini           ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1613674ae819SStefano Zampini           k++;
1614674ae819SStefano Zampini         }
1615674ae819SStefano Zampini       }
1616674ae819SStefano Zampini     }
1617674ae819SStefano Zampini     ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1618674ae819SStefano Zampini     n_vertices = total_counts;
1619674ae819SStefano Zampini   }
1620984c4197SStefano Zampini 
1621674ae819SStefano Zampini   /* edges and faces */
1622674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1623674ae819SStefano Zampini     if (i<n_ISForEdges) {
1624674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1625984c4197SStefano Zampini       boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
1626674ae819SStefano Zampini     } else {
1627674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1628984c4197SStefano Zampini       boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
1629674ae819SStefano Zampini     }
1630674ae819SStefano Zampini     temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
1631674ae819SStefano Zampini     temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
1632674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
1633674ae819SStefano Zampini     ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1634984c4197SStefano Zampini     /* change of basis should not be performed on local periodic nodes */
1635984c4197SStefano Zampini     if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
1636674ae819SStefano Zampini     if (nnsp_has_cnst) {
16375b08dc53SStefano Zampini       PetscScalar quad_value;
1638674ae819SStefano Zampini       temp_constraints++;
1639674ae819SStefano Zampini       quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
164039e2fb2aSStefano Zampini       ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
1641674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1642674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
1643674ae819SStefano Zampini       }
1644674ae819SStefano Zampini       temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
1645674ae819SStefano Zampini       total_counts++;
1646674ae819SStefano Zampini     }
1647674ae819SStefano Zampini     for (k=0;k<nnsp_size;k++) {
1648984c4197SStefano Zampini       PetscReal real_value;
1649984c4197SStefano Zampini       ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
165039e2fb2aSStefano Zampini       ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
1651674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1652984c4197SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=array[is_indices[j]];
1653674ae819SStefano Zampini       }
1654984c4197SStefano Zampini       ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1655984c4197SStefano Zampini       /* check if array is null on the connected component */
1656e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1657e310c8b4SStefano Zampini       PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_one));
16585b08dc53SStefano Zampini       if (real_value > 0.0) { /* keep indices and values */
1659674ae819SStefano Zampini         temp_constraints++;
1660674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
1661674ae819SStefano Zampini         total_counts++;
1662674ae819SStefano Zampini       }
1663674ae819SStefano Zampini     }
1664674ae819SStefano Zampini     ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
166545a1bb75SStefano Zampini     valid_constraints = temp_constraints;
1666eb97c9d2SStefano 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 */
1667eb97c9d2SStefano Zampini     if (!pcbddc->use_nnsp_true && temp_constraints) {
1668984c4197SStefano Zampini       PetscReal tol = 1.0e-8; /* tolerance for retaining eigenmodes */
1669674ae819SStefano Zampini 
1670674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1671984c4197SStefano Zampini       /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
1672984c4197SStefano Zampini          POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
1673984c4197SStefano Zampini          -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
1674984c4197SStefano Zampini             the constraints basis will differ (by a complex factor with absolute value equal to 1)
1675984c4197SStefano Zampini             from that computed using LAPACKgesvd
1676984c4197SStefano Zampini          -> This is due to a different computation of eigenvectors in LAPACKheev
1677984c4197SStefano Zampini          -> The quality of the POD-computed basis will be the same */
1678984c4197SStefano Zampini       ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
1679674ae819SStefano Zampini       /* Store upper triangular part of correlation matrix */
1680e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1681984c4197SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1682674ae819SStefano Zampini       for (j=0;j<temp_constraints;j++) {
1683674ae819SStefano Zampini         for (k=0;k<j+1;k++) {
1684e310c8b4SStefano 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));
1685674ae819SStefano Zampini         }
1686674ae819SStefano Zampini       }
1687e310c8b4SStefano Zampini       /* compute eigenvalues and eigenvectors of correlation matrix */
1688e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1689e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
1690674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1691c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
1692674ae819SStefano Zampini #else
1693c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
1694674ae819SStefano Zampini #endif
1695674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1696984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
1697984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
1698674ae819SStefano Zampini       j=0;
1699984c4197SStefano Zampini       while (j < temp_constraints && singular_vals[j] < tol) j++;
1700674ae819SStefano Zampini       total_counts=total_counts-j;
170145a1bb75SStefano Zampini       valid_constraints = temp_constraints-j;
1702e310c8b4SStefano Zampini       /* scale and copy POD basis into used quadrature memory */
1703c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1704c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1705c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
1706c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1707c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
1708c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1709674ae819SStefano Zampini       if (j<temp_constraints) {
1710984c4197SStefano Zampini         PetscInt ii;
1711984c4197SStefano Zampini         for (k=j;k<temp_constraints;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]);
1712674ae819SStefano Zampini         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1713c4303822SStefano 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));
1714674ae819SStefano Zampini         ierr = PetscFPTrapPop();CHKERRQ(ierr);
1715984c4197SStefano Zampini         for (k=0;k<temp_constraints-j;k++) {
1716674ae819SStefano Zampini           for (ii=0;ii<size_of_constraint;ii++) {
1717984c4197SStefano 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];
1718674ae819SStefano Zampini           }
1719674ae819SStefano Zampini         }
1720674ae819SStefano Zampini       }
1721674ae819SStefano Zampini #else  /* on missing GESVD */
1722e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1723e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1724b7d8b9f8SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1725674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1726674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1727e310c8b4SStefano 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));
1728674ae819SStefano Zampini #else
1729e310c8b4SStefano 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));
1730674ae819SStefano Zampini #endif
1731984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
1732674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1733984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
1734e310c8b4SStefano Zampini       k = temp_constraints;
1735e310c8b4SStefano Zampini       if (k > size_of_constraint) k = size_of_constraint;
1736674ae819SStefano Zampini       j = 0;
1737e310c8b4SStefano Zampini       while (j < k && singular_vals[k-j-1] < tol) j++;
1738e310c8b4SStefano Zampini       total_counts = total_counts-temp_constraints+k-j;
173945a1bb75SStefano Zampini       valid_constraints = k-j;
1740984c4197SStefano Zampini #endif /* on missing GESVD */
1741674ae819SStefano Zampini     }
174245a1bb75SStefano Zampini     /* setting change_of_basis flag is safe now */
174345a1bb75SStefano Zampini     if (boolforchange) {
174445a1bb75SStefano Zampini       for (j=0;j<valid_constraints;j++) {
174545a1bb75SStefano Zampini         PetscBTSet(change_basis,total_counts-j-1);
174645a1bb75SStefano Zampini       }
174745a1bb75SStefano Zampini     }
1748674ae819SStefano Zampini   }
1749674ae819SStefano Zampini   /* free index sets of faces, edges and vertices */
1750674ae819SStefano Zampini   for (i=0;i<n_ISForFaces;i++) {
1751674ae819SStefano Zampini     ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
1752674ae819SStefano Zampini   }
1753*d06fc5fdSStefano Zampini   if (n_ISForFaces) {
1754674ae819SStefano Zampini     ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
1755*d06fc5fdSStefano Zampini   }
1756674ae819SStefano Zampini   for (i=0;i<n_ISForEdges;i++) {
1757674ae819SStefano Zampini     ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
1758674ae819SStefano Zampini   }
1759*d06fc5fdSStefano Zampini   if (n_ISForEdges) {
1760674ae819SStefano Zampini     ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
1761*d06fc5fdSStefano Zampini   }
1762674ae819SStefano Zampini   ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
176339e2fb2aSStefano Zampini   /* map temp_indices_to_constraint in boundary numbering */
176439e2fb2aSStefano Zampini   ierr = ISGlobalToLocalMappingApply(pcbddc->BtoNmap,IS_GTOLM_DROP,temp_indices[total_counts],temp_indices_to_constraint,&i,temp_indices_to_constraint_B);CHKERRQ(ierr);
176539e2fb2aSStefano Zampini   if (i != temp_indices[total_counts]) {
176639e2fb2aSStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for constraints indices %d != %d\n",temp_indices[total_counts],i);
176739e2fb2aSStefano Zampini   }
1768674ae819SStefano Zampini 
1769984c4197SStefano Zampini   /* free workspace */
1770242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1771984c4197SStefano Zampini     ierr = PetscFree(work);CHKERRQ(ierr);
1772984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1773984c4197SStefano Zampini     ierr = PetscFree(rwork);CHKERRQ(ierr);
1774984c4197SStefano Zampini #endif
1775984c4197SStefano Zampini     ierr = PetscFree(singular_vals);CHKERRQ(ierr);
1776984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1777984c4197SStefano Zampini     ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
1778984c4197SStefano Zampini     ierr = PetscFree(temp_basis);CHKERRQ(ierr);
1779984c4197SStefano Zampini #endif
1780984c4197SStefano Zampini   }
1781984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1782984c4197SStefano Zampini     ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
1783984c4197SStefano Zampini   }
1784984c4197SStefano Zampini   ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
1785984c4197SStefano Zampini 
1786727cdba6SStefano Zampini   /* set quantities in pcbddc data structure and store previous primal size */
1787984c4197SStefano Zampini   /* n_vertices defines the number of subdomain corners in the primal space */
1788674ae819SStefano Zampini   /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */
1789727cdba6SStefano Zampini   olocal_primal_size = pcbddc->local_primal_size;
1790984c4197SStefano Zampini   pcbddc->local_primal_size = total_counts;
1791674ae819SStefano Zampini   pcbddc->n_vertices = n_vertices;
1792984c4197SStefano Zampini   pcbddc->n_constraints = pcbddc->local_primal_size-pcbddc->n_vertices;
1793674ae819SStefano Zampini 
1794674ae819SStefano Zampini   /* Create constraint matrix */
1795674ae819SStefano Zampini   /* The constraint matrix is used to compute the l2g map of primal dofs */
1796674ae819SStefano Zampini   /* so we need to set it up properly either with or without change of basis */
1797674ae819SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1798674ae819SStefano Zampini   ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr);
1799984c4197SStefano Zampini   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
1800984c4197SStefano Zampini   /* array to compute a local numbering of constraints : vertices first then constraints */
1801785e854fSJed Brown   ierr = PetscMalloc1(pcbddc->local_primal_size,&aux_primal_numbering);CHKERRQ(ierr);
1802984c4197SStefano Zampini   /* array to select the proper local node (of minimum index with respect to global ordering) when changing the basis */
1803984c4197SStefano 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 */
1804785e854fSJed Brown   ierr = PetscMalloc1(pcbddc->local_primal_size,&aux_primal_minloc);CHKERRQ(ierr);
1805984c4197SStefano Zampini   /* auxiliary stuff for basis change */
1806785e854fSJed Brown   ierr = PetscMalloc1(max_size_of_constraint,&global_indices);CHKERRQ(ierr);
18074641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n_B,&touched);CHKERRQ(ierr);
1808984c4197SStefano Zampini 
1809984c4197SStefano Zampini   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
1810984c4197SStefano Zampini   total_primal_vertices=0;
1811984c4197SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
1812674ae819SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
1813984c4197SStefano Zampini     if (size_of_constraint == 1) {
18144641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]]);CHKERRQ(ierr);
1815984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]];
1816984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=0;
1817984c4197SStefano Zampini       total_primal_vertices++;
18184641a718SStefano Zampini     } else if (PetscBTLookup(change_basis,i)) { /* Same procedure used in PCBDDCGetPrimalConstraintsLocalIdx */
1819984c4197SStefano Zampini       PetscInt min_loc,min_index;
1820984c4197SStefano Zampini       ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],global_indices);CHKERRQ(ierr);
1821984c4197SStefano Zampini       /* find first untouched local node */
1822674ae819SStefano Zampini       k = 0;
18234641a718SStefano Zampini       while (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) k++;
1824984c4197SStefano Zampini       min_index = global_indices[k];
1825984c4197SStefano Zampini       min_loc = k;
1826984c4197SStefano Zampini       /* search the minimum among global nodes already untouched on the cc */
1827984c4197SStefano Zampini       for (k=1;k<size_of_constraint;k++) {
1828984c4197SStefano Zampini         /* there can be more than one constraint on a single connected component */
18294641a718SStefano Zampini         if (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k]) && min_index > global_indices[k]) {
1830984c4197SStefano Zampini           min_index = global_indices[k];
1831984c4197SStefano Zampini           min_loc = k;
1832674ae819SStefano Zampini         }
1833674ae819SStefano Zampini       }
18344641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]+min_loc]);CHKERRQ(ierr);
1835984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]+min_loc];
1836984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=min_loc;
1837984c4197SStefano Zampini       total_primal_vertices++;
1838984c4197SStefano Zampini     }
1839984c4197SStefano Zampini   }
1840a717540cSStefano Zampini   /* determine if a QR strategy is needed for change of basis */
1841a717540cSStefano Zampini   qr_needed = PETSC_FALSE;
1842a717540cSStefano Zampini   ierr = PetscBTCreate(pcbddc->local_primal_size,&qr_needed_idx);CHKERRQ(ierr);
1843a717540cSStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1844a717540cSStefano Zampini     if (PetscBTLookup(change_basis,i)) {
1845a717540cSStefano Zampini       size_of_constraint = temp_indices[i+1]-temp_indices[i];
1846a717540cSStefano Zampini       j = 0;
1847a717540cSStefano Zampini       for (k=0;k<size_of_constraint;k++) {
1848a717540cSStefano Zampini         if (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) {
1849a717540cSStefano Zampini           j++;
1850a717540cSStefano Zampini         }
1851a717540cSStefano Zampini       }
1852a717540cSStefano Zampini       /* found more than one primal dof on the cc */
1853a717540cSStefano Zampini       if (j > 1) {
1854a717540cSStefano Zampini         PetscBTSet(qr_needed_idx,i);
1855a717540cSStefano Zampini         qr_needed = PETSC_TRUE;
1856a717540cSStefano Zampini       }
1857a717540cSStefano Zampini     }
1858a717540cSStefano Zampini   }
1859984c4197SStefano Zampini   /* free workspace */
1860984c4197SStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
186145a1bb75SStefano Zampini 
1862674ae819SStefano Zampini   /* permute indices in order to have a sorted set of vertices */
1863a717540cSStefano Zampini   ierr = PetscSortInt(total_primal_vertices,aux_primal_numbering);CHKERRQ(ierr);
1864984c4197SStefano Zampini 
1865984c4197SStefano Zampini   /* nonzero structure of constraint matrix */
1866785e854fSJed Brown   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
1867984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) nnz[i]=1;
1868984c4197SStefano Zampini   j=total_primal_vertices;
1869984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
18704641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1871674ae819SStefano Zampini       nnz[j]=temp_indices[i+1]-temp_indices[i];
1872674ae819SStefano Zampini       j++;
1873674ae819SStefano Zampini     }
1874674ae819SStefano Zampini   }
1875674ae819SStefano Zampini   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
1876674ae819SStefano Zampini   ierr = PetscFree(nnz);CHKERRQ(ierr);
1877674ae819SStefano Zampini   /* set values in constraint matrix */
1878984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) {
1879984c4197SStefano Zampini     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,aux_primal_numbering[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
1880674ae819SStefano Zampini   }
1881984c4197SStefano Zampini   total_counts = total_primal_vertices;
1882984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
18834641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1884674ae819SStefano Zampini       size_of_constraint=temp_indices[i+1]-temp_indices[i];
1885674ae819SStefano 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);
1886674ae819SStefano Zampini       total_counts++;
1887674ae819SStefano Zampini     }
1888674ae819SStefano Zampini   }
1889674ae819SStefano Zampini   /* assembling */
1890674ae819SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1891674ae819SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1892984c4197SStefano Zampini   /*
189345a1bb75SStefano Zampini   ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
1894984c4197SStefano Zampini   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
1895984c4197SStefano Zampini   */
1896674ae819SStefano Zampini   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
1897674ae819SStefano Zampini   if (pcbddc->use_change_of_basis) {
1898026de310SStefano Zampini     /* dual and primal dofs on a single cc */
1899984c4197SStefano Zampini     PetscInt     dual_dofs,primal_dofs;
1900026de310SStefano Zampini     /* iterator on aux_primal_minloc (ordered as read from nearnullspace: vertices, edges and then constraints) */
1901026de310SStefano Zampini     PetscInt     primal_counter;
1902984c4197SStefano Zampini     /* working stuff for GEQRF */
190381d9aea3SBarry Smith     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
1904984c4197SStefano Zampini     PetscBLASInt lqr_work;
1905984c4197SStefano Zampini     /* working stuff for UNGQR */
1906984c4197SStefano Zampini     PetscScalar  *gqr_work,lgqr_work_t;
1907984c4197SStefano Zampini     PetscBLASInt lgqr_work;
1908984c4197SStefano Zampini     /* working stuff for TRTRS */
1909984c4197SStefano Zampini     PetscScalar  *trs_rhs;
19103f08241aSStefano Zampini     PetscBLASInt Blas_NRHS;
1911984c4197SStefano Zampini     /* pointers for values insertion into change of basis matrix */
1912984c4197SStefano Zampini     PetscInt     *start_rows,*start_cols;
1913984c4197SStefano Zampini     PetscScalar  *start_vals;
1914984c4197SStefano Zampini     /* working stuff for values insertion */
19154641a718SStefano Zampini     PetscBT      is_primal;
1916984c4197SStefano Zampini 
1917a717540cSStefano Zampini     /* change of basis acts on local interfaces -> dimension is n_B x n_B */
1918a717540cSStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
1919a717540cSStefano Zampini     ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr);
1920a717540cSStefano Zampini     ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr);
1921a717540cSStefano Zampini     /* work arrays */
1922785e854fSJed Brown     ierr = PetscMalloc1(pcis->n_B,&nnz);CHKERRQ(ierr);
1923a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) nnz[i]=1;
1924a717540cSStefano Zampini     /* nonzeros per row */
1925a717540cSStefano Zampini     for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1926a717540cSStefano Zampini       if (PetscBTLookup(change_basis,i)) {
1927a717540cSStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
1928a717540cSStefano Zampini         if (PetscBTLookup(qr_needed_idx,i)) {
1929a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1930a717540cSStefano Zampini         } else {
1931a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = 2;
1932a717540cSStefano Zampini           /* get local primal index on the cc */
1933a717540cSStefano Zampini           j = 0;
1934a717540cSStefano Zampini           while (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+j])) j++;
1935a717540cSStefano Zampini           nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1936a717540cSStefano Zampini         }
1937a717540cSStefano Zampini       }
1938a717540cSStefano Zampini     }
1939a717540cSStefano Zampini     ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
1940a717540cSStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
1941a717540cSStefano Zampini     /* Set initial identity in the matrix */
1942a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) {
1943a717540cSStefano Zampini       ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
1944a717540cSStefano Zampini     }
1945a717540cSStefano Zampini 
1946a717540cSStefano Zampini     if (pcbddc->dbg_flag) {
1947a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1948a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
1949a717540cSStefano Zampini     }
1950a717540cSStefano Zampini 
1951a717540cSStefano Zampini 
1952a717540cSStefano Zampini     /* Now we loop on the constraints which need a change of basis */
1953a717540cSStefano Zampini     /*
1954a717540cSStefano Zampini        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
1955a717540cSStefano Zampini        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
1956a717540cSStefano Zampini 
1957a717540cSStefano Zampini        Basic blocks of change of basis matrix T computed
1958a717540cSStefano Zampini 
1959a717540cSStefano Zampini           - Using the following block transformation if there is only a primal dof on the cc
1960a717540cSStefano Zampini             (in the example, primal dof is the last one of the edge in LOCAL ordering
1961a717540cSStefano Zampini              in this code, primal dof is the first one of the edge in GLOBAL ordering)
1962a717540cSStefano Zampini             | 1        0   ...        0     1 |
1963a717540cSStefano Zampini             | 0        1   ...        0     1 |
1964a717540cSStefano Zampini             |              ...                |
1965a717540cSStefano Zampini             | 0        ...            1     1 |
1966a717540cSStefano Zampini             | -s_1/s_n ...    -s_{n-1}/-s_n 1 |
1967a717540cSStefano Zampini 
1968a717540cSStefano Zampini           - via QR decomposition of constraints otherwise
1969a717540cSStefano Zampini     */
1970a717540cSStefano Zampini     if (qr_needed) {
1971984c4197SStefano Zampini       /* space to store Q */
1972785e854fSJed Brown       ierr = PetscMalloc1((max_size_of_constraint)*(max_size_of_constraint),&qr_basis);CHKERRQ(ierr);
1973984c4197SStefano Zampini       /* first we issue queries for optimal work */
19743f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
19753f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
19763f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1977984c4197SStefano Zampini       lqr_work = -1;
19783f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
1979984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
1980984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
1981785e854fSJed Brown       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
1982984c4197SStefano Zampini       lgqr_work = -1;
19833f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
19843f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
19853f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
19863f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
19873f08241aSStefano Zampini       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
19883f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
1989984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
1990984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
1991785e854fSJed Brown       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
1992984c4197SStefano Zampini       /* array to store scaling factors for reflectors */
1993785e854fSJed Brown       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
1994984c4197SStefano Zampini       /* array to store rhs and solution of triangular solver */
1995785e854fSJed Brown       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
1996a717540cSStefano Zampini       /* allocating workspace for check */
1997a717540cSStefano Zampini       if (pcbddc->dbg_flag) {
1998785e854fSJed Brown         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&work);CHKERRQ(ierr);
1999a717540cSStefano Zampini       }
2000a717540cSStefano Zampini     }
2001984c4197SStefano Zampini     /* array to store whether a node is primal or not */
20024641a718SStefano Zampini     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
2003473ba861SJed Brown     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
200439e2fb2aSStefano Zampini     ierr = ISGlobalToLocalMappingApply(pcbddc->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,aux_primal_numbering,&i,aux_primal_numbering_B);CHKERRQ(ierr);
200539e2fb2aSStefano Zampini     if (i != total_primal_vertices) {
200639e2fb2aSStefano Zampini       SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %d != %d\n",total_primal_vertices,i);
20074641a718SStefano Zampini     }
200839e2fb2aSStefano Zampini     for (i=0;i<total_primal_vertices;i++) {
200939e2fb2aSStefano Zampini       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
201039e2fb2aSStefano Zampini     }
201139e2fb2aSStefano Zampini     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
2012984c4197SStefano Zampini 
2013a717540cSStefano Zampini     /* loop on constraints and see whether or not they need a change of basis and compute it */
2014026de310SStefano Zampini     /* -> using implicit ordering contained in temp_indices data */
2015026de310SStefano Zampini     total_counts = pcbddc->n_vertices;
2016026de310SStefano Zampini     primal_counter = total_counts;
2017026de310SStefano Zampini     while (total_counts<pcbddc->local_primal_size) {
2018026de310SStefano Zampini       primal_dofs = 1;
20194641a718SStefano Zampini       if (PetscBTLookup(change_basis,total_counts)) {
2020026de310SStefano Zampini         /* get all constraints with same support: if more then one constraint is present on the cc then surely indices are stored contiguosly */
2021026de310SStefano 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]]) {
2022026de310SStefano Zampini           primal_dofs++;
2023674ae819SStefano Zampini         }
2024984c4197SStefano Zampini         /* get constraint info */
2025026de310SStefano Zampini         size_of_constraint = temp_indices[total_counts+1]-temp_indices[total_counts];
2026984c4197SStefano Zampini         dual_dofs = size_of_constraint-primal_dofs;
2027984c4197SStefano Zampini 
2028984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
2029a717540cSStefano 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);
2030674ae819SStefano Zampini         }
2031984c4197SStefano Zampini 
2032a717540cSStefano Zampini         if (primal_dofs > 1) { /* QR */
2033a717540cSStefano Zampini 
2034a717540cSStefano Zampini           /* copy quadrature constraints for change of basis check */
2035a717540cSStefano Zampini           if (pcbddc->dbg_flag) {
2036a717540cSStefano Zampini             ierr = PetscMemcpy(work,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
2037a717540cSStefano Zampini           }
2038984c4197SStefano Zampini           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
2039026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
2040984c4197SStefano Zampini 
2041984c4197SStefano Zampini           /* compute QR decomposition of constraints */
20423f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
20433f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
20443f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2045674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
20463f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
2047984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
2048674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2049984c4197SStefano Zampini 
2050984c4197SStefano Zampini           /* explictly compute R^-T */
2051984c4197SStefano Zampini           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
2052984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
20533f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
20543f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
20553f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
20563f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
2057984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
20583f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
2059984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
2060984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2061984c4197SStefano Zampini 
2062a717540cSStefano Zampini           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
20633f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
20643f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
20653f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
20663f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2067984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
20683f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
2069984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
2070984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2071984c4197SStefano Zampini 
2072984c4197SStefano Zampini           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
2073984c4197SStefano Zampini              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
2074984c4197SStefano Zampini              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
20753f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
20763f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
20773f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
20783f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
20793f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
20803f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
2081984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2082c4303822SStefano 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));
2083984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2084026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
2085984c4197SStefano Zampini 
2086984c4197SStefano Zampini           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
2087026de310SStefano Zampini           start_rows = &temp_indices_to_constraint_B[temp_indices[total_counts]];
2088984c4197SStefano Zampini           /* insert cols for primal dofs */
2089984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) {
2090984c4197SStefano Zampini             start_vals = &qr_basis[j*size_of_constraint];
2091026de310SStefano Zampini             start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter+j]];
2092984c4197SStefano Zampini             ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
2093984c4197SStefano Zampini           }
2094984c4197SStefano Zampini           /* insert cols for dual dofs */
2095984c4197SStefano Zampini           for (j=0,k=0;j<dual_dofs;k++) {
20964641a718SStefano Zampini             if (!PetscBTLookup(is_primal,temp_indices_to_constraint_B[temp_indices[total_counts]+k])) {
2097984c4197SStefano Zampini               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
2098026de310SStefano Zampini               start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+k];
2099984c4197SStefano Zampini               ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
2100984c4197SStefano Zampini               j++;
2101674ae819SStefano Zampini             }
2102674ae819SStefano Zampini           }
2103984c4197SStefano Zampini 
2104984c4197SStefano Zampini           /* check change of basis */
2105984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
2106984c4197SStefano Zampini             PetscInt   ii,jj;
2107984c4197SStefano Zampini             PetscBool valid_qr=PETSC_TRUE;
2108c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
2109c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2110c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
2111c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2112c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
2113c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
2114984c4197SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2115c4303822SStefano 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));
2116984c4197SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
2117984c4197SStefano Zampini             for (jj=0;jj<size_of_constraint;jj++) {
2118984c4197SStefano Zampini               for (ii=0;ii<primal_dofs;ii++) {
2119984c4197SStefano Zampini                 if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
2120984c4197SStefano Zampini                 if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
2121674ae819SStefano Zampini               }
2122674ae819SStefano Zampini             }
2123984c4197SStefano Zampini             if (!valid_qr) {
212422d5777bSStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
2125984c4197SStefano Zampini               for (jj=0;jj<size_of_constraint;jj++) {
2126984c4197SStefano Zampini                 for (ii=0;ii<primal_dofs;ii++) {
2127984c4197SStefano Zampini                   if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
2128984c4197SStefano 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]));
2129674ae819SStefano Zampini                   }
2130984c4197SStefano Zampini                   if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
2131984c4197SStefano 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]));
2132984c4197SStefano Zampini                   }
2133984c4197SStefano Zampini                 }
2134984c4197SStefano Zampini               }
2135674ae819SStefano Zampini             } else {
213622d5777bSStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
2137674ae819SStefano Zampini             }
2138674ae819SStefano Zampini           }
2139a717540cSStefano Zampini         } else { /* simple transformation block */
2140a717540cSStefano Zampini           PetscInt row,col;
2141a717540cSStefano Zampini           PetscScalar val;
2142a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) {
2143a717540cSStefano Zampini             row = temp_indices_to_constraint_B[temp_indices[total_counts]+j];
2144a717540cSStefano Zampini             if (!PetscBTLookup(is_primal,row)) {
2145a717540cSStefano Zampini               col = temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
2146a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
2147a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,1.0,INSERT_VALUES);CHKERRQ(ierr);
2148a717540cSStefano Zampini             } else {
2149a717540cSStefano Zampini               for (k=0;k<size_of_constraint;k++) {
2150a717540cSStefano Zampini                 col = temp_indices_to_constraint_B[temp_indices[total_counts]+k];
2151a717540cSStefano Zampini                 if (row != col) {
2152a717540cSStefano Zampini                   val = -temp_quadrature_constraint[temp_indices[total_counts]+k]/temp_quadrature_constraint[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
2153a717540cSStefano Zampini                 } else {
2154a717540cSStefano Zampini                   val = 1.0;
2155a717540cSStefano Zampini                 }
2156a717540cSStefano Zampini                 ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
2157a717540cSStefano Zampini               }
2158a717540cSStefano Zampini             }
2159a717540cSStefano Zampini           }
216098a51de6SStefano Zampini           if (pcbddc->dbg_flag) {
216122d5777bSStefano Zampini             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
2162a717540cSStefano Zampini           }
2163674ae819SStefano Zampini         }
2164026de310SStefano Zampini         /* increment primal counter */
2165026de310SStefano Zampini         primal_counter += primal_dofs;
2166984c4197SStefano Zampini       } else {
2167984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
2168026de310SStefano 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);
2169674ae819SStefano Zampini         }
2170674ae819SStefano Zampini       }
2171026de310SStefano Zampini       /* increment constraint counter total_counts */
2172026de310SStefano Zampini       total_counts += primal_dofs;
2173674ae819SStefano Zampini     }
2174a717540cSStefano Zampini 
2175a717540cSStefano Zampini     /* free workspace */
2176a717540cSStefano Zampini     if (qr_needed) {
2177984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
2178984c4197SStefano Zampini         ierr = PetscFree(work);CHKERRQ(ierr);
2179984c4197SStefano Zampini       }
2180984c4197SStefano Zampini       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
2181984c4197SStefano Zampini       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
2182984c4197SStefano Zampini       ierr = PetscFree(qr_work);CHKERRQ(ierr);
2183984c4197SStefano Zampini       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
2184984c4197SStefano Zampini       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
2185674ae819SStefano Zampini     }
2186a717540cSStefano Zampini     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
2187674ae819SStefano Zampini     /* assembling */
2188674ae819SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2189674ae819SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2190984c4197SStefano Zampini     /*
219145a1bb75SStefano Zampini     ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
2192984c4197SStefano Zampini     ierr = MatView(pcbddc->ChangeOfBasisMatrix,(PetscViewer)0);CHKERRQ(ierr);
2193984c4197SStefano Zampini     */
2194674ae819SStefano Zampini   }
2195b9b85e73SStefano Zampini   /* Change of basis as provided by the user in local numbering (internal and boundary) or boundary only */
2196b9b85e73SStefano Zampini   if (pcbddc->user_ChangeOfBasisMatrix) {
2197b9b85e73SStefano Zampini     PetscInt rows,cols;
2198b9b85e73SStefano Zampini     ierr = MatGetSize(pcbddc->user_ChangeOfBasisMatrix,&rows,&cols);CHKERRQ(ierr);
2199b9b85e73SStefano Zampini     if (rows == pcis->n && cols == pcis->n) {
2200b9b85e73SStefano Zampini       ierr = MatGetSubMatrix(pcbddc->user_ChangeOfBasisMatrix,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
2201b9b85e73SStefano Zampini     } else {
2202b9b85e73SStefano Zampini       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
2203b9b85e73SStefano Zampini       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
2204b9b85e73SStefano Zampini     }
2205b9b85e73SStefano Zampini   }
2206a717540cSStefano Zampini 
2207727cdba6SStefano Zampini   /* get indices in local ordering for vertices and constraints */
2208727cdba6SStefano 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 */
2209473ba861SJed Brown     ierr = PetscMalloc1(olocal_primal_size,&oprimal_indices_local_idxs);CHKERRQ(ierr);
2210727cdba6SStefano Zampini     ierr = PetscMemcpy(oprimal_indices_local_idxs,pcbddc->primal_indices_local_idxs,olocal_primal_size*sizeof(PetscInt));CHKERRQ(ierr);
2211727cdba6SStefano Zampini   }
2212727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2213f347579bSStefano Zampini   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
2214473ba861SJed Brown   ierr = PetscMalloc1(pcbddc->local_primal_size,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
2215727cdba6SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&i,&aux_primal_numbering);CHKERRQ(ierr);
2216727cdba6SStefano Zampini   ierr = PetscMemcpy(pcbddc->primal_indices_local_idxs,aux_primal_numbering,i*sizeof(PetscInt));CHKERRQ(ierr);
2217727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2218727cdba6SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&j,&aux_primal_numbering);CHKERRQ(ierr);
2219727cdba6SStefano Zampini   ierr = PetscMemcpy(&pcbddc->primal_indices_local_idxs[i],aux_primal_numbering,j*sizeof(PetscInt));CHKERRQ(ierr);
2220727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2221e9189074SStefano Zampini   /* set quantities in PCBDDC data struct */
2222e9189074SStefano Zampini   pcbddc->n_actual_vertices = i;
2223727cdba6SStefano Zampini   /* check if a new primal space has been introduced */
2224727cdba6SStefano Zampini   pcbddc->new_primal_space_local = PETSC_TRUE;
2225727cdba6SStefano Zampini   if (olocal_primal_size == pcbddc->local_primal_size) {
2226727cdba6SStefano Zampini     ierr = PetscMemcmp(pcbddc->primal_indices_local_idxs,oprimal_indices_local_idxs,olocal_primal_size,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
2227c1c8e736SStefano Zampini     pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
2228727cdba6SStefano Zampini     ierr = PetscFree(oprimal_indices_local_idxs);CHKERRQ(ierr);
2229727cdba6SStefano Zampini   }
2230727cdba6SStefano Zampini   /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
2231727cdba6SStefano Zampini   ierr = MPI_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2232727cdba6SStefano Zampini 
2233a717540cSStefano Zampini   /* flush dbg viewer */
2234b8ffe317SStefano Zampini   if (pcbddc->dbg_flag) {
2235b8ffe317SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2236b8ffe317SStefano Zampini   }
2237a717540cSStefano Zampini 
2238e310c8b4SStefano Zampini   /* free workspace */
2239a717540cSStefano Zampini   ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2240a717540cSStefano Zampini   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
2241984c4197SStefano Zampini   ierr = PetscFree(aux_primal_minloc);CHKERRQ(ierr);
2242674ae819SStefano Zampini   ierr = PetscFree(temp_indices);CHKERRQ(ierr);
22434641a718SStefano Zampini   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
2244674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr);
2245674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
2246674ae819SStefano Zampini   ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr);
2247674ae819SStefano Zampini   PetscFunctionReturn(0);
2248674ae819SStefano Zampini }
2249674ae819SStefano Zampini 
2250674ae819SStefano Zampini #undef __FUNCT__
2251674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
2252674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
2253674ae819SStefano Zampini {
2254674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
2255674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
2256674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
225763602bcaSStefano Zampini   PetscInt    ierr,i,vertex_size;
2258674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
2259674ae819SStefano Zampini 
2260674ae819SStefano Zampini   PetscFunctionBegin;
22618e61c736SStefano Zampini   /* Reset previously computed graph */
22628e61c736SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
2263674ae819SStefano Zampini   /* Init local Graph struct */
2264674ae819SStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr);
2265674ae819SStefano Zampini 
2266575ad6abSStefano Zampini   /* Check validity of the csr graph passed in by the user */
2267575ad6abSStefano Zampini   if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) {
2268575ad6abSStefano Zampini     ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
2269575ad6abSStefano Zampini   }
22709577ea80SStefano Zampini 
2271674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
227208a5cf49SStefano Zampini   if (pcbddc->use_local_adj && (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy)) {
2273674ae819SStefano Zampini     Mat mat_adj;
2274674ae819SStefano Zampini     const PetscInt *xadj,*adjncy;
2275674ae819SStefano Zampini     PetscBool flg_row=PETSC_TRUE;
2276674ae819SStefano Zampini 
2277674ae819SStefano Zampini     ierr = MatConvert(matis->A,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr);
2278674ae819SStefano Zampini     ierr = MatGetRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2279674ae819SStefano Zampini     if (!flg_row) {
2280674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ called in %s\n",__FUNCT__);
2281674ae819SStefano Zampini     }
2282674ae819SStefano Zampini     ierr = PCBDDCSetLocalAdjacencyGraph(pc,i,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
2283674ae819SStefano Zampini     ierr = MatRestoreRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2284674ae819SStefano Zampini     if (!flg_row) {
2285674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__);
2286674ae819SStefano Zampini     }
2287674ae819SStefano Zampini     ierr = MatDestroy(&mat_adj);CHKERRQ(ierr);
2288674ae819SStefano Zampini   }
2289674ae819SStefano Zampini 
229063602bcaSStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting or PCBDDCSetDofsSplittingLocal */
2291674ae819SStefano Zampini   vertex_size = 1;
229263602bcaSStefano Zampini   if (pcbddc->user_provided_isfordofs) {
229363602bcaSStefano Zampini     if (pcbddc->n_ISForDofs) { /* need to convert from global to local and remove references to global dofs splitting */
229495ecbf38SStefano Zampini       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
229563602bcaSStefano Zampini       for (i=0;i<pcbddc->n_ISForDofs;i++) {
2296a7dc3881SStefano Zampini         ierr = PCBDDCGlobalToLocal(matis->ctx,pcis->vec1_global,pcis->vec1_N,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
229763602bcaSStefano Zampini         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
2298674ae819SStefano Zampini       }
229963602bcaSStefano Zampini       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
230063602bcaSStefano Zampini       pcbddc->n_ISForDofs = 0;
230163602bcaSStefano Zampini       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
2302674ae819SStefano Zampini     }
230363602bcaSStefano Zampini     /* mat block size as vertex size (used for elasticity with rigid body modes as nearnullspace) */
2304674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
230563602bcaSStefano Zampini   } else {
230663602bcaSStefano Zampini     if (!pcbddc->n_ISForDofsLocal) { /* field split not present, create it in local ordering */
230763602bcaSStefano Zampini       ierr = MatGetBlockSize(pc->pmat,&pcbddc->n_ISForDofsLocal);CHKERRQ(ierr);
230863602bcaSStefano Zampini       ierr = PetscMalloc(pcbddc->n_ISForDofsLocal*sizeof(IS),&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
230963602bcaSStefano Zampini       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
231063602bcaSStefano Zampini         ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),pcis->n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
231163602bcaSStefano Zampini       }
231263602bcaSStefano Zampini     }
2313674ae819SStefano Zampini   }
2314674ae819SStefano Zampini 
2315674ae819SStefano Zampini   /* Setup of Graph */
2316785d1243SStefano Zampini   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) { /* need to convert from global to local */
2317a7dc3881SStefano Zampini     ierr = PCBDDCGlobalToLocal(matis->ctx,pcis->vec1_global,pcis->vec1_N,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
2318785d1243SStefano Zampini   }
2319785d1243SStefano Zampini   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) { /* need to convert from global to local */
2320a7dc3881SStefano Zampini     ierr = PCBDDCGlobalToLocal(matis->ctx,pcis->vec1_global,pcis->vec1_N,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
2321785d1243SStefano Zampini   }
232263602bcaSStefano Zampini   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices);
2323674ae819SStefano Zampini 
2324674ae819SStefano Zampini   /* Graph's connected components analysis */
2325674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
2326674ae819SStefano Zampini 
2327674ae819SStefano Zampini   /* print some info to stdout */
2328674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
2329e49050b4SStefano Zampini     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer);
2330674ae819SStefano Zampini   }
2331fb180af4SStefano Zampini 
2332fb180af4SStefano Zampini   /* mark topography has done */
2333fb180af4SStefano Zampini   pcbddc->recompute_topography = PETSC_FALSE;
2334674ae819SStefano Zampini   PetscFunctionReturn(0);
2335674ae819SStefano Zampini }
2336674ae819SStefano Zampini 
2337674ae819SStefano Zampini #undef __FUNCT__
2338674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx"
2339f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt **vertices_idx)
2340674ae819SStefano Zampini {
2341674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2342674ae819SStefano Zampini   PetscInt       *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size;
2343674ae819SStefano Zampini   PetscErrorCode ierr;
2344674ae819SStefano Zampini 
2345674ae819SStefano Zampini   PetscFunctionBegin;
2346674ae819SStefano Zampini   n = 0;
2347674ae819SStefano Zampini   vertices = 0;
2348674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2349674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr);
2350b120a5c6SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2351b120a5c6SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2352b120a5c6SStefano Zampini       if (size_of_constraint == 1) n++;
2353b120a5c6SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2354b120a5c6SStefano Zampini     }
2355811e8ca2SStefano Zampini     if (vertices_idx) {
2356785e854fSJed Brown       ierr = PetscMalloc1(n,&vertices);CHKERRQ(ierr);
2357b120a5c6SStefano Zampini       n = 0;
2358674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2359674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2360674ae819SStefano Zampini         if (size_of_constraint == 1) {
2361674ae819SStefano Zampini           vertices[n++]=row_cmat_indices[0];
2362674ae819SStefano Zampini         }
2363674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2364674ae819SStefano Zampini       }
2365674ae819SStefano Zampini     }
2366811e8ca2SStefano Zampini   }
2367674ae819SStefano Zampini   *n_vertices = n;
2368811e8ca2SStefano Zampini   if (vertices_idx) *vertices_idx = vertices;
2369674ae819SStefano Zampini   PetscFunctionReturn(0);
2370674ae819SStefano Zampini }
2371674ae819SStefano Zampini 
2372674ae819SStefano Zampini #undef __FUNCT__
2373674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx"
2374f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt **constraints_idx)
2375674ae819SStefano Zampini {
2376674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2377674ae819SStefano Zampini   PetscInt       *constraints_index,*row_cmat_indices,*row_cmat_global_indices;
2378674ae819SStefano Zampini   PetscInt       n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc;
23794641a718SStefano Zampini   PetscBT        touched;
2380674ae819SStefano Zampini   PetscErrorCode ierr;
2381674ae819SStefano Zampini 
2382f34684f1SStefano Zampini     /* This function assumes that the number of local constraints per connected component
2383f34684f1SStefano Zampini        is not greater than the number of nodes defined for the connected component
2384f34684f1SStefano Zampini        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
2385674ae819SStefano Zampini   PetscFunctionBegin;
2386674ae819SStefano Zampini   n = 0;
2387674ae819SStefano Zampini   constraints_index = 0;
2388674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2389674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr);
2390674ae819SStefano Zampini     max_size_of_constraint = 0;
2391674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2392674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2393674ae819SStefano Zampini       if (size_of_constraint > 1) {
2394674ae819SStefano Zampini         n++;
2395674ae819SStefano Zampini       }
2396674ae819SStefano Zampini       max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint);
2397674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2398674ae819SStefano Zampini     }
2399811e8ca2SStefano Zampini     if (constraints_idx) {
2400785e854fSJed Brown       ierr = PetscMalloc1(n,&constraints_index);CHKERRQ(ierr);
2401785e854fSJed Brown       ierr = PetscMalloc1(max_size_of_constraint,&row_cmat_global_indices);CHKERRQ(ierr);
24024641a718SStefano Zampini       ierr = PetscBTCreate(local_size,&touched);CHKERRQ(ierr);
2403674ae819SStefano Zampini       n = 0;
2404674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2405674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2406674ae819SStefano Zampini         if (size_of_constraint > 1) {
2407674ae819SStefano Zampini           ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr);
240882d3d8afSStefano Zampini           /* find first untouched local node */
240982d3d8afSStefano Zampini           j = 0;
24104641a718SStefano Zampini           while (PetscBTLookup(touched,row_cmat_indices[j])) j++;
241182d3d8afSStefano Zampini           min_index = row_cmat_global_indices[j];
241282d3d8afSStefano Zampini           min_loc = j;
241382d3d8afSStefano Zampini           /* search the minimum among nodes not yet touched on the connected component
241482d3d8afSStefano Zampini              since there can be more than one constraint on a single cc */
2415674ae819SStefano Zampini           for (j=1;j<size_of_constraint;j++) {
24164641a718SStefano Zampini             if (!PetscBTLookup(touched,row_cmat_indices[j]) && min_index > row_cmat_global_indices[j]) {
2417674ae819SStefano Zampini               min_index = row_cmat_global_indices[j];
2418674ae819SStefano Zampini               min_loc = j;
2419674ae819SStefano Zampini             }
2420674ae819SStefano Zampini           }
24214641a718SStefano Zampini           ierr = PetscBTSet(touched,row_cmat_indices[min_loc]);CHKERRQ(ierr);
2422674ae819SStefano Zampini           constraints_index[n++] = row_cmat_indices[min_loc];
2423674ae819SStefano Zampini         }
2424674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2425674ae819SStefano Zampini       }
24264641a718SStefano Zampini       ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2427674ae819SStefano Zampini       ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr);
2428811e8ca2SStefano Zampini     }
2429811e8ca2SStefano Zampini   }
2430674ae819SStefano Zampini   *n_constraints = n;
2431811e8ca2SStefano Zampini   if (constraints_idx) *constraints_idx = constraints_index;
2432674ae819SStefano Zampini   PetscFunctionReturn(0);
2433674ae819SStefano Zampini }
2434674ae819SStefano Zampini 
2435674ae819SStefano Zampini /* the next two functions has been adapted from pcis.c */
2436674ae819SStefano Zampini #undef __FUNCT__
2437674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchur"
2438674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchur(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2439674ae819SStefano Zampini {
2440674ae819SStefano Zampini   PetscErrorCode ierr;
2441674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2442674ae819SStefano Zampini 
2443674ae819SStefano Zampini   PetscFunctionBegin;
2444674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2445674ae819SStefano Zampini   ierr = MatMult(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2446674ae819SStefano Zampini   ierr = MatMult(pcis->A_IB,v,vec1_D);CHKERRQ(ierr);
2447674ae819SStefano Zampini   ierr = KSPSolve(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2448674ae819SStefano Zampini   ierr = MatMult(pcis->A_BI,vec2_D,vec2_B);CHKERRQ(ierr);
2449674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2450674ae819SStefano Zampini   PetscFunctionReturn(0);
2451674ae819SStefano Zampini }
2452674ae819SStefano Zampini 
2453674ae819SStefano Zampini #undef __FUNCT__
2454674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchurTranspose"
2455674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchurTranspose(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2456674ae819SStefano Zampini {
2457674ae819SStefano Zampini   PetscErrorCode ierr;
2458674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2459674ae819SStefano Zampini 
2460674ae819SStefano Zampini   PetscFunctionBegin;
2461674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2462674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2463674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BI,v,vec1_D);CHKERRQ(ierr);
2464674ae819SStefano Zampini   ierr = KSPSolveTranspose(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2465674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_IB,vec2_D,vec2_B);CHKERRQ(ierr);
2466674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2467674ae819SStefano Zampini   PetscFunctionReturn(0);
2468674ae819SStefano Zampini }
2469674ae819SStefano Zampini 
2470674ae819SStefano Zampini #undef __FUNCT__
2471674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
2472674ae819SStefano 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[])
2473674ae819SStefano Zampini {
2474674ae819SStefano Zampini   Vec            local_vec,global_vec;
2475674ae819SStefano Zampini   IS             seqis,paris;
2476674ae819SStefano Zampini   VecScatter     scatter_ctx;
2477674ae819SStefano Zampini   PetscScalar    *array;
2478674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
2479674ae819SStefano Zampini   PetscScalar    globalsum;
2480674ae819SStefano Zampini   PetscInt       i,j,s;
2481674ae819SStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local;
2482674ae819SStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm,max_global;
2483674ae819SStefano Zampini   PetscMPIInt    *dof_sizes,*dof_displs;
2484674ae819SStefano Zampini   PetscBool      first_found;
2485674ae819SStefano Zampini   PetscErrorCode ierr;
2486674ae819SStefano Zampini 
2487674ae819SStefano Zampini   PetscFunctionBegin;
2488674ae819SStefano Zampini   /* mpi buffers */
2489b9b85e73SStefano Zampini   ierr = MPI_Comm_size(comm,&size_prec_comm);CHKERRQ(ierr);
2490b9b85e73SStefano Zampini   ierr = MPI_Comm_rank(comm,&rank_prec_comm);CHKERRQ(ierr);
2491674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
2492785e854fSJed Brown   ierr = PetscMalloc1(j,&dof_sizes);CHKERRQ(ierr);
2493785e854fSJed Brown   ierr = PetscMalloc1(j,&dof_displs);CHKERRQ(ierr);
2494674ae819SStefano Zampini   /* get maximum size of subset */
2495785e854fSJed Brown   ierr = PetscMalloc1(n_local_dofs,&temp_global_dofs);CHKERRQ(ierr);
2496674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
2497674ae819SStefano Zampini   max_local = 0;
2498b9b85e73SStefano Zampini   for (i=0;i<n_local_dofs;i++) {
2499674ae819SStefano Zampini     if (max_local < temp_global_dofs[i] ) {
2500674ae819SStefano Zampini       max_local = temp_global_dofs[i];
2501674ae819SStefano Zampini     }
2502674ae819SStefano Zampini   }
2503b9b85e73SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);CHKERRQ(ierr);
2504674ae819SStefano Zampini   max_global++;
2505674ae819SStefano Zampini   max_local = 0;
2506b9b85e73SStefano Zampini   for (i=0;i<n_local_dofs;i++) {
2507674ae819SStefano Zampini     if (max_local < local_dofs[i] ) {
2508674ae819SStefano Zampini       max_local = local_dofs[i];
2509674ae819SStefano Zampini     }
2510674ae819SStefano Zampini   }
2511674ae819SStefano Zampini   max_local++;
2512674ae819SStefano Zampini   /* allocate workspace */
2513674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
2514674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
2515674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
2516674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
2517674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
2518674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
2519674ae819SStefano Zampini   /* create scatter */
2520674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
2521674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
2522674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
2523674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
2524674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
2525674ae819SStefano Zampini   /* init array */
2526674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
2527674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2528674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2529674ae819SStefano Zampini   if (local_dofs_mult) {
2530674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2531674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
2532674ae819SStefano Zampini     }
2533674ae819SStefano Zampini   } else {
2534674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2535674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
2536674ae819SStefano Zampini     }
2537674ae819SStefano Zampini   }
2538674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2539674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
2540674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2541674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2542674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
25435b08dc53SStefano Zampini   *n_global_subset = (PetscInt)PetscRealPart(globalsum);
2544674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
2545674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
2546674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
2547674ae819SStefano Zampini   nlocals = 0;
2548674ae819SStefano Zampini   first_index = -1;
2549674ae819SStefano Zampini   first_found = PETSC_FALSE;
2550674ae819SStefano Zampini   for (i=0;i<s;i++) {
2551b9b85e73SStefano Zampini     if (!first_found && PetscRealPart(array[i]) > 0.1) {
2552674ae819SStefano Zampini       first_found = PETSC_TRUE;
2553674ae819SStefano Zampini       first_index = i;
2554674ae819SStefano Zampini     }
25555b08dc53SStefano Zampini     nlocals += (PetscInt)PetscRealPart(array[i]);
2556674ae819SStefano Zampini   }
2557674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2558674ae819SStefano Zampini   if (!rank_prec_comm) {
2559674ae819SStefano Zampini     dof_displs[0]=0;
2560674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
2561674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
2562674ae819SStefano Zampini     }
2563674ae819SStefano Zampini   }
2564674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2565674ae819SStefano Zampini   if (first_found) {
2566674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
2567674ae819SStefano Zampini     old_index = first_index;
2568674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
2569b9b85e73SStefano Zampini       if (PetscRealPart(array[i]) > 0.1) {
2570674ae819SStefano Zampini         array[i] += array[old_index];
2571674ae819SStefano Zampini         old_index = i;
2572674ae819SStefano Zampini       }
2573674ae819SStefano Zampini     }
2574674ae819SStefano Zampini   }
2575674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
2576674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2577674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2578674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2579674ae819SStefano Zampini   /* get global ordering of local dofs */
2580674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2581674ae819SStefano Zampini   if (local_dofs_mult) {
2582674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
25835b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i];
2584674ae819SStefano Zampini     }
2585674ae819SStefano Zampini   } else {
2586674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
25875b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1;
2588674ae819SStefano Zampini     }
2589674ae819SStefano Zampini   }
2590674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2591674ae819SStefano Zampini   /* free workspace */
2592674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
2593674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
2594674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
2595674ae819SStefano Zampini   ierr = PetscFree(dof_sizes);CHKERRQ(ierr);
2596674ae819SStefano Zampini   ierr = PetscFree(dof_displs);CHKERRQ(ierr);
2597674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
2598674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
2599674ae819SStefano Zampini   PetscFunctionReturn(0);
2600674ae819SStefano Zampini }
26019a7d3425SStefano Zampini 
26029a7d3425SStefano Zampini #undef __FUNCT__
26039a7d3425SStefano Zampini #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
26049a7d3425SStefano Zampini PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
26059a7d3425SStefano Zampini {
26069a7d3425SStefano Zampini   PetscInt       i,j;
26079a7d3425SStefano Zampini   PetscScalar    *alphas;
26089a7d3425SStefano Zampini   PetscErrorCode ierr;
26099a7d3425SStefano Zampini 
26109a7d3425SStefano Zampini   PetscFunctionBegin;
26119a7d3425SStefano Zampini   /* this implements stabilized Gram-Schmidt */
2612785e854fSJed Brown   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
26139a7d3425SStefano Zampini   for (i=0;i<n;i++) {
26149a7d3425SStefano Zampini     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
26159a7d3425SStefano Zampini     if (i<n) { ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],&alphas[i+1]);CHKERRQ(ierr); }
26169a7d3425SStefano Zampini     for (j=i+1;j<n;j++) { ierr = VecAXPY(vecs[j],PetscConj(-alphas[j]),vecs[i]);CHKERRQ(ierr); }
26179a7d3425SStefano Zampini   }
26189a7d3425SStefano Zampini   ierr = PetscFree(alphas);CHKERRQ(ierr);
26199a7d3425SStefano Zampini   PetscFunctionReturn(0);
26209a7d3425SStefano Zampini }
26219a7d3425SStefano Zampini 
2622e7931f94SStefano Zampini #undef __FUNCT__
262370cf5478SStefano Zampini #define __FUNCT__ "MatISGetSubassemblingPattern"
262428143c3dSStefano Zampini PetscErrorCode MatISGetSubassemblingPattern(Mat mat, PetscInt n_subdomains, PetscBool contiguous, IS* is_sends)
2625e7931f94SStefano Zampini {
2626e7931f94SStefano Zampini   Mat             subdomain_adj;
2627e7931f94SStefano Zampini   IS              new_ranks,ranks_send_to;
2628e7931f94SStefano Zampini   MatPartitioning partitioner;
2629e7931f94SStefano Zampini   Mat_IS          *matis;
2630e7931f94SStefano Zampini   PetscInt        n_neighs,*neighs,*n_shared,**shared;
2631e7931f94SStefano Zampini   PetscInt        prank;
2632e7931f94SStefano Zampini   PetscMPIInt     size,rank,color;
2633e7931f94SStefano Zampini   PetscInt        *xadj,*adjncy,*oldranks;
2634e7931f94SStefano Zampini   PetscInt        *adjncy_wgt,*v_wgt,*is_indices,*ranks_send_to_idx;
263528143c3dSStefano Zampini   PetscInt        i,j,local_size,threshold=0;
2636e7931f94SStefano Zampini   PetscErrorCode  ierr;
26372b510759SStefano Zampini   PetscBool       use_vwgt=PETSC_FALSE,use_square=PETSC_FALSE;
2638e7931f94SStefano Zampini   PetscSubcomm    subcomm;
2639a57a6d2fSStefano Zampini 
2640e7931f94SStefano Zampini   PetscFunctionBegin;
26412b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_square",&use_square,NULL);CHKERRQ(ierr);
26422b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
26432b510759SStefano Zampini   ierr = PetscOptionsGetInt(NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
2644e7931f94SStefano Zampini 
2645e7931f94SStefano Zampini   /* Get info on mapping */
2646e7931f94SStefano Zampini   matis = (Mat_IS*)(mat->data);
2647e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&local_size);CHKERRQ(ierr);
2648e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2649e7931f94SStefano Zampini 
2650e7931f94SStefano Zampini   /* build local CSR graph of subdomains' connectivity */
2651785e854fSJed Brown   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
2652e7931f94SStefano Zampini   xadj[0] = 0;
2653e7931f94SStefano Zampini   xadj[1] = PetscMax(n_neighs-1,0);
2654785e854fSJed Brown   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
2655785e854fSJed Brown   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
2656e7931f94SStefano Zampini 
26572b510759SStefano Zampini   if (threshold) {
26582b510759SStefano Zampini     PetscInt* count,min_threshold;
2659785e854fSJed Brown     ierr = PetscMalloc1(local_size,&count);CHKERRQ(ierr);
2660e7931f94SStefano Zampini     ierr = PetscMemzero(count,local_size*sizeof(PetscInt));CHKERRQ(ierr);
2661e7931f94SStefano Zampini     for (i=1;i<n_neighs;i++) {/* i=1 so I don't count myself -> faces nodes counts to 1 */
2662e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2663e7931f94SStefano Zampini         count[shared[i][j]] += 1;
2664e7931f94SStefano Zampini       }
2665e7931f94SStefano Zampini     }
26662b510759SStefano Zampini     /* adapt threshold since we dont want to lose significant connections */
26672b510759SStefano Zampini     min_threshold = n_neighs;
26682b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
26692b510759SStefano Zampini       for (j=0;j<n_shared[i];j++) {
26702b510759SStefano Zampini         min_threshold = PetscMin(count[shared[i][j]],min_threshold);
26712b510759SStefano Zampini       }
26722b510759SStefano Zampini     }
26732b510759SStefano Zampini     threshold = PetscMax(min_threshold+1,threshold);
2674e7931f94SStefano Zampini     xadj[1] = 0;
26752b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
2676e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2677e7931f94SStefano Zampini         if (count[shared[i][j]] < threshold) {
2678e7931f94SStefano Zampini           adjncy[xadj[1]] = neighs[i];
2679e7931f94SStefano Zampini           adjncy_wgt[xadj[1]] = n_shared[i];
2680e7931f94SStefano Zampini           xadj[1]++;
2681e7931f94SStefano Zampini           break;
2682e7931f94SStefano Zampini         }
2683e7931f94SStefano Zampini       }
2684e7931f94SStefano Zampini     }
2685e7931f94SStefano Zampini     ierr = PetscFree(count);CHKERRQ(ierr);
2686c8587f34SStefano Zampini   } else {
2687e7931f94SStefano Zampini     if (xadj[1]) {
2688e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy,&neighs[1],xadj[1]*sizeof(*adjncy));CHKERRQ(ierr);
2689e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy_wgt,&n_shared[1],xadj[1]*sizeof(*adjncy_wgt));CHKERRQ(ierr);
2690c8587f34SStefano Zampini     }
2691e7931f94SStefano Zampini   }
2692e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingRestoreInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2693e7931f94SStefano Zampini   if (use_square) {
2694e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2695e7931f94SStefano Zampini       adjncy_wgt[i] = adjncy_wgt[i]*adjncy_wgt[i];
2696e7931f94SStefano Zampini     }
2697e7931f94SStefano Zampini   }
2698e7931f94SStefano Zampini   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2699e7931f94SStefano Zampini 
2700e7931f94SStefano Zampini   ierr = PetscMalloc(sizeof(PetscInt),&ranks_send_to_idx);CHKERRQ(ierr);
2701e7931f94SStefano Zampini 
2702e7931f94SStefano Zampini   /*
2703e7931f94SStefano Zampini     Restrict work on active processes only.
2704e7931f94SStefano Zampini   */
2705e7931f94SStefano Zampini   ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&subcomm);CHKERRQ(ierr);
2706e7931f94SStefano Zampini   ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
2707e7931f94SStefano Zampini   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
27082b510759SStefano Zampini   ierr = PetscMPIIntCast(!local_size,&color);CHKERRQ(ierr);
2709d3531aaaSJed Brown   ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
2710e7931f94SStefano Zampini   if (color) {
2711e7931f94SStefano Zampini     ierr = PetscFree(xadj);CHKERRQ(ierr);
2712e7931f94SStefano Zampini     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2713e7931f94SStefano Zampini     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
2714c8587f34SStefano Zampini   } else {
271528143c3dSStefano Zampini     PetscInt coarsening_ratio;
2716e7931f94SStefano Zampini     ierr = MPI_Comm_size(subcomm->comm,&size);CHKERRQ(ierr);
2717785e854fSJed Brown     ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
2718e7931f94SStefano Zampini     prank = rank;
2719e7931f94SStefano Zampini     ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm->comm);CHKERRQ(ierr);
27208002ef2cSStefano Zampini     /*
2721e7931f94SStefano Zampini     for (i=0;i<size;i++) {
2722e7931f94SStefano Zampini       PetscPrintf(subcomm->comm,"oldranks[%d] = %d\n",i,oldranks[i]);
2723c8587f34SStefano Zampini     }
27248002ef2cSStefano Zampini     */
2725e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2726e7931f94SStefano Zampini       ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
2727c8587f34SStefano Zampini     }
2728e7931f94SStefano Zampini     ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2729e7931f94SStefano Zampini     ierr = MatCreateMPIAdj(subcomm->comm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
273022b6e8a2SStefano Zampini     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
2731e7931f94SStefano Zampini 
2732e7931f94SStefano Zampini     /* Partition */
2733e7931f94SStefano Zampini     ierr = MatPartitioningCreate(subcomm->comm,&partitioner);CHKERRQ(ierr);
2734e7931f94SStefano Zampini     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
2735e7931f94SStefano Zampini     if (use_vwgt) {
2736e7931f94SStefano Zampini       ierr = PetscMalloc(sizeof(*v_wgt),&v_wgt);CHKERRQ(ierr);
2737e7931f94SStefano Zampini       v_wgt[0] = local_size;
2738e7931f94SStefano Zampini       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
2739c8587f34SStefano Zampini     }
274028143c3dSStefano Zampini     n_subdomains = PetscMin((PetscInt)size,n_subdomains);
274128143c3dSStefano Zampini     coarsening_ratio = size/n_subdomains;
274228143c3dSStefano Zampini     /* Parmetis does not always give back nparts with small graphs! this should be taken into account */
274328143c3dSStefano Zampini     ierr = MatPartitioningSetNParts(partitioner,n_subdomains);CHKERRQ(ierr);
2744e7931f94SStefano Zampini     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
2745e7931f94SStefano Zampini     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
274622b6e8a2SStefano Zampini     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
2747e7931f94SStefano Zampini 
2748e7931f94SStefano Zampini     ierr = ISGetIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
274928143c3dSStefano Zampini     if (contiguous) {
275028143c3dSStefano Zampini       ranks_send_to_idx[0] = oldranks[is_indices[0]]; /* contiguos set of processes */
275128143c3dSStefano Zampini     } else {
275284ba6060SStefano Zampini       ranks_send_to_idx[0] = coarsening_ratio*oldranks[is_indices[0]]; /* scattered set of processes */
275328143c3dSStefano Zampini     }
2754e7931f94SStefano Zampini     ierr = ISRestoreIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2755e7931f94SStefano Zampini     /* clean up */
2756e7931f94SStefano Zampini     ierr = PetscFree(oldranks);CHKERRQ(ierr);
2757e7931f94SStefano Zampini     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
2758e7931f94SStefano Zampini     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
2759e7931f94SStefano Zampini     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
2760e7931f94SStefano Zampini   }
2761e7931f94SStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
2762e7931f94SStefano Zampini 
2763e7931f94SStefano Zampini   /* assemble parallel IS for sends */
2764e7931f94SStefano Zampini   i = 1;
2765e7931f94SStefano Zampini   if (color) i=0;
2766e7931f94SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,&ranks_send_to);CHKERRQ(ierr);
2767e7931f94SStefano Zampini 
2768e7931f94SStefano Zampini   /* get back IS */
2769e7931f94SStefano Zampini   *is_sends = ranks_send_to;
2770e7931f94SStefano Zampini   PetscFunctionReturn(0);
2771e7931f94SStefano Zampini }
2772e7931f94SStefano Zampini 
2773e7931f94SStefano Zampini typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
2774e7931f94SStefano Zampini 
2775e7931f94SStefano Zampini #undef __FUNCT__
2776e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble"
277728143c3dSStefano Zampini PetscErrorCode MatISSubassemble(Mat mat, IS is_sends, PetscInt n_subdomains, PetscBool restrict_comm, MatReuse reuse, Mat *mat_n, PetscInt nis, IS isarray[])
2778e7931f94SStefano Zampini {
277970cf5478SStefano Zampini   Mat                    local_mat;
2780e7931f94SStefano Zampini   Mat_IS                 *matis;
2781e7931f94SStefano Zampini   IS                     is_sends_internal;
2782e7931f94SStefano Zampini   PetscInt               rows,cols;
278328143c3dSStefano Zampini   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals;
278428143c3dSStefano Zampini   PetscBool              ismatis,isdense,destroy_mat;
2785e7931f94SStefano Zampini   ISLocalToGlobalMapping l2gmap;
2786e7931f94SStefano Zampini   PetscInt*              l2gmap_indices;
2787e7931f94SStefano Zampini   const PetscInt*        is_indices;
2788e7931f94SStefano Zampini   MatType                new_local_type;
2789e7931f94SStefano Zampini   /* buffers */
2790e7931f94SStefano Zampini   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
279128143c3dSStefano Zampini   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
2792e7931f94SStefano Zampini   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
2793e7931f94SStefano Zampini   /* MPI */
279428143c3dSStefano Zampini   MPI_Comm               comm,comm_n;
279528143c3dSStefano Zampini   PetscSubcomm           subcomm;
2796e7931f94SStefano Zampini   PetscMPIInt            n_sends,n_recvs,commsize;
279728143c3dSStefano Zampini   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
279828143c3dSStefano Zampini   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
279928143c3dSStefano Zampini   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,source_dest;
280028143c3dSStefano Zampini   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals;
280128143c3dSStefano Zampini   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals;
2802e7931f94SStefano Zampini   PetscErrorCode         ierr;
2803e7931f94SStefano Zampini 
2804e7931f94SStefano Zampini   PetscFunctionBegin;
280528143c3dSStefano Zampini   /* TODO: add missing checks */
280628143c3dSStefano Zampini   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
280728143c3dSStefano Zampini   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
280828143c3dSStefano Zampini   PetscValidLogicalCollectiveEnum(mat,reuse,5);
280928143c3dSStefano Zampini   PetscValidLogicalCollectiveInt(mat,nis,7);
2810e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
281128143c3dSStefano Zampini   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",__FUNCT__);
2812e7931f94SStefano Zampini   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2813e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
2814e7931f94SStefano Zampini   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
2815e7931f94SStefano Zampini   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
2816e7931f94SStefano Zampini   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
281728143c3dSStefano Zampini   if (reuse == MAT_REUSE_MATRIX && *mat_n) {
281870cf5478SStefano Zampini     PetscInt mrows,mcols,mnrows,mncols;
281970cf5478SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
282028143c3dSStefano Zampini     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
282170cf5478SStefano Zampini     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
282270cf5478SStefano Zampini     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
282370cf5478SStefano Zampini     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
282470cf5478SStefano Zampini     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
282570cf5478SStefano Zampini   }
2826e7931f94SStefano Zampini   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
2827e7931f94SStefano Zampini   PetscValidLogicalCollectiveInt(mat,bs,0);
2828e7931f94SStefano Zampini   /* prepare IS for sending if not provided */
2829e7931f94SStefano Zampini   if (!is_sends) {
283028143c3dSStefano Zampini     PetscBool pcontig = PETSC_TRUE;
283128143c3dSStefano Zampini     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
283228143c3dSStefano Zampini     ierr = MatISGetSubassemblingPattern(mat,n_subdomains,pcontig,&is_sends_internal);CHKERRQ(ierr);
2833c8587f34SStefano Zampini   } else {
2834e7931f94SStefano Zampini     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
2835e7931f94SStefano Zampini     is_sends_internal = is_sends;
2836c8587f34SStefano Zampini   }
2837e7931f94SStefano Zampini 
2838e7931f94SStefano Zampini   /* get pointer of MATIS data */
2839e7931f94SStefano Zampini   matis = (Mat_IS*)mat->data;
2840e7931f94SStefano Zampini 
2841e7931f94SStefano Zampini   /* get comm */
2842a316fed8SStefano Zampini   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
2843e7931f94SStefano Zampini 
2844e7931f94SStefano Zampini   /* compute number of sends */
2845e7931f94SStefano Zampini   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
2846e7931f94SStefano Zampini   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
2847e7931f94SStefano Zampini 
2848e7931f94SStefano Zampini   /* compute number of receives */
2849e7931f94SStefano Zampini   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
2850785e854fSJed Brown   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
2851e7931f94SStefano Zampini   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
2852e7931f94SStefano Zampini   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2853e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
2854e7931f94SStefano Zampini   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
2855e7931f94SStefano Zampini   ierr = PetscFree(iflags);CHKERRQ(ierr);
2856e7931f94SStefano Zampini 
285728143c3dSStefano Zampini   /* restrict comm if requested */
285828143c3dSStefano Zampini   subcomm = 0;
285928143c3dSStefano Zampini   destroy_mat = PETSC_FALSE;
286028143c3dSStefano Zampini   if (restrict_comm) {
286128143c3dSStefano Zampini     PetscMPIInt color,rank,subcommsize;
286228143c3dSStefano Zampini     ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
286328143c3dSStefano Zampini     color = 0;
286428143c3dSStefano Zampini     if (n_sends && !n_recvs) color = 1; /* sending only processes will not partecipate in new comm */
286528143c3dSStefano Zampini     ierr = MPI_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
286628143c3dSStefano Zampini     subcommsize = commsize - subcommsize;
286728143c3dSStefano Zampini     /* check if reuse has been requested */
286828143c3dSStefano Zampini     if (reuse == MAT_REUSE_MATRIX) {
286928143c3dSStefano Zampini       if (*mat_n) {
287028143c3dSStefano Zampini         PetscMPIInt subcommsize2;
287128143c3dSStefano Zampini         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
287228143c3dSStefano Zampini         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
287328143c3dSStefano Zampini         comm_n = PetscObjectComm((PetscObject)*mat_n);
287428143c3dSStefano Zampini       } else {
287528143c3dSStefano Zampini         comm_n = PETSC_COMM_SELF;
287628143c3dSStefano Zampini       }
287728143c3dSStefano Zampini     } else { /* MAT_INITIAL_MATRIX */
287828143c3dSStefano Zampini       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
287928143c3dSStefano Zampini       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
288028143c3dSStefano Zampini       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
288128143c3dSStefano Zampini       comm_n = subcomm->comm;
288228143c3dSStefano Zampini     }
288328143c3dSStefano Zampini     /* flag to destroy *mat_n if not significative */
288428143c3dSStefano Zampini     if (color) destroy_mat = PETSC_TRUE;
288528143c3dSStefano Zampini   } else {
288628143c3dSStefano Zampini     comm_n = comm;
288728143c3dSStefano Zampini   }
288828143c3dSStefano Zampini 
2889e7931f94SStefano Zampini   /* prepare send/receive buffers */
2890785e854fSJed Brown   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
2891e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
2892785e854fSJed Brown   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
2893e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
289428143c3dSStefano Zampini   if (nis) {
289528143c3dSStefano Zampini     ierr = PetscMalloc(commsize*sizeof(*ilengths_idxs_is),&ilengths_idxs_is);CHKERRQ(ierr);
289628143c3dSStefano Zampini     ierr = PetscMemzero(ilengths_idxs_is,commsize*sizeof(*ilengths_idxs_is));CHKERRQ(ierr);
289728143c3dSStefano Zampini   }
2898e7931f94SStefano Zampini 
289928143c3dSStefano Zampini   /* Get data from local matrices */
2900e7931f94SStefano Zampini   if (!isdense) {
2901e7931f94SStefano Zampini     /* TODO: See below some guidelines on how to prepare the local buffers */
2902e7931f94SStefano Zampini     /*
2903e7931f94SStefano Zampini        send_buffer_vals should contain the raw values of the local matrix
2904e7931f94SStefano Zampini        send_buffer_idxs should contain:
2905e7931f94SStefano Zampini        - MatType_PRIVATE type
2906e7931f94SStefano Zampini        - PetscInt        size_of_l2gmap
2907e7931f94SStefano Zampini        - PetscInt        global_row_indices[size_of_l2gmap]
2908e7931f94SStefano Zampini        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
2909e7931f94SStefano Zampini     */
2910e7931f94SStefano Zampini   } else {
2911e7931f94SStefano Zampini     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
2912e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&i);CHKERRQ(ierr);
2913785e854fSJed Brown     ierr = PetscMalloc1((i+2),&send_buffer_idxs);CHKERRQ(ierr);
2914e7931f94SStefano Zampini     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
2915e7931f94SStefano Zampini     send_buffer_idxs[1] = i;
2916e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2917e7931f94SStefano Zampini     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
2918e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingRestoreIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2919e7931f94SStefano Zampini     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
2920e7931f94SStefano Zampini     for (i=0;i<n_sends;i++) {
2921e7931f94SStefano Zampini       ilengths_vals[is_indices[i]] = len*len;
2922e7931f94SStefano Zampini       ilengths_idxs[is_indices[i]] = len+2;
2923c8587f34SStefano Zampini     }
2924c8587f34SStefano Zampini   }
2925e7931f94SStefano Zampini   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
292628143c3dSStefano Zampini   /* additional is (if any) */
292728143c3dSStefano Zampini   if (nis) {
292828143c3dSStefano Zampini     PetscMPIInt psum;
292928143c3dSStefano Zampini     PetscInt j;
293028143c3dSStefano Zampini     for (j=0,psum=0;j<nis;j++) {
293128143c3dSStefano Zampini       PetscInt plen;
293228143c3dSStefano Zampini       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
293328143c3dSStefano Zampini       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
293428143c3dSStefano Zampini       psum += len+1; /* indices + lenght */
293528143c3dSStefano Zampini     }
293628143c3dSStefano Zampini     ierr = PetscMalloc(psum*sizeof(PetscInt),&send_buffer_idxs_is);CHKERRQ(ierr);
293728143c3dSStefano Zampini     for (j=0,psum=0;j<nis;j++) {
293828143c3dSStefano Zampini       PetscInt plen;
293928143c3dSStefano Zampini       const PetscInt *is_array_idxs;
294028143c3dSStefano Zampini       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
294128143c3dSStefano Zampini       send_buffer_idxs_is[psum] = plen;
294228143c3dSStefano Zampini       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
294328143c3dSStefano Zampini       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
294428143c3dSStefano Zampini       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
294528143c3dSStefano Zampini       psum += plen+1; /* indices + lenght */
294628143c3dSStefano Zampini     }
294728143c3dSStefano Zampini     for (i=0;i<n_sends;i++) {
294828143c3dSStefano Zampini       ilengths_idxs_is[is_indices[i]] = psum;
294928143c3dSStefano Zampini     }
295028143c3dSStefano Zampini     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
295128143c3dSStefano Zampini   }
295228143c3dSStefano Zampini 
2953e7931f94SStefano Zampini   buf_size_idxs = 0;
2954e7931f94SStefano Zampini   buf_size_vals = 0;
295528143c3dSStefano Zampini   buf_size_idxs_is = 0;
2956e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2957e7931f94SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
2958e7931f94SStefano Zampini     buf_size_vals += (PetscInt)olengths_vals[i];
295928143c3dSStefano Zampini     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
2960e7931f94SStefano Zampini   }
2961785e854fSJed Brown   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
2962785e854fSJed Brown   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
296395ecbf38SStefano Zampini   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
2964e7931f94SStefano Zampini 
2965e7931f94SStefano Zampini   /* get new tags for clean communications */
2966e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
2967e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
296828143c3dSStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
2969e7931f94SStefano Zampini 
2970e7931f94SStefano Zampini   /* allocate for requests */
2971785e854fSJed Brown   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
2972785e854fSJed Brown   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
297395ecbf38SStefano Zampini   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
2974785e854fSJed Brown   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
2975785e854fSJed Brown   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
297695ecbf38SStefano Zampini   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
2977e7931f94SStefano Zampini 
2978e7931f94SStefano Zampini   /* communications */
2979e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2980e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
298128143c3dSStefano Zampini   ptr_idxs_is = recv_buffer_idxs_is;
2982e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2983e7931f94SStefano Zampini     source_dest = onodes[i];
2984e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
2985e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
2986e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2987e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
298828143c3dSStefano Zampini     if (nis) {
298928143c3dSStefano Zampini       ierr = MPI_Irecv(ptr_idxs_is,olengths_idxs_is[i],MPIU_INT,source_dest,tag_idxs_is,comm,&recv_req_idxs_is[i]);CHKERRQ(ierr);
299028143c3dSStefano Zampini       ptr_idxs_is += olengths_idxs_is[i];
299128143c3dSStefano Zampini     }
2992e7931f94SStefano Zampini   }
2993e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) {
2994e7931f94SStefano Zampini     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
2995e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
2996e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
299728143c3dSStefano Zampini     if (nis) {
299828143c3dSStefano Zampini       ierr = MPI_Isend(send_buffer_idxs_is,ilengths_idxs_is[source_dest],MPIU_INT,source_dest,tag_idxs_is,comm,&send_req_idxs_is[i]);CHKERRQ(ierr);
299928143c3dSStefano Zampini     }
3000e7931f94SStefano Zampini   }
3001e7931f94SStefano Zampini   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
3002e7931f94SStefano Zampini   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
3003e7931f94SStefano Zampini 
3004e7931f94SStefano Zampini   /* assemble new l2g map */
3005e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3006e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
3007e7931f94SStefano Zampini   buf_size_idxs = 0;
3008e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3009e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
3010e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3011e7931f94SStefano Zampini   }
3012785e854fSJed Brown   ierr = PetscMalloc1(buf_size_idxs,&l2gmap_indices);CHKERRQ(ierr);
3013e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
3014e7931f94SStefano Zampini   buf_size_idxs = 0;
3015e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3016e7931f94SStefano Zampini     ierr = PetscMemcpy(&l2gmap_indices[buf_size_idxs],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
3017e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
3018e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3019e7931f94SStefano Zampini   }
3020e7931f94SStefano Zampini   ierr = PetscSortRemoveDupsInt(&buf_size_idxs,l2gmap_indices);CHKERRQ(ierr);
302183f1a634SStefano Zampini   ierr = ISLocalToGlobalMappingCreate(comm_n,1,buf_size_idxs,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
3022e7931f94SStefano Zampini   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
3023e7931f94SStefano Zampini 
3024e7931f94SStefano Zampini   /* infer new local matrix type from received local matrices type */
3025e7931f94SStefano Zampini   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
3026e7931f94SStefano 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) */
3027e7931f94SStefano Zampini   if (n_recvs) {
302828143c3dSStefano Zampini     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
3029e7931f94SStefano Zampini     ptr_idxs = recv_buffer_idxs;
3030e7931f94SStefano Zampini     for (i=0;i<n_recvs;i++) {
3031e7931f94SStefano Zampini       if ((PetscInt)new_local_type_private != *ptr_idxs) {
3032e7931f94SStefano Zampini         new_local_type_private = MATAIJ_PRIVATE;
3033e7931f94SStefano Zampini         break;
3034e7931f94SStefano Zampini       }
3035e7931f94SStefano Zampini       ptr_idxs += olengths_idxs[i];
3036e7931f94SStefano Zampini     }
3037e7931f94SStefano Zampini     switch (new_local_type_private) {
303828143c3dSStefano Zampini       case MATDENSE_PRIVATE:
303928143c3dSStefano Zampini         if (n_recvs>1) { /* subassembling of dense matrices does not give a dense matrix! */
3040e7931f94SStefano Zampini           new_local_type = MATSEQAIJ;
3041e7931f94SStefano Zampini           bs = 1;
304228143c3dSStefano Zampini         } else { /* if I receive only 1 dense matrix */
304328143c3dSStefano Zampini           new_local_type = MATSEQDENSE;
304428143c3dSStefano Zampini           bs = 1;
304528143c3dSStefano Zampini         }
3046e7931f94SStefano Zampini         break;
3047e7931f94SStefano Zampini       case MATAIJ_PRIVATE:
3048e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
3049e7931f94SStefano Zampini         bs = 1;
3050e7931f94SStefano Zampini         break;
3051e7931f94SStefano Zampini       case MATBAIJ_PRIVATE:
3052e7931f94SStefano Zampini         new_local_type = MATSEQBAIJ;
3053e7931f94SStefano Zampini         break;
3054e7931f94SStefano Zampini       case MATSBAIJ_PRIVATE:
3055e7931f94SStefano Zampini         new_local_type = MATSEQSBAIJ;
3056e7931f94SStefano Zampini         break;
3057e7931f94SStefano Zampini       default:
305828143c3dSStefano Zampini         SETERRQ2(comm,PETSC_ERR_PLIB,"Unkwown private type %d in %s",new_local_type_private,__FUNCT__);
3059e7931f94SStefano Zampini         break;
3060e7931f94SStefano Zampini     }
306128143c3dSStefano Zampini   } else { /* by default, new_local_type is seqdense */
306228143c3dSStefano Zampini     new_local_type = MATSEQDENSE;
306328143c3dSStefano Zampini     bs = 1;
3064e7931f94SStefano Zampini   }
3065e7931f94SStefano Zampini 
306670cf5478SStefano Zampini   /* create MATIS object if needed */
306770cf5478SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
3068e7931f94SStefano Zampini     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
306928143c3dSStefano Zampini     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,mat_n);CHKERRQ(ierr);
307070cf5478SStefano Zampini   } else {
307170cf5478SStefano Zampini     /* it also destroys the local matrices */
307270cf5478SStefano Zampini     ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
307370cf5478SStefano Zampini   }
3074e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
307570cf5478SStefano Zampini   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
3076e7931f94SStefano Zampini   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
3077e7931f94SStefano Zampini   ierr = MatSetUp(local_mat);CHKERRQ(ierr); /* WARNING -> no preallocation yet */
3078e7931f94SStefano Zampini 
3079e7931f94SStefano Zampini   /* set values */
3080e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3081e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
3082e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
3083e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3084e7931f94SStefano Zampini     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
3085e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
308670cf5478SStefano Zampini       ierr = MatSetValues(*mat_n,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
3087e7931f94SStefano Zampini       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3088e7931f94SStefano Zampini       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3089e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
309028143c3dSStefano Zampini     } else {
309128143c3dSStefano Zampini       /* TODO */
3092e7931f94SStefano Zampini     }
3093e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3094e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
3095e7931f94SStefano Zampini   }
3096e7931f94SStefano Zampini   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3097e7931f94SStefano Zampini   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
309870cf5478SStefano Zampini   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
309970cf5478SStefano Zampini   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3100e7931f94SStefano Zampini 
3101dfd14d43SStefano Zampini #if 0
310228143c3dSStefano Zampini   if (!restrict_comm) { /* check */
3103e7931f94SStefano Zampini     Vec       lvec,rvec;
3104e7931f94SStefano Zampini     PetscReal infty_error;
3105e7931f94SStefano Zampini 
3106e7931f94SStefano Zampini     ierr = MatGetVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
3107e7931f94SStefano Zampini     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
3108e7931f94SStefano Zampini     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
3109e7931f94SStefano Zampini     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
311070cf5478SStefano Zampini     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
3111e7931f94SStefano Zampini     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3112e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
3113e7931f94SStefano Zampini     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
3114e7931f94SStefano Zampini     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
3115e7931f94SStefano Zampini   }
311628143c3dSStefano Zampini #endif
3117e7931f94SStefano Zampini 
311828143c3dSStefano Zampini   /* assemble new additional is (if any) */
311928143c3dSStefano Zampini   if (nis) {
312028143c3dSStefano Zampini     PetscInt **temp_idxs,*count_is,j,psum;
312128143c3dSStefano Zampini 
312228143c3dSStefano Zampini     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
312328143c3dSStefano Zampini     ierr = PetscMalloc(nis*sizeof(PetscInt),&count_is);CHKERRQ(ierr);
312428143c3dSStefano Zampini     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
312528143c3dSStefano Zampini     ptr_idxs = recv_buffer_idxs_is;
312628143c3dSStefano Zampini     psum = 0;
312728143c3dSStefano Zampini     for (i=0;i<n_recvs;i++) {
312828143c3dSStefano Zampini       for (j=0;j<nis;j++) {
312928143c3dSStefano Zampini         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
313028143c3dSStefano Zampini         count_is[j] += plen; /* increment counting of buffer for j-th IS */
313128143c3dSStefano Zampini         psum += plen;
313228143c3dSStefano Zampini         ptr_idxs += plen+1; /* shift pointer to received data */
313328143c3dSStefano Zampini       }
313428143c3dSStefano Zampini     }
313528143c3dSStefano Zampini     ierr = PetscMalloc(nis*sizeof(PetscInt*),&temp_idxs);CHKERRQ(ierr);
313628143c3dSStefano Zampini     ierr = PetscMalloc(psum*sizeof(PetscInt),&temp_idxs[0]);CHKERRQ(ierr);
313728143c3dSStefano Zampini     for (i=1;i<nis;i++) {
313828143c3dSStefano Zampini       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
313928143c3dSStefano Zampini     }
314028143c3dSStefano Zampini     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
314128143c3dSStefano Zampini     ptr_idxs = recv_buffer_idxs_is;
314228143c3dSStefano Zampini     for (i=0;i<n_recvs;i++) {
314328143c3dSStefano Zampini       for (j=0;j<nis;j++) {
314428143c3dSStefano Zampini         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
314528143c3dSStefano Zampini         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
314628143c3dSStefano Zampini         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
314728143c3dSStefano Zampini         ptr_idxs += plen+1; /* shift pointer to received data */
314828143c3dSStefano Zampini       }
314928143c3dSStefano Zampini     }
315028143c3dSStefano Zampini     for (i=0;i<nis;i++) {
315128143c3dSStefano Zampini       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
315228143c3dSStefano Zampini       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
315328143c3dSStefano Zampini       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
315428143c3dSStefano Zampini     }
315528143c3dSStefano Zampini     ierr = PetscFree(count_is);CHKERRQ(ierr);
315628143c3dSStefano Zampini     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
315728143c3dSStefano Zampini     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
315828143c3dSStefano Zampini   }
3159e7931f94SStefano Zampini   /* free workspace */
3160e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
3161e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
316228143c3dSStefano Zampini   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
3163e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3164e7931f94SStefano Zampini   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
3165e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3166e7931f94SStefano Zampini   if (isdense) {
3167e7931f94SStefano Zampini     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
3168e7931f94SStefano Zampini     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
3169e7931f94SStefano Zampini   } else {
3170e7931f94SStefano Zampini     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
3171e7931f94SStefano Zampini   }
317228143c3dSStefano Zampini   if (nis) {
317328143c3dSStefano Zampini     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
317428143c3dSStefano Zampini     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
317528143c3dSStefano Zampini   }
3176e7931f94SStefano Zampini   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
3177e7931f94SStefano Zampini   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
317828143c3dSStefano Zampini   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
3179e7931f94SStefano Zampini   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
3180e7931f94SStefano Zampini   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
318128143c3dSStefano Zampini   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
3182e7931f94SStefano Zampini   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
3183e7931f94SStefano Zampini   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
3184e7931f94SStefano Zampini   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
3185e7931f94SStefano Zampini   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
3186e7931f94SStefano Zampini   ierr = PetscFree(onodes);CHKERRQ(ierr);
318728143c3dSStefano Zampini   if (nis) {
318828143c3dSStefano Zampini     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
318928143c3dSStefano Zampini     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
319028143c3dSStefano Zampini     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
319128143c3dSStefano Zampini   }
319228143c3dSStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
319328143c3dSStefano Zampini   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
319428143c3dSStefano Zampini     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
319528143c3dSStefano Zampini     for (i=0;i<nis;i++) {
319628143c3dSStefano Zampini       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
319728143c3dSStefano Zampini     }
319828143c3dSStefano Zampini   }
3199e7931f94SStefano Zampini   PetscFunctionReturn(0);
3200e7931f94SStefano Zampini }
3201a57a6d2fSStefano Zampini 
320212edc857SStefano Zampini /* temporary hack into ksp private data structure */
320312edc857SStefano Zampini #include <petsc-private/kspimpl.h>
320412edc857SStefano Zampini 
3205c8587f34SStefano Zampini #undef __FUNCT__
3206c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
3207c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
3208c8587f34SStefano Zampini {
3209c8587f34SStefano Zampini   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
3210c8587f34SStefano Zampini   PC_IS                  *pcis = (PC_IS*)pc->data;
321120a2ab83SStefano Zampini   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
32129881197aSStefano Zampini   MatNullSpace           CoarseNullSpace=NULL;
321320a2ab83SStefano Zampini   ISLocalToGlobalMapping coarse_islg;
32146e683305SStefano Zampini   IS                     coarse_is,*isarray;
32156e683305SStefano Zampini   PetscInt               i,im_active=-1,active_procs=-1;
32166e683305SStefano Zampini   PetscInt               nis,nisdofs,nisneu;
3217f9eb5b7dSStefano Zampini   PC                     pc_temp;
3218c8587f34SStefano Zampini   PCType                 coarse_pc_type;
3219c8587f34SStefano Zampini   KSPType                coarse_ksp_type;
3220f9eb5b7dSStefano Zampini   PetscBool              multilevel_requested,multilevel_allowed;
32214f3a063dSStefano Zampini   PetscBool              isredundant,isbddc,isnn,coarse_reuse;
32226e683305SStefano Zampini   Mat                    t_coarse_mat_is;
32236e683305SStefano Zampini   PetscInt               void_procs,ncoarse_ml,ncoarse_ds,ncoarse;
32246e683305SStefano Zampini   PetscMPIInt            all_procs;
32256e683305SStefano Zampini   PetscBool              csin_ml,csin_ds,csin,csin_type_simple;
322668457ee5SStefano Zampini   PetscBool              compute_vecs = PETSC_FALSE;
32279881197aSStefano Zampini   PetscErrorCode         ierr;
3228fdc09c96SStefano Zampini 
3229c8587f34SStefano Zampini   PetscFunctionBegin;
3230c8587f34SStefano Zampini   /* Assign global numbering to coarse dofs */
323168457ee5SStefano Zampini   if (pcbddc->new_primal_space || pcbddc->coarse_size == -1) { /* a new primal space is present or it is the first initialization, so recompute global numbering */
323268457ee5SStefano Zampini     compute_vecs = PETSC_TRUE;
3233fa7f1dd8SStefano Zampini     PetscInt ocoarse_size;
3234fa7f1dd8SStefano Zampini     ocoarse_size = pcbddc->coarse_size;
3235f4ddd8eeSStefano Zampini     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3236f4ddd8eeSStefano Zampini     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
3237f4ddd8eeSStefano Zampini     /* see if we can avoid some work */
3238fa7f1dd8SStefano Zampini     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
3239fa7f1dd8SStefano Zampini       if (ocoarse_size != pcbddc->coarse_size) { /* ...but with different size, so reset it and set reuse flag to false */
3240727cdba6SStefano Zampini         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3241fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_FALSE;
3242fa7f1dd8SStefano Zampini       } else { /* we can safely reuse already computed coarse matrix */
3243fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_TRUE;
3244f4ddd8eeSStefano Zampini       }
3245fa7f1dd8SStefano Zampini     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
3246fa7f1dd8SStefano Zampini       coarse_reuse = PETSC_FALSE;
3247f4ddd8eeSStefano Zampini     }
324870cf5478SStefano Zampini     /* reset any subassembling information */
324970cf5478SStefano Zampini     ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
32506e683305SStefano Zampini     ierr = ISDestroy(&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
32516e683305SStefano Zampini   } else { /* primal space is unchanged, so we can reuse coarse matrix */
3252fa7f1dd8SStefano Zampini     coarse_reuse = PETSC_TRUE;
3253f4ddd8eeSStefano Zampini   }
3254c8587f34SStefano Zampini 
32556e683305SStefano Zampini   /* count "active" (i.e. with positive local size) and "void" processes */
32562b510759SStefano Zampini   im_active = !!(pcis->n);
32572b510759SStefano Zampini   ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
32586e683305SStefano Zampini   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&all_procs);CHKERRQ(ierr);
32596e683305SStefano Zampini   void_procs = all_procs-active_procs;
32606e683305SStefano Zampini   csin_type_simple = PETSC_TRUE;
32616e683305SStefano Zampini   if (pcbddc->current_level) {
32626e683305SStefano Zampini     csin_ml = PETSC_TRUE;
32636e683305SStefano Zampini     ncoarse_ml = void_procs;
32646e683305SStefano Zampini     csin_ds = PETSC_TRUE;
32656e683305SStefano Zampini     ncoarse_ds = void_procs;
32666e683305SStefano Zampini     if (!void_procs) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen");
32676e683305SStefano Zampini   } else {
32686e683305SStefano Zampini     csin_ml = PETSC_FALSE;
32696e683305SStefano Zampini     ncoarse_ml = all_procs;
32706e683305SStefano Zampini     if (void_procs) {
32716e683305SStefano Zampini       csin_ds = PETSC_TRUE;
32726e683305SStefano Zampini       ncoarse_ds = void_procs;
32736e683305SStefano Zampini       csin_type_simple = PETSC_FALSE;
32746e683305SStefano Zampini     } else {
32756e683305SStefano Zampini       csin_ds = PETSC_FALSE;
32766e683305SStefano Zampini       ncoarse_ds = all_procs;
32776e683305SStefano Zampini     }
32786e683305SStefano Zampini   }
32796e683305SStefano Zampini 
32806e683305SStefano Zampini   /*
32816e683305SStefano Zampini     test if we can go multilevel: three conditions must be satisfied:
32826e683305SStefano Zampini     - we have not exceeded the number of levels requested
32836e683305SStefano Zampini     - we can actually subassemble the active processes
32846e683305SStefano Zampini     - we can find a suitable number of MPI processes where we can place the subassembled problem
32856e683305SStefano Zampini   */
32866e683305SStefano Zampini   multilevel_allowed = PETSC_FALSE;
32876e683305SStefano Zampini   multilevel_requested = PETSC_FALSE;
32886e683305SStefano Zampini   if (pcbddc->current_level < pcbddc->max_levels) {
32896e683305SStefano Zampini     multilevel_requested = PETSC_TRUE;
32906e683305SStefano Zampini     if (active_procs/pcbddc->coarsening_ratio < 2 || ncoarse_ml/pcbddc->coarsening_ratio < 2) {
3291f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_FALSE;
32922b510759SStefano Zampini     } else {
3293f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_TRUE;
3294c8587f34SStefano Zampini     }
3295c8587f34SStefano Zampini   }
32966e683305SStefano Zampini   /* determine number of process partecipating to coarse solver */
32976e683305SStefano Zampini   if (multilevel_allowed) {
32986e683305SStefano Zampini     ncoarse = ncoarse_ml;
32996e683305SStefano Zampini     csin = csin_ml;
33006e683305SStefano Zampini   } else {
33016e683305SStefano Zampini     ncoarse = ncoarse_ds;
33026e683305SStefano Zampini     csin = csin_ds;
33036e683305SStefano Zampini   }
3304e7931f94SStefano Zampini 
3305abbbba34SStefano Zampini   /* creates temporary l2gmap and IS for coarse indexes */
3306abbbba34SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
3307abbbba34SStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
3308abbbba34SStefano Zampini 
3309abbbba34SStefano Zampini   /* creates temporary MATIS object for coarse matrix */
3310abbbba34SStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
3311b9b85e73SStefano Zampini #if 0
3312b9b85e73SStefano Zampini   {
3313b9b85e73SStefano Zampini     PetscViewer viewer;
3314b9b85e73SStefano Zampini     char filename[256];
3315b9b85e73SStefano Zampini     sprintf(filename,"local_coarse_mat%d.m",PetscGlobalRank);
3316b9b85e73SStefano Zampini     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
3317b9b85e73SStefano Zampini     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
3318b9b85e73SStefano Zampini     ierr = MatView(coarse_submat_dense,viewer);CHKERRQ(ierr);
3319b9b85e73SStefano Zampini     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
3320b9b85e73SStefano Zampini   }
3321b9b85e73SStefano Zampini #endif
33226e683305SStefano Zampini   ierr = MatCreateIS(PetscObjectComm((PetscObject)pc),1,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size,coarse_islg,&t_coarse_mat_is);CHKERRQ(ierr);
33236e683305SStefano Zampini   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
33246e683305SStefano Zampini   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
33256e683305SStefano Zampini   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3326abbbba34SStefano Zampini   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
3327abbbba34SStefano Zampini 
33286e683305SStefano Zampini   /* compute dofs splitting and neumann boundaries for coarse dofs */
33296e683305SStefano Zampini   if (multilevel_allowed && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal) ) { /* protects from unneded computations */
33306e683305SStefano Zampini     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
33316e683305SStefano Zampini     const PetscInt         *idxs;
33326e683305SStefano Zampini     ISLocalToGlobalMapping tmap;
33336e683305SStefano Zampini 
33346e683305SStefano Zampini     /* create map between primal indices (in local representative ordering) and local primal numbering */
33350be93d54SStefano Zampini     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
33366e683305SStefano Zampini     /* allocate space for temporary storage */
33376e683305SStefano Zampini     ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&tidxs);CHKERRQ(ierr);
33386e683305SStefano Zampini     ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&tidxs2);CHKERRQ(ierr);
33396e683305SStefano Zampini     /* allocate for IS array */
33406e683305SStefano Zampini     nisdofs = pcbddc->n_ISForDofsLocal;
33416e683305SStefano Zampini     nisneu = !!pcbddc->NeumannBoundariesLocal;
33426e683305SStefano Zampini     nis = nisdofs + nisneu;
33436e683305SStefano Zampini     ierr = PetscMalloc(nis*sizeof(IS),&isarray);CHKERRQ(ierr);
33446e683305SStefano Zampini     /* dofs splitting */
33456e683305SStefano Zampini     for (i=0;i<nisdofs;i++) {
33466e683305SStefano Zampini       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
33476e683305SStefano Zampini       ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
33486e683305SStefano Zampini       ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
33496e683305SStefano Zampini       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
33506e683305SStefano Zampini       ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
33516e683305SStefano Zampini       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
33526e683305SStefano Zampini       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pcbddc->ISForDofsLocal[i]),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
33536e683305SStefano Zampini       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
33546e683305SStefano Zampini     }
33556e683305SStefano Zampini     /* neumann boundaries */
33566e683305SStefano Zampini     if (pcbddc->NeumannBoundariesLocal) {
33576e683305SStefano Zampini       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
33586e683305SStefano Zampini       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
33596e683305SStefano Zampini       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
33606e683305SStefano Zampini       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
33616e683305SStefano Zampini       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
33626e683305SStefano Zampini       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
33636e683305SStefano Zampini       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pcbddc->NeumannBoundariesLocal),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
33646e683305SStefano Zampini       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
33656e683305SStefano Zampini     }
33666e683305SStefano Zampini     /* free memory */
33676e683305SStefano Zampini     ierr = PetscFree(tidxs);CHKERRQ(ierr);
33686e683305SStefano Zampini     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
33696e683305SStefano Zampini     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
33706e683305SStefano Zampini   } else {
33716e683305SStefano Zampini     nis = 0;
33726e683305SStefano Zampini     nisdofs = 0;
33736e683305SStefano Zampini     nisneu = 0;
33746e683305SStefano Zampini     isarray = NULL;
33756e683305SStefano Zampini   }
33766e683305SStefano Zampini   /* destroy no longer needed map */
33776e683305SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
33786e683305SStefano Zampini 
33796e683305SStefano Zampini   /* restrict on coarse candidates (if needed) */
33806e683305SStefano Zampini   coarse_mat_is = NULL;
33816e683305SStefano Zampini   if (csin) {
33826e683305SStefano Zampini     if (!pcbddc->coarse_subassembling_init ) { /* creates subassembling init pattern if not present */
33836e683305SStefano Zampini       PetscInt j,tissize,*nisindices;
33846e683305SStefano Zampini       PetscInt *coarse_candidates;
33856e683305SStefano Zampini       const PetscInt* tisindices;
33866e683305SStefano Zampini       /* get coarse candidates' ranks in pc communicator */
33876e683305SStefano Zampini       ierr = PetscMalloc(all_procs*sizeof(PetscInt),&coarse_candidates);CHKERRQ(ierr);
33886e683305SStefano Zampini       ierr = MPI_Allgather(&im_active,1,MPIU_INT,coarse_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
33896e683305SStefano Zampini       for (i=0,j=0;i<all_procs;i++) {
33906e683305SStefano Zampini         if (!coarse_candidates[i]) {
33916e683305SStefano Zampini           coarse_candidates[j]=i;
33926e683305SStefano Zampini           j++;
33936e683305SStefano Zampini         }
33946e683305SStefano Zampini       }
33956e683305SStefano Zampini       if (j < ncoarse) SETERRQ2(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen! %d < %d",j,ncoarse);
33966e683305SStefano Zampini       /* get a suitable subassembling pattern */
33976e683305SStefano Zampini       if (csin_type_simple) {
33986e683305SStefano Zampini         PetscMPIInt rank;
33996e683305SStefano Zampini         PetscInt    issize,isidx;
34006e683305SStefano Zampini         ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
34016e683305SStefano Zampini         if (im_active) {
34026e683305SStefano Zampini           issize = 1;
34036e683305SStefano Zampini           isidx = (PetscInt)rank;
34046e683305SStefano Zampini         } else {
34056e683305SStefano Zampini           issize = 0;
34066e683305SStefano Zampini           isidx = -1;
34076e683305SStefano Zampini         }
34086e683305SStefano Zampini         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),issize,&isidx,PETSC_COPY_VALUES,&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
34096e683305SStefano Zampini       } else {
34106e683305SStefano Zampini         ierr = MatISGetSubassemblingPattern(t_coarse_mat_is,ncoarse,PETSC_TRUE,&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
34116e683305SStefano Zampini       }
34126e683305SStefano Zampini       if (pcbddc->dbg_flag) {
34136e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
34146e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Subassembling pattern init (before shift)\n");CHKERRQ(ierr);
34156e683305SStefano Zampini         ierr = ISView(pcbddc->coarse_subassembling_init,pcbddc->dbg_viewer);CHKERRQ(ierr);
34166e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse candidates\n");CHKERRQ(ierr);
34176e683305SStefano Zampini         for (i=0;i<j;i++) {
34186e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"%d ",coarse_candidates[i]);CHKERRQ(ierr);
34196e683305SStefano Zampini         }
34206e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"\n");CHKERRQ(ierr);
34216e683305SStefano Zampini         ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
34226e683305SStefano Zampini       }
34236e683305SStefano Zampini       /* shift the pattern on coarse candidates */
34246e683305SStefano Zampini       ierr = ISGetLocalSize(pcbddc->coarse_subassembling_init,&tissize);CHKERRQ(ierr);
34256e683305SStefano Zampini       ierr = ISGetIndices(pcbddc->coarse_subassembling_init,&tisindices);CHKERRQ(ierr);
34266e683305SStefano Zampini       ierr = PetscMalloc(tissize*sizeof(PetscInt),&nisindices);CHKERRQ(ierr);
34276e683305SStefano Zampini       for (i=0;i<tissize;i++) nisindices[i] = coarse_candidates[tisindices[i]];
34286e683305SStefano Zampini       ierr = ISRestoreIndices(pcbddc->coarse_subassembling_init,&tisindices);CHKERRQ(ierr);
34296e683305SStefano Zampini       ierr = ISGeneralSetIndices(pcbddc->coarse_subassembling_init,tissize,nisindices,PETSC_OWN_POINTER);CHKERRQ(ierr);
34306e683305SStefano Zampini       ierr = PetscFree(coarse_candidates);CHKERRQ(ierr);
34316e683305SStefano Zampini     }
34326e683305SStefano Zampini     if (pcbddc->dbg_flag) {
34336e683305SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
34346e683305SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Subassembling pattern init\n");CHKERRQ(ierr);
34356e683305SStefano Zampini       ierr = ISView(pcbddc->coarse_subassembling_init,pcbddc->dbg_viewer);CHKERRQ(ierr);
34366e683305SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
34376e683305SStefano Zampini     }
34386e683305SStefano Zampini     /* get temporary coarse mat in IS format restricted on coarse procs (plus additional index sets of isarray) */
34396e683305SStefano Zampini     ierr = MatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling_init,0,PETSC_TRUE,MAT_INITIAL_MATRIX,&coarse_mat_is,nis,isarray);CHKERRQ(ierr);
34406e683305SStefano Zampini   } else {
34416e683305SStefano Zampini     if (pcbddc->dbg_flag) {
34426e683305SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
34436e683305SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Subassembling pattern init not needed\n");CHKERRQ(ierr);
34446e683305SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
34456e683305SStefano Zampini     }
34466e683305SStefano Zampini     ierr = PetscObjectReference((PetscObject)t_coarse_mat_is);CHKERRQ(ierr);
34476e683305SStefano Zampini     coarse_mat_is = t_coarse_mat_is;
34486e683305SStefano Zampini   }
34496e683305SStefano Zampini 
34506e683305SStefano Zampini   /* create local to global scatters for coarse problem */
345168457ee5SStefano Zampini   if (compute_vecs) {
34526e683305SStefano Zampini     PetscInt lrows;
34536e683305SStefano Zampini     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
34546e683305SStefano Zampini     if (coarse_mat_is) {
34556e683305SStefano Zampini       ierr = MatGetLocalSize(coarse_mat_is,&lrows,NULL);CHKERRQ(ierr);
34566e683305SStefano Zampini     } else {
34576e683305SStefano Zampini       lrows = 0;
34586e683305SStefano Zampini     }
34596e683305SStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
34606e683305SStefano Zampini     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
34616e683305SStefano Zampini     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
34626e683305SStefano Zampini     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
34636e683305SStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
34646e683305SStefano Zampini   }
34656e683305SStefano Zampini   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
34666e683305SStefano Zampini   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
3467c8587f34SStefano Zampini 
3468f9eb5b7dSStefano Zampini   /* set defaults for coarse KSP and PC */
3469f9eb5b7dSStefano Zampini   if (multilevel_allowed) {
3470f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPRICHARDSON;
3471f9eb5b7dSStefano Zampini     coarse_pc_type = PCBDDC;
3472f9eb5b7dSStefano Zampini   } else {
3473f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPPREONLY;
3474f9eb5b7dSStefano Zampini     coarse_pc_type = PCREDUNDANT;
3475c8587f34SStefano Zampini   }
3476c8587f34SStefano Zampini 
34776e683305SStefano Zampini   /* print some info if requested */
34786e683305SStefano Zampini   if (pcbddc->dbg_flag) {
34796e683305SStefano Zampini     if (!multilevel_allowed) {
34806e683305SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
34816e683305SStefano Zampini       if (multilevel_requested) {
34826e683305SStefano 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);
34836e683305SStefano Zampini       } else if (pcbddc->max_levels) {
34846e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
34856e683305SStefano Zampini       }
34866e683305SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
34876e683305SStefano Zampini     }
34886e683305SStefano Zampini   }
34896e683305SStefano Zampini 
3490f9eb5b7dSStefano Zampini   /* create the coarse KSP object only once with defaults */
34916e683305SStefano Zampini   if (coarse_mat_is) {
34926e683305SStefano Zampini     MatReuse coarse_mat_reuse;
34936a1308c2SStefano Zampini     PetscViewer dbg_viewer = NULL;
34946e683305SStefano Zampini     if (pcbddc->dbg_flag) {
34956e683305SStefano Zampini       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat_is));
34966e683305SStefano Zampini       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
34976e683305SStefano Zampini     }
3498f9eb5b7dSStefano Zampini     if (!pcbddc->coarse_ksp) {
3499312be037SStefano Zampini       char prefix[256],str_level[16];
3500e604994aSStefano Zampini       size_t len;
35016e683305SStefano Zampini       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat_is),&pcbddc->coarse_ksp);CHKERRQ(ierr);
3502c8587f34SStefano Zampini       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
3503f9eb5b7dSStefano Zampini       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
35045f76c7aeSStefano Zampini       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat_is,coarse_mat_is);CHKERRQ(ierr);
3505c8587f34SStefano Zampini       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
35066e683305SStefano Zampini       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
3507c8587f34SStefano Zampini       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3508c8587f34SStefano Zampini       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
3509e604994aSStefano Zampini       /* prefix */
3510e604994aSStefano Zampini       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
3511e604994aSStefano Zampini       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
3512e604994aSStefano Zampini       if (!pcbddc->current_level) {
3513e604994aSStefano Zampini         ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
3514e604994aSStefano Zampini         ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
3515c8587f34SStefano Zampini       } else {
3516e604994aSStefano Zampini         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
3517312be037SStefano Zampini         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
3518312be037SStefano Zampini         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
351934d6797cSStefano Zampini         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
3520312be037SStefano Zampini         sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
3521e604994aSStefano Zampini         ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
3522e604994aSStefano Zampini       }
3523e604994aSStefano Zampini       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
3524f9eb5b7dSStefano Zampini       /* allow user customization */
3525f9eb5b7dSStefano Zampini       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
35267e0def11SStefano Zampini       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
3527312be037SStefano Zampini     }
3528f9eb5b7dSStefano Zampini 
3529f9eb5b7dSStefano Zampini     /* get some info after set from options */
3530f9eb5b7dSStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3531f9eb5b7dSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
3532f9eb5b7dSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
35334f3a063dSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
35346e683305SStefano Zampini     if (isbddc && !multilevel_allowed) { /* multilevel can only be requested via pc_bddc_set_levels */
3535f9eb5b7dSStefano Zampini       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
3536f9eb5b7dSStefano Zampini       isbddc = PETSC_FALSE;
3537f9eb5b7dSStefano Zampini     }
35384f3a063dSStefano Zampini     if (isredundant) {
35394f3a063dSStefano Zampini       KSP inner_ksp;
35404f3a063dSStefano Zampini       PC inner_pc;
35414f3a063dSStefano Zampini       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
35424f3a063dSStefano Zampini       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
35434f3a063dSStefano Zampini       ierr = PCFactorSetReuseFill(inner_pc,PETSC_TRUE);CHKERRQ(ierr);
35444f3a063dSStefano Zampini     }
3545f9eb5b7dSStefano Zampini 
35466e683305SStefano Zampini     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
3547f9eb5b7dSStefano Zampini     ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
3548f9eb5b7dSStefano Zampini     ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
3549f9eb5b7dSStefano Zampini     ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
35506e683305SStefano Zampini     if (nisdofs) {
35516e683305SStefano Zampini       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
35526e683305SStefano Zampini       for (i=0;i<nisdofs;i++) {
35536e683305SStefano Zampini         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
35541035eff8SStefano Zampini       }
35551035eff8SStefano Zampini     }
35566e683305SStefano Zampini     if (nisneu) {
35576e683305SStefano Zampini       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
35586e683305SStefano Zampini       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
35591035eff8SStefano Zampini     }
3560fdc09c96SStefano Zampini 
3561f9eb5b7dSStefano Zampini     /* assemble coarse matrix */
3562fa7f1dd8SStefano Zampini     if (coarse_reuse) {
356381d9aea3SBarry Smith       ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
3564fa7f1dd8SStefano Zampini       ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
35656e683305SStefano Zampini       coarse_mat_reuse = MAT_REUSE_MATRIX;
3566fa7f1dd8SStefano Zampini     } else {
35676e683305SStefano Zampini       coarse_mat_reuse = MAT_INITIAL_MATRIX;
3568fa7f1dd8SStefano Zampini     }
3569c8587f34SStefano Zampini     if (isbddc || isnn) {
357070cf5478SStefano Zampini       if (!pcbddc->coarse_subassembling) { /* subassembling info is not present */
357128143c3dSStefano Zampini         ierr = MatISGetSubassemblingPattern(coarse_mat_is,active_procs/pcbddc->coarsening_ratio,PETSC_TRUE,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
357222b6e8a2SStefano Zampini         if (pcbddc->dbg_flag) {
35736e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
35746e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Subassembling pattern\n");CHKERRQ(ierr);
35756e683305SStefano Zampini           ierr = ISView(pcbddc->coarse_subassembling,dbg_viewer);CHKERRQ(ierr);
35766e683305SStefano Zampini           ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
357722b6e8a2SStefano Zampini         }
357870cf5478SStefano Zampini       }
35796e683305SStefano Zampini       ierr = MatISSubassemble(coarse_mat_is,pcbddc->coarse_subassembling,0,PETSC_FALSE,coarse_mat_reuse,&coarse_mat,0,NULL);CHKERRQ(ierr);
358070cf5478SStefano Zampini     } else {
35812e1e5fa4SStefano Zampini       ierr = MatISGetMPIXAIJ(coarse_mat_is,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
3582c8587f34SStefano Zampini     }
3583c8587f34SStefano Zampini     ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
3584c8587f34SStefano Zampini 
3585c8587f34SStefano Zampini     /* propagate symmetry info to coarse matrix */
3586b9d89cd5SStefano Zampini     ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pcbddc->issym);CHKERRQ(ierr);
35875a16e3a0SStefano Zampini     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
3588c8587f34SStefano Zampini 
35896e683305SStefano Zampini     /* set operators */
35905f76c7aeSStefano Zampini     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
35916e683305SStefano Zampini     if (pcbddc->dbg_flag) {
35926e683305SStefano Zampini       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
35936e683305SStefano Zampini     }
35946e683305SStefano Zampini   } else { /* processes non partecipating to coarse solver (if any) */
35956e683305SStefano Zampini     coarse_mat = 0;
35966e683305SStefano Zampini   }
35976e683305SStefano Zampini   ierr = PetscFree(isarray);CHKERRQ(ierr);
3598b9b85e73SStefano Zampini #if 0
3599b9b85e73SStefano Zampini   {
3600b9b85e73SStefano Zampini     PetscViewer viewer;
3601b9b85e73SStefano Zampini     char filename[256];
3602b9b85e73SStefano Zampini     sprintf(filename,"coarse_mat.m");
3603b9b85e73SStefano Zampini     ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,filename,&viewer);CHKERRQ(ierr);
3604b9b85e73SStefano Zampini     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
3605b9b85e73SStefano Zampini     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
3606b9b85e73SStefano Zampini     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
3607b9b85e73SStefano Zampini   }
3608b9b85e73SStefano Zampini #endif
3609c8587f34SStefano Zampini 
3610c8587f34SStefano Zampini   /* Compute coarse null space (special handling by BDDC only) */
3611c8587f34SStefano Zampini   if (pcbddc->NullSpace) {
3612c8587f34SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCoarse(pc,coarse_mat,&CoarseNullSpace);CHKERRQ(ierr);
361398a51de6SStefano Zampini   }
361498a51de6SStefano Zampini 
361598a51de6SStefano Zampini   if (pcbddc->coarse_ksp) {
361698a51de6SStefano Zampini     Vec crhs,csol;
361798a51de6SStefano Zampini     PetscBool ispreonly;
361898a51de6SStefano Zampini     if (CoarseNullSpace) {
3619c8587f34SStefano Zampini       if (isbddc) {
3620c8587f34SStefano Zampini         ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
3621c8587f34SStefano Zampini       } else {
3622c8587f34SStefano Zampini         ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
3623c8587f34SStefano Zampini       }
3624c8587f34SStefano Zampini     }
3625f9eb5b7dSStefano Zampini     /* setup coarse ksp */
3626f9eb5b7dSStefano Zampini     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
3627f347579bSStefano Zampini     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
3628f347579bSStefano Zampini     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
36296e683305SStefano Zampini     /* hack */
3630f347579bSStefano Zampini     if (!csol) {
3631f347579bSStefano Zampini       ierr = MatGetVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
3632f9eb5b7dSStefano Zampini     }
3633f347579bSStefano Zampini     if (!crhs) {
3634f347579bSStefano Zampini       ierr = MatGetVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
3635f347579bSStefano Zampini     }
3636cbcc2c2aSStefano Zampini     /* Check coarse problem if in debug mode or if solving with an iterative method */
3637cbcc2c2aSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
36386e683305SStefano Zampini     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
3639c8587f34SStefano Zampini       KSP       check_ksp;
36402b510759SStefano Zampini       KSPType   check_ksp_type;
3641c8587f34SStefano Zampini       PC        check_pc;
36426e683305SStefano Zampini       Vec       check_vec,coarse_vec;
36436a1308c2SStefano Zampini       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
36442b510759SStefano Zampini       PetscInt  its;
36456e683305SStefano Zampini       PetscBool compute_eigs;
36466e683305SStefano Zampini       PetscReal *eigs_r,*eigs_c;
36476e683305SStefano Zampini       PetscInt  neigs;
36488e185a42SStefano Zampini       const char *prefix;
3649c8587f34SStefano Zampini 
36502b510759SStefano Zampini       /* Create ksp object suitable for estimation of extreme eigenvalues */
36516e683305SStefano Zampini       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
365223ee1639SBarry Smith       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
3653f4ddd8eeSStefano Zampini       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
36542b510759SStefano Zampini       if (ispreonly) {
36552b510759SStefano Zampini         check_ksp_type = KSPPREONLY;
36566e683305SStefano Zampini         compute_eigs = PETSC_FALSE;
36572b510759SStefano Zampini       } else {
3658cbcc2c2aSStefano Zampini         check_ksp_type = KSPGMRES;
36596e683305SStefano Zampini         compute_eigs = PETSC_TRUE;
3660c8587f34SStefano Zampini       }
3661c8587f34SStefano Zampini       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
36626e683305SStefano Zampini       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
36636e683305SStefano Zampini       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
36646e683305SStefano Zampini       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
3665a7dc3881SStefano Zampini       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
3666a7dc3881SStefano Zampini       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
3667a7dc3881SStefano Zampini       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
3668a7dc3881SStefano Zampini       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
3669c8587f34SStefano Zampini       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
3670c8587f34SStefano Zampini       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
3671c8587f34SStefano Zampini       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
3672c8587f34SStefano Zampini       /* create random vec */
36736e683305SStefano Zampini       ierr = KSPGetSolution(pcbddc->coarse_ksp,&coarse_vec);CHKERRQ(ierr);
36746e683305SStefano Zampini       ierr = VecDuplicate(coarse_vec,&check_vec);CHKERRQ(ierr);
3675c8587f34SStefano Zampini       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
3676c8587f34SStefano Zampini       if (CoarseNullSpace) {
3677c8587f34SStefano Zampini         ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec);CHKERRQ(ierr);
3678c8587f34SStefano Zampini       }
36796e683305SStefano Zampini       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
3680c8587f34SStefano Zampini       /* solve coarse problem */
36816e683305SStefano Zampini       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
3682c8587f34SStefano Zampini       if (CoarseNullSpace) {
36836e683305SStefano Zampini         ierr = MatNullSpaceRemove(CoarseNullSpace,coarse_vec);CHKERRQ(ierr);
3684c8587f34SStefano Zampini       }
3685cbcc2c2aSStefano Zampini       /* set eigenvalue estimation if preonly has not been requested */
36866e683305SStefano Zampini       if (compute_eigs) {
36876e683305SStefano Zampini         ierr = PetscMalloc((pcbddc->coarse_size+1)*sizeof(PetscReal),&eigs_r);CHKERRQ(ierr);
36886e683305SStefano Zampini         ierr = PetscMalloc((pcbddc->coarse_size+1)*sizeof(PetscReal),&eigs_c);CHKERRQ(ierr);
36896e683305SStefano Zampini         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
36906e683305SStefano Zampini         lambda_max = eigs_r[neigs-1];
36916e683305SStefano Zampini         lambda_min = eigs_r[0];
36926e683305SStefano Zampini         if (pcbddc->use_coarse_estimates) {
36936e683305SStefano Zampini           if (lambda_max>lambda_min) {
3694cbcc2c2aSStefano Zampini             ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max,lambda_min);CHKERRQ(ierr);
3695cbcc2c2aSStefano Zampini             ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
3696cbcc2c2aSStefano Zampini           }
3697c8587f34SStefano Zampini         }
3698c8587f34SStefano Zampini       }
3699cbcc2c2aSStefano Zampini 
3700c8587f34SStefano Zampini       /* check coarse problem residual error */
37016e683305SStefano Zampini       if (pcbddc->dbg_flag) {
37026e683305SStefano Zampini         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
37036e683305SStefano Zampini         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
37046e683305SStefano Zampini         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
3705c8587f34SStefano Zampini         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
37066e683305SStefano Zampini         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
37076e683305SStefano Zampini         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
3708c8587f34SStefano Zampini         ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
37096e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (%d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
37106e683305SStefano Zampini         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
37116e683305SStefano Zampini         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
37126e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
37136e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
37146e683305SStefano Zampini         if (compute_eigs) {
37156e683305SStefano Zampini           PetscReal lambda_max_s,lambda_min_s;
3716c8587f34SStefano Zampini           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
37176e683305SStefano Zampini           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
37186e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem eigenvalues (estimated with %d iterations of %s): %1.6e %1.6e (%1.6e %1.6e)\n",its,check_ksp_type,lambda_min,lambda_max,lambda_min_s,lambda_max_s);CHKERRQ(ierr);
37196e683305SStefano Zampini           for (i=0;i<neigs;i++) {
37206e683305SStefano Zampini             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
3721c8587f34SStefano Zampini           }
37226e683305SStefano Zampini         }
37236e683305SStefano Zampini         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
37246e683305SStefano Zampini         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
37256e683305SStefano Zampini       }
3726c8587f34SStefano Zampini       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
37276e683305SStefano Zampini       if (compute_eigs) {
37286e683305SStefano Zampini         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
37296e683305SStefano Zampini         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
3730c8587f34SStefano Zampini       }
37316e683305SStefano Zampini     }
37326e683305SStefano Zampini   }
3733cbcc2c2aSStefano Zampini   /* print additional info */
3734cbcc2c2aSStefano Zampini   if (pcbddc->dbg_flag) {
37356e683305SStefano Zampini     /* waits until all processes reaches this point */
37366e683305SStefano Zampini     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
3737cbcc2c2aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
3738cbcc2c2aSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3739cbcc2c2aSStefano Zampini   }
3740cbcc2c2aSStefano Zampini 
37412b510759SStefano Zampini   /* free memory */
3742c8587f34SStefano Zampini   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
3743fdc635d7SStefano Zampini   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
3744c8587f34SStefano Zampini   PetscFunctionReturn(0);
3745c8587f34SStefano Zampini }
3746674ae819SStefano Zampini 
3747f34684f1SStefano Zampini #undef __FUNCT__
3748f34684f1SStefano Zampini #define __FUNCT__ "PCBDDCComputePrimalNumbering"
3749f34684f1SStefano Zampini PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
3750f34684f1SStefano Zampini {
3751f34684f1SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3752f34684f1SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
3753f34684f1SStefano Zampini   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
3754727cdba6SStefano Zampini   PetscInt       i,coarse_size;
3755727cdba6SStefano Zampini   PetscInt       *local_primal_indices;
3756f34684f1SStefano Zampini   PetscErrorCode ierr;
3757f34684f1SStefano Zampini 
3758f34684f1SStefano Zampini   PetscFunctionBegin;
3759f34684f1SStefano Zampini   /* Compute global number of coarse dofs */
376089c96988SStefano Zampini   if (!pcbddc->primal_indices_local_idxs && pcbddc->local_primal_size) {
376189c96988SStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Local primal indices have not been created");
3762727cdba6SStefano Zampini   }
3763727cdba6SStefano 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);
3764f34684f1SStefano Zampini 
3765f34684f1SStefano Zampini   /* check numbering */
3766f34684f1SStefano Zampini   if (pcbddc->dbg_flag) {
3767f34684f1SStefano Zampini     PetscScalar coarsesum,*array;
3768b9b85e73SStefano Zampini     PetscBool set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
3769f34684f1SStefano Zampini 
3770f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3771f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3772f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
37730fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
3774f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
3775f34684f1SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
3776727cdba6SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
3777f34684f1SStefano Zampini     }
3778f34684f1SStefano Zampini     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
3779f34684f1SStefano Zampini     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
3780f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3781f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3782f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3783f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3784f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3785f34684f1SStefano Zampini     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3786f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3787f34684f1SStefano Zampini       if (array[i] == 1.0) {
3788b9b85e73SStefano Zampini         set_error = PETSC_TRUE;
3789f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %d owned by a single process!\n",PetscGlobalRank,i);CHKERRQ(ierr);
3790f34684f1SStefano Zampini       }
3791f34684f1SStefano Zampini     }
3792b9b85e73SStefano Zampini     ierr = MPI_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3793f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3794f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3795f34684f1SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
3796f34684f1SStefano Zampini     }
3797f34684f1SStefano Zampini     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3798f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3799f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3800f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3801f34684f1SStefano Zampini     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
3802f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
3803b9b85e73SStefano Zampini     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
3804f34684f1SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
3805f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3806f34684f1SStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
3807f34684f1SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
3808727cdba6SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_primal_indices[%d]=%d (%d)\n",i,local_primal_indices[i],pcbddc->primal_indices_local_idxs[i]);
3809f34684f1SStefano Zampini       }
3810f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3811f34684f1SStefano Zampini     }
3812f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3813b9b85e73SStefano Zampini     if (set_error_reduced) {
3814b9b85e73SStefano Zampini       SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
3815b9b85e73SStefano Zampini     }
3816f34684f1SStefano Zampini   }
3817f34684f1SStefano Zampini   /* get back data */
3818f34684f1SStefano Zampini   *coarse_size_n = coarse_size;
3819f34684f1SStefano Zampini   *local_primal_indices_n = local_primal_indices;
3820674ae819SStefano Zampini   PetscFunctionReturn(0);
3821674ae819SStefano Zampini }
3822674ae819SStefano Zampini 
3823e456f2a8SStefano Zampini #undef __FUNCT__
3824e456f2a8SStefano Zampini #define __FUNCT__ "PCBDDCGlobalToLocal"
3825a7dc3881SStefano Zampini PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
3826e456f2a8SStefano Zampini {
3827e456f2a8SStefano Zampini   IS             localis_t;
3828a7dc3881SStefano Zampini   PetscInt       i,lsize,*idxs,n;
3829e456f2a8SStefano Zampini   PetscScalar    *vals;
3830e456f2a8SStefano Zampini   PetscErrorCode ierr;
3831e456f2a8SStefano Zampini 
3832e456f2a8SStefano Zampini   PetscFunctionBegin;
3833a7dc3881SStefano Zampini   /* get indices in local ordering exploiting local to global map */
3834e456f2a8SStefano Zampini   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
3835e456f2a8SStefano Zampini   ierr = PetscMalloc(lsize*sizeof(PetscScalar),&vals);CHKERRQ(ierr);
3836e456f2a8SStefano Zampini   for (i=0;i<lsize;i++) vals[i] = 1.0;
3837e456f2a8SStefano Zampini   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
3838a7dc3881SStefano Zampini   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
3839a7dc3881SStefano Zampini   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
38401035eff8SStefano Zampini   if (idxs) { /* multilevel guard */
3841a7dc3881SStefano Zampini     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
38421035eff8SStefano Zampini   }
3843a7dc3881SStefano Zampini   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
3844e456f2a8SStefano Zampini   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
3845e456f2a8SStefano Zampini   ierr = PetscFree(vals);CHKERRQ(ierr);
3846a7dc3881SStefano Zampini   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
3847a7dc3881SStefano Zampini   /* now compute set in local ordering */
3848a7dc3881SStefano Zampini   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3849a7dc3881SStefano Zampini   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3850a7dc3881SStefano Zampini   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
3851a7dc3881SStefano Zampini   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
3852a7dc3881SStefano Zampini   for (i=0,lsize=0;i<n;i++) {
3853ff92baa0SMatthew G. Knepley     if (PetscRealPart(vals[i]) > 0.5) {
3854e456f2a8SStefano Zampini       lsize++;
3855e456f2a8SStefano Zampini     }
3856e456f2a8SStefano Zampini   }
3857e456f2a8SStefano Zampini   ierr = PetscMalloc(lsize*sizeof(PetscInt),&idxs);CHKERRQ(ierr);
3858a7dc3881SStefano Zampini   for (i=0,lsize=0;i<n;i++) {
3859ff92baa0SMatthew G. Knepley     if (PetscRealPart(vals[i]) > 0.5) {
3860e456f2a8SStefano Zampini       idxs[lsize++] = i;
3861e456f2a8SStefano Zampini     }
3862e456f2a8SStefano Zampini   }
3863a7dc3881SStefano Zampini   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
3864a7dc3881SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
3865e456f2a8SStefano Zampini   *localis = localis_t;
3866e456f2a8SStefano Zampini   PetscFunctionReturn(0);
3867e456f2a8SStefano Zampini }
3868