xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision fa7f1dd8e278332e434e1b3656065318d124c448)
1674ae819SStefano Zampini #include "bddc.h"
2674ae819SStefano Zampini #include "bddcprivate.h"
3674ae819SStefano Zampini #include <petscblaslapack.h>
4674ae819SStefano Zampini 
5674ae819SStefano Zampini #undef __FUNCT__
6c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpSolvers"
7c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpSolvers(PC pc)
8c8587f34SStefano Zampini {
9c8587f34SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
108629588bSStefano Zampini   PetscScalar    *coarse_submat_vals;
11c8587f34SStefano Zampini   PetscErrorCode ierr;
12c8587f34SStefano Zampini 
13c8587f34SStefano Zampini   PetscFunctionBegin;
14c8587f34SStefano Zampini   /* Compute matrix after change of basis and extract local submatrices */
15c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalMatrices(pc);CHKERRQ(ierr);
16c8587f34SStefano Zampini 
17f4ddd8eeSStefano Zampini   /* Setup local scatters R_to_B and (optionally) R_to_D */
18f4ddd8eeSStefano Zampini   /* PCBDDCSetUpLocalWorkVectors and PCBDDCSetUpLocalMatrices should be called first! */
19c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
20c8587f34SStefano Zampini 
21c8587f34SStefano Zampini   /* Setup local solvers ksp_D and ksp_R */
22c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalSolvers(pc);CHKERRQ(ierr);
23c8587f34SStefano Zampini 
24c8587f34SStefano Zampini   /* Change global null space passed in by the user if change of basis has been requested */
25c8587f34SStefano Zampini   if (pcbddc->NullSpace && pcbddc->use_change_of_basis) {
26c8587f34SStefano Zampini     ierr = PCBDDCNullSpaceAdaptGlobal(pc);CHKERRQ(ierr);
27c8587f34SStefano Zampini   }
28c8587f34SStefano Zampini 
298629588bSStefano Zampini   /*
308629588bSStefano Zampini      Setup local correction and local part of coarse basis.
318629588bSStefano Zampini      Gives back the dense local part of the coarse matrix in column major ordering
328629588bSStefano Zampini   */
3347f4ddc3SStefano Zampini   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
348629588bSStefano Zampini 
358629588bSStefano Zampini   /* Compute total number of coarse nodes and setup coarse solver */
368629588bSStefano Zampini   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
378629588bSStefano Zampini 
388629588bSStefano Zampini   /* free */
398629588bSStefano Zampini   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
40c8587f34SStefano Zampini   PetscFunctionReturn(0);
41c8587f34SStefano Zampini }
42c8587f34SStefano Zampini 
43c8587f34SStefano Zampini #undef __FUNCT__
44674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetCustomization"
45674ae819SStefano Zampini PetscErrorCode PCBDDCResetCustomization(PC pc)
46674ae819SStefano Zampini {
47674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
48674ae819SStefano Zampini   PetscInt       i;
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);
56674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
57674ae819SStefano Zampini   for (i=0;i<pcbddc->n_ISForDofs;i++) {
58674ae819SStefano Zampini     ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
59674ae819SStefano Zampini   }
60674ae819SStefano Zampini   ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
619577ea80SStefano Zampini   pcbddc->n_ISForDofs = 0;
62f4ddd8eeSStefano Zampini   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
63f4ddd8eeSStefano Zampini   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
64674ae819SStefano Zampini   PetscFunctionReturn(0);
65674ae819SStefano Zampini }
66674ae819SStefano Zampini 
67674ae819SStefano Zampini #undef __FUNCT__
68674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetTopography"
69674ae819SStefano Zampini PetscErrorCode PCBDDCResetTopography(PC pc)
70674ae819SStefano Zampini {
71674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
72674ae819SStefano Zampini   PetscErrorCode ierr;
73674ae819SStefano Zampini 
74674ae819SStefano Zampini   PetscFunctionBegin;
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);
111674ae819SStefano Zampini   PetscFunctionReturn(0);
112674ae819SStefano Zampini }
113674ae819SStefano Zampini 
114674ae819SStefano Zampini #undef __FUNCT__
115f4ddd8eeSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalWorkVectors"
116f4ddd8eeSStefano Zampini PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
1176bfb1811SStefano Zampini {
1186bfb1811SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1196bfb1811SStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
1206bfb1811SStefano Zampini   VecType        impVecType;
121e7b262bdSStefano Zampini   PetscInt       n_vertices,n_constraints,local_primal_size,n_R,old_size;
1226bfb1811SStefano Zampini   PetscErrorCode ierr;
1236bfb1811SStefano Zampini 
1246bfb1811SStefano Zampini   PetscFunctionBegin;
125f4ddd8eeSStefano Zampini   if (!pcbddc->ConstraintMatrix) {
126f4ddd8eeSStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Constraint matrix has not been created");
127f4ddd8eeSStefano Zampini   }
128e7b262bdSStefano Zampini   /* get sizes */
129e7b262bdSStefano Zampini   ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,NULL);CHKERRQ(ierr);
130f4ddd8eeSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,NULL);CHKERRQ(ierr);
131e7b262bdSStefano Zampini   n_constraints = local_primal_size - n_vertices;
1326bfb1811SStefano Zampini   n_R = pcis->n-n_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   }
153e7b262bdSStefano Zampini   if (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);
1566bfb1811SStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,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;
18988ebb749SStefano Zampini   ISLocalToGlobalMapping BtoNmap;
19025084f0cSStefano Zampini   PetscScalar            *coarse_submat_vals; /* TODO: use a PETSc matrix */
19125084f0cSStefano Zampini   const PetscScalar      *array,*row_cmat_values;
19225084f0cSStefano Zampini   const PetscInt         *row_cmat_indices,*idx_R_local;
19325084f0cSStefano Zampini   PetscInt               *vertices,*idx_V_B,*auxindices;
19425084f0cSStefano Zampini   PetscInt               n_vertices,n_constraints,size_of_constraint;
19525084f0cSStefano Zampini   PetscInt               i,j,n_R,n_D,n_B;
19688ebb749SStefano Zampini   PetscBool              setsym=PETSC_FALSE,issym=PETSC_FALSE;
19745a1bb75SStefano Zampini   /* matrix type (vector type propagated downstream from vec1_C and local matrix type) */
19888ebb749SStefano Zampini   MatType                impMatType;
19925084f0cSStefano Zampini   /* some shortcuts to scalars */
20025084f0cSStefano Zampini   PetscScalar            zero=0.0,one=1.0,m_one=-1.0;
20125084f0cSStefano Zampini   /* for debugging purposes */
20288ebb749SStefano Zampini   PetscReal              *coarsefunctions_errors,*constraints_errors;
20388ebb749SStefano Zampini 
20488ebb749SStefano Zampini   PetscFunctionBegin;
20525084f0cSStefano Zampini   /* get number of vertices and their local indices */
20625084f0cSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
20788ebb749SStefano Zampini   n_constraints = pcbddc->local_primal_size-n_vertices;
20888ebb749SStefano Zampini   /* Set Non-overlapping dimensions */
20988ebb749SStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
21088ebb749SStefano Zampini   n_R = pcis->n-n_vertices;
21188ebb749SStefano Zampini 
21288ebb749SStefano Zampini   /* Set types for local objects needed by BDDC precondtioner */
21388ebb749SStefano Zampini   impMatType = MATSEQDENSE;
21488ebb749SStefano Zampini 
21588ebb749SStefano Zampini   /* Allocating some extra storage just to be safe */
21688ebb749SStefano Zampini   ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&auxindices);CHKERRQ(ierr);
21788ebb749SStefano Zampini   for (i=0;i<pcis->n;i++) auxindices[i]=i;
21888ebb749SStefano Zampini 
21988ebb749SStefano Zampini   /* vertices in boundary numbering */
22088ebb749SStefano Zampini   ierr = PetscMalloc(n_vertices*sizeof(PetscInt),&idx_V_B);CHKERRQ(ierr);
22188ebb749SStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(pcis->is_B_local,&BtoNmap);CHKERRQ(ierr);
22288ebb749SStefano Zampini   ierr = ISGlobalToLocalMappingApply(BtoNmap,IS_GTOLM_DROP,n_vertices,vertices,&i,idx_V_B);CHKERRQ(ierr);
22388ebb749SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&BtoNmap);CHKERRQ(ierr);
22488ebb749SStefano Zampini   if (i != n_vertices) {
22588ebb749SStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %d != %d\n",n_vertices,i);
22688ebb749SStefano Zampini   }
22788ebb749SStefano Zampini 
22888ebb749SStefano Zampini   /* Precompute stuffs needed for preprocessing and application of BDDC*/
22988ebb749SStefano Zampini   if (n_constraints) {
230f4ddd8eeSStefano Zampini     /* see if we can save some allocations */
231f4ddd8eeSStefano Zampini     if (pcbddc->local_auxmat2) {
232f4ddd8eeSStefano Zampini       PetscInt on_R,on_constraints;
233f4ddd8eeSStefano Zampini       ierr = MatGetSize(pcbddc->local_auxmat2,&on_R,&on_constraints);CHKERRQ(ierr);
234f4ddd8eeSStefano Zampini       if (on_R != n_R || on_constraints != n_constraints) {
235f4ddd8eeSStefano Zampini         ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
236f4ddd8eeSStefano Zampini         ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
237f4ddd8eeSStefano Zampini       }
238f4ddd8eeSStefano Zampini     }
23945a1bb75SStefano Zampini     /* work vectors */
24045a1bb75SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec1_C);CHKERRQ(ierr);
24145a1bb75SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec2_C);CHKERRQ(ierr);
24245a1bb75SStefano Zampini     /* auxiliary matrices */
243f4ddd8eeSStefano Zampini     if (!pcbddc->local_auxmat2) {
24488ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->local_auxmat2);CHKERRQ(ierr);
24525084f0cSStefano Zampini       ierr = MatSetSizes(pcbddc->local_auxmat2,n_R,n_constraints,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
24688ebb749SStefano Zampini       ierr = MatSetType(pcbddc->local_auxmat2,impMatType);CHKERRQ(ierr);
24725084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->local_auxmat2);CHKERRQ(ierr);
248f4ddd8eeSStefano Zampini     }
24988ebb749SStefano Zampini 
25025084f0cSStefano Zampini     /* Extract constraints on R nodes: C_{CR}  */
25125084f0cSStefano Zampini     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
2528ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
25325084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
25488ebb749SStefano Zampini 
25588ebb749SStefano Zampini     /* Assemble local_auxmat2 = - A_{RR}^{-1} C^T_{CR} needed by BDDC application */
25688ebb749SStefano Zampini     for (i=0;i<n_constraints;i++) {
25788ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
25888ebb749SStefano Zampini       /* Get row of constraint matrix in R numbering */
25925084f0cSStefano Zampini       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
26025084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_R,size_of_constraint,row_cmat_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
26125084f0cSStefano Zampini       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
26225084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_R);CHKERRQ(ierr);
26325084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_R);CHKERRQ(ierr);
26488ebb749SStefano Zampini       /* Solve for row of constraint matrix in R numbering */
26588ebb749SStefano Zampini       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
26625084f0cSStefano Zampini       /* Set values in local_auxmat2 */
26725084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
26888ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->local_auxmat2,n_R,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
26925084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
27088ebb749SStefano Zampini     }
27188ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
27288ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
27325084f0cSStefano Zampini     ierr = MatScale(pcbddc->local_auxmat2,m_one);CHKERRQ(ierr);
27488ebb749SStefano Zampini 
27588ebb749SStefano Zampini     /* Assemble explicitly M1 = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1} needed in preproc  */
27625084f0cSStefano Zampini     ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
27725084f0cSStefano Zampini     ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
27888ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&M1);CHKERRQ(ierr);
27988ebb749SStefano Zampini     ierr = MatSetSizes(M1,n_constraints,n_constraints,n_constraints,n_constraints);CHKERRQ(ierr);
28088ebb749SStefano Zampini     ierr = MatSetType(M1,impMatType);CHKERRQ(ierr);
28125084f0cSStefano Zampini     ierr = MatSetUp(M1);CHKERRQ(ierr);
28225084f0cSStefano Zampini     ierr = MatDuplicate(M1,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
28325084f0cSStefano Zampini     ierr = MatZeroEntries(M2);CHKERRQ(ierr);
28425084f0cSStefano Zampini     ierr = VecSet(vec1_C,m_one);CHKERRQ(ierr);
28525084f0cSStefano Zampini     ierr = MatDiagonalSet(M2,vec1_C,INSERT_VALUES);CHKERRQ(ierr);
28625084f0cSStefano Zampini     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
28725084f0cSStefano Zampini     ierr = MatDestroy(&M2);CHKERRQ(ierr);
28825084f0cSStefano Zampini     ierr = MatDestroy(&M3);CHKERRQ(ierr);
28988ebb749SStefano Zampini     /* Assemble local_auxmat1 = M1*C_{CR} needed by BDDC application in KSP and in preproc */
290f4ddd8eeSStefano Zampini     if (!pcbddc->local_auxmat1) {
29188ebb749SStefano Zampini       ierr = MatMatMult(M1,C_CR,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
292f4ddd8eeSStefano Zampini     } else {
293f4ddd8eeSStefano Zampini       ierr = MatMatMult(M1,C_CR,MAT_REUSE_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
294f4ddd8eeSStefano Zampini     }
29588ebb749SStefano Zampini   }
29688ebb749SStefano Zampini 
29788ebb749SStefano Zampini   /* Get submatrices from subdomain matrix */
29888ebb749SStefano Zampini   if (n_vertices) {
2993a50541eSStefano Zampini     PetscInt ibs,mbs;
3003a50541eSStefano Zampini     PetscBool issbaij;
301af732b37SStefano Zampini     Mat newmat;
3023a50541eSStefano Zampini 
3033a50541eSStefano Zampini     ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
3049577ea80SStefano Zampini     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
3059577ea80SStefano Zampini     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
3063a50541eSStefano Zampini     if (ibs != mbs) { /* need to convert to SEQAIJ */
3079577ea80SStefano Zampini       ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
3089577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3099577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3109577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3119577ea80SStefano Zampini       ierr = MatDestroy(&newmat);CHKERRQ(ierr);
3129577ea80SStefano Zampini     } else {
3133a50541eSStefano Zampini       /* this is safe */
3149577ea80SStefano Zampini       ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3153a50541eSStefano Zampini       ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
3163a50541eSStefano Zampini       if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
3173a50541eSStefano Zampini         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
31845a1bb75SStefano Zampini         /* which of the two approaches is faster? */
3193a50541eSStefano Zampini         /* ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3203a50541eSStefano Zampini         ierr = MatCreateTranspose(A_RV,&A_VR);CHKERRQ(ierr);*/
3213a50541eSStefano Zampini         ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3223a50541eSStefano Zampini         ierr = MatCreateTranspose(A_VR,&A_RV);CHKERRQ(ierr);
3233a50541eSStefano Zampini         ierr = MatDestroy(&newmat);CHKERRQ(ierr);
3243a50541eSStefano Zampini       } else {
3259577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3269577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3279577ea80SStefano Zampini       }
3283a50541eSStefano Zampini     }
32945a1bb75SStefano Zampini     ierr = MatGetVecs(A_RV,&vec1_V,NULL);CHKERRQ(ierr);
33045a1bb75SStefano Zampini     ierr = VecDuplicate(vec1_V,&vec2_V);CHKERRQ(ierr);
33125084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
33288ebb749SStefano Zampini   }
33388ebb749SStefano Zampini 
33488ebb749SStefano Zampini   /* Matrix of coarse basis functions (local) */
335f4ddd8eeSStefano Zampini   if (pcbddc->coarse_phi_B) {
336f4ddd8eeSStefano Zampini     PetscInt on_B,on_primal;
337f4ddd8eeSStefano Zampini     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
338f4ddd8eeSStefano Zampini     if (on_B != n_B || on_primal != pcbddc->local_primal_size) {
339f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
340f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
341f4ddd8eeSStefano Zampini     }
342f4ddd8eeSStefano Zampini   }
343f4ddd8eeSStefano Zampini   if (pcbddc->coarse_phi_D) {
344f4ddd8eeSStefano Zampini     PetscInt on_D,on_primal;
345f4ddd8eeSStefano Zampini     ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,&on_primal);CHKERRQ(ierr);
346f4ddd8eeSStefano Zampini     if (on_D != n_D || on_primal != pcbddc->local_primal_size) {
347f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
348f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
349f4ddd8eeSStefano Zampini     }
350f4ddd8eeSStefano Zampini   }
351f4ddd8eeSStefano Zampini   if (!pcbddc->coarse_phi_B) {
35288ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
35388ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_phi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
35488ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_phi_B,impMatType);CHKERRQ(ierr);
35525084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_phi_B);CHKERRQ(ierr);
356f4ddd8eeSStefano Zampini   }
357f4ddd8eeSStefano Zampini   if ( (pcbddc->switch_static || pcbddc->dbg_flag) && !pcbddc->coarse_phi_D ) {
35888ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
35988ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_phi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
36088ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_phi_D,impMatType);CHKERRQ(ierr);
36125084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_phi_D);CHKERRQ(ierr);
36288ebb749SStefano Zampini   }
36388ebb749SStefano Zampini 
36425084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
3658ce42a96SStefano Zampini     ierr = ISGetIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
36688ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*coarsefunctions_errors),&coarsefunctions_errors);CHKERRQ(ierr);
36788ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*constraints_errors),&constraints_errors);CHKERRQ(ierr);
36888ebb749SStefano Zampini   }
36988ebb749SStefano Zampini   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
37088ebb749SStefano Zampini   ierr = PetscMalloc((pcbddc->local_primal_size)*(pcbddc->local_primal_size)*sizeof(PetscScalar),&coarse_submat_vals);CHKERRQ(ierr);
37188ebb749SStefano Zampini 
37288ebb749SStefano Zampini   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
37325084f0cSStefano Zampini 
37425084f0cSStefano Zampini   /* vertices */
37588ebb749SStefano Zampini   for (i=0;i<n_vertices;i++) {
37645a1bb75SStefano Zampini     /* this should not be needed, but MatMult_BAIJ is broken when using compressed row routines */
377f4ddd8eeSStefano Zampini     ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr); /* TODO: REMOVE IT */
37888ebb749SStefano Zampini     ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
37988ebb749SStefano Zampini     ierr = VecSetValue(vec1_V,i,one,INSERT_VALUES);CHKERRQ(ierr);
38088ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
38188ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
38225084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on constraints multipliers */
38388ebb749SStefano Zampini     ierr = MatMult(A_RV,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
38488ebb749SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
38588ebb749SStefano Zampini     ierr = VecScale(pcbddc->vec1_R,m_one);CHKERRQ(ierr);
38688ebb749SStefano Zampini     if (n_constraints) {
38788ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec1_R,vec1_C);CHKERRQ(ierr);
38888ebb749SStefano Zampini       ierr = MatMultAdd(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
38988ebb749SStefano Zampini       ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
39088ebb749SStefano Zampini     }
39188ebb749SStefano Zampini     ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
39288ebb749SStefano Zampini     ierr = MatMultAdd(A_VV,vec1_V,vec2_V,vec2_V);CHKERRQ(ierr);
39388ebb749SStefano Zampini 
39488ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
39588ebb749SStefano Zampini     /* coarse basis functions */
39688ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
39788ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
39888ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
39925084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
40088ebb749SStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
40125084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
40288ebb749SStefano Zampini     ierr = MatSetValue(pcbddc->coarse_phi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
4038eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
40488ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40588ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40625084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
40788ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
40825084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
40988ebb749SStefano Zampini     }
41025084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
41125084f0cSStefano Zampini     ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
41225084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
41325084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
41488ebb749SStefano Zampini     if (n_constraints) {
41525084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
41625084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
41725084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
41888ebb749SStefano Zampini     }
41988ebb749SStefano Zampini 
42025084f0cSStefano Zampini     /* check */
42125084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
42225084f0cSStefano Zampini       /* assemble subdomain vector on local nodes */
42388ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
42425084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
42525084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
42625084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
42725084f0cSStefano Zampini       ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
42825084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
42925084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
43088ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers (i.e. primal nodes) */
43188ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
43225084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
43325084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
43425084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
43588ebb749SStefano Zampini       if (n_constraints) {
43625084f0cSStefano Zampini         ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
43725084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
43825084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
43988ebb749SStefano Zampini       }
44025084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
44125084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
44288ebb749SStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
44388ebb749SStefano Zampini       /* check saddle point solution */
44488ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
44588ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
44688ebb749SStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i]);CHKERRQ(ierr);
44788ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
44825084f0cSStefano Zampini       /* shift by the identity matrix */
44925084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
45025084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
45125084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
45288ebb749SStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i]);CHKERRQ(ierr);
45388ebb749SStefano Zampini     }
45488ebb749SStefano Zampini   }
45588ebb749SStefano Zampini 
45625084f0cSStefano Zampini   /* constraints */
45788ebb749SStefano Zampini   for (i=0;i<n_constraints;i++) {
45888ebb749SStefano Zampini     ierr = VecSet(vec2_C,zero);CHKERRQ(ierr);
45988ebb749SStefano Zampini     ierr = VecSetValue(vec2_C,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
46088ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec2_C);CHKERRQ(ierr);
46188ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec2_C);CHKERRQ(ierr);
46225084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on vertices multipliers */
46388ebb749SStefano Zampini     ierr = MatMult(M1,vec2_C,vec1_C);CHKERRQ(ierr);
46488ebb749SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
46588ebb749SStefano Zampini     ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
46625084f0cSStefano Zampini     if (n_vertices) {
46725084f0cSStefano Zampini       ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
46825084f0cSStefano Zampini     }
46988ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
47088ebb749SStefano Zampini     /* coarse basis functions */
47125084f0cSStefano Zampini     j = i+n_vertices; /* don't touch this! */
47288ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
47388ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
47488ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
47525084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
47625084f0cSStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
47725084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
4788eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
47988ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
48088ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
48125084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
48225084f0cSStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
48325084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
48488ebb749SStefano Zampini     }
48525084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
48688ebb749SStefano Zampini     if (n_vertices) {
48725084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
48825084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
48925084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
49088ebb749SStefano Zampini     }
49125084f0cSStefano Zampini     ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
49225084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
49325084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
49488ebb749SStefano Zampini 
49525084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
49688ebb749SStefano Zampini       /* assemble subdomain vector on nodes */
49788ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
49825084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
49925084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
50025084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
50125084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
50225084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
50388ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers */
50488ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
50588ebb749SStefano Zampini       if (n_vertices) {
50625084f0cSStefano Zampini         ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
50725084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
50825084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
50988ebb749SStefano Zampini       }
51025084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
51125084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
51225084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
51325084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
51425084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
51525084f0cSStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
51688ebb749SStefano Zampini       /* check saddle point solution */
51788ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
51888ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
51925084f0cSStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[j]);CHKERRQ(ierr);
52088ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
52125084f0cSStefano Zampini       /* shift by the identity matrix */
52225084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,j,m_one,ADD_VALUES);CHKERRQ(ierr);
52325084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
52425084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
52525084f0cSStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[j]);CHKERRQ(ierr);
52688ebb749SStefano Zampini     }
52788ebb749SStefano Zampini   }
52825084f0cSStefano Zampini   /* call assembling routines for local coarse basis */
52988ebb749SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
53088ebb749SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5318eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
53288ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
53388ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
53488ebb749SStefano Zampini   }
53525084f0cSStefano Zampini 
53688ebb749SStefano Zampini   /* compute other basis functions for non-symmetric problems */
53788ebb749SStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
53888ebb749SStefano Zampini   if (!setsym || (setsym && !issym)) {
539f4ddd8eeSStefano Zampini     if (!pcbddc->coarse_psi_B) {
54088ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
54188ebb749SStefano Zampini       ierr = MatSetSizes(pcbddc->coarse_psi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
54288ebb749SStefano Zampini       ierr = MatSetType(pcbddc->coarse_psi_B,impMatType);CHKERRQ(ierr);
54325084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->coarse_psi_B);CHKERRQ(ierr);
544f4ddd8eeSStefano Zampini     }
545f4ddd8eeSStefano Zampini     if ( (pcbddc->switch_static || pcbddc->dbg_flag) && !pcbddc->coarse_psi_D) {
54688ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
54788ebb749SStefano Zampini       ierr = MatSetSizes(pcbddc->coarse_psi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
54888ebb749SStefano Zampini       ierr = MatSetType(pcbddc->coarse_psi_D,impMatType);CHKERRQ(ierr);
54925084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->coarse_psi_D);CHKERRQ(ierr);
55088ebb749SStefano Zampini     }
55188ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
55288ebb749SStefano Zampini       if (n_constraints) {
55388ebb749SStefano Zampini         ierr = VecSet(vec1_C,zero);CHKERRQ(ierr);
55488ebb749SStefano Zampini         for (j=0;j<n_constraints;j++) {
55525084f0cSStefano Zampini           ierr = VecSetValue(vec1_C,j,coarse_submat_vals[(j+n_vertices)*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
55688ebb749SStefano Zampini         }
55725084f0cSStefano Zampini         ierr = VecAssemblyBegin(vec1_C);CHKERRQ(ierr);
55825084f0cSStefano Zampini         ierr = VecAssemblyEnd(vec1_C);CHKERRQ(ierr);
55988ebb749SStefano Zampini       }
56088ebb749SStefano Zampini       if (i<n_vertices) {
56188ebb749SStefano Zampini         ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
56288ebb749SStefano Zampini         ierr = VecSetValue(vec1_V,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
56388ebb749SStefano Zampini         ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
56488ebb749SStefano Zampini         ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
56588ebb749SStefano Zampini         ierr = MatMultTranspose(A_VR,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
56688ebb749SStefano Zampini         if (n_constraints) {
56788ebb749SStefano Zampini           ierr = MatMultTransposeAdd(C_CR,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
56888ebb749SStefano Zampini         }
56988ebb749SStefano Zampini       } else {
57088ebb749SStefano Zampini         ierr = MatMultTranspose(C_CR,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
57188ebb749SStefano Zampini       }
57288ebb749SStefano Zampini       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
57388ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
57488ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
57588ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
57625084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
57788ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_psi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
57825084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
57988ebb749SStefano Zampini       if (i<n_vertices) {
58088ebb749SStefano Zampini         ierr = MatSetValue(pcbddc->coarse_psi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
58188ebb749SStefano Zampini       }
5828eeda7d8SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
58388ebb749SStefano Zampini         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
58488ebb749SStefano Zampini         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
58525084f0cSStefano Zampini         ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
58688ebb749SStefano Zampini         ierr = MatSetValues(pcbddc->coarse_psi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
58725084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
58888ebb749SStefano Zampini       }
58988ebb749SStefano Zampini 
59025084f0cSStefano Zampini       if (pcbddc->dbg_flag) {
59188ebb749SStefano Zampini         /* assemble subdomain vector on nodes */
59288ebb749SStefano Zampini         ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
59325084f0cSStefano Zampini         ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
59425084f0cSStefano Zampini         ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
59525084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
59625084f0cSStefano Zampini         if (i<n_vertices) {
59725084f0cSStefano Zampini           ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
59888ebb749SStefano Zampini         }
59925084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
60025084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
60125084f0cSStefano Zampini         /* assemble subdomain vector of lagrange multipliers */
60225084f0cSStefano Zampini         for (j=0;j<pcbddc->local_primal_size;j++) {
60325084f0cSStefano Zampini           ierr = VecSetValue(pcbddc->vec1_P,j,-coarse_submat_vals[j*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
60425084f0cSStefano Zampini         }
60525084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
60625084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
60788ebb749SStefano Zampini         /* check saddle point solution */
60888ebb749SStefano Zampini         ierr = MatMultTranspose(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
60988ebb749SStefano Zampini         ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
61088ebb749SStefano Zampini         ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
61188ebb749SStefano Zampini         ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
61225084f0cSStefano Zampini         /* shift by the identity matrix */
61325084f0cSStefano Zampini         ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
61425084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
61525084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
61688ebb749SStefano Zampini         ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
61788ebb749SStefano Zampini       }
61888ebb749SStefano Zampini     }
61988ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
62088ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6218eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
62288ebb749SStefano Zampini       ierr = MatAssemblyBegin(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
62388ebb749SStefano Zampini       ierr = MatAssemblyEnd(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
62488ebb749SStefano Zampini     }
62588ebb749SStefano Zampini   }
62688ebb749SStefano Zampini   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
62788ebb749SStefano Zampini   /* Checking coarse_sub_mat and coarse basis functios */
62888ebb749SStefano Zampini   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
62988ebb749SStefano Zampini   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
63025084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
63188ebb749SStefano Zampini     Mat         coarse_sub_mat;
63225084f0cSStefano Zampini     Mat         AUXMAT,TM1,TM2,TM3,TM4;
63388ebb749SStefano Zampini     Mat         coarse_phi_D,coarse_phi_B;
63488ebb749SStefano Zampini     Mat         coarse_psi_D,coarse_psi_B;
63588ebb749SStefano Zampini     Mat         A_II,A_BB,A_IB,A_BI;
63688ebb749SStefano Zampini     MatType     checkmattype=MATSEQAIJ;
63788ebb749SStefano Zampini     PetscReal   real_value;
63888ebb749SStefano Zampini 
63988ebb749SStefano Zampini     ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
64088ebb749SStefano Zampini     ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
64188ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
64288ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
64388ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
64488ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
64588ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
64688ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
64788ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
64888ebb749SStefano Zampini     }
64988ebb749SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
65088ebb749SStefano Zampini 
65125084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
65225084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat and local basis functions\n");CHKERRQ(ierr);
65325084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
65488ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
65588ebb749SStefano Zampini       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
65688ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
65788ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
65888ebb749SStefano Zampini       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
65988ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
66088ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
66188ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
66288ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
66388ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
66488ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
66588ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
66688ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
66788ebb749SStefano Zampini     } else {
66888ebb749SStefano Zampini       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
66988ebb749SStefano Zampini       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
67088ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
67188ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
67288ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
67388ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
67488ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
67588ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
67688ebb749SStefano Zampini     }
67788ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
67888ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
67988ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
68088ebb749SStefano Zampini     ierr = MatConvert(TM1,MATSEQDENSE,MAT_REUSE_MATRIX,&TM1);CHKERRQ(ierr);
68188ebb749SStefano Zampini     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
68288ebb749SStefano Zampini     ierr = MatNorm(TM1,NORM_INFINITY,&real_value);CHKERRQ(ierr);
68325084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"----------------------------------\n");CHKERRQ(ierr);
68425084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d \n",PetscGlobalRank);CHKERRQ(ierr);
68525084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"matrix error = % 1.14e\n",real_value);CHKERRQ(ierr);
68625084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (phi) errors\n");CHKERRQ(ierr);
68788ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
68825084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,coarsefunctions_errors[i]);CHKERRQ(ierr);
68988ebb749SStefano Zampini     }
69025084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (phi) errors\n");CHKERRQ(ierr);
69188ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
69225084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,constraints_errors[i]);CHKERRQ(ierr);
69388ebb749SStefano Zampini     }
69488ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
69525084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (psi) errors\n");CHKERRQ(ierr);
69688ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
69725084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,coarsefunctions_errors[i]);CHKERRQ(ierr);
69888ebb749SStefano Zampini       }
69925084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (psi) errors\n");CHKERRQ(ierr);
70088ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
70125084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,constraints_errors[i]);CHKERRQ(ierr);
70288ebb749SStefano Zampini       }
70388ebb749SStefano Zampini     }
70425084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
70588ebb749SStefano Zampini     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
70688ebb749SStefano Zampini     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
70788ebb749SStefano Zampini     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
70888ebb749SStefano Zampini     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
70988ebb749SStefano Zampini     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
71088ebb749SStefano Zampini     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
71188ebb749SStefano Zampini     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
71288ebb749SStefano Zampini     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
71388ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
71488ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
71588ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
71688ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
71788ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
71888ebb749SStefano Zampini     }
71988ebb749SStefano Zampini     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
7208ce42a96SStefano Zampini     ierr = ISRestoreIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
72188ebb749SStefano Zampini     ierr = PetscFree(coarsefunctions_errors);CHKERRQ(ierr);
72288ebb749SStefano Zampini     ierr = PetscFree(constraints_errors);CHKERRQ(ierr);
72388ebb749SStefano Zampini   }
72488ebb749SStefano Zampini   /* free memory */
72588ebb749SStefano Zampini   if (n_vertices) {
72688ebb749SStefano Zampini     ierr = PetscFree(vertices);CHKERRQ(ierr);
72788ebb749SStefano Zampini     ierr = VecDestroy(&vec1_V);CHKERRQ(ierr);
72888ebb749SStefano Zampini     ierr = VecDestroy(&vec2_V);CHKERRQ(ierr);
72988ebb749SStefano Zampini     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
73088ebb749SStefano Zampini     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
73188ebb749SStefano Zampini     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
73288ebb749SStefano Zampini   }
73388ebb749SStefano Zampini   if (n_constraints) {
73488ebb749SStefano Zampini     ierr = VecDestroy(&vec1_C);CHKERRQ(ierr);
73588ebb749SStefano Zampini     ierr = VecDestroy(&vec2_C);CHKERRQ(ierr);
73688ebb749SStefano Zampini     ierr = MatDestroy(&M1);CHKERRQ(ierr);
73788ebb749SStefano Zampini     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
73888ebb749SStefano Zampini   }
73988ebb749SStefano Zampini   ierr = PetscFree(auxindices);CHKERRQ(ierr);
7408629588bSStefano Zampini   /* get back data */
7418629588bSStefano Zampini   *coarse_submat_vals_n = coarse_submat_vals;
74288ebb749SStefano Zampini   PetscFunctionReturn(0);
74388ebb749SStefano Zampini }
74488ebb749SStefano Zampini 
74588ebb749SStefano Zampini #undef __FUNCT__
746aa0d41d4SStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalMatrices"
747aa0d41d4SStefano Zampini PetscErrorCode PCBDDCSetUpLocalMatrices(PC pc)
748aa0d41d4SStefano Zampini {
749aa0d41d4SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
750aa0d41d4SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
751aa0d41d4SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
7529577ea80SStefano Zampini   PetscBool         issbaij,isbaij;
753aa0d41d4SStefano Zampini   /* manage repeated solves */
754aa0d41d4SStefano Zampini   MatReuse          reuse;
755aa0d41d4SStefano Zampini   MatStructure      matstruct;
756aa0d41d4SStefano Zampini   PetscErrorCode    ierr;
757aa0d41d4SStefano Zampini 
758aa0d41d4SStefano Zampini   PetscFunctionBegin;
759f4ddd8eeSStefano Zampini   if (pcbddc->use_change_of_basis && !pcbddc->ChangeOfBasisMatrix) {
760f4ddd8eeSStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Change of basis matrix has not been created");
761f4ddd8eeSStefano Zampini   }
762aa0d41d4SStefano Zampini   /* get mat flags */
763aa0d41d4SStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
764aa0d41d4SStefano Zampini   reuse = MAT_INITIAL_MATRIX;
765aa0d41d4SStefano Zampini   if (pc->setupcalled) {
766aa0d41d4SStefano Zampini     /* when matstruct is SAME_PRECONDITIONER, we shouldn't be here */
767aa0d41d4SStefano Zampini     if (matstruct == SAME_PRECONDITIONER) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen");
768aa0d41d4SStefano Zampini     if (matstruct == SAME_NONZERO_PATTERN) {
769aa0d41d4SStefano Zampini       reuse = MAT_REUSE_MATRIX;
770aa0d41d4SStefano Zampini     } else {
771aa0d41d4SStefano Zampini       reuse = MAT_INITIAL_MATRIX;
772aa0d41d4SStefano Zampini     }
773aa0d41d4SStefano Zampini   }
774aa0d41d4SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
775aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
776aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
777aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
778aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BB);CHKERRQ(ierr);
779aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
780aa0d41d4SStefano Zampini   }
781aa0d41d4SStefano Zampini 
782aa0d41d4SStefano Zampini   /* transform local matrices if needed */
783aa0d41d4SStefano Zampini   if (pcbddc->use_change_of_basis) {
784aa0d41d4SStefano Zampini     Mat         change_mat_all;
785aa0d41d4SStefano Zampini     PetscScalar *row_cmat_values;
786aa0d41d4SStefano Zampini     PetscInt    *row_cmat_indices;
787aa0d41d4SStefano Zampini     PetscInt    *nnz,*is_indices,*temp_indices;
788aa0d41d4SStefano Zampini     PetscInt    i,j,k,n_D,n_B;
789aa0d41d4SStefano Zampini 
790aa0d41d4SStefano Zampini     /* Get Non-overlapping dimensions */
791aa0d41d4SStefano Zampini     n_B = pcis->n_B;
792aa0d41d4SStefano Zampini     n_D = pcis->n-n_B;
793aa0d41d4SStefano Zampini 
794aa0d41d4SStefano Zampini     /* compute nonzero structure of change of basis on all local nodes */
795aa0d41d4SStefano Zampini     ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
796aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
797aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) nnz[is_indices[i]] = 1;
798aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
799aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
800aa0d41d4SStefano Zampini     k=1;
801aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
802aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
803aa0d41d4SStefano Zampini       nnz[is_indices[i]]=j;
804aa0d41d4SStefano Zampini       if (k < j) k = j;
805aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
806aa0d41d4SStefano Zampini     }
807aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
808aa0d41d4SStefano Zampini     /* assemble change of basis matrix on the whole set of local dofs */
809aa0d41d4SStefano Zampini     ierr = PetscMalloc(k*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
810aa0d41d4SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&change_mat_all);CHKERRQ(ierr);
811aa0d41d4SStefano Zampini     ierr = MatSetSizes(change_mat_all,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
812aa0d41d4SStefano Zampini     ierr = MatSetType(change_mat_all,MATSEQAIJ);CHKERRQ(ierr);
813aa0d41d4SStefano Zampini     ierr = MatSeqAIJSetPreallocation(change_mat_all,0,nnz);CHKERRQ(ierr);
814aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
815aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) {
816aa0d41d4SStefano Zampini       ierr = MatSetValue(change_mat_all,is_indices[i],is_indices[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
817aa0d41d4SStefano Zampini     }
818aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
819aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
820aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
821aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
822aa0d41d4SStefano Zampini       for (k=0; k<j; k++) temp_indices[k]=is_indices[row_cmat_indices[k]];
823aa0d41d4SStefano Zampini       ierr = MatSetValues(change_mat_all,1,&is_indices[i],j,temp_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
824aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
825aa0d41d4SStefano Zampini     }
826aa0d41d4SStefano Zampini     ierr = MatAssemblyBegin(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
827aa0d41d4SStefano Zampini     ierr = MatAssemblyEnd(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8289577ea80SStefano Zampini     /* TODO: HOW TO WORK WITH BAIJ and SBAIJ? PtAP not provided */
8299577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
8309577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQBAIJ,&isbaij);CHKERRQ(ierr);
8319577ea80SStefano Zampini     if (!issbaij && !isbaij) {
832aa0d41d4SStefano Zampini       ierr = MatPtAP(matis->A,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
833aa0d41d4SStefano Zampini     } else {
834aa0d41d4SStefano Zampini       Mat work_mat;
835aa0d41d4SStefano Zampini       ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
836aa0d41d4SStefano Zampini       ierr = MatPtAP(work_mat,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
837aa0d41d4SStefano Zampini       ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
838aa0d41d4SStefano Zampini     }
83945a1bb75SStefano Zampini     /*
84045a1bb75SStefano Zampini     ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
84145a1bb75SStefano Zampini     ierr = MatView(change_mat_all,(PetscViewer)0);CHKERRQ(ierr);
84245a1bb75SStefano Zampini     */
843aa0d41d4SStefano Zampini     ierr = MatDestroy(&change_mat_all);CHKERRQ(ierr);
844aa0d41d4SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
845aa0d41d4SStefano Zampini     ierr = PetscFree(temp_indices);CHKERRQ(ierr);
846aa0d41d4SStefano Zampini   } else {
847aa0d41d4SStefano Zampini     /* without change of basis, the local matrix is unchanged */
848aa0d41d4SStefano Zampini     if (!pcbddc->local_mat) {
849aa0d41d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)matis->A);CHKERRQ(ierr);
850aa0d41d4SStefano Zampini       pcbddc->local_mat = matis->A;
851aa0d41d4SStefano Zampini     }
852aa0d41d4SStefano Zampini   }
853aa0d41d4SStefano Zampini 
854aa0d41d4SStefano Zampini   /* get submatrices */
855aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_I_local,reuse,&pcis->A_II);CHKERRQ(ierr);
8569577ea80SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_B_local,reuse,&pcis->A_BB);CHKERRQ(ierr);
8579577ea80SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
8589577ea80SStefano Zampini   if (!issbaij) {
859aa0d41d4SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
860aa0d41d4SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
8619577ea80SStefano Zampini   } else {
8629577ea80SStefano Zampini     Mat newmat;
8639577ea80SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
8649577ea80SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
8659577ea80SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
8669577ea80SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
8679577ea80SStefano Zampini   }
868aa0d41d4SStefano Zampini   PetscFunctionReturn(0);
869aa0d41d4SStefano Zampini }
870aa0d41d4SStefano Zampini 
871aa0d41d4SStefano Zampini #undef __FUNCT__
872a64d13efSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalScatters"
8738ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
874a64d13efSStefano Zampini {
875a64d13efSStefano Zampini   PC_IS*         pcis = (PC_IS*)(pc->data);
876a64d13efSStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8778ce42a96SStefano Zampini   IS             is_aux1,is_aux2;
878a64d13efSStefano Zampini   PetscInt       *vertices,*aux_array1,*aux_array2,*is_indices,*idx_R_local;
8793a50541eSStefano Zampini   PetscInt       n_vertices,i,j,n_R,n_D,n_B;
8803a50541eSStefano Zampini   PetscInt       vbs,bs;
8814641a718SStefano Zampini   PetscBT        bitmask;
882a64d13efSStefano Zampini   PetscErrorCode ierr;
883a64d13efSStefano Zampini 
884a64d13efSStefano Zampini   PetscFunctionBegin;
885f4ddd8eeSStefano Zampini   /* No need to setup local scatters if primal space is unchanged */
886727cdba6SStefano Zampini   if (!pcbddc->new_primal_space_local) {
887f4ddd8eeSStefano Zampini     PetscFunctionReturn(0);
888f4ddd8eeSStefano Zampini   }
889f4ddd8eeSStefano Zampini   /* destroy old objects */
890f4ddd8eeSStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
891f4ddd8eeSStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
892f4ddd8eeSStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
893a64d13efSStefano Zampini   /* Set Non-overlapping dimensions */
894a64d13efSStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
895a64d13efSStefano Zampini   /* get vertex indices from constraint matrix */
896a64d13efSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
8973a50541eSStefano Zampini 
8984641a718SStefano Zampini   /* create auxiliary bitmask */
8994641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
9004641a718SStefano Zampini   for (i=0;i<n_vertices;i++) {
9014641a718SStefano Zampini     ierr = PetscBTSet(bitmask,vertices[i]);CHKERRQ(ierr);
9024641a718SStefano Zampini   }
9033a50541eSStefano Zampini 
904a64d13efSStefano Zampini   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
905a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n-n_vertices)*sizeof(PetscInt),&idx_R_local);CHKERRQ(ierr);
906a64d13efSStefano Zampini   for (i=0, n_R=0; i<pcis->n; i++) {
9074641a718SStefano Zampini     if (!PetscBTLookup(bitmask,i)) {
908a64d13efSStefano Zampini       idx_R_local[n_R] = i;
909a64d13efSStefano Zampini       n_R++;
910a64d13efSStefano Zampini     }
911a64d13efSStefano Zampini   }
9123a50541eSStefano Zampini 
9133a50541eSStefano Zampini   /* Block code */
9143a50541eSStefano Zampini   vbs = 1;
9153a50541eSStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
9163a50541eSStefano Zampini   if (bs>1 && !(n_vertices%bs)) {
9173a50541eSStefano Zampini     PetscBool is_blocked = PETSC_TRUE;
9183a50541eSStefano Zampini     PetscInt  *vary;
9193a50541eSStefano Zampini     /* Verify if the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
9203a50541eSStefano Zampini     ierr = PetscMalloc(pcis->n/bs*sizeof(PetscInt),&vary);CHKERRQ(ierr);
9213a50541eSStefano Zampini     ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
9223a50541eSStefano Zampini     for (i=0; i<n_vertices; i++) vary[vertices[i]/bs]++;
9233a50541eSStefano Zampini     for (i=0; i<n_vertices; i++) {
9243a50541eSStefano Zampini       if (vary[i]!=0 && vary[i]!=bs) {
9253a50541eSStefano Zampini         is_blocked = PETSC_FALSE;
9263a50541eSStefano Zampini         break;
9273a50541eSStefano Zampini       }
9283a50541eSStefano Zampini     }
9293a50541eSStefano Zampini     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
9303a50541eSStefano Zampini       vbs = bs;
9313a50541eSStefano Zampini       for (i=0;i<n_R/vbs;i++) {
9323a50541eSStefano Zampini         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
9333a50541eSStefano Zampini       }
9343a50541eSStefano Zampini     }
9353a50541eSStefano Zampini     ierr = PetscFree(vary);CHKERRQ(ierr);
9363a50541eSStefano Zampini   }
937a64d13efSStefano Zampini   ierr = PetscFree(vertices);CHKERRQ(ierr);
9383a50541eSStefano Zampini   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
9393a50541eSStefano Zampini   ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
940a64d13efSStefano Zampini 
941a64d13efSStefano Zampini   /* print some info if requested */
942a64d13efSStefano Zampini   if (pcbddc->dbg_flag) {
943a64d13efSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
944a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
945a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
946a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
9473a50541eSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"r_size = %d, v_size = %d, constraints = %d, local_primal_size = %d\n",n_R,n_vertices,pcbddc->local_primal_size-n_vertices,pcbddc->local_primal_size);CHKERRQ(ierr);
948a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr);
949a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
950a64d13efSStefano Zampini   }
951a64d13efSStefano Zampini 
952a64d13efSStefano Zampini   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
9533a50541eSStefano Zampini   ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
954a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
955a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array2);CHKERRQ(ierr);
956a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
9574641a718SStefano Zampini   for (i=0; i<n_D; i++) {
9584641a718SStefano Zampini     ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
9594641a718SStefano Zampini   }
960a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
961a64d13efSStefano Zampini   for (i=0, j=0; i<n_R; i++) {
9624641a718SStefano Zampini     if (!PetscBTLookup(bitmask,idx_R_local[i])) {
9634641a718SStefano Zampini       aux_array1[j++] = i;
964a64d13efSStefano Zampini     }
965a64d13efSStefano Zampini   }
966a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
967a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
968a64d13efSStefano Zampini   for (i=0, j=0; i<n_B; i++) {
9694641a718SStefano Zampini     if (!PetscBTLookup(bitmask,is_indices[i])) {
9704641a718SStefano Zampini       aux_array2[j++] = i;
971a64d13efSStefano Zampini     }
972a64d13efSStefano Zampini   }
973a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
974a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
975a64d13efSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
976a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
977a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
978a64d13efSStefano Zampini 
9798eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
980a64d13efSStefano Zampini     ierr = PetscMalloc(n_D*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
981a64d13efSStefano Zampini     for (i=0, j=0; i<n_R; i++) {
9824641a718SStefano Zampini       if (PetscBTLookup(bitmask,idx_R_local[i])) {
9834641a718SStefano Zampini         aux_array1[j++] = i;
984a64d13efSStefano Zampini       }
985a64d13efSStefano Zampini     }
986a64d13efSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
987a64d13efSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
988a64d13efSStefano Zampini     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
989a64d13efSStefano Zampini   }
9904641a718SStefano Zampini   ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
9913a50541eSStefano Zampini   ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
992a64d13efSStefano Zampini   PetscFunctionReturn(0);
993a64d13efSStefano Zampini }
994a64d13efSStefano Zampini 
995304d26faSStefano Zampini 
996304d26faSStefano Zampini #undef __FUNCT__
997304d26faSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
9988ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc)
999304d26faSStefano Zampini {
1000304d26faSStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1001304d26faSStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
1002304d26faSStefano Zampini   PC             pc_temp;
1003304d26faSStefano Zampini   Mat            A_RR;
1004304d26faSStefano Zampini   Vec            vec1,vec2,vec3;
1005304d26faSStefano Zampini   MatStructure   matstruct;
1006f4ddd8eeSStefano Zampini   MatReuse       reuse;
1007304d26faSStefano Zampini   PetscScalar    m_one = -1.0;
1008304d26faSStefano Zampini   PetscReal      value;
1009af732b37SStefano Zampini   PetscInt       n_D,n_R,ibs,mbs;
10109577ea80SStefano Zampini   PetscBool      use_exact,use_exact_reduced,issbaij;
1011304d26faSStefano Zampini   PetscErrorCode ierr;
1012e604994aSStefano Zampini   /* prefixes stuff */
1013e604994aSStefano Zampini   char           dir_prefix[256],neu_prefix[256],str_level[3];
1014e604994aSStefano Zampini   size_t         len;
1015304d26faSStefano Zampini 
1016304d26faSStefano Zampini   PetscFunctionBegin;
1017304d26faSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
1018304d26faSStefano Zampini 
1019e604994aSStefano Zampini   /* compute prefixes */
1020e604994aSStefano Zampini   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
1021e604994aSStefano Zampini   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
1022e604994aSStefano Zampini   if (!pcbddc->current_level) {
1023e604994aSStefano Zampini     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
1024e604994aSStefano Zampini     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
1025e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
1026e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
1027e604994aSStefano Zampini   } else {
1028e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
1029e604994aSStefano Zampini     sprintf(str_level,"%d_",(int)(pcbddc->current_level));
1030e604994aSStefano Zampini     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
1031e604994aSStefano Zampini     len -= 15; /* remove "pc_bddc_coarse_" */
1032e604994aSStefano Zampini     if (pcbddc->current_level>1) len -= 2; /* remove "X_" with X level number (works with 9 levels max) */
1033e604994aSStefano Zampini     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
1034e604994aSStefano Zampini     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
1035e604994aSStefano Zampini     *(dir_prefix+len)='\0';
1036e604994aSStefano Zampini     *(neu_prefix+len)='\0';
1037e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
1038e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
1039e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
1040e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
1041e604994aSStefano Zampini   }
1042e604994aSStefano Zampini 
1043304d26faSStefano Zampini   /* DIRICHLET PROBLEM */
1044ac78edfcSStefano Zampini   /* Matrix for Dirichlet problem is pcis->A_II */
10458ce42a96SStefano Zampini   ierr = ISGetSize(pcis->is_I_local,&n_D);CHKERRQ(ierr);
1046304d26faSStefano Zampini   if (!pcbddc->ksp_D) { /* create object if not yet build */
1047304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
1048304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
1049304d26faSStefano Zampini     /* default */
1050304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
1051e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
10529577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
1053304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
10549577ea80SStefano Zampini     if (issbaij) {
10559577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
10569577ea80SStefano Zampini     } else {
1057304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
10589577ea80SStefano Zampini     }
1059304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1060304d26faSStefano Zampini   }
1061304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II,matstruct);CHKERRQ(ierr);
1062304d26faSStefano Zampini   /* Allow user's customization */
1063304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
1064304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1065304d26faSStefano Zampini   if (!n_D) {
1066304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
1067304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1068304d26faSStefano Zampini   }
1069304d26faSStefano Zampini   /* Set Up KSP for Dirichlet problem of BDDC */
1070304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
1071304d26faSStefano Zampini   /* set ksp_D into pcis data */
1072304d26faSStefano Zampini   ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
1073304d26faSStefano Zampini   ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
1074304d26faSStefano Zampini   pcis->ksp_D = pcbddc->ksp_D;
1075304d26faSStefano Zampini 
1076304d26faSStefano Zampini   /* NEUMANN PROBLEM */
1077f4ddd8eeSStefano Zampini   /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
10788ce42a96SStefano Zampini   ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
1079f4ddd8eeSStefano Zampini   if (pcbddc->ksp_R) { /* already created ksp */
1080f4ddd8eeSStefano Zampini     PetscInt nn_R;
1081f4ddd8eeSStefano Zampini     ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR,NULL);CHKERRQ(ierr);
1082f4ddd8eeSStefano Zampini     ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
1083f4ddd8eeSStefano Zampini     ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
1084f4ddd8eeSStefano Zampini     if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
1085f4ddd8eeSStefano Zampini       ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
1086f4ddd8eeSStefano Zampini       ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1087f4ddd8eeSStefano Zampini       reuse = MAT_INITIAL_MATRIX;
1088f4ddd8eeSStefano Zampini     } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
1089727cdba6SStefano Zampini       if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
1090f4ddd8eeSStefano Zampini         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1091f4ddd8eeSStefano Zampini         reuse = MAT_INITIAL_MATRIX;
1092f4ddd8eeSStefano Zampini       } else { /* safe to reuse the matrix */
1093f4ddd8eeSStefano Zampini         reuse = MAT_REUSE_MATRIX;
1094f4ddd8eeSStefano Zampini       }
1095f4ddd8eeSStefano Zampini     }
1096f4ddd8eeSStefano Zampini     /* last check */
1097f4ddd8eeSStefano Zampini     if (matstruct == DIFFERENT_NONZERO_PATTERN) {
1098f4ddd8eeSStefano Zampini       ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1099f4ddd8eeSStefano Zampini       reuse = MAT_INITIAL_MATRIX;
1100f4ddd8eeSStefano Zampini     }
1101f4ddd8eeSStefano Zampini   } else { /* first time, so we need to create the matrix */
1102f4ddd8eeSStefano Zampini     reuse = MAT_INITIAL_MATRIX;
1103f4ddd8eeSStefano Zampini   }
1104f4ddd8eeSStefano Zampini   /* extract A_RR */
1105af732b37SStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
1106af732b37SStefano Zampini   ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
11073a50541eSStefano Zampini   if (ibs != mbs) {
1108af732b37SStefano Zampini     Mat newmat;
1109af732b37SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
1110f4ddd8eeSStefano Zampini     ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
1111af732b37SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
1112af732b37SStefano Zampini   } else {
1113f4ddd8eeSStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
1114af732b37SStefano Zampini   }
1115f4ddd8eeSStefano Zampini   if (!pcbddc->ksp_R) { /* create object if not present */
1116304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
1117304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
1118304d26faSStefano Zampini     /* default */
1119304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
1120e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
1121304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
11229577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
11239577ea80SStefano Zampini     if (issbaij) {
11249577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
11259577ea80SStefano Zampini     } else {
1126304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
11279577ea80SStefano Zampini     }
1128304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1129304d26faSStefano Zampini   }
1130304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR,matstruct);CHKERRQ(ierr);
1131304d26faSStefano Zampini   /* Allow user's customization */
1132304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
1133304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1134304d26faSStefano Zampini   if (!n_R) {
1135304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
1136304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1137304d26faSStefano Zampini   }
1138304d26faSStefano Zampini   /* Set Up KSP for Neumann problem of BDDC */
1139304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
1140304d26faSStefano Zampini 
1141304d26faSStefano Zampini   /* check Dirichlet and Neumann solvers and adapt them if a nullspace correction is needed */
1142304d26faSStefano Zampini 
1143304d26faSStefano Zampini   /* Dirichlet */
1144304d26faSStefano Zampini   ierr = MatGetVecs(pcis->A_II,&vec1,&vec2);CHKERRQ(ierr);
1145304d26faSStefano Zampini   ierr = VecDuplicate(vec1,&vec3);CHKERRQ(ierr);
1146304d26faSStefano Zampini   ierr = VecSetRandom(vec1,NULL);CHKERRQ(ierr);
1147304d26faSStefano Zampini   ierr = MatMult(pcis->A_II,vec1,vec2);CHKERRQ(ierr);
1148304d26faSStefano Zampini   ierr = KSPSolve(pcbddc->ksp_D,vec2,vec3);CHKERRQ(ierr);
1149304d26faSStefano Zampini   ierr = VecAXPY(vec3,m_one,vec1);CHKERRQ(ierr);
1150304d26faSStefano Zampini   ierr = VecNorm(vec3,NORM_INFINITY,&value);CHKERRQ(ierr);
1151304d26faSStefano Zampini   ierr = VecDestroy(&vec1);CHKERRQ(ierr);
1152304d26faSStefano Zampini   ierr = VecDestroy(&vec2);CHKERRQ(ierr);
1153304d26faSStefano Zampini   ierr = VecDestroy(&vec3);CHKERRQ(ierr);
1154304d26faSStefano Zampini   /* need to be adapted? */
1155b8ffe317SStefano Zampini   use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1156b8ffe317SStefano Zampini   ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1157b8ffe317SStefano Zampini   ierr = PCBDDCSetUseExactDirichlet(pc,use_exact_reduced);CHKERRQ(ierr);
1158304d26faSStefano Zampini   /* print info */
1159304d26faSStefano Zampini   if (pcbddc->dbg_flag) {
1160304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1161304d26faSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
1162304d26faSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Checking solution of Dirichlet and Neumann problems\n");CHKERRQ(ierr);
1163e604994aSStefano 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);
1164304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1165304d26faSStefano Zampini   }
1166b8ffe317SStefano Zampini   if (pcbddc->NullSpace && !use_exact_reduced && !pcbddc->switch_static) {
11678ce42a96SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcis->is_I_local);CHKERRQ(ierr);
1168304d26faSStefano Zampini   }
1169304d26faSStefano Zampini 
1170304d26faSStefano Zampini   /* Neumann */
1171304d26faSStefano Zampini   ierr = MatGetVecs(A_RR,&vec1,&vec2);CHKERRQ(ierr);
1172304d26faSStefano Zampini   ierr = VecDuplicate(vec1,&vec3);CHKERRQ(ierr);
1173304d26faSStefano Zampini   ierr = VecSetRandom(vec1,NULL);CHKERRQ(ierr);
1174304d26faSStefano Zampini   ierr = MatMult(A_RR,vec1,vec2);CHKERRQ(ierr);
1175304d26faSStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,vec2,vec3);CHKERRQ(ierr);
1176304d26faSStefano Zampini   ierr = VecAXPY(vec3,m_one,vec1);CHKERRQ(ierr);
1177304d26faSStefano Zampini   ierr = VecNorm(vec3,NORM_INFINITY,&value);CHKERRQ(ierr);
1178304d26faSStefano Zampini   ierr = VecDestroy(&vec1);CHKERRQ(ierr);
1179304d26faSStefano Zampini   ierr = VecDestroy(&vec2);CHKERRQ(ierr);
1180304d26faSStefano Zampini   ierr = VecDestroy(&vec3);CHKERRQ(ierr);
1181304d26faSStefano Zampini   /* need to be adapted? */
1182b8ffe317SStefano Zampini   use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1183b8ffe317SStefano Zampini   ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1184304d26faSStefano Zampini   /* print info */
1185304d26faSStefano Zampini   if (pcbddc->dbg_flag) {
1186e604994aSStefano 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);
1187304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1188304d26faSStefano Zampini   }
1189b8ffe317SStefano Zampini   if (pcbddc->NullSpace && !use_exact_reduced) { /* is it the right logic? */
11908ce42a96SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcbddc->is_R_local);CHKERRQ(ierr);
1191304d26faSStefano Zampini   }
1192304d26faSStefano Zampini   /* free Neumann problem's matrix */
1193304d26faSStefano Zampini   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1194304d26faSStefano Zampini   PetscFunctionReturn(0);
1195304d26faSStefano Zampini }
1196304d26faSStefano Zampini 
1197304d26faSStefano Zampini #undef __FUNCT__
1198674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSolveSaddlePoint"
1199674ae819SStefano Zampini static PetscErrorCode  PCBDDCSolveSaddlePoint(PC pc)
1200674ae819SStefano Zampini {
1201674ae819SStefano Zampini   PetscErrorCode ierr;
1202674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1203674ae819SStefano Zampini 
1204674ae819SStefano Zampini   PetscFunctionBegin;
1205674ae819SStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
1206674ae819SStefano Zampini   if (pcbddc->local_auxmat1) {
1207674ae819SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec2_R,pcbddc->vec1_C);CHKERRQ(ierr);
1208674ae819SStefano Zampini     ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
1209674ae819SStefano Zampini   }
1210674ae819SStefano Zampini   PetscFunctionReturn(0);
1211674ae819SStefano Zampini }
1212674ae819SStefano Zampini 
1213674ae819SStefano Zampini #undef __FUNCT__
1214674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
1215674ae819SStefano Zampini PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc)
1216674ae819SStefano Zampini {
1217674ae819SStefano Zampini   PetscErrorCode ierr;
1218674ae819SStefano Zampini   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
1219674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)  (pc->data);
1220674ae819SStefano Zampini   const PetscScalar zero = 0.0;
1221674ae819SStefano Zampini 
1222674ae819SStefano Zampini   PetscFunctionBegin;
122315aaf578SStefano Zampini   /* Application of PHI^T (or PSI^T)  */
122415aaf578SStefano Zampini   if (pcbddc->coarse_psi_B) {
122515aaf578SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
12268eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
122715aaf578SStefano Zampini   } else {
1228674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
12298eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
123015aaf578SStefano Zampini   }
1231674ae819SStefano Zampini   /* Scatter data of coarse_rhs */
1232674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { ierr = VecSet(pcbddc->coarse_rhs,zero);CHKERRQ(ierr); }
1233674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1234674ae819SStefano Zampini 
1235674ae819SStefano Zampini   /* Local solution on R nodes */
1236674ae819SStefano Zampini   ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
1237674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1238674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
12398eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1240674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1241674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1242674ae819SStefano Zampini   }
1243674ae819SStefano Zampini   ierr = PCBDDCSolveSaddlePoint(pc);CHKERRQ(ierr);
1244674ae819SStefano Zampini   ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1245674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1246674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
12478eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1248674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1249674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1250674ae819SStefano Zampini   }
1251674ae819SStefano Zampini 
1252674ae819SStefano Zampini   /* Coarse solution */
1253674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1254674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { /* TODO remove null space when doing multilevel */
1255674ae819SStefano Zampini     ierr = KSPSolve(pcbddc->coarse_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
1256674ae819SStefano Zampini   }
1257674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1258674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd  (pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1259674ae819SStefano Zampini 
1260674ae819SStefano Zampini   /* Sum contributions from two levels */
1261674ae819SStefano Zampini   ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
12628eeda7d8SStefano Zampini   if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1263674ae819SStefano Zampini   PetscFunctionReturn(0);
1264674ae819SStefano Zampini }
1265674ae819SStefano Zampini 
1266674ae819SStefano Zampini #undef __FUNCT__
1267674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
1268674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1269674ae819SStefano Zampini {
1270674ae819SStefano Zampini   PetscErrorCode ierr;
1271674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1272674ae819SStefano Zampini 
1273674ae819SStefano Zampini   PetscFunctionBegin;
1274674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1275674ae819SStefano Zampini   PetscFunctionReturn(0);
1276674ae819SStefano Zampini }
1277674ae819SStefano Zampini 
1278674ae819SStefano Zampini #undef __FUNCT__
1279674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
1280674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1281674ae819SStefano Zampini {
1282674ae819SStefano Zampini   PetscErrorCode ierr;
1283674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1284674ae819SStefano Zampini 
1285674ae819SStefano Zampini   PetscFunctionBegin;
1286674ae819SStefano Zampini   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1287674ae819SStefano Zampini   PetscFunctionReturn(0);
1288674ae819SStefano Zampini }
1289674ae819SStefano Zampini 
1290984c4197SStefano Zampini /* uncomment for testing purposes */
1291984c4197SStefano Zampini /* #define PETSC_MISSING_LAPACK_GESVD 1 */
1292674ae819SStefano Zampini #undef __FUNCT__
1293674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp"
1294674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
1295674ae819SStefano Zampini {
1296674ae819SStefano Zampini   PetscErrorCode    ierr;
1297674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
1298674ae819SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
1299674ae819SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
1300984c4197SStefano Zampini   /* constraint and (optionally) change of basis matrix implemented as SeqAIJ */
1301674ae819SStefano Zampini   MatType           impMatType=MATSEQAIJ;
1302984c4197SStefano Zampini   /* one and zero */
1303984c4197SStefano Zampini   PetscScalar       one=1.0,zero=0.0;
1304984c4197SStefano Zampini   /* space to store constraints and their local indices */
1305984c4197SStefano Zampini   PetscScalar       *temp_quadrature_constraint;
1306984c4197SStefano Zampini   PetscInt          *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B;
1307984c4197SStefano Zampini   /* iterators */
1308984c4197SStefano Zampini   PetscInt          i,j,k,total_counts,temp_start_ptr;
1309984c4197SStefano Zampini   /* stuff to store connected components stored in pcbddc->mat_graph */
1310984c4197SStefano Zampini   IS                ISForVertices,*ISForFaces,*ISForEdges,*used_IS;
1311984c4197SStefano Zampini   PetscInt          n_ISForFaces,n_ISForEdges;
1312984c4197SStefano Zampini   /* near null space stuff */
1313674ae819SStefano Zampini   MatNullSpace      nearnullsp;
1314674ae819SStefano Zampini   const Vec         *nearnullvecs;
1315674ae819SStefano Zampini   Vec               *localnearnullsp;
1316984c4197SStefano Zampini   PetscBool         nnsp_has_cnst;
1317984c4197SStefano Zampini   PetscInt          nnsp_size;
1318984c4197SStefano Zampini   PetscScalar       *array;
1319984c4197SStefano Zampini   /* BLAS integers */
1320e310c8b4SStefano Zampini   PetscBLASInt      lwork,lierr;
1321e310c8b4SStefano Zampini   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
1322c4303822SStefano Zampini   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
1323984c4197SStefano Zampini   /* LAPACK working arrays for SVD or POD */
1324242a89d7SStefano Zampini   PetscBool         skip_lapack;
1325984c4197SStefano Zampini   PetscScalar       *work;
1326984c4197SStefano Zampini   PetscReal         *singular_vals;
1327984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1328984c4197SStefano Zampini   PetscReal         *rwork;
1329674ae819SStefano Zampini #endif
1330984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1331e310c8b4SStefano Zampini   PetscBLASInt      Blas_one_2=1;
1332984c4197SStefano Zampini   PetscScalar       *temp_basis,*correlation_mat;
1333b7d8b9f8SStefano Zampini #else
1334b7d8b9f8SStefano Zampini   PetscBLASInt      dummy_int_1=1,dummy_int_2=1;
1335b7d8b9f8SStefano Zampini   PetscScalar       dummy_scalar_1=0.0,dummy_scalar_2=0.0;
1336984c4197SStefano Zampini #endif
1337727cdba6SStefano Zampini   /* reuse */
1338727cdba6SStefano Zampini   PetscInt          olocal_primal_size;
1339727cdba6SStefano Zampini   PetscInt          *oprimal_indices_local_idxs;
1340984c4197SStefano Zampini   /* change of basis */
1341984c4197SStefano Zampini   PetscInt          *aux_primal_numbering,*aux_primal_minloc,*global_indices;
1342a717540cSStefano Zampini   PetscBool         boolforchange,qr_needed;
1343a717540cSStefano Zampini   PetscBT           touched,change_basis,qr_needed_idx;
1344984c4197SStefano Zampini   /* auxiliary stuff */
1345984c4197SStefano Zampini   PetscInt          *nnz,*is_indices,*local_to_B;
1346984c4197SStefano Zampini   /* some quantities */
134745a1bb75SStefano Zampini   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
1348984c4197SStefano Zampini   PetscInt          size_of_constraint,max_size_of_constraint,max_constraints,temp_constraints;
1349984c4197SStefano Zampini 
1350674ae819SStefano Zampini 
1351674ae819SStefano Zampini   PetscFunctionBegin;
13528e61c736SStefano Zampini   /* Destroy Mat objects computed previously */
13538e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
13548e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1355674ae819SStefano Zampini   /* Get index sets for faces, edges and vertices from graph */
13568eeda7d8SStefano Zampini   if (!pcbddc->use_faces && !pcbddc->use_edges && !pcbddc->use_vertices) {
13578eeda7d8SStefano Zampini     pcbddc->use_vertices = PETSC_TRUE;
1358674ae819SStefano Zampini   }
13598eeda7d8SStefano Zampini   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,pcbddc->use_faces,pcbddc->use_edges,pcbddc->use_vertices,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);
1360b8ffe317SStefano Zampini   /* HACK: provide functions to set change of basis */
1361b8ffe317SStefano Zampini   if (!ISForVertices && pcbddc->NullSpace) {
1362b8ffe317SStefano Zampini     pcbddc->use_change_of_basis = PETSC_TRUE;
1363b8ffe317SStefano Zampini     pcbddc->use_change_on_faces = PETSC_FALSE;
1364b8ffe317SStefano Zampini   }
1365984c4197SStefano Zampini   /* print some info */
1366674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
1367674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1368674ae819SStefano Zampini     i = 0;
1369674ae819SStefano Zampini     if (ISForVertices) {
1370674ae819SStefano Zampini       ierr = ISGetSize(ISForVertices,&i);CHKERRQ(ierr);
1371674ae819SStefano Zampini     }
1372674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices\n",PetscGlobalRank,i);CHKERRQ(ierr);
1373674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges\n",PetscGlobalRank,n_ISForEdges);CHKERRQ(ierr);
137415aaf578SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces\n",PetscGlobalRank,n_ISForFaces);CHKERRQ(ierr);
1375674ae819SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1376674ae819SStefano Zampini   }
1377674ae819SStefano Zampini   /* check if near null space is attached to global mat */
1378674ae819SStefano Zampini   ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
1379674ae819SStefano Zampini   if (nearnullsp) {
1380674ae819SStefano Zampini     ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
1381f4ddd8eeSStefano Zampini     /* remove any stored info */
1382f4ddd8eeSStefano Zampini     ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
1383f4ddd8eeSStefano Zampini     ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1384f4ddd8eeSStefano Zampini     /* store information for BDDC solver reuse */
1385f4ddd8eeSStefano Zampini     ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
1386f4ddd8eeSStefano Zampini     pcbddc->onearnullspace = nearnullsp;
1387f4ddd8eeSStefano Zampini     ierr = PetscMalloc(nnsp_size*sizeof(PetscObjectState),&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1388f4ddd8eeSStefano Zampini     for (i=0;i<nnsp_size;i++) {
1389f4ddd8eeSStefano Zampini       ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
1390f4ddd8eeSStefano Zampini     }
1391984c4197SStefano Zampini   } else { /* if near null space is not provided BDDC uses constants by default */
1392984c4197SStefano Zampini     nnsp_size = 0;
1393674ae819SStefano Zampini     nnsp_has_cnst = PETSC_TRUE;
1394674ae819SStefano Zampini   }
1395984c4197SStefano Zampini   /* get max number of constraints on a single cc */
1396984c4197SStefano Zampini   max_constraints = nnsp_size;
1397984c4197SStefano Zampini   if (nnsp_has_cnst) max_constraints++;
1398984c4197SStefano Zampini 
1399674ae819SStefano Zampini   /*
1400674ae819SStefano Zampini        Evaluate maximum storage size needed by the procedure
1401674ae819SStefano Zampini        - temp_indices will contain start index of each constraint stored as follows
1402674ae819SStefano 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
1403674ae819SStefano 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
1404674ae819SStefano Zampini        - temp_quadrature_constraint  [temp_indices[i],...,temp[indices[i+1]-1] will contain the scalars representing the constraint itself
1405674ae819SStefano Zampini                                                                                                                                                          */
1406674ae819SStefano Zampini   total_counts = n_ISForFaces+n_ISForEdges;
1407984c4197SStefano Zampini   total_counts *= max_constraints;
1408674ae819SStefano Zampini   n_vertices = 0;
1409674ae819SStefano Zampini   if (ISForVertices) {
1410674ae819SStefano Zampini     ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
1411674ae819SStefano Zampini   }
1412674ae819SStefano Zampini   total_counts += n_vertices;
1413674ae819SStefano Zampini   ierr = PetscMalloc((total_counts+1)*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
14144641a718SStefano Zampini   ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
1415674ae819SStefano Zampini   total_counts = 0;
1416674ae819SStefano Zampini   max_size_of_constraint = 0;
1417674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1418674ae819SStefano Zampini     if (i<n_ISForEdges) {
1419674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1420674ae819SStefano Zampini     } else {
1421674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1422674ae819SStefano Zampini     }
1423674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
1424674ae819SStefano Zampini     total_counts += j;
1425674ae819SStefano Zampini     max_size_of_constraint = PetscMax(j,max_size_of_constraint);
1426674ae819SStefano Zampini   }
1427984c4197SStefano Zampini   total_counts *= max_constraints;
1428674ae819SStefano Zampini   total_counts += n_vertices;
1429674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&temp_quadrature_constraint);CHKERRQ(ierr);
1430674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint);CHKERRQ(ierr);
1431674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint_B);CHKERRQ(ierr);
1432984c4197SStefano Zampini   /* local to boundary numbering */
1433674ae819SStefano Zampini   ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&local_to_B);CHKERRQ(ierr);
1434674ae819SStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1435984c4197SStefano Zampini   for (i=0;i<pcis->n;i++) local_to_B[i]=-1;
1436984c4197SStefano Zampini   for (i=0;i<pcis->n_B;i++) local_to_B[is_indices[i]]=i;
1437674ae819SStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1438984c4197SStefano Zampini   /* get local part of global near null space vectors */
1439984c4197SStefano Zampini   ierr = PetscMalloc(nnsp_size*sizeof(Vec),&localnearnullsp);CHKERRQ(ierr);
1440984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1441984c4197SStefano Zampini     ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
1442984c4197SStefano Zampini     ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1443984c4197SStefano Zampini     ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1444984c4197SStefano Zampini   }
1445674ae819SStefano Zampini 
1446242a89d7SStefano Zampini   /* whether or not to skip lapack calls */
1447242a89d7SStefano Zampini   skip_lapack = PETSC_TRUE;
1448242a89d7SStefano Zampini   if (n_ISForFaces+n_ISForEdges) skip_lapack = PETSC_FALSE;
1449242a89d7SStefano Zampini 
1450984c4197SStefano Zampini   /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
1451242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1452674ae819SStefano Zampini     PetscScalar temp_work;
1453674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1454984c4197SStefano Zampini     /* Proper Orthogonal Decomposition (POD) using the snapshot method */
1455984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*max_constraints*sizeof(PetscScalar),&correlation_mat);CHKERRQ(ierr);
1456984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1457984c4197SStefano Zampini     ierr = PetscMalloc(max_size_of_constraint*max_constraints*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr);
1458674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1459984c4197SStefano Zampini     ierr = PetscMalloc(3*max_constraints*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1460674ae819SStefano Zampini #endif
1461674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1462c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
1463c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
1464674ae819SStefano Zampini     lwork = -1;
1465674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1466674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1467c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
1468674ae819SStefano Zampini #else
1469c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
1470674ae819SStefano Zampini #endif
1471674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1472984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
1473674ae819SStefano Zampini #else /* on missing GESVD */
1474674ae819SStefano Zampini     /* SVD */
1475674ae819SStefano Zampini     PetscInt max_n,min_n;
1476674ae819SStefano Zampini     max_n = max_size_of_constraint;
1477984c4197SStefano Zampini     min_n = max_constraints;
1478984c4197SStefano Zampini     if (max_size_of_constraint < max_constraints) {
1479674ae819SStefano Zampini       min_n = max_size_of_constraint;
1480984c4197SStefano Zampini       max_n = max_constraints;
1481674ae819SStefano Zampini     }
1482674ae819SStefano Zampini     ierr = PetscMalloc(min_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1483674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1484674ae819SStefano Zampini     ierr = PetscMalloc(5*min_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1485674ae819SStefano Zampini #endif
1486674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1487674ae819SStefano Zampini     lwork = -1;
1488e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
1489e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
1490b7d8b9f8SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
1491674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1492674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1493e310c8b4SStefano 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));
1494674ae819SStefano Zampini #else
1495e310c8b4SStefano 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));
1496674ae819SStefano Zampini #endif
1497674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1498984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
1499984c4197SStefano Zampini #endif /* on missing GESVD */
1500674ae819SStefano Zampini     /* Allocate optimal workspace */
1501674ae819SStefano Zampini     ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
1502984c4197SStefano Zampini     ierr = PetscMalloc((PetscInt)lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
1503674ae819SStefano Zampini   }
1504674ae819SStefano Zampini   /* Now we can loop on constraining sets */
1505674ae819SStefano Zampini   total_counts = 0;
1506674ae819SStefano Zampini   temp_indices[0] = 0;
1507674ae819SStefano Zampini   /* vertices */
1508674ae819SStefano Zampini   if (ISForVertices) {
1509674ae819SStefano Zampini     ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1510674ae819SStefano Zampini     if (nnsp_has_cnst) { /* consider all vertices */
1511674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1512674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1513674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
1514674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1515674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1516674ae819SStefano Zampini         total_counts++;
1517674ae819SStefano Zampini       }
1518674ae819SStefano Zampini     } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
1519984c4197SStefano Zampini       PetscBool used_vertex;
1520674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1521674ae819SStefano Zampini         used_vertex = PETSC_FALSE;
1522674ae819SStefano Zampini         k = 0;
1523674ae819SStefano Zampini         while (!used_vertex && k<nnsp_size) {
1524984c4197SStefano Zampini           ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1525984c4197SStefano Zampini           if (PetscAbsScalar(array[is_indices[i]])>0.0) {
1526674ae819SStefano Zampini             temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1527674ae819SStefano Zampini             temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
1528674ae819SStefano Zampini             temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1529674ae819SStefano Zampini             temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1530674ae819SStefano Zampini             total_counts++;
1531674ae819SStefano Zampini             used_vertex = PETSC_TRUE;
1532674ae819SStefano Zampini           }
1533984c4197SStefano Zampini           ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1534674ae819SStefano Zampini           k++;
1535674ae819SStefano Zampini         }
1536674ae819SStefano Zampini       }
1537674ae819SStefano Zampini     }
1538674ae819SStefano Zampini     ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1539674ae819SStefano Zampini     n_vertices = total_counts;
1540674ae819SStefano Zampini   }
1541984c4197SStefano Zampini 
1542674ae819SStefano Zampini   /* edges and faces */
1543674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1544674ae819SStefano Zampini     if (i<n_ISForEdges) {
1545674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1546984c4197SStefano Zampini       boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
1547674ae819SStefano Zampini     } else {
1548674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1549984c4197SStefano Zampini       boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
1550674ae819SStefano Zampini     }
1551674ae819SStefano Zampini     temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
1552674ae819SStefano Zampini     temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
1553674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
1554674ae819SStefano Zampini     ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1555984c4197SStefano Zampini     /* change of basis should not be performed on local periodic nodes */
1556984c4197SStefano Zampini     if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
1557674ae819SStefano Zampini     if (nnsp_has_cnst) {
15585b08dc53SStefano Zampini       PetscScalar quad_value;
1559674ae819SStefano Zampini       temp_constraints++;
1560674ae819SStefano Zampini       quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
1561674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1562674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
1563674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
1564674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
1565674ae819SStefano Zampini       }
1566674ae819SStefano Zampini       temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
1567674ae819SStefano Zampini       total_counts++;
1568674ae819SStefano Zampini     }
1569674ae819SStefano Zampini     for (k=0;k<nnsp_size;k++) {
1570984c4197SStefano Zampini       PetscReal real_value;
1571984c4197SStefano Zampini       ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1572674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1573674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
1574674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
1575984c4197SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=array[is_indices[j]];
1576674ae819SStefano Zampini       }
1577984c4197SStefano Zampini       ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1578984c4197SStefano Zampini       /* check if array is null on the connected component */
1579e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1580e310c8b4SStefano Zampini       PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_one));
15815b08dc53SStefano Zampini       if (real_value > 0.0) { /* keep indices and values */
1582674ae819SStefano Zampini         temp_constraints++;
1583674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
1584674ae819SStefano Zampini         total_counts++;
1585674ae819SStefano Zampini       }
1586674ae819SStefano Zampini     }
1587674ae819SStefano Zampini     ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
158845a1bb75SStefano Zampini     valid_constraints = temp_constraints;
1589eb97c9d2SStefano 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 */
1590eb97c9d2SStefano Zampini     if (!pcbddc->use_nnsp_true && temp_constraints) {
1591984c4197SStefano Zampini       PetscReal tol = 1.0e-8; /* tolerance for retaining eigenmodes */
1592674ae819SStefano Zampini 
1593674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1594984c4197SStefano Zampini       /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
1595984c4197SStefano Zampini          POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
1596984c4197SStefano Zampini          -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
1597984c4197SStefano Zampini             the constraints basis will differ (by a complex factor with absolute value equal to 1)
1598984c4197SStefano Zampini             from that computed using LAPACKgesvd
1599984c4197SStefano Zampini          -> This is due to a different computation of eigenvectors in LAPACKheev
1600984c4197SStefano Zampini          -> The quality of the POD-computed basis will be the same */
1601984c4197SStefano Zampini       ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
1602674ae819SStefano Zampini       /* Store upper triangular part of correlation matrix */
1603e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1604984c4197SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1605674ae819SStefano Zampini       for (j=0;j<temp_constraints;j++) {
1606674ae819SStefano Zampini         for (k=0;k<j+1;k++) {
1607e310c8b4SStefano 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));
1608674ae819SStefano Zampini         }
1609674ae819SStefano Zampini       }
1610e310c8b4SStefano Zampini       /* compute eigenvalues and eigenvectors of correlation matrix */
1611e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1612e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
1613674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1614c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
1615674ae819SStefano Zampini #else
1616c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
1617674ae819SStefano Zampini #endif
1618674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1619984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
1620984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
1621674ae819SStefano Zampini       j=0;
1622984c4197SStefano Zampini       while (j < temp_constraints && singular_vals[j] < tol) j++;
1623674ae819SStefano Zampini       total_counts=total_counts-j;
162445a1bb75SStefano Zampini       valid_constraints = temp_constraints-j;
1625e310c8b4SStefano Zampini       /* scale and copy POD basis into used quadrature memory */
1626c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1627c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1628c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
1629c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1630c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
1631c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1632674ae819SStefano Zampini       if (j<temp_constraints) {
1633984c4197SStefano Zampini         PetscInt ii;
1634984c4197SStefano Zampini         for (k=j;k<temp_constraints;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]);
1635674ae819SStefano Zampini         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1636c4303822SStefano 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));
1637674ae819SStefano Zampini         ierr = PetscFPTrapPop();CHKERRQ(ierr);
1638984c4197SStefano Zampini         for (k=0;k<temp_constraints-j;k++) {
1639674ae819SStefano Zampini           for (ii=0;ii<size_of_constraint;ii++) {
1640984c4197SStefano 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];
1641674ae819SStefano Zampini           }
1642674ae819SStefano Zampini         }
1643674ae819SStefano Zampini       }
1644674ae819SStefano Zampini #else  /* on missing GESVD */
1645e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1646e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1647b7d8b9f8SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1648674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1649674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1650e310c8b4SStefano 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));
1651674ae819SStefano Zampini #else
1652e310c8b4SStefano 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));
1653674ae819SStefano Zampini #endif
1654984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
1655674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1656984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
1657e310c8b4SStefano Zampini       k = temp_constraints;
1658e310c8b4SStefano Zampini       if (k > size_of_constraint) k = size_of_constraint;
1659674ae819SStefano Zampini       j = 0;
1660e310c8b4SStefano Zampini       while (j < k && singular_vals[k-j-1] < tol) j++;
1661e310c8b4SStefano Zampini       total_counts = total_counts-temp_constraints+k-j;
166245a1bb75SStefano Zampini       valid_constraints = k-j;
1663984c4197SStefano Zampini #endif /* on missing GESVD */
1664674ae819SStefano Zampini     }
166545a1bb75SStefano Zampini     /* setting change_of_basis flag is safe now */
166645a1bb75SStefano Zampini     if (boolforchange) {
166745a1bb75SStefano Zampini       for (j=0;j<valid_constraints;j++) {
166845a1bb75SStefano Zampini         PetscBTSet(change_basis,total_counts-j-1);
166945a1bb75SStefano Zampini       }
167045a1bb75SStefano Zampini     }
1671674ae819SStefano Zampini   }
1672674ae819SStefano Zampini   /* free index sets of faces, edges and vertices */
1673674ae819SStefano Zampini   for (i=0;i<n_ISForFaces;i++) {
1674674ae819SStefano Zampini     ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
1675674ae819SStefano Zampini   }
1676674ae819SStefano Zampini   ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
1677674ae819SStefano Zampini   for (i=0;i<n_ISForEdges;i++) {
1678674ae819SStefano Zampini     ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
1679674ae819SStefano Zampini   }
1680674ae819SStefano Zampini   ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
1681674ae819SStefano Zampini   ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
1682674ae819SStefano Zampini 
1683984c4197SStefano Zampini   /* free workspace */
1684242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1685984c4197SStefano Zampini     ierr = PetscFree(work);CHKERRQ(ierr);
1686984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1687984c4197SStefano Zampini     ierr = PetscFree(rwork);CHKERRQ(ierr);
1688984c4197SStefano Zampini #endif
1689984c4197SStefano Zampini     ierr = PetscFree(singular_vals);CHKERRQ(ierr);
1690984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1691984c4197SStefano Zampini     ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
1692984c4197SStefano Zampini     ierr = PetscFree(temp_basis);CHKERRQ(ierr);
1693984c4197SStefano Zampini #endif
1694984c4197SStefano Zampini   }
1695984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1696984c4197SStefano Zampini     ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
1697984c4197SStefano Zampini   }
1698984c4197SStefano Zampini   ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
1699984c4197SStefano Zampini 
1700727cdba6SStefano Zampini   /* set quantities in pcbddc data structure and store previous primal size */
1701984c4197SStefano Zampini   /* n_vertices defines the number of subdomain corners in the primal space */
1702674ae819SStefano Zampini   /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */
1703727cdba6SStefano Zampini   olocal_primal_size = pcbddc->local_primal_size;
1704984c4197SStefano Zampini   pcbddc->local_primal_size = total_counts;
1705674ae819SStefano Zampini   pcbddc->n_vertices = n_vertices;
1706984c4197SStefano Zampini   pcbddc->n_constraints = pcbddc->local_primal_size-pcbddc->n_vertices;
1707674ae819SStefano Zampini 
1708674ae819SStefano Zampini   /* Create constraint matrix */
1709674ae819SStefano Zampini   /* The constraint matrix is used to compute the l2g map of primal dofs */
1710674ae819SStefano Zampini   /* so we need to set it up properly either with or without change of basis */
1711674ae819SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1712674ae819SStefano Zampini   ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr);
1713984c4197SStefano Zampini   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
1714984c4197SStefano Zampini   /* array to compute a local numbering of constraints : vertices first then constraints */
1715984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_numbering);CHKERRQ(ierr);
1716984c4197SStefano Zampini   /* array to select the proper local node (of minimum index with respect to global ordering) when changing the basis */
1717984c4197SStefano 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 */
1718984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_minloc);CHKERRQ(ierr);
1719984c4197SStefano Zampini   /* auxiliary stuff for basis change */
1720984c4197SStefano Zampini   ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&global_indices);CHKERRQ(ierr);
17214641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n_B,&touched);CHKERRQ(ierr);
1722984c4197SStefano Zampini 
1723984c4197SStefano Zampini   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
1724984c4197SStefano Zampini   total_primal_vertices=0;
1725984c4197SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
1726674ae819SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
1727984c4197SStefano Zampini     if (size_of_constraint == 1) {
17284641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]]);CHKERRQ(ierr);
1729984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]];
1730984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=0;
1731984c4197SStefano Zampini       total_primal_vertices++;
17324641a718SStefano Zampini     } else if (PetscBTLookup(change_basis,i)) { /* Same procedure used in PCBDDCGetPrimalConstraintsLocalIdx */
1733984c4197SStefano Zampini       PetscInt min_loc,min_index;
1734984c4197SStefano Zampini       ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],global_indices);CHKERRQ(ierr);
1735984c4197SStefano Zampini       /* find first untouched local node */
1736674ae819SStefano Zampini       k = 0;
17374641a718SStefano Zampini       while (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) k++;
1738984c4197SStefano Zampini       min_index = global_indices[k];
1739984c4197SStefano Zampini       min_loc = k;
1740984c4197SStefano Zampini       /* search the minimum among global nodes already untouched on the cc */
1741984c4197SStefano Zampini       for (k=1;k<size_of_constraint;k++) {
1742984c4197SStefano Zampini         /* there can be more than one constraint on a single connected component */
17434641a718SStefano Zampini         if (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k]) && min_index > global_indices[k]) {
1744984c4197SStefano Zampini           min_index = global_indices[k];
1745984c4197SStefano Zampini           min_loc = k;
1746674ae819SStefano Zampini         }
1747674ae819SStefano Zampini       }
17484641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]+min_loc]);CHKERRQ(ierr);
1749984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]+min_loc];
1750984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=min_loc;
1751984c4197SStefano Zampini       total_primal_vertices++;
1752984c4197SStefano Zampini     }
1753984c4197SStefano Zampini   }
1754a717540cSStefano Zampini   /* determine if a QR strategy is needed for change of basis */
1755a717540cSStefano Zampini   qr_needed = PETSC_FALSE;
1756a717540cSStefano Zampini   ierr = PetscBTCreate(pcbddc->local_primal_size,&qr_needed_idx);CHKERRQ(ierr);
1757a717540cSStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1758a717540cSStefano Zampini     if (PetscBTLookup(change_basis,i)) {
1759a717540cSStefano Zampini       size_of_constraint = temp_indices[i+1]-temp_indices[i];
1760a717540cSStefano Zampini       j = 0;
1761a717540cSStefano Zampini       for (k=0;k<size_of_constraint;k++) {
1762a717540cSStefano Zampini         if (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) {
1763a717540cSStefano Zampini           j++;
1764a717540cSStefano Zampini         }
1765a717540cSStefano Zampini       }
1766a717540cSStefano Zampini       /* found more than one primal dof on the cc */
1767a717540cSStefano Zampini       if (j > 1) {
1768a717540cSStefano Zampini         PetscBTSet(qr_needed_idx,i);
1769a717540cSStefano Zampini         qr_needed = PETSC_TRUE;
1770a717540cSStefano Zampini       }
1771a717540cSStefano Zampini     }
1772a717540cSStefano Zampini   }
1773984c4197SStefano Zampini   /* free workspace */
1774984c4197SStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
177545a1bb75SStefano Zampini 
1776674ae819SStefano Zampini   /* permute indices in order to have a sorted set of vertices */
1777a717540cSStefano Zampini   ierr = PetscSortInt(total_primal_vertices,aux_primal_numbering);CHKERRQ(ierr);
1778984c4197SStefano Zampini 
1779984c4197SStefano Zampini   /* nonzero structure of constraint matrix */
1780984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1781984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) nnz[i]=1;
1782984c4197SStefano Zampini   j=total_primal_vertices;
1783984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
17844641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1785674ae819SStefano Zampini       nnz[j]=temp_indices[i+1]-temp_indices[i];
1786674ae819SStefano Zampini       j++;
1787674ae819SStefano Zampini     }
1788674ae819SStefano Zampini   }
1789674ae819SStefano Zampini   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
1790674ae819SStefano Zampini   ierr = PetscFree(nnz);CHKERRQ(ierr);
1791674ae819SStefano Zampini   /* set values in constraint matrix */
1792984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) {
1793984c4197SStefano Zampini     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,aux_primal_numbering[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
1794674ae819SStefano Zampini   }
1795984c4197SStefano Zampini   total_counts = total_primal_vertices;
1796984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
17974641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1798674ae819SStefano Zampini       size_of_constraint=temp_indices[i+1]-temp_indices[i];
1799674ae819SStefano 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);
1800674ae819SStefano Zampini       total_counts++;
1801674ae819SStefano Zampini     }
1802674ae819SStefano Zampini   }
1803674ae819SStefano Zampini   /* assembling */
1804674ae819SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1805674ae819SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1806984c4197SStefano Zampini   /*
180745a1bb75SStefano Zampini   ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
1808984c4197SStefano Zampini   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
1809984c4197SStefano Zampini   */
1810674ae819SStefano Zampini   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
1811674ae819SStefano Zampini   if (pcbddc->use_change_of_basis) {
1812026de310SStefano Zampini     /* dual and primal dofs on a single cc */
1813984c4197SStefano Zampini     PetscInt     dual_dofs,primal_dofs;
1814026de310SStefano Zampini     /* iterator on aux_primal_minloc (ordered as read from nearnullspace: vertices, edges and then constraints) */
1815026de310SStefano Zampini     PetscInt     primal_counter;
1816984c4197SStefano Zampini     /* working stuff for GEQRF */
1817984c4197SStefano Zampini     PetscScalar  *qr_basis,*qr_tau,*qr_work,lqr_work_t;
1818984c4197SStefano Zampini     PetscBLASInt lqr_work;
1819984c4197SStefano Zampini     /* working stuff for UNGQR */
1820984c4197SStefano Zampini     PetscScalar  *gqr_work,lgqr_work_t;
1821984c4197SStefano Zampini     PetscBLASInt lgqr_work;
1822984c4197SStefano Zampini     /* working stuff for TRTRS */
1823984c4197SStefano Zampini     PetscScalar  *trs_rhs;
18243f08241aSStefano Zampini     PetscBLASInt Blas_NRHS;
1825984c4197SStefano Zampini     /* pointers for values insertion into change of basis matrix */
1826984c4197SStefano Zampini     PetscInt     *start_rows,*start_cols;
1827984c4197SStefano Zampini     PetscScalar  *start_vals;
1828984c4197SStefano Zampini     /* working stuff for values insertion */
18294641a718SStefano Zampini     PetscBT      is_primal;
1830984c4197SStefano Zampini 
1831a717540cSStefano Zampini     /* change of basis acts on local interfaces -> dimension is n_B x n_B */
1832a717540cSStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
1833a717540cSStefano Zampini     ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr);
1834a717540cSStefano Zampini     ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr);
1835a717540cSStefano Zampini     /* work arrays */
1836a717540cSStefano Zampini     ierr = PetscMalloc(pcis->n_B*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1837a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) nnz[i]=1;
1838a717540cSStefano Zampini     /* nonzeros per row */
1839a717540cSStefano Zampini     for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1840a717540cSStefano Zampini       if (PetscBTLookup(change_basis,i)) {
1841a717540cSStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
1842a717540cSStefano Zampini         if (PetscBTLookup(qr_needed_idx,i)) {
1843a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1844a717540cSStefano Zampini         } else {
1845a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = 2;
1846a717540cSStefano Zampini           /* get local primal index on the cc */
1847a717540cSStefano Zampini           j = 0;
1848a717540cSStefano Zampini           while (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+j])) j++;
1849a717540cSStefano Zampini           nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1850a717540cSStefano Zampini         }
1851a717540cSStefano Zampini       }
1852a717540cSStefano Zampini     }
1853a717540cSStefano Zampini     ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
1854a717540cSStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
1855a717540cSStefano Zampini     /* Set initial identity in the matrix */
1856a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) {
1857a717540cSStefano Zampini       ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
1858a717540cSStefano Zampini     }
1859a717540cSStefano Zampini 
1860a717540cSStefano Zampini     if (pcbddc->dbg_flag) {
1861a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1862a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
1863a717540cSStefano Zampini     }
1864a717540cSStefano Zampini 
1865a717540cSStefano Zampini 
1866a717540cSStefano Zampini     /* Now we loop on the constraints which need a change of basis */
1867a717540cSStefano Zampini     /*
1868a717540cSStefano Zampini        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
1869a717540cSStefano Zampini        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
1870a717540cSStefano Zampini 
1871a717540cSStefano Zampini        Basic blocks of change of basis matrix T computed
1872a717540cSStefano Zampini 
1873a717540cSStefano Zampini           - Using the following block transformation if there is only a primal dof on the cc
1874a717540cSStefano Zampini             (in the example, primal dof is the last one of the edge in LOCAL ordering
1875a717540cSStefano Zampini              in this code, primal dof is the first one of the edge in GLOBAL ordering)
1876a717540cSStefano Zampini             | 1        0   ...        0     1 |
1877a717540cSStefano Zampini             | 0        1   ...        0     1 |
1878a717540cSStefano Zampini             |              ...                |
1879a717540cSStefano Zampini             | 0        ...            1     1 |
1880a717540cSStefano Zampini             | -s_1/s_n ...    -s_{n-1}/-s_n 1 |
1881a717540cSStefano Zampini 
1882a717540cSStefano Zampini           - via QR decomposition of constraints otherwise
1883a717540cSStefano Zampini     */
1884a717540cSStefano Zampini     if (qr_needed) {
1885984c4197SStefano Zampini       /* space to store Q */
1886984c4197SStefano Zampini       ierr = PetscMalloc((max_size_of_constraint)*(max_size_of_constraint)*sizeof(PetscScalar),&qr_basis);CHKERRQ(ierr);
1887984c4197SStefano Zampini       /* first we issue queries for optimal work */
18883f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
18893f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
18903f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1891984c4197SStefano Zampini       lqr_work = -1;
18923f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
1893984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
1894984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
1895984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lqr_work_t)*sizeof(*qr_work),&qr_work);CHKERRQ(ierr);
1896984c4197SStefano Zampini       lgqr_work = -1;
18973f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
18983f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
18993f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
19003f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
19013f08241aSStefano Zampini       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
19023f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
1903984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
1904984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
1905984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lgqr_work_t)*sizeof(*gqr_work),&gqr_work);CHKERRQ(ierr);
1906984c4197SStefano Zampini       /* array to store scaling factors for reflectors */
1907984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*sizeof(*qr_tau),&qr_tau);CHKERRQ(ierr);
1908984c4197SStefano Zampini       /* array to store rhs and solution of triangular solver */
1909984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*max_constraints*sizeof(*trs_rhs),&trs_rhs);CHKERRQ(ierr);
1910a717540cSStefano Zampini       /* allocating workspace for check */
1911a717540cSStefano Zampini       if (pcbddc->dbg_flag) {
1912a717540cSStefano Zampini         ierr = PetscMalloc(max_size_of_constraint*(max_constraints+max_size_of_constraint)*sizeof(*work),&work);CHKERRQ(ierr);
1913a717540cSStefano Zampini       }
1914a717540cSStefano Zampini     }
1915984c4197SStefano Zampini     /* array to store whether a node is primal or not */
19164641a718SStefano Zampini     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
19174641a718SStefano Zampini     for (i=0;i<total_primal_vertices;i++) {
19184641a718SStefano Zampini       ierr = PetscBTSet(is_primal,local_to_B[aux_primal_numbering[i]]);CHKERRQ(ierr);
19194641a718SStefano Zampini     }
1920984c4197SStefano Zampini 
1921a717540cSStefano Zampini     /* loop on constraints and see whether or not they need a change of basis and compute it */
1922026de310SStefano Zampini     /* -> using implicit ordering contained in temp_indices data */
1923026de310SStefano Zampini     total_counts = pcbddc->n_vertices;
1924026de310SStefano Zampini     primal_counter = total_counts;
1925026de310SStefano Zampini     while (total_counts<pcbddc->local_primal_size) {
1926026de310SStefano Zampini       primal_dofs = 1;
19274641a718SStefano Zampini       if (PetscBTLookup(change_basis,total_counts)) {
1928026de310SStefano Zampini         /* get all constraints with same support: if more then one constraint is present on the cc then surely indices are stored contiguosly */
1929026de310SStefano 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]]) {
1930026de310SStefano Zampini           primal_dofs++;
1931674ae819SStefano Zampini         }
1932984c4197SStefano Zampini         /* get constraint info */
1933026de310SStefano Zampini         size_of_constraint = temp_indices[total_counts+1]-temp_indices[total_counts];
1934984c4197SStefano Zampini         dual_dofs = size_of_constraint-primal_dofs;
1935984c4197SStefano Zampini 
1936984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
1937a717540cSStefano 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);
1938674ae819SStefano Zampini         }
1939984c4197SStefano Zampini 
1940a717540cSStefano Zampini         if (primal_dofs > 1) { /* QR */
1941a717540cSStefano Zampini 
1942a717540cSStefano Zampini           /* copy quadrature constraints for change of basis check */
1943a717540cSStefano Zampini           if (pcbddc->dbg_flag) {
1944a717540cSStefano Zampini             ierr = PetscMemcpy(work,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1945a717540cSStefano Zampini           }
1946984c4197SStefano Zampini           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
1947026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1948984c4197SStefano Zampini 
1949984c4197SStefano Zampini           /* compute QR decomposition of constraints */
19503f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
19513f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
19523f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1953674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
19543f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
1955984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
1956674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1957984c4197SStefano Zampini 
1958984c4197SStefano Zampini           /* explictly compute R^-T */
1959984c4197SStefano Zampini           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
1960984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
19613f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
19623f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
19633f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
19643f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
1965984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
19663f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
1967984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
1968984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1969984c4197SStefano Zampini 
1970a717540cSStefano Zampini           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
19713f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
19723f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
19733f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
19743f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1975984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
19763f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
1977984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
1978984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1979984c4197SStefano Zampini 
1980984c4197SStefano Zampini           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
1981984c4197SStefano Zampini              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
1982984c4197SStefano Zampini              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
19833f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
19843f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
19853f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
19863f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
19873f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
19883f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1989984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1990c4303822SStefano 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));
1991984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1992026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1993984c4197SStefano Zampini 
1994984c4197SStefano Zampini           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
1995026de310SStefano Zampini           start_rows = &temp_indices_to_constraint_B[temp_indices[total_counts]];
1996984c4197SStefano Zampini           /* insert cols for primal dofs */
1997984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) {
1998984c4197SStefano Zampini             start_vals = &qr_basis[j*size_of_constraint];
1999026de310SStefano Zampini             start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter+j]];
2000984c4197SStefano Zampini             ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
2001984c4197SStefano Zampini           }
2002984c4197SStefano Zampini           /* insert cols for dual dofs */
2003984c4197SStefano Zampini           for (j=0,k=0;j<dual_dofs;k++) {
20044641a718SStefano Zampini             if (!PetscBTLookup(is_primal,temp_indices_to_constraint_B[temp_indices[total_counts]+k])) {
2005984c4197SStefano Zampini               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
2006026de310SStefano Zampini               start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+k];
2007984c4197SStefano Zampini               ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
2008984c4197SStefano Zampini               j++;
2009674ae819SStefano Zampini             }
2010674ae819SStefano Zampini           }
2011984c4197SStefano Zampini 
2012984c4197SStefano Zampini           /* check change of basis */
2013984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
2014984c4197SStefano Zampini             PetscInt   ii,jj;
2015984c4197SStefano Zampini             PetscBool valid_qr=PETSC_TRUE;
2016c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
2017c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2018c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
2019c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2020c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
2021c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
2022984c4197SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2023c4303822SStefano 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));
2024984c4197SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
2025984c4197SStefano Zampini             for (jj=0;jj<size_of_constraint;jj++) {
2026984c4197SStefano Zampini               for (ii=0;ii<primal_dofs;ii++) {
2027984c4197SStefano Zampini                 if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
2028984c4197SStefano Zampini                 if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
2029674ae819SStefano Zampini               }
2030674ae819SStefano Zampini             }
2031984c4197SStefano Zampini             if (!valid_qr) {
2032984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
2033984c4197SStefano Zampini               for (jj=0;jj<size_of_constraint;jj++) {
2034984c4197SStefano Zampini                 for (ii=0;ii<primal_dofs;ii++) {
2035984c4197SStefano Zampini                   if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
2036984c4197SStefano 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]));
2037674ae819SStefano Zampini                   }
2038984c4197SStefano Zampini                   if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
2039984c4197SStefano 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]));
2040984c4197SStefano Zampini                   }
2041984c4197SStefano Zampini                 }
2042984c4197SStefano Zampini               }
2043674ae819SStefano Zampini             } else {
2044984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
2045674ae819SStefano Zampini             }
2046674ae819SStefano Zampini           }
2047a717540cSStefano Zampini         } else { /* simple transformation block */
2048a717540cSStefano Zampini           PetscInt row,col;
2049a717540cSStefano Zampini           PetscScalar val;
2050a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) {
2051a717540cSStefano Zampini             row = temp_indices_to_constraint_B[temp_indices[total_counts]+j];
2052a717540cSStefano Zampini             if (!PetscBTLookup(is_primal,row)) {
2053a717540cSStefano Zampini               col = temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
2054a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
2055a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,1.0,INSERT_VALUES);CHKERRQ(ierr);
2056a717540cSStefano Zampini             } else {
2057a717540cSStefano Zampini               for (k=0;k<size_of_constraint;k++) {
2058a717540cSStefano Zampini                 col = temp_indices_to_constraint_B[temp_indices[total_counts]+k];
2059a717540cSStefano Zampini                 if (row != col) {
2060a717540cSStefano Zampini                   val = -temp_quadrature_constraint[temp_indices[total_counts]+k]/temp_quadrature_constraint[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
2061a717540cSStefano Zampini                 } else {
2062a717540cSStefano Zampini                   val = 1.0;
2063a717540cSStefano Zampini                 }
2064a717540cSStefano Zampini                 ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
2065a717540cSStefano Zampini               }
2066a717540cSStefano Zampini             }
2067a717540cSStefano Zampini           }
2068a717540cSStefano Zampini         }
2069026de310SStefano Zampini         /* increment primal counter */
2070026de310SStefano Zampini         primal_counter += primal_dofs;
2071984c4197SStefano Zampini       } else {
2072984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
2073026de310SStefano 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);
2074674ae819SStefano Zampini         }
2075674ae819SStefano Zampini       }
2076026de310SStefano Zampini       /* increment constraint counter total_counts */
2077026de310SStefano Zampini       total_counts += primal_dofs;
2078674ae819SStefano Zampini     }
2079a717540cSStefano Zampini 
2080a717540cSStefano Zampini     /* free workspace */
2081a717540cSStefano Zampini     if (qr_needed) {
2082984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
2083984c4197SStefano Zampini         ierr = PetscFree(work);CHKERRQ(ierr);
2084984c4197SStefano Zampini       }
2085984c4197SStefano Zampini       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
2086984c4197SStefano Zampini       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
2087984c4197SStefano Zampini       ierr = PetscFree(qr_work);CHKERRQ(ierr);
2088984c4197SStefano Zampini       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
2089984c4197SStefano Zampini       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
2090674ae819SStefano Zampini     }
2091a717540cSStefano Zampini     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
2092674ae819SStefano Zampini     /* assembling */
2093674ae819SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2094674ae819SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2095984c4197SStefano Zampini     /*
209645a1bb75SStefano Zampini     ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
2097984c4197SStefano Zampini     ierr = MatView(pcbddc->ChangeOfBasisMatrix,(PetscViewer)0);CHKERRQ(ierr);
2098984c4197SStefano Zampini     */
2099674ae819SStefano Zampini   }
2100a717540cSStefano Zampini 
2101727cdba6SStefano Zampini   /* get indices in local ordering for vertices and constraints */
2102727cdba6SStefano 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 */
2103727cdba6SStefano Zampini     ierr = PetscMalloc(olocal_primal_size*sizeof(PetscInt),&oprimal_indices_local_idxs);CHKERRQ(ierr);
2104727cdba6SStefano Zampini     ierr = PetscMemcpy(oprimal_indices_local_idxs,pcbddc->primal_indices_local_idxs,olocal_primal_size*sizeof(PetscInt));CHKERRQ(ierr);
2105727cdba6SStefano Zampini   }
2106727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2107727cdba6SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
2108727cdba6SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&i,&aux_primal_numbering);CHKERRQ(ierr);
2109727cdba6SStefano Zampini   ierr = PetscMemcpy(pcbddc->primal_indices_local_idxs,aux_primal_numbering,i*sizeof(PetscInt));CHKERRQ(ierr);
2110727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2111727cdba6SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&j,&aux_primal_numbering);CHKERRQ(ierr);
2112727cdba6SStefano Zampini   ierr = PetscMemcpy(&pcbddc->primal_indices_local_idxs[i],aux_primal_numbering,j*sizeof(PetscInt));CHKERRQ(ierr);
2113727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2114727cdba6SStefano Zampini   /* check if a new primal space has been introduced */
2115727cdba6SStefano Zampini   pcbddc->new_primal_space_local = PETSC_TRUE;
2116727cdba6SStefano Zampini   if (olocal_primal_size == pcbddc->local_primal_size) {
2117727cdba6SStefano Zampini     ierr = PetscMemcmp(pcbddc->primal_indices_local_idxs,oprimal_indices_local_idxs,olocal_primal_size,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
2118727cdba6SStefano Zampini     pcbddc->new_primal_space_local = !pcbddc->new_primal_space_local;
2119727cdba6SStefano Zampini     ierr = PetscFree(oprimal_indices_local_idxs);CHKERRQ(ierr);
2120727cdba6SStefano Zampini   }
2121727cdba6SStefano Zampini   /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
2122727cdba6SStefano Zampini   ierr = MPI_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2123727cdba6SStefano Zampini 
2124a717540cSStefano Zampini   /* flush dbg viewer */
2125b8ffe317SStefano Zampini   if (pcbddc->dbg_flag) {
2126b8ffe317SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2127b8ffe317SStefano Zampini   }
2128a717540cSStefano Zampini 
2129e310c8b4SStefano Zampini   /* free workspace */
2130a717540cSStefano Zampini   ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2131a717540cSStefano Zampini   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
2132984c4197SStefano Zampini   ierr = PetscFree(aux_primal_minloc);CHKERRQ(ierr);
2133674ae819SStefano Zampini   ierr = PetscFree(temp_indices);CHKERRQ(ierr);
21344641a718SStefano Zampini   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
2135674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr);
2136674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
2137674ae819SStefano Zampini   ierr = PetscFree(local_to_B);CHKERRQ(ierr);
2138674ae819SStefano Zampini   ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr);
2139674ae819SStefano Zampini   PetscFunctionReturn(0);
2140674ae819SStefano Zampini }
2141674ae819SStefano Zampini 
2142674ae819SStefano Zampini #undef __FUNCT__
2143674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
2144674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
2145674ae819SStefano Zampini {
2146674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
2147674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
2148674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
2149674ae819SStefano Zampini   PetscInt    bs,ierr,i,vertex_size;
2150674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
2151674ae819SStefano Zampini 
2152674ae819SStefano Zampini   PetscFunctionBegin;
21538e61c736SStefano Zampini   /* Reset previously computed graph */
21548e61c736SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
2155674ae819SStefano Zampini   /* Init local Graph struct */
2156674ae819SStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr);
2157674ae819SStefano Zampini 
2158575ad6abSStefano Zampini   /* Check validity of the csr graph passed in by the user */
2159575ad6abSStefano Zampini   if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) {
2160575ad6abSStefano Zampini     ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
2161575ad6abSStefano Zampini   }
21629577ea80SStefano Zampini 
2163674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
2164674ae819SStefano Zampini   if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) {
2165674ae819SStefano Zampini     Mat mat_adj;
2166674ae819SStefano Zampini     const PetscInt *xadj,*adjncy;
2167674ae819SStefano Zampini     PetscBool flg_row=PETSC_TRUE;
2168674ae819SStefano Zampini 
2169674ae819SStefano Zampini     ierr = MatConvert(matis->A,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr);
2170674ae819SStefano Zampini     ierr = MatGetRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2171674ae819SStefano Zampini     if (!flg_row) {
2172674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ called in %s\n",__FUNCT__);
2173674ae819SStefano Zampini     }
2174674ae819SStefano Zampini     ierr = PCBDDCSetLocalAdjacencyGraph(pc,i,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
2175674ae819SStefano Zampini     ierr = MatRestoreRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2176674ae819SStefano Zampini     if (!flg_row) {
2177674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__);
2178674ae819SStefano Zampini     }
2179674ae819SStefano Zampini     ierr = MatDestroy(&mat_adj);CHKERRQ(ierr);
2180674ae819SStefano Zampini   }
2181674ae819SStefano Zampini 
2182674ae819SStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting */
2183674ae819SStefano Zampini   vertex_size = 1;
21849577ea80SStefano Zampini   if (!pcbddc->user_provided_isfordofs) {
2185674ae819SStefano Zampini     if (!pcbddc->n_ISForDofs) {
2186674ae819SStefano Zampini       IS *custom_ISForDofs;
2187674ae819SStefano Zampini 
2188674ae819SStefano Zampini       ierr = MatGetBlockSize(matis->A,&bs);CHKERRQ(ierr);
2189674ae819SStefano Zampini       ierr = PetscMalloc(bs*sizeof(IS),&custom_ISForDofs);CHKERRQ(ierr);
2190674ae819SStefano Zampini       for (i=0;i<bs;i++) {
2191674ae819SStefano Zampini         ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n/bs,i,bs,&custom_ISForDofs[i]);CHKERRQ(ierr);
2192674ae819SStefano Zampini       }
2193674ae819SStefano Zampini       ierr = PCBDDCSetDofsSplitting(pc,bs,custom_ISForDofs);CHKERRQ(ierr);
21949577ea80SStefano Zampini       pcbddc->user_provided_isfordofs = PETSC_FALSE;
2195674ae819SStefano Zampini       /* remove my references to IS objects */
2196674ae819SStefano Zampini       for (i=0;i<bs;i++) {
2197674ae819SStefano Zampini         ierr = ISDestroy(&custom_ISForDofs[i]);CHKERRQ(ierr);
2198674ae819SStefano Zampini       }
2199674ae819SStefano Zampini       ierr = PetscFree(custom_ISForDofs);CHKERRQ(ierr);
22009577ea80SStefano Zampini     }
22019577ea80SStefano Zampini   } else { /* mat block size as vertex size (used for elasticity with rigid body modes as nearnullspace) */
2202674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
2203674ae819SStefano Zampini   }
2204674ae819SStefano Zampini 
2205674ae819SStefano Zampini   /* Setup of Graph */
2206674ae819SStefano Zampini   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundaries,pcbddc->DirichletBoundaries,pcbddc->n_ISForDofs,pcbddc->ISForDofs,pcbddc->user_primal_vertices);
2207674ae819SStefano Zampini 
2208674ae819SStefano Zampini   /* Graph's connected components analysis */
2209674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
2210674ae819SStefano Zampini 
2211674ae819SStefano Zampini   /* print some info to stdout */
2212674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
2213e49050b4SStefano Zampini     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer);
2214674ae819SStefano Zampini   }
2215fb180af4SStefano Zampini 
2216fb180af4SStefano Zampini   /* mark topography has done */
2217fb180af4SStefano Zampini   pcbddc->recompute_topography = PETSC_FALSE;
2218674ae819SStefano Zampini   PetscFunctionReturn(0);
2219674ae819SStefano Zampini }
2220674ae819SStefano Zampini 
2221674ae819SStefano Zampini #undef __FUNCT__
2222674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx"
2223f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt **vertices_idx)
2224674ae819SStefano Zampini {
2225674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2226674ae819SStefano Zampini   PetscInt       *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size;
2227674ae819SStefano Zampini   PetscErrorCode ierr;
2228674ae819SStefano Zampini 
2229674ae819SStefano Zampini   PetscFunctionBegin;
2230674ae819SStefano Zampini   n = 0;
2231674ae819SStefano Zampini   vertices = 0;
2232674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2233674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr);
2234b120a5c6SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2235b120a5c6SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2236b120a5c6SStefano Zampini       if (size_of_constraint == 1) n++;
2237b120a5c6SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2238b120a5c6SStefano Zampini     }
2239811e8ca2SStefano Zampini     if (vertices_idx) {
2240b120a5c6SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&vertices);CHKERRQ(ierr);
2241b120a5c6SStefano Zampini       n = 0;
2242674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2243674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2244674ae819SStefano Zampini         if (size_of_constraint == 1) {
2245674ae819SStefano Zampini           vertices[n++]=row_cmat_indices[0];
2246674ae819SStefano Zampini         }
2247674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2248674ae819SStefano Zampini       }
2249674ae819SStefano Zampini     }
2250811e8ca2SStefano Zampini   }
2251674ae819SStefano Zampini   *n_vertices = n;
2252811e8ca2SStefano Zampini   if (vertices_idx) *vertices_idx = vertices;
2253674ae819SStefano Zampini   PetscFunctionReturn(0);
2254674ae819SStefano Zampini }
2255674ae819SStefano Zampini 
2256674ae819SStefano Zampini #undef __FUNCT__
2257674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx"
2258f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt **constraints_idx)
2259674ae819SStefano Zampini {
2260674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2261674ae819SStefano Zampini   PetscInt       *constraints_index,*row_cmat_indices,*row_cmat_global_indices;
2262674ae819SStefano Zampini   PetscInt       n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc;
22634641a718SStefano Zampini   PetscBT        touched;
2264674ae819SStefano Zampini   PetscErrorCode ierr;
2265674ae819SStefano Zampini 
2266f34684f1SStefano Zampini     /* This function assumes that the number of local constraints per connected component
2267f34684f1SStefano Zampini        is not greater than the number of nodes defined for the connected component
2268f34684f1SStefano Zampini        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
2269674ae819SStefano Zampini   PetscFunctionBegin;
2270674ae819SStefano Zampini   n = 0;
2271674ae819SStefano Zampini   constraints_index = 0;
2272674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2273674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr);
2274674ae819SStefano Zampini     max_size_of_constraint = 0;
2275674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2276674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2277674ae819SStefano Zampini       if (size_of_constraint > 1) {
2278674ae819SStefano Zampini         n++;
2279674ae819SStefano Zampini       }
2280674ae819SStefano Zampini       max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint);
2281674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2282674ae819SStefano Zampini     }
2283811e8ca2SStefano Zampini     if (constraints_idx) {
2284674ae819SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&constraints_index);CHKERRQ(ierr);
2285674ae819SStefano Zampini       ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&row_cmat_global_indices);CHKERRQ(ierr);
22864641a718SStefano Zampini       ierr = PetscBTCreate(local_size,&touched);CHKERRQ(ierr);
2287674ae819SStefano Zampini       n = 0;
2288674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2289674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2290674ae819SStefano Zampini         if (size_of_constraint > 1) {
2291674ae819SStefano Zampini           ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr);
229282d3d8afSStefano Zampini           /* find first untouched local node */
229382d3d8afSStefano Zampini           j = 0;
22944641a718SStefano Zampini           while (PetscBTLookup(touched,row_cmat_indices[j])) j++;
229582d3d8afSStefano Zampini           min_index = row_cmat_global_indices[j];
229682d3d8afSStefano Zampini           min_loc = j;
229782d3d8afSStefano Zampini           /* search the minimum among nodes not yet touched on the connected component
229882d3d8afSStefano Zampini              since there can be more than one constraint on a single cc */
2299674ae819SStefano Zampini           for (j=1;j<size_of_constraint;j++) {
23004641a718SStefano Zampini             if (!PetscBTLookup(touched,row_cmat_indices[j]) && min_index > row_cmat_global_indices[j]) {
2301674ae819SStefano Zampini               min_index = row_cmat_global_indices[j];
2302674ae819SStefano Zampini               min_loc = j;
2303674ae819SStefano Zampini             }
2304674ae819SStefano Zampini           }
23054641a718SStefano Zampini           ierr = PetscBTSet(touched,row_cmat_indices[min_loc]);CHKERRQ(ierr);
2306674ae819SStefano Zampini           constraints_index[n++] = row_cmat_indices[min_loc];
2307674ae819SStefano Zampini         }
2308674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2309674ae819SStefano Zampini       }
23104641a718SStefano Zampini       ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2311674ae819SStefano Zampini       ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr);
2312811e8ca2SStefano Zampini     }
2313811e8ca2SStefano Zampini   }
2314674ae819SStefano Zampini   *n_constraints = n;
2315811e8ca2SStefano Zampini   if (constraints_idx) *constraints_idx = constraints_index;
2316674ae819SStefano Zampini   PetscFunctionReturn(0);
2317674ae819SStefano Zampini }
2318674ae819SStefano Zampini 
2319674ae819SStefano Zampini /* the next two functions has been adapted from pcis.c */
2320674ae819SStefano Zampini #undef __FUNCT__
2321674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchur"
2322674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchur(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2323674ae819SStefano Zampini {
2324674ae819SStefano Zampini   PetscErrorCode ierr;
2325674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2326674ae819SStefano Zampini 
2327674ae819SStefano Zampini   PetscFunctionBegin;
2328674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2329674ae819SStefano Zampini   ierr = MatMult(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2330674ae819SStefano Zampini   ierr = MatMult(pcis->A_IB,v,vec1_D);CHKERRQ(ierr);
2331674ae819SStefano Zampini   ierr = KSPSolve(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2332674ae819SStefano Zampini   ierr = MatMult(pcis->A_BI,vec2_D,vec2_B);CHKERRQ(ierr);
2333674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2334674ae819SStefano Zampini   PetscFunctionReturn(0);
2335674ae819SStefano Zampini }
2336674ae819SStefano Zampini 
2337674ae819SStefano Zampini #undef __FUNCT__
2338674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchurTranspose"
2339674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchurTranspose(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2340674ae819SStefano Zampini {
2341674ae819SStefano Zampini   PetscErrorCode ierr;
2342674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2343674ae819SStefano Zampini 
2344674ae819SStefano Zampini   PetscFunctionBegin;
2345674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2346674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2347674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BI,v,vec1_D);CHKERRQ(ierr);
2348674ae819SStefano Zampini   ierr = KSPSolveTranspose(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2349674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_IB,vec2_D,vec2_B);CHKERRQ(ierr);
2350674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2351674ae819SStefano Zampini   PetscFunctionReturn(0);
2352674ae819SStefano Zampini }
2353674ae819SStefano Zampini 
2354674ae819SStefano Zampini #undef __FUNCT__
2355674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
2356674ae819SStefano 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[])
2357674ae819SStefano Zampini {
2358674ae819SStefano Zampini   Vec            local_vec,global_vec;
2359674ae819SStefano Zampini   IS             seqis,paris;
2360674ae819SStefano Zampini   VecScatter     scatter_ctx;
2361674ae819SStefano Zampini   PetscScalar    *array;
2362674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
2363674ae819SStefano Zampini   PetscScalar    globalsum;
2364674ae819SStefano Zampini   PetscInt       i,j,s;
2365674ae819SStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local;
2366674ae819SStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm,max_global;
2367674ae819SStefano Zampini   PetscMPIInt    *dof_sizes,*dof_displs;
2368674ae819SStefano Zampini   PetscBool      first_found;
2369674ae819SStefano Zampini   PetscErrorCode ierr;
2370674ae819SStefano Zampini 
2371674ae819SStefano Zampini   PetscFunctionBegin;
2372674ae819SStefano Zampini   /* mpi buffers */
2373674ae819SStefano Zampini   MPI_Comm_size(comm,&size_prec_comm);
2374674ae819SStefano Zampini   MPI_Comm_rank(comm,&rank_prec_comm);
2375674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
2376674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_sizes),&dof_sizes);CHKERRQ(ierr);
2377674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_displs),&dof_displs);CHKERRQ(ierr);
2378674ae819SStefano Zampini   /* get maximum size of subset */
2379674ae819SStefano Zampini   ierr = PetscMalloc(n_local_dofs*sizeof(PetscInt),&temp_global_dofs);CHKERRQ(ierr);
2380674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
2381674ae819SStefano Zampini   max_local = 0;
2382674ae819SStefano Zampini   if (n_local_dofs) {
2383674ae819SStefano Zampini     max_local = temp_global_dofs[0];
2384674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2385674ae819SStefano Zampini       if (max_local < temp_global_dofs[i] ) {
2386674ae819SStefano Zampini         max_local = temp_global_dofs[i];
2387674ae819SStefano Zampini       }
2388674ae819SStefano Zampini     }
2389674ae819SStefano Zampini   }
2390674ae819SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);
2391674ae819SStefano Zampini   max_global++;
2392674ae819SStefano Zampini   max_local = 0;
2393674ae819SStefano Zampini   if (n_local_dofs) {
2394674ae819SStefano Zampini     max_local = local_dofs[0];
2395674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2396674ae819SStefano Zampini       if (max_local < local_dofs[i] ) {
2397674ae819SStefano Zampini         max_local = local_dofs[i];
2398674ae819SStefano Zampini       }
2399674ae819SStefano Zampini     }
2400674ae819SStefano Zampini   }
2401674ae819SStefano Zampini   max_local++;
2402674ae819SStefano Zampini   /* allocate workspace */
2403674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
2404674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
2405674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
2406674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
2407674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
2408674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
2409674ae819SStefano Zampini   /* create scatter */
2410674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
2411674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
2412674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
2413674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
2414674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
2415674ae819SStefano Zampini   /* init array */
2416674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
2417674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2418674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2419674ae819SStefano Zampini   if (local_dofs_mult) {
2420674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2421674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
2422674ae819SStefano Zampini     }
2423674ae819SStefano Zampini   } else {
2424674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2425674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
2426674ae819SStefano Zampini     }
2427674ae819SStefano Zampini   }
2428674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2429674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
2430674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2431674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2432674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
24335b08dc53SStefano Zampini   *n_global_subset = (PetscInt)PetscRealPart(globalsum);
2434674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
2435674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
2436674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
2437674ae819SStefano Zampini   nlocals = 0;
2438674ae819SStefano Zampini   first_index = -1;
2439674ae819SStefano Zampini   first_found = PETSC_FALSE;
2440674ae819SStefano Zampini   for (i=0;i<s;i++) {
24415b08dc53SStefano Zampini     if (!first_found && PetscRealPart(array[i]) > 0.0) {
2442674ae819SStefano Zampini       first_found = PETSC_TRUE;
2443674ae819SStefano Zampini       first_index = i;
2444674ae819SStefano Zampini     }
24455b08dc53SStefano Zampini     nlocals += (PetscInt)PetscRealPart(array[i]);
2446674ae819SStefano Zampini   }
2447674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2448674ae819SStefano Zampini   if (!rank_prec_comm) {
2449674ae819SStefano Zampini     dof_displs[0]=0;
2450674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
2451674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
2452674ae819SStefano Zampini     }
2453674ae819SStefano Zampini   }
2454674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2455674ae819SStefano Zampini   if (first_found) {
2456674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
2457674ae819SStefano Zampini     old_index = first_index;
2458674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
24595b08dc53SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) {
2460674ae819SStefano Zampini         array[i] += array[old_index];
2461674ae819SStefano Zampini         old_index = i;
2462674ae819SStefano Zampini       }
2463674ae819SStefano Zampini     }
2464674ae819SStefano Zampini   }
2465674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
2466674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2467674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2468674ae819SStefano Zampini   ierr = VecScatterEnd  (scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2469674ae819SStefano Zampini   /* get global ordering of local dofs */
2470674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2471674ae819SStefano Zampini   if (local_dofs_mult) {
2472674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
24735b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i];
2474674ae819SStefano Zampini     }
2475674ae819SStefano Zampini   } else {
2476674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
24775b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1;
2478674ae819SStefano Zampini     }
2479674ae819SStefano Zampini   }
2480674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2481674ae819SStefano Zampini   /* free workspace */
2482674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
2483674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
2484674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
2485674ae819SStefano Zampini   ierr = PetscFree(dof_sizes);CHKERRQ(ierr);
2486674ae819SStefano Zampini   ierr = PetscFree(dof_displs);CHKERRQ(ierr);
2487674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
2488674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
2489674ae819SStefano Zampini   PetscFunctionReturn(0);
2490674ae819SStefano Zampini }
24919a7d3425SStefano Zampini 
24929a7d3425SStefano Zampini #undef __FUNCT__
24939a7d3425SStefano Zampini #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
24949a7d3425SStefano Zampini PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
24959a7d3425SStefano Zampini {
24969a7d3425SStefano Zampini   PetscInt       i,j;
24979a7d3425SStefano Zampini   PetscScalar    *alphas;
24989a7d3425SStefano Zampini   PetscErrorCode ierr;
24999a7d3425SStefano Zampini 
25009a7d3425SStefano Zampini   PetscFunctionBegin;
25019a7d3425SStefano Zampini   /* this implements stabilized Gram-Schmidt */
25029a7d3425SStefano Zampini   ierr = PetscMalloc(n*sizeof(PetscScalar),&alphas);CHKERRQ(ierr);
25039a7d3425SStefano Zampini   for (i=0;i<n;i++) {
25049a7d3425SStefano Zampini     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
25059a7d3425SStefano Zampini     if (i<n) { ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],&alphas[i+1]);CHKERRQ(ierr); }
25069a7d3425SStefano Zampini     for (j=i+1;j<n;j++) { ierr = VecAXPY(vecs[j],PetscConj(-alphas[j]),vecs[i]);CHKERRQ(ierr); }
25079a7d3425SStefano Zampini   }
25089a7d3425SStefano Zampini   ierr = PetscFree(alphas);CHKERRQ(ierr);
25099a7d3425SStefano Zampini   PetscFunctionReturn(0);
25109a7d3425SStefano Zampini }
25119a7d3425SStefano Zampini 
2512*fa7f1dd8SStefano Zampini /* TODO
2513*fa7f1dd8SStefano Zampini    - now preallocation is done assuming SEQDENSE local matrices
2514*fa7f1dd8SStefano Zampini */
2515c8587f34SStefano Zampini #undef __FUNCT__
2516*fa7f1dd8SStefano Zampini #define __FUNCT__ "MatISGetMPIXAIJ"
2517*fa7f1dd8SStefano Zampini static PetscErrorCode MatISGetMPIXAIJ(Mat mat, MatType Mtype, MatReuse reuse, Mat *M)
2518c8587f34SStefano Zampini {
2519a57a6d2fSStefano Zampini   Mat                    new_mat;
2520a57a6d2fSStefano Zampini   Mat_IS                 *matis = (Mat_IS*)(mat->data);
2521a57a6d2fSStefano Zampini   /* info on mat */
2522*fa7f1dd8SStefano Zampini   /* ISLocalToGlobalMapping rmapping,cmapping; */
2523a57a6d2fSStefano Zampini   PetscInt               bs,rows,cols;
2524a57a6d2fSStefano Zampini   PetscInt               lrows,lcols;
2525a57a6d2fSStefano Zampini   PetscInt               local_rows,local_cols;
2526*fa7f1dd8SStefano Zampini   PetscBool              isdense;
2527*fa7f1dd8SStefano Zampini   /* values insertion */
2528*fa7f1dd8SStefano Zampini   PetscScalar            *array;
2529a57a6d2fSStefano Zampini   PetscInt               *local_indices,*global_indices;
2530a57a6d2fSStefano Zampini   /* work */
2531*fa7f1dd8SStefano Zampini   PetscInt               i,j,index_row;
2532a57a6d2fSStefano Zampini   PetscErrorCode         ierr;
2533c8587f34SStefano Zampini 
2534a57a6d2fSStefano Zampini   PetscFunctionBegin;
2535*fa7f1dd8SStefano Zampini   /* MISSING CHECKS
2536*fa7f1dd8SStefano Zampini     - rectangular case not covered (it is not allowed by MATIS)
2537*fa7f1dd8SStefano Zampini   */
2538a57a6d2fSStefano Zampini   /* get info from mat */
2539*fa7f1dd8SStefano Zampini   /* ierr = MatGetLocalToGlobalMapping(mat,&rmapping,&cmapping);CHKERRQ(ierr); */
2540a57a6d2fSStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
2541a57a6d2fSStefano Zampini   ierr = MatGetBlockSize(mat,&bs);CHKERRQ(ierr);
2542a57a6d2fSStefano Zampini   ierr = MatGetSize(matis->A,&local_rows,&local_cols);CHKERRQ(ierr);
2543a57a6d2fSStefano Zampini 
2544*fa7f1dd8SStefano Zampini   /* work */
2545*fa7f1dd8SStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*local_indices),&local_indices);CHKERRQ(ierr);
2546*fa7f1dd8SStefano Zampini   for (i=0;i<local_rows;i++) local_indices[i]=i;
2547*fa7f1dd8SStefano Zampini   /* map indices of local mat to global values */
2548*fa7f1dd8SStefano Zampini   ierr = PetscMalloc(PetscMax(local_cols,local_rows)*sizeof(*global_indices),&global_indices);CHKERRQ(ierr);
2549*fa7f1dd8SStefano Zampini   /* ierr = ISLocalToGlobalMappingApply(rmapping,local_rows,local_indices,global_indices);CHKERRQ(ierr); */
2550*fa7f1dd8SStefano Zampini   ierr = ISLocalToGlobalMappingApply(matis->mapping,local_rows,local_indices,global_indices);CHKERRQ(ierr);
2551*fa7f1dd8SStefano Zampini 
2552*fa7f1dd8SStefano Zampini   if (reuse==MAT_INITIAL_MATRIX) {
2553*fa7f1dd8SStefano Zampini     Vec         vec_dnz,vec_onz;
2554*fa7f1dd8SStefano Zampini     PetscScalar *my_dnz,*my_onz;
2555*fa7f1dd8SStefano Zampini     PetscInt    *dnz,*onz,*mat_ranges,*row_ownership;
2556*fa7f1dd8SStefano Zampini     PetscInt    index_col,owner;
2557*fa7f1dd8SStefano Zampini     PetscMPIInt nsubdomains;
2558*fa7f1dd8SStefano Zampini 
2559*fa7f1dd8SStefano Zampini     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&nsubdomains);CHKERRQ(ierr);
2560a57a6d2fSStefano Zampini     ierr = MatCreate(PetscObjectComm((PetscObject)mat),&new_mat);CHKERRQ(ierr);
2561a57a6d2fSStefano Zampini     ierr = MatSetSizes(new_mat,PETSC_DECIDE,PETSC_DECIDE,rows,cols);CHKERRQ(ierr);
2562a57a6d2fSStefano Zampini     ierr = MatSetBlockSize(new_mat,bs);CHKERRQ(ierr);
2563*fa7f1dd8SStefano Zampini     ierr = MatSetType(new_mat,Mtype);CHKERRQ(ierr);
2564a57a6d2fSStefano Zampini     ierr = MatSetUp(new_mat);CHKERRQ(ierr);
2565a57a6d2fSStefano Zampini     ierr = MatGetLocalSize(new_mat,&lrows,&lcols);CHKERRQ(ierr);
2566a57a6d2fSStefano Zampini 
2567a57a6d2fSStefano Zampini     /*
2568a57a6d2fSStefano Zampini       preallocation
2569a57a6d2fSStefano Zampini     */
2570a57a6d2fSStefano Zampini 
2571a57a6d2fSStefano Zampini     ierr = MatPreallocateInitialize(PetscObjectComm((PetscObject)new_mat),lrows,lcols,dnz,onz);CHKERRQ(ierr);
2572a57a6d2fSStefano Zampini     /*
2573a57a6d2fSStefano Zampini        Some vectors are needed to sum up properly on shared interface dofs.
2574*fa7f1dd8SStefano Zampini        Preallocation macros cannot do the job.
2575a57a6d2fSStefano Zampini        Note that preallocation is not exact, since it overestimates nonzeros
2576a57a6d2fSStefano Zampini     */
2577a57a6d2fSStefano Zampini     ierr = MatGetVecs(new_mat,NULL,&vec_dnz);CHKERRQ(ierr);
2578*fa7f1dd8SStefano Zampini     /* ierr = VecSetLocalToGlobalMapping(vec_dnz,rmapping);CHKERRQ(ierr); */
2579*fa7f1dd8SStefano Zampini     ierr = VecSetLocalToGlobalMapping(vec_dnz,matis->mapping);CHKERRQ(ierr);
2580c8587f34SStefano Zampini     ierr = VecDuplicate(vec_dnz,&vec_onz);CHKERRQ(ierr);
2581e7931f94SStefano Zampini     /* All processes need to compute entire row ownership */
2582a57a6d2fSStefano Zampini     ierr = PetscMalloc(rows*sizeof(*row_ownership),&row_ownership);CHKERRQ(ierr);
2583a57a6d2fSStefano Zampini     ierr = MatGetOwnershipRanges(new_mat,(const PetscInt**)&mat_ranges);CHKERRQ(ierr);
2584a57a6d2fSStefano Zampini     for (i=0;i<nsubdomains;i++) {
2585c8587f34SStefano Zampini       for (j=mat_ranges[i];j<mat_ranges[i+1];j++) {
2586c8587f34SStefano Zampini         row_ownership[j]=i;
2587c8587f34SStefano Zampini       }
2588c8587f34SStefano Zampini     }
2589c8587f34SStefano Zampini 
2590e7931f94SStefano Zampini     /*
2591e7931f94SStefano Zampini        my_dnz and my_onz contains exact contribution to preallocation from each local mat
2592e7931f94SStefano Zampini        then, they will be summed up properly. This way, preallocation is always sufficient
2593e7931f94SStefano Zampini     */
2594a57a6d2fSStefano Zampini     ierr = PetscMalloc(local_rows*sizeof(*my_dnz),&my_dnz);CHKERRQ(ierr);
2595a57a6d2fSStefano Zampini     ierr = PetscMalloc(local_rows*sizeof(*my_onz),&my_onz);CHKERRQ(ierr);
2596a57a6d2fSStefano Zampini     ierr = PetscMemzero(my_dnz,local_rows*sizeof(*my_dnz));CHKERRQ(ierr);
2597a57a6d2fSStefano Zampini     ierr = PetscMemzero(my_onz,local_rows*sizeof(*my_onz));CHKERRQ(ierr);
2598a57a6d2fSStefano Zampini     for (i=0;i<local_rows;i++) {
2599a57a6d2fSStefano Zampini       index_row = global_indices[i];
2600a57a6d2fSStefano Zampini       for (j=i;j<local_rows;j++) {
2601a57a6d2fSStefano Zampini         owner = row_ownership[index_row];
2602a57a6d2fSStefano Zampini         index_col = global_indices[j];
2603a57a6d2fSStefano Zampini         if (index_col > mat_ranges[owner]-1 && index_col < mat_ranges[owner+1] ) { /* diag block */
2604c8587f34SStefano Zampini           my_dnz[i] += 1.0;
2605a57a6d2fSStefano Zampini         } else { /* offdiag block */
2606c8587f34SStefano Zampini           my_onz[i] += 1.0;
2607c8587f34SStefano Zampini         }
2608a57a6d2fSStefano Zampini         /* same as before, interchanging rows and cols */
2609c8587f34SStefano Zampini         if (i != j) {
2610a57a6d2fSStefano Zampini           owner = row_ownership[index_col];
2611a57a6d2fSStefano Zampini           if (index_row > mat_ranges[owner]-1 && index_row < mat_ranges[owner+1] ) {
2612c8587f34SStefano Zampini             my_dnz[j] += 1.0;
2613c8587f34SStefano Zampini           } else {
2614c8587f34SStefano Zampini             my_onz[j] += 1.0;
2615c8587f34SStefano Zampini           }
2616c8587f34SStefano Zampini         }
2617c8587f34SStefano Zampini       }
2618c8587f34SStefano Zampini     }
2619c8587f34SStefano Zampini     ierr = VecSet(vec_dnz,0.0);CHKERRQ(ierr);
2620c8587f34SStefano Zampini     ierr = VecSet(vec_onz,0.0);CHKERRQ(ierr);
262120a2ab83SStefano Zampini     if (local_rows) { /* multilevel guard */
2622*fa7f1dd8SStefano Zampini       ierr = VecSetValuesLocal(vec_dnz,local_rows,local_indices,my_dnz,ADD_VALUES);CHKERRQ(ierr);
2623*fa7f1dd8SStefano Zampini       ierr = VecSetValuesLocal(vec_onz,local_rows,local_indices,my_onz,ADD_VALUES);CHKERRQ(ierr);
2624c8587f34SStefano Zampini     }
2625c8587f34SStefano Zampini     ierr = VecAssemblyBegin(vec_dnz);CHKERRQ(ierr);
2626c8587f34SStefano Zampini     ierr = VecAssemblyBegin(vec_onz);CHKERRQ(ierr);
2627c8587f34SStefano Zampini     ierr = VecAssemblyEnd(vec_dnz);CHKERRQ(ierr);
2628c8587f34SStefano Zampini     ierr = VecAssemblyEnd(vec_onz);CHKERRQ(ierr);
2629c8587f34SStefano Zampini     ierr = PetscFree(my_dnz);CHKERRQ(ierr);
2630c8587f34SStefano Zampini     ierr = PetscFree(my_onz);CHKERRQ(ierr);
2631c8587f34SStefano Zampini     ierr = PetscFree(row_ownership);CHKERRQ(ierr);
2632a57a6d2fSStefano Zampini 
2633a57a6d2fSStefano Zampini     /* set computed preallocation in dnz and onz */
2634a57a6d2fSStefano Zampini     ierr = VecGetArray(vec_dnz,&array);CHKERRQ(ierr);
2635a57a6d2fSStefano Zampini     for (i=0; i<lrows; i++) dnz[i] = (PetscInt)PetscRealPart(array[i]);
2636a57a6d2fSStefano Zampini     ierr = VecRestoreArray(vec_dnz,&array);CHKERRQ(ierr);
2637a57a6d2fSStefano Zampini     ierr = VecGetArray(vec_onz,&array);CHKERRQ(ierr);
2638a57a6d2fSStefano Zampini     for (i=0;i<lrows;i++) onz[i] = (PetscInt)PetscRealPart(array[i]);
2639a57a6d2fSStefano Zampini     ierr = VecRestoreArray(vec_onz,&array);CHKERRQ(ierr);
2640c8587f34SStefano Zampini     ierr = VecDestroy(&vec_dnz);CHKERRQ(ierr);
2641c8587f34SStefano Zampini     ierr = VecDestroy(&vec_onz);CHKERRQ(ierr);
2642c8587f34SStefano Zampini 
2643e7931f94SStefano Zampini     /* Resize preallocation if overestimated */
2644c8587f34SStefano Zampini     for (i=0;i<lrows;i++) {
2645a57a6d2fSStefano Zampini       dnz[i] = PetscMin(dnz[i],lcols);
2646a57a6d2fSStefano Zampini       onz[i] = PetscMin(onz[i],cols-lcols);
2647c8587f34SStefano Zampini     }
2648*fa7f1dd8SStefano Zampini     /* set preallocation */
2649a57a6d2fSStefano Zampini     ierr = MatMPIAIJSetPreallocation(new_mat,0,dnz,0,onz);CHKERRQ(ierr);
2650*fa7f1dd8SStefano Zampini     for (i=0;i<lrows/bs;i++) {
2651*fa7f1dd8SStefano Zampini       dnz[i] = dnz[i*bs]/bs;
2652*fa7f1dd8SStefano Zampini       onz[i] = onz[i*bs]/bs;
2653*fa7f1dd8SStefano Zampini     }
2654*fa7f1dd8SStefano Zampini     ierr = MatMPIBAIJSetPreallocation(new_mat,bs,0,dnz,0,onz);CHKERRQ(ierr);
2655*fa7f1dd8SStefano Zampini     for (i=0;i<lrows/bs;i++) {
2656*fa7f1dd8SStefano Zampini       dnz[i] = dnz[i]-i;
2657*fa7f1dd8SStefano Zampini     }
2658*fa7f1dd8SStefano Zampini     ierr = MatMPISBAIJSetPreallocation(new_mat,bs,0,dnz,0,onz);CHKERRQ(ierr);
2659c8587f34SStefano Zampini     ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
2660*fa7f1dd8SStefano Zampini     *M = new_mat;
2661*fa7f1dd8SStefano Zampini   } else {
2662*fa7f1dd8SStefano Zampini     PetscInt mbs,mrows,mcols;
2663*fa7f1dd8SStefano Zampini     /* some checks */
2664*fa7f1dd8SStefano Zampini     ierr = MatGetBlockSize(*M,&mbs);CHKERRQ(ierr);
2665*fa7f1dd8SStefano Zampini     ierr = MatGetSize(*M,&mrows,&mcols);CHKERRQ(ierr);
2666*fa7f1dd8SStefano Zampini     if (mrows != rows) {
2667*fa7f1dd8SStefano Zampini       SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong number of rows (%d != %d)",rows,mrows);
2668*fa7f1dd8SStefano Zampini     }
2669*fa7f1dd8SStefano Zampini     if (mrows != rows) {
2670*fa7f1dd8SStefano Zampini       SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong number of cols (%d != %d)",cols,mcols);
2671*fa7f1dd8SStefano Zampini     }
2672*fa7f1dd8SStefano Zampini     if (mbs != bs) {
2673*fa7f1dd8SStefano Zampini       SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong block size (%d != %d)",bs,mbs);
2674*fa7f1dd8SStefano Zampini     }
2675*fa7f1dd8SStefano Zampini     ierr = MatZeroEntries(*M);CHKERRQ(ierr);
2676*fa7f1dd8SStefano Zampini   }
2677*fa7f1dd8SStefano Zampini   /* set local to global mappings */
2678*fa7f1dd8SStefano Zampini   /* ierr = MatSetLocalToGlobalMapping(*M,rmapping,cmapping);CHKERRQ(ierr); */
2679*fa7f1dd8SStefano Zampini   /* Set values */
2680*fa7f1dd8SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQDENSE,&isdense);CHKERRQ(ierr);
2681*fa7f1dd8SStefano Zampini   if (isdense) { /* special case for dense local matrices */
2682*fa7f1dd8SStefano Zampini     ierr = MatSetOption(*M,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
2683*fa7f1dd8SStefano Zampini     ierr = MatDenseGetArray(matis->A,&array);CHKERRQ(ierr);
2684*fa7f1dd8SStefano Zampini     ierr = MatSetValues(*M,local_rows,global_indices,local_cols,global_indices,array,ADD_VALUES);CHKERRQ(ierr);
2685*fa7f1dd8SStefano Zampini     ierr = MatDenseRestoreArray(matis->A,&array);CHKERRQ(ierr);
2686*fa7f1dd8SStefano Zampini     ierr = PetscFree(local_indices);CHKERRQ(ierr);
2687*fa7f1dd8SStefano Zampini     ierr = PetscFree(global_indices);CHKERRQ(ierr);
2688*fa7f1dd8SStefano Zampini   } else { /* very basic values insertion for all other matrix types */
2689*fa7f1dd8SStefano Zampini     ierr = PetscFree(local_indices);CHKERRQ(ierr);
2690*fa7f1dd8SStefano Zampini     ierr = PetscFree(global_indices);CHKERRQ(ierr);
2691a57a6d2fSStefano Zampini     for (i=0;i<local_rows;i++) {
2692a57a6d2fSStefano Zampini       ierr = MatGetRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2693*fa7f1dd8SStefano Zampini       /* ierr = MatSetValuesLocal(*M,1,&i,j,local_indices,array,ADD_VALUES);CHKERRQ(ierr); */
2694a57a6d2fSStefano Zampini       ierr = ISLocalToGlobalMappingApply(matis->mapping,j,local_indices,global_indices);CHKERRQ(ierr);
2695a57a6d2fSStefano Zampini       ierr = ISLocalToGlobalMappingApply(matis->mapping,1,&i,&index_row);CHKERRQ(ierr);
2696*fa7f1dd8SStefano Zampini       ierr = MatSetValues(*M,1,&index_row,j,global_indices,array,ADD_VALUES);CHKERRQ(ierr);
2697a57a6d2fSStefano Zampini       ierr = MatRestoreRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2698a57a6d2fSStefano Zampini     }
2699*fa7f1dd8SStefano Zampini   }
2700*fa7f1dd8SStefano Zampini   ierr = MatAssemblyBegin(*M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2701*fa7f1dd8SStefano Zampini   ierr = MatAssemblyEnd(*M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2702*fa7f1dd8SStefano Zampini   if (isdense) {
2703*fa7f1dd8SStefano Zampini     ierr = MatSetOption(*M,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
2704*fa7f1dd8SStefano Zampini   }
2705a57a6d2fSStefano Zampini   PetscFunctionReturn(0);
2706a57a6d2fSStefano Zampini }
2707a57a6d2fSStefano Zampini 
2708e7931f94SStefano Zampini #undef __FUNCT__
2709e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble_Private"
2710e7931f94SStefano Zampini PetscErrorCode MatISSubassemble_Private(Mat mat, PetscInt coarsening_ratio, IS* is_sends)
2711e7931f94SStefano Zampini {
2712e7931f94SStefano Zampini   Mat             subdomain_adj;
2713e7931f94SStefano Zampini   IS              new_ranks,ranks_send_to;
2714e7931f94SStefano Zampini   MatPartitioning partitioner;
2715e7931f94SStefano Zampini   Mat_IS          *matis;
2716e7931f94SStefano Zampini   PetscInt        n_neighs,*neighs,*n_shared,**shared;
2717e7931f94SStefano Zampini   PetscInt        prank;
2718e7931f94SStefano Zampini   PetscMPIInt     size,rank,color;
2719e7931f94SStefano Zampini   PetscInt        *xadj,*adjncy,*oldranks;
2720e7931f94SStefano Zampini   PetscInt        *adjncy_wgt,*v_wgt,*is_indices,*ranks_send_to_idx;
2721e7931f94SStefano Zampini   PetscInt        i,j,n_subdomains,local_size,threshold=0;
2722e7931f94SStefano Zampini   PetscErrorCode  ierr;
27232b510759SStefano Zampini   PetscBool       use_vwgt=PETSC_FALSE,use_square=PETSC_FALSE;
2724e7931f94SStefano Zampini   PetscSubcomm    subcomm;
2725a57a6d2fSStefano Zampini 
2726e7931f94SStefano Zampini   PetscFunctionBegin;
27272b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_square",&use_square,NULL);CHKERRQ(ierr);
27282b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
27292b510759SStefano Zampini   ierr = PetscOptionsGetInt(NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
2730e7931f94SStefano Zampini 
2731e7931f94SStefano Zampini   /* Get info on mapping */
2732e7931f94SStefano Zampini   matis = (Mat_IS*)(mat->data);
2733e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&local_size);CHKERRQ(ierr);
2734e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2735e7931f94SStefano Zampini 
2736e7931f94SStefano Zampini   /* build local CSR graph of subdomains' connectivity */
2737e7931f94SStefano Zampini   ierr = PetscMalloc(2*sizeof(*xadj),&xadj);CHKERRQ(ierr);
2738e7931f94SStefano Zampini   xadj[0] = 0;
2739e7931f94SStefano Zampini   xadj[1] = PetscMax(n_neighs-1,0);
2740e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy),&adjncy);CHKERRQ(ierr);
2741e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy_wgt),&adjncy_wgt);CHKERRQ(ierr);
2742e7931f94SStefano Zampini 
27432b510759SStefano Zampini   if (threshold) {
27442b510759SStefano Zampini     PetscInt* count,min_threshold;
2745e7931f94SStefano Zampini     ierr = PetscMalloc(local_size*sizeof(PetscInt),&count);CHKERRQ(ierr);
2746e7931f94SStefano Zampini     ierr = PetscMemzero(count,local_size*sizeof(PetscInt));CHKERRQ(ierr);
2747e7931f94SStefano Zampini     for (i=1;i<n_neighs;i++) {/* i=1 so I don't count myself -> faces nodes counts to 1 */
2748e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2749e7931f94SStefano Zampini         count[shared[i][j]] += 1;
2750e7931f94SStefano Zampini       }
2751e7931f94SStefano Zampini     }
27522b510759SStefano Zampini     /* adapt threshold since we dont want to lose significant connections */
27532b510759SStefano Zampini     min_threshold = n_neighs;
27542b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
27552b510759SStefano Zampini       for (j=0;j<n_shared[i];j++) {
27562b510759SStefano Zampini         min_threshold = PetscMin(count[shared[i][j]],min_threshold);
27572b510759SStefano Zampini       }
27582b510759SStefano Zampini     }
27592b510759SStefano Zampini     threshold = PetscMax(min_threshold+1,threshold);
2760e7931f94SStefano Zampini     xadj[1] = 0;
27612b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
2762e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2763e7931f94SStefano Zampini         if (count[shared[i][j]] < threshold) {
2764e7931f94SStefano Zampini           adjncy[xadj[1]] = neighs[i];
2765e7931f94SStefano Zampini           adjncy_wgt[xadj[1]] = n_shared[i];
2766e7931f94SStefano Zampini           xadj[1]++;
2767e7931f94SStefano Zampini           break;
2768e7931f94SStefano Zampini         }
2769e7931f94SStefano Zampini       }
2770e7931f94SStefano Zampini     }
2771e7931f94SStefano Zampini     ierr = PetscFree(count);CHKERRQ(ierr);
2772c8587f34SStefano Zampini   } else {
2773e7931f94SStefano Zampini     if (xadj[1]) {
2774e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy,&neighs[1],xadj[1]*sizeof(*adjncy));CHKERRQ(ierr);
2775e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy_wgt,&n_shared[1],xadj[1]*sizeof(*adjncy_wgt));CHKERRQ(ierr);
2776c8587f34SStefano Zampini     }
2777e7931f94SStefano Zampini   }
2778e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingRestoreInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2779e7931f94SStefano Zampini   if (use_square) {
2780e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2781e7931f94SStefano Zampini       adjncy_wgt[i] = adjncy_wgt[i]*adjncy_wgt[i];
2782e7931f94SStefano Zampini     }
2783e7931f94SStefano Zampini   }
2784e7931f94SStefano Zampini   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2785e7931f94SStefano Zampini 
2786e7931f94SStefano Zampini   ierr = PetscMalloc(sizeof(PetscInt),&ranks_send_to_idx);CHKERRQ(ierr);
2787e7931f94SStefano Zampini 
2788e7931f94SStefano Zampini   /*
2789e7931f94SStefano Zampini     Restrict work on active processes only.
2790e7931f94SStefano Zampini   */
2791e7931f94SStefano Zampini   ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&subcomm);CHKERRQ(ierr);
2792e7931f94SStefano Zampini   ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
2793e7931f94SStefano Zampini   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
27942b510759SStefano Zampini   ierr = PetscMPIIntCast(!local_size,&color);CHKERRQ(ierr);
2795d3531aaaSJed Brown   ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
2796e7931f94SStefano Zampini   if (color) {
2797e7931f94SStefano Zampini     ierr = PetscFree(xadj);CHKERRQ(ierr);
2798e7931f94SStefano Zampini     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2799e7931f94SStefano Zampini     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
2800c8587f34SStefano Zampini   } else {
2801e7931f94SStefano Zampini     ierr = MPI_Comm_size(subcomm->comm,&size);CHKERRQ(ierr);
2802e7931f94SStefano Zampini     ierr = PetscMalloc(size*sizeof(*oldranks),&oldranks);CHKERRQ(ierr);
2803e7931f94SStefano Zampini     prank = rank;
2804e7931f94SStefano Zampini     ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm->comm);CHKERRQ(ierr);
2805e7931f94SStefano Zampini     for (i=0;i<size;i++) {
2806e7931f94SStefano Zampini       PetscPrintf(subcomm->comm,"oldranks[%d] = %d\n",i,oldranks[i]);
2807c8587f34SStefano Zampini     }
2808e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2809e7931f94SStefano Zampini       ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
2810c8587f34SStefano Zampini     }
2811e7931f94SStefano Zampini     ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2812e7931f94SStefano Zampini     ierr = MatCreateMPIAdj(subcomm->comm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
2813e7931f94SStefano Zampini     n_subdomains = (PetscInt)size;
2814e7931f94SStefano Zampini     ierr = MatView(subdomain_adj,0);CHKERRQ(ierr);
2815e7931f94SStefano Zampini 
2816e7931f94SStefano Zampini     /* Partition */
2817e7931f94SStefano Zampini     ierr = MatPartitioningCreate(subcomm->comm,&partitioner);CHKERRQ(ierr);
2818e7931f94SStefano Zampini     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
2819e7931f94SStefano Zampini     if (use_vwgt) {
2820e7931f94SStefano Zampini       ierr = PetscMalloc(sizeof(*v_wgt),&v_wgt);CHKERRQ(ierr);
2821e7931f94SStefano Zampini       v_wgt[0] = local_size;
2822e7931f94SStefano Zampini       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
2823c8587f34SStefano Zampini     }
2824e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)partitioner),"NPARTS %d\n",n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2825e7931f94SStefano Zampini     ierr = MatPartitioningSetNParts(partitioner,n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2826e7931f94SStefano Zampini     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
2827e7931f94SStefano Zampini     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
2828e7931f94SStefano Zampini     ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr);
2829e7931f94SStefano Zampini 
2830e7931f94SStefano Zampini     ierr = ISGetIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2831e7931f94SStefano Zampini     ranks_send_to_idx[0] = oldranks[is_indices[0]];
2832e7931f94SStefano Zampini     ierr = ISRestoreIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2833e7931f94SStefano Zampini     /* clean up */
2834e7931f94SStefano Zampini     ierr = PetscFree(oldranks);CHKERRQ(ierr);
2835e7931f94SStefano Zampini     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
2836e7931f94SStefano Zampini     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
2837e7931f94SStefano Zampini     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
2838e7931f94SStefano Zampini   }
2839e7931f94SStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
2840e7931f94SStefano Zampini 
2841e7931f94SStefano Zampini   /* assemble parallel IS for sends */
2842e7931f94SStefano Zampini   i = 1;
2843e7931f94SStefano Zampini   if (color) i=0;
2844e7931f94SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,&ranks_send_to);CHKERRQ(ierr);
2845e7931f94SStefano Zampini   ierr = ISView(ranks_send_to,0);CHKERRQ(ierr);
2846e7931f94SStefano Zampini 
2847e7931f94SStefano Zampini   /* get back IS */
2848e7931f94SStefano Zampini   *is_sends = ranks_send_to;
2849e7931f94SStefano Zampini   PetscFunctionReturn(0);
2850e7931f94SStefano Zampini }
2851e7931f94SStefano Zampini 
2852e7931f94SStefano Zampini typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
2853e7931f94SStefano Zampini 
2854e7931f94SStefano Zampini #undef __FUNCT__
2855e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble"
2856e7931f94SStefano Zampini PetscErrorCode MatISSubassemble(Mat mat, IS is_sends, PetscInt coarsening_ratio, Mat *mat_n)
2857e7931f94SStefano Zampini {
2858e7931f94SStefano Zampini   Mat                    local_mat,new_mat;
2859e7931f94SStefano Zampini   Mat_IS                 *matis;
2860e7931f94SStefano Zampini   IS                     is_sends_internal;
2861e7931f94SStefano Zampini   PetscInt               rows,cols;
2862e7931f94SStefano Zampini   PetscInt               i,bs,buf_size_idxs,buf_size_vals;
2863e7931f94SStefano Zampini   PetscBool              ismatis,isdense;
2864e7931f94SStefano Zampini   ISLocalToGlobalMapping l2gmap;
2865e7931f94SStefano Zampini   PetscInt*              l2gmap_indices;
2866e7931f94SStefano Zampini   const PetscInt*        is_indices;
2867e7931f94SStefano Zampini   MatType                new_local_type;
2868e7931f94SStefano Zampini   MatTypePrivate         new_local_type_private;
2869e7931f94SStefano Zampini   /* buffers */
2870e7931f94SStefano Zampini   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
2871e7931f94SStefano Zampini   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
2872e7931f94SStefano Zampini   /* MPI */
2873e7931f94SStefano Zampini   MPI_Comm               comm;
2874e7931f94SStefano Zampini   PetscMPIInt            n_sends,n_recvs,commsize;
2875e7931f94SStefano Zampini   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals;
2876e7931f94SStefano Zampini   PetscMPIInt            *onodes,*olengths_idxs,*olengths_vals;
2877e7931f94SStefano Zampini   PetscMPIInt            len,tag_idxs,tag_vals,source_dest;
2878e7931f94SStefano Zampini   MPI_Request            *send_req_idxs,*send_req_vals,*recv_req_idxs,*recv_req_vals;
2879e7931f94SStefano Zampini   PetscErrorCode         ierr;
2880e7931f94SStefano Zampini 
2881e7931f94SStefano Zampini   PetscFunctionBegin;
2882e7931f94SStefano Zampini   /* checks */
2883e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
2884e7931f94SStefano Zampini   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on an matrix object which is not of type MATIS",__FUNCT__);
2885e7931f94SStefano Zampini   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2886e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
2887e7931f94SStefano Zampini   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
2888e7931f94SStefano Zampini   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
2889e7931f94SStefano Zampini   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
2890e7931f94SStefano Zampini   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
2891e7931f94SStefano Zampini   PetscValidLogicalCollectiveInt(mat,bs,0);
2892e7931f94SStefano Zampini   /* prepare IS for sending if not provided */
2893e7931f94SStefano Zampini   if (!is_sends) {
2894e7931f94SStefano Zampini     if (!coarsening_ratio) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a coarsening ratio");
2895e7931f94SStefano Zampini     ierr = MatISSubassemble_Private(mat,coarsening_ratio,&is_sends_internal);CHKERRQ(ierr);
2896c8587f34SStefano Zampini   } else {
2897e7931f94SStefano Zampini     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
2898e7931f94SStefano Zampini     is_sends_internal = is_sends;
2899c8587f34SStefano Zampini   }
2900e7931f94SStefano Zampini 
2901e7931f94SStefano Zampini   /* get pointer of MATIS data */
2902e7931f94SStefano Zampini   matis = (Mat_IS*)mat->data;
2903e7931f94SStefano Zampini 
2904e7931f94SStefano Zampini   /* get comm */
2905e7931f94SStefano Zampini   comm = PetscObjectComm((PetscObject)mat);
2906e7931f94SStefano Zampini 
2907e7931f94SStefano Zampini   /* compute number of sends */
2908e7931f94SStefano Zampini   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
2909e7931f94SStefano Zampini   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
2910e7931f94SStefano Zampini 
2911e7931f94SStefano Zampini   /* compute number of receives */
2912e7931f94SStefano Zampini   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
2913e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*iflags),&iflags);CHKERRQ(ierr);
2914e7931f94SStefano Zampini   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
2915e7931f94SStefano Zampini   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2916e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
2917e7931f94SStefano Zampini   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
2918e7931f94SStefano Zampini   ierr = PetscFree(iflags);CHKERRQ(ierr);
2919e7931f94SStefano Zampini 
2920e7931f94SStefano Zampini   /* prepare send/receive buffers */
2921e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_idxs),&ilengths_idxs);CHKERRQ(ierr);
2922e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
2923e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_vals),&ilengths_vals);CHKERRQ(ierr);
2924e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
2925e7931f94SStefano Zampini 
2926e7931f94SStefano Zampini   /* Get data from local mat */
2927e7931f94SStefano Zampini   if (!isdense) {
2928e7931f94SStefano Zampini     /* TODO: See below some guidelines on how to prepare the local buffers */
2929e7931f94SStefano Zampini     /*
2930e7931f94SStefano Zampini        send_buffer_vals should contain the raw values of the local matrix
2931e7931f94SStefano Zampini        send_buffer_idxs should contain:
2932e7931f94SStefano Zampini        - MatType_PRIVATE type
2933e7931f94SStefano Zampini        - PetscInt        size_of_l2gmap
2934e7931f94SStefano Zampini        - PetscInt        global_row_indices[size_of_l2gmap]
2935e7931f94SStefano Zampini        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
2936e7931f94SStefano Zampini     */
2937e7931f94SStefano Zampini   } else {
2938e7931f94SStefano Zampini     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
2939e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&i);CHKERRQ(ierr);
2940e7931f94SStefano Zampini     ierr = PetscMalloc((i+2)*sizeof(PetscInt),&send_buffer_idxs);CHKERRQ(ierr);
2941e7931f94SStefano Zampini     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
2942e7931f94SStefano Zampini     send_buffer_idxs[1] = i;
2943e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2944e7931f94SStefano Zampini     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
2945e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingRestoreIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2946e7931f94SStefano Zampini     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
2947e7931f94SStefano Zampini     for (i=0;i<n_sends;i++) {
2948e7931f94SStefano Zampini       ilengths_vals[is_indices[i]] = len*len;
2949e7931f94SStefano Zampini       ilengths_idxs[is_indices[i]] = len+2;
2950c8587f34SStefano Zampini     }
2951c8587f34SStefano Zampini   }
2952e7931f94SStefano Zampini   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
2953e7931f94SStefano Zampini   buf_size_idxs = 0;
2954e7931f94SStefano Zampini   buf_size_vals = 0;
2955e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2956e7931f94SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
2957e7931f94SStefano Zampini     buf_size_vals += (PetscInt)olengths_vals[i];
2958e7931f94SStefano Zampini   }
2959e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&recv_buffer_idxs);CHKERRQ(ierr);
2960e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_vals*sizeof(PetscScalar),&recv_buffer_vals);CHKERRQ(ierr);
2961e7931f94SStefano Zampini 
2962e7931f94SStefano Zampini   /* get new tags for clean communications */
2963e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
2964e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
2965e7931f94SStefano Zampini 
2966e7931f94SStefano Zampini   /* allocate for requests */
2967e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_idxs);CHKERRQ(ierr);
2968e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_vals);CHKERRQ(ierr);
2969e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_idxs);CHKERRQ(ierr);
2970e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_vals);CHKERRQ(ierr);
2971e7931f94SStefano Zampini 
2972e7931f94SStefano Zampini   /* communications */
2973e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2974e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
2975e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2976e7931f94SStefano Zampini     source_dest = onodes[i];
2977e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
2978e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
2979e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2980e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
2981e7931f94SStefano Zampini   }
2982e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) {
2983e7931f94SStefano Zampini     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
2984e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
2985e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
2986e7931f94SStefano Zampini   }
2987e7931f94SStefano Zampini   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2988e7931f94SStefano Zampini   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
2989e7931f94SStefano Zampini 
2990e7931f94SStefano Zampini   /* assemble new l2g map */
2991e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2992e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2993e7931f94SStefano Zampini   buf_size_idxs = 0;
2994e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2995e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
2996e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2997e7931f94SStefano Zampini   }
2998e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&l2gmap_indices);CHKERRQ(ierr);
2999e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
3000e7931f94SStefano Zampini   buf_size_idxs = 0;
3001e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3002e7931f94SStefano Zampini     ierr = PetscMemcpy(&l2gmap_indices[buf_size_idxs],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
3003e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
3004e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3005e7931f94SStefano Zampini   }
3006e7931f94SStefano Zampini   ierr = PetscSortRemoveDupsInt(&buf_size_idxs,l2gmap_indices);CHKERRQ(ierr);
3007e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingCreate(comm,buf_size_idxs,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
3008e7931f94SStefano Zampini   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
3009e7931f94SStefano Zampini 
3010e7931f94SStefano Zampini   /* infer new local matrix type from received local matrices type */
3011e7931f94SStefano Zampini   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
3012e7931f94SStefano 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) */
3013e7931f94SStefano Zampini   new_local_type_private = MATAIJ_PRIVATE;
3014e7931f94SStefano Zampini   new_local_type = MATSEQAIJ;
3015e7931f94SStefano Zampini   if (n_recvs) {
3016be4bc593SStefano Zampini     new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
3017e7931f94SStefano Zampini     ptr_idxs = recv_buffer_idxs;
3018e7931f94SStefano Zampini     for (i=0;i<n_recvs;i++) {
3019e7931f94SStefano Zampini       if ((PetscInt)new_local_type_private != *ptr_idxs) {
3020e7931f94SStefano Zampini         new_local_type_private = MATAIJ_PRIVATE;
3021e7931f94SStefano Zampini         break;
3022e7931f94SStefano Zampini       }
3023e7931f94SStefano Zampini       ptr_idxs += olengths_idxs[i];
3024e7931f94SStefano Zampini     }
3025e7931f94SStefano Zampini     switch (new_local_type_private) {
3026e7931f94SStefano Zampini       case MATDENSE_PRIVATE: /* subassembling of dense matrices does not give a dense matrix! */
3027e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
3028e7931f94SStefano Zampini         bs = 1;
3029e7931f94SStefano Zampini         break;
3030e7931f94SStefano Zampini       case MATAIJ_PRIVATE:
3031e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
3032e7931f94SStefano Zampini         bs = 1;
3033e7931f94SStefano Zampini         break;
3034e7931f94SStefano Zampini       case MATBAIJ_PRIVATE:
3035e7931f94SStefano Zampini         new_local_type = MATSEQBAIJ;
3036e7931f94SStefano Zampini         break;
3037e7931f94SStefano Zampini       case MATSBAIJ_PRIVATE:
3038e7931f94SStefano Zampini         new_local_type = MATSEQSBAIJ;
3039e7931f94SStefano Zampini         break;
3040e7931f94SStefano Zampini       default:
3041e7931f94SStefano Zampini         SETERRQ2(comm,PETSC_ERR_LIB,"Unkwown private type %d in %s",new_local_type_private,__FUNCT__);
3042e7931f94SStefano Zampini         break;
3043e7931f94SStefano Zampini     }
3044e7931f94SStefano Zampini   }
3045e7931f94SStefano Zampini 
3046e7931f94SStefano Zampini   /* create MATIS object */
3047e7931f94SStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
3048e7931f94SStefano Zampini   ierr = MatCreateIS(comm,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,&new_mat);CHKERRQ(ierr);
3049e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
3050e7931f94SStefano Zampini   ierr = MatISGetLocalMat(new_mat,&local_mat);CHKERRQ(ierr);
3051e7931f94SStefano Zampini   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
3052e7931f94SStefano Zampini   ierr = MatSetUp(local_mat);CHKERRQ(ierr); /* WARNING -> no preallocation yet */
3053e7931f94SStefano Zampini 
3054e7931f94SStefano Zampini   /* set values */
3055e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3056e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
3057e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
3058e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3059e7931f94SStefano Zampini     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
3060e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
3061e7931f94SStefano Zampini       ierr = MatSetValues(new_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
3062e7931f94SStefano Zampini       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3063e7931f94SStefano Zampini       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3064e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
3065e7931f94SStefano Zampini     }
3066e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3067e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
3068e7931f94SStefano Zampini   }
3069e7931f94SStefano Zampini   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3070e7931f94SStefano Zampini   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3071e7931f94SStefano Zampini   ierr = MatAssemblyBegin(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3072e7931f94SStefano Zampini   ierr = MatAssemblyEnd(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3073e7931f94SStefano Zampini 
3074e7931f94SStefano Zampini   { /* check */
3075e7931f94SStefano Zampini     Vec       lvec,rvec;
3076e7931f94SStefano Zampini     PetscReal infty_error;
3077e7931f94SStefano Zampini 
3078e7931f94SStefano Zampini     ierr = MatGetVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
3079e7931f94SStefano Zampini     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
3080e7931f94SStefano Zampini     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
3081e7931f94SStefano Zampini     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
3082e7931f94SStefano Zampini     ierr = MatMultAdd(new_mat,rvec,lvec,lvec);CHKERRQ(ierr);
3083e7931f94SStefano Zampini     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3084e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
3085e7931f94SStefano Zampini     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
3086e7931f94SStefano Zampini     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
3087e7931f94SStefano Zampini   }
3088e7931f94SStefano Zampini 
3089e7931f94SStefano Zampini   /* free workspace */
3090e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
3091e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
3092e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3093e7931f94SStefano Zampini   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
3094e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3095e7931f94SStefano Zampini   if (isdense) {
3096e7931f94SStefano Zampini     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
3097e7931f94SStefano Zampini     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
3098e7931f94SStefano Zampini   } else {
3099e7931f94SStefano Zampini     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
3100e7931f94SStefano Zampini   }
3101e7931f94SStefano Zampini   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
3102e7931f94SStefano Zampini   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
3103e7931f94SStefano Zampini   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
3104e7931f94SStefano Zampini   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
3105e7931f94SStefano Zampini   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
3106e7931f94SStefano Zampini   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
3107e7931f94SStefano Zampini   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
3108e7931f94SStefano Zampini   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
3109e7931f94SStefano Zampini   ierr = PetscFree(onodes);CHKERRQ(ierr);
3110e7931f94SStefano Zampini   /* get back new mat */
3111e7931f94SStefano Zampini   *mat_n = new_mat;
3112e7931f94SStefano Zampini   PetscFunctionReturn(0);
3113e7931f94SStefano Zampini }
3114a57a6d2fSStefano Zampini 
3115c8587f34SStefano Zampini #undef __FUNCT__
3116c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
3117c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
3118c8587f34SStefano Zampini {
3119c8587f34SStefano Zampini   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
3120c8587f34SStefano Zampini   PC_IS                  *pcis = (PC_IS*)pc->data;
312120a2ab83SStefano Zampini   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
31229881197aSStefano Zampini   MatNullSpace           CoarseNullSpace=NULL;
312320a2ab83SStefano Zampini   ISLocalToGlobalMapping coarse_islg;
312420a2ab83SStefano Zampini   IS                     coarse_is;
3125f4ddd8eeSStefano Zampini   PetscInt               max_it;
3126f9eb5b7dSStefano Zampini   PetscInt               im_active=-1,active_procs=-1;
3127f9eb5b7dSStefano Zampini   PC                     pc_temp;
3128c8587f34SStefano Zampini   PCType                 coarse_pc_type;
3129c8587f34SStefano Zampini   KSPType                coarse_ksp_type;
3130f9eb5b7dSStefano Zampini   PetscBool              multilevel_requested,multilevel_allowed;
3131*fa7f1dd8SStefano Zampini   PetscBool              setsym,issym,isbddc,isnn,coarse_reuse;
3132f9eb5b7dSStefano Zampini   MatStructure           matstruct;
31339881197aSStefano Zampini   PetscErrorCode         ierr;
3134fdc09c96SStefano Zampini 
3135c8587f34SStefano Zampini   PetscFunctionBegin;
3136c8587f34SStefano Zampini   /* Assign global numbering to coarse dofs */
3137*fa7f1dd8SStefano Zampini   if (pcbddc->new_primal_space) { /* a new primal space is present, so recompute global numbering */
3138*fa7f1dd8SStefano Zampini     PetscInt ocoarse_size;
3139*fa7f1dd8SStefano Zampini     ocoarse_size = pcbddc->coarse_size;
3140f4ddd8eeSStefano Zampini     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3141f4ddd8eeSStefano Zampini     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
3142f4ddd8eeSStefano Zampini     /* see if we can avoid some work */
3143*fa7f1dd8SStefano Zampini     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
3144*fa7f1dd8SStefano Zampini       if (ocoarse_size != pcbddc->coarse_size) { /* ...but with different size, so reset it and set reuse flag to false */
3145727cdba6SStefano Zampini         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3146*fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_FALSE;
3147*fa7f1dd8SStefano Zampini       } else { /* we can safely reuse already computed coarse matrix */
3148*fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_TRUE;
3149f4ddd8eeSStefano Zampini       }
3150*fa7f1dd8SStefano Zampini     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
3151*fa7f1dd8SStefano Zampini       coarse_reuse = PETSC_FALSE;
3152f4ddd8eeSStefano Zampini     }
3153*fa7f1dd8SStefano Zampini   } else { /* primal space has not been changed, so we can reuse coarse matrix */
3154*fa7f1dd8SStefano Zampini     coarse_reuse = PETSC_TRUE;
3155f4ddd8eeSStefano Zampini   }
3156c8587f34SStefano Zampini 
3157f9eb5b7dSStefano Zampini   /* infer some info from user */
3158f9eb5b7dSStefano Zampini   issym = PETSC_FALSE;
3159f9eb5b7dSStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
3160f9eb5b7dSStefano Zampini   multilevel_allowed = PETSC_FALSE;
3161f9eb5b7dSStefano Zampini   multilevel_requested = PETSC_FALSE;
3162f9eb5b7dSStefano Zampini   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
3163f9eb5b7dSStefano Zampini   if (multilevel_requested) {
31642b510759SStefano Zampini     /* count "active processes" */
31652b510759SStefano Zampini     im_active = !!(pcis->n);
31662b510759SStefano Zampini     ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
31672b510759SStefano Zampini     if (active_procs/pcbddc->coarsening_ratio < 2) {
3168f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_FALSE;
31692b510759SStefano Zampini     } else {
3170f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_TRUE;
3171c8587f34SStefano Zampini     }
3172c8587f34SStefano Zampini   }
3173e7931f94SStefano Zampini 
3174f9eb5b7dSStefano Zampini   /* set defaults for coarse KSP and PC */
3175f9eb5b7dSStefano Zampini   if (multilevel_allowed) {
3176c8587f34SStefano Zampini     if (issym) {
3177f9eb5b7dSStefano Zampini       coarse_ksp_type = KSPRICHARDSON;
3178f9eb5b7dSStefano Zampini     } else {
3179f9eb5b7dSStefano Zampini       coarse_ksp_type = KSPCHEBYSHEV;
3180c8587f34SStefano Zampini     }
3181f9eb5b7dSStefano Zampini     coarse_pc_type = PCBDDC;
3182f9eb5b7dSStefano Zampini   } else {
3183f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPPREONLY;
3184f9eb5b7dSStefano Zampini     coarse_pc_type = PCREDUNDANT;
3185c8587f34SStefano Zampini   }
3186c8587f34SStefano Zampini 
3187f9eb5b7dSStefano Zampini   /* create the coarse KSP object only once with defaults */
3188f9eb5b7dSStefano Zampini   if (!pcbddc->coarse_ksp) {
3189e604994aSStefano Zampini     char prefix[256],str_level[3];
3190e604994aSStefano Zampini     size_t len;
3191f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_ksp);CHKERRQ(ierr);
3192c8587f34SStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
3193f9eb5b7dSStefano Zampini     ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
3194c8587f34SStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
3195c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3196c8587f34SStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
3197e604994aSStefano Zampini     /* prefix */
3198e604994aSStefano Zampini     ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
3199e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
3200e604994aSStefano Zampini     if (!pcbddc->current_level) {
3201e604994aSStefano Zampini       ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
3202e604994aSStefano Zampini       ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
3203c8587f34SStefano Zampini     } else {
3204e604994aSStefano Zampini       ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
3205e604994aSStefano Zampini       if (pcbddc->current_level>1) len -= 2;
3206e604994aSStefano Zampini       ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
3207e604994aSStefano Zampini       *(prefix+len)='\0';
3208e604994aSStefano Zampini       sprintf(str_level,"%d_",(int)(pcbddc->current_level));
3209e604994aSStefano Zampini       ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
3210e604994aSStefano Zampini     }
3211e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
3212f9eb5b7dSStefano Zampini   }
3213f9eb5b7dSStefano Zampini   /* allow user customization */
321485c4d303SStefano Zampini   /* ierr = PetscPrintf(PETSC_COMM_WORLD,"Type of %s before setting from options %s\n",((PetscObject)pcbddc->coarse_ksp)->prefix,((PetscObject)pcbddc->coarse_ksp)->type_name);CHKERRQ(ierr); */
3215f9eb5b7dSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
321685c4d303SStefano Zampini   /* ierr = PetscPrintf(PETSC_COMM_WORLD,"Type of %s after setting from options %s\n",((PetscObject)pcbddc->coarse_ksp)->prefix,((PetscObject)pcbddc->coarse_ksp)->type_name);CHKERRQ(ierr); */
3217f9eb5b7dSStefano Zampini 
3218f9eb5b7dSStefano Zampini   /* get some info after set from options */
3219f9eb5b7dSStefano Zampini   ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3220f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
3221f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
3222f9eb5b7dSStefano Zampini   if (isbddc && !multilevel_allowed) { /* prevent from infinite loop if user as requested bddc pc for coarse solver */
3223f9eb5b7dSStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
3224f9eb5b7dSStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
3225f9eb5b7dSStefano Zampini     isbddc = PETSC_FALSE;
3226f9eb5b7dSStefano Zampini   }
3227f9eb5b7dSStefano Zampini 
3228f9eb5b7dSStefano Zampini   /* propagate BDDC info to the next level */
3229f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
3230f9eb5b7dSStefano Zampini   ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
3231f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
3232f9eb5b7dSStefano Zampini 
3233f9eb5b7dSStefano Zampini   /* creates temporary MATIS object for coarse matrix */
3234f4ddd8eeSStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
3235a57a6d2fSStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
3236a57a6d2fSStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
3237f4ddd8eeSStefano Zampini   ierr = MatCreateIS(PetscObjectComm((PetscObject)pc),1,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size,coarse_islg,&coarse_mat_is);CHKERRQ(ierr);
3238a57a6d2fSStefano Zampini   ierr = MatISSetLocalMat(coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
3239e7931f94SStefano Zampini   ierr = MatAssemblyBegin(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3240e7931f94SStefano Zampini   ierr = MatAssemblyEnd(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
324120a2ab83SStefano Zampini   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
324220a2ab83SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
3243fdc09c96SStefano Zampini 
3244f9eb5b7dSStefano Zampini   /* assemble coarse matrix */
3245f9eb5b7dSStefano Zampini   if (isbddc || isnn) {
3246f9eb5b7dSStefano Zampini     ierr = MatISSubassemble(coarse_mat_is,NULL,pcbddc->coarsening_ratio,&coarse_mat);CHKERRQ(ierr);
3247*fa7f1dd8SStefano Zampini   } else {
3248*fa7f1dd8SStefano Zampini     if (coarse_reuse) {
3249*fa7f1dd8SStefano Zampini       ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL,NULL);CHKERRQ(ierr);
3250*fa7f1dd8SStefano Zampini       ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
3251*fa7f1dd8SStefano Zampini       ierr = MatISGetMPIXAIJ(coarse_mat_is,MATMPIAIJ,MAT_REUSE_MATRIX,&coarse_mat);CHKERRQ(ierr);
3252*fa7f1dd8SStefano Zampini     } else {
3253*fa7f1dd8SStefano Zampini       ierr = MatISGetMPIXAIJ(coarse_mat_is,MATMPIAIJ,MAT_INITIAL_MATRIX,&coarse_mat);CHKERRQ(ierr);
3254*fa7f1dd8SStefano Zampini     }
3255c8587f34SStefano Zampini   }
32562b510759SStefano Zampini   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
32579881197aSStefano Zampini 
3258f9eb5b7dSStefano Zampini   /* create local to global scatters for coarse problem */
3259f4ddd8eeSStefano Zampini   if (pcbddc->new_primal_space) {
3260f4ddd8eeSStefano Zampini     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3261f4ddd8eeSStefano Zampini     ierr = VecDestroy(&pcbddc->coarse_rhs);CHKERRQ(ierr);
3262f4ddd8eeSStefano Zampini     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3263f9eb5b7dSStefano Zampini     ierr = MatGetVecs(coarse_mat,&pcbddc->coarse_vec,&pcbddc->coarse_rhs);CHKERRQ(ierr);
3264f9eb5b7dSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3265f4ddd8eeSStefano Zampini   }
3266f9eb5b7dSStefano Zampini   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
3267f9eb5b7dSStefano Zampini 
3268f9eb5b7dSStefano Zampini   /* propagate symmetry info to coarse matrix */
3269f9eb5b7dSStefano Zampini   ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,issym);CHKERRQ(ierr);
3270f9eb5b7dSStefano Zampini 
3271b8ffe317SStefano Zampini   /* Compute coarse null space (special handling by BDDC only) */
3272b8ffe317SStefano Zampini   if (pcbddc->NullSpace) {
3273b8ffe317SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCoarse(pc,coarse_mat,&CoarseNullSpace);CHKERRQ(ierr);
3274b8ffe317SStefano Zampini     if (isbddc) {
3275b8ffe317SStefano Zampini       ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
3276b8ffe317SStefano Zampini     } else {
3277c8587f34SStefano Zampini       ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
3278c8587f34SStefano Zampini     }
3279c8587f34SStefano Zampini   }
3280c8587f34SStefano Zampini 
3281f9eb5b7dSStefano Zampini   /* set operators */
3282f9eb5b7dSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
3283f9eb5b7dSStefano Zampini   ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat,matstruct);CHKERRQ(ierr);
3284f9eb5b7dSStefano Zampini 
3285f9eb5b7dSStefano Zampini   /* additional KSP customization */
3286f9eb5b7dSStefano Zampini   ierr = KSPGetTolerances(pcbddc->coarse_ksp,NULL,NULL,NULL,&max_it);CHKERRQ(ierr);
3287f9eb5b7dSStefano Zampini   if (max_it < 5) {
3288c8587f34SStefano Zampini     ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
3289f9eb5b7dSStefano Zampini   }
3290b8ffe317SStefano Zampini   /* ierr = KSPChebyshevSetEstimateEigenvalues(pcbddc->coarse_ksp,1.0,0.0,0.0,1.1);CHKERRQ(ierr); */
3291f9eb5b7dSStefano Zampini 
3292f9eb5b7dSStefano Zampini 
3293f9eb5b7dSStefano Zampini   /* print some info if requested */
3294f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
3295f9eb5b7dSStefano Zampini     ierr = KSPGetType(pcbddc->coarse_ksp,&coarse_ksp_type);CHKERRQ(ierr);
3296f9eb5b7dSStefano Zampini     ierr = PCGetType(pc_temp,&coarse_pc_type);CHKERRQ(ierr);
3297f9eb5b7dSStefano Zampini     if (!multilevel_allowed) {
3298f9eb5b7dSStefano Zampini       if (multilevel_requested) {
3299f9eb5b7dSStefano 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);
3300f9eb5b7dSStefano Zampini       } else if (pcbddc->max_levels) {
3301f9eb5b7dSStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
3302c8587f34SStefano Zampini       }
3303c8587f34SStefano Zampini     }
3304e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Calling %s/%s setup at level %d for coarse solver (%s)\n",coarse_ksp_type,coarse_pc_type,pcbddc->current_level,((PetscObject)pcbddc->coarse_ksp)->prefix);CHKERRQ(ierr);
3305f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3306c8587f34SStefano Zampini   }
3307f9eb5b7dSStefano Zampini 
3308f9eb5b7dSStefano Zampini   /* setup coarse ksp */
3309f9eb5b7dSStefano Zampini   ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
3310f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
3311f9eb5b7dSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
3312f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3313f9eb5b7dSStefano Zampini     ierr = KSPView(pcbddc->coarse_ksp,pcbddc->dbg_viewer);CHKERRQ(ierr);
3314f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3315f9eb5b7dSStefano Zampini   }
3316f9eb5b7dSStefano Zampini 
3317c8587f34SStefano Zampini   /* Check coarse problem if requested */
331820a2ab83SStefano Zampini   if (pcbddc->dbg_flag) {
3319c8587f34SStefano Zampini     KSP       check_ksp;
33202b510759SStefano Zampini     KSPType   check_ksp_type;
3321c8587f34SStefano Zampini     PC        check_pc;
3322c8587f34SStefano Zampini     Vec       check_vec;
3323c8587f34SStefano Zampini     PetscReal abs_infty_error,infty_error,lambda_min,lambda_max;
33242b510759SStefano Zampini     PetscInt  its;
3325f9eb5b7dSStefano Zampini     PetscBool ispreonly,compute;
3326c8587f34SStefano Zampini 
33272b510759SStefano Zampini     /* Create ksp object suitable for estimation of extreme eigenvalues */
3328f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&check_ksp);CHKERRQ(ierr);
3329fdc635d7SStefano Zampini     ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
3330f4ddd8eeSStefano Zampini     ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
33312b510759SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
33322b510759SStefano Zampini     if (ispreonly) {
33332b510759SStefano Zampini       check_ksp_type = KSPPREONLY;
3334f9eb5b7dSStefano Zampini       compute = PETSC_FALSE;
33352b510759SStefano Zampini     } else {
3336c8587f34SStefano Zampini       if (issym) check_ksp_type = KSPCG;
3337c8587f34SStefano Zampini       else check_ksp_type = KSPGMRES;
3338f9eb5b7dSStefano Zampini       compute = PETSC_TRUE;
3339c8587f34SStefano Zampini     }
3340c8587f34SStefano Zampini     ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
3341f9eb5b7dSStefano Zampini     ierr = KSPSetComputeSingularValues(check_ksp,compute);CHKERRQ(ierr);
3342c8587f34SStefano Zampini     ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
3343c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
3344c8587f34SStefano Zampini     ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
3345c8587f34SStefano Zampini     /* create random vec */
3346c8587f34SStefano Zampini     ierr = VecDuplicate(pcbddc->coarse_vec,&check_vec);CHKERRQ(ierr);
3347c8587f34SStefano Zampini     ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
3348c8587f34SStefano Zampini     if (CoarseNullSpace) {
3349c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec);CHKERRQ(ierr);
3350c8587f34SStefano Zampini     }
3351fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3352c8587f34SStefano Zampini     /* solve coarse problem */
3353c8587f34SStefano Zampini     ierr = KSPSolve(check_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
3354c8587f34SStefano Zampini     if (CoarseNullSpace) {
3355c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,pcbddc->coarse_vec);CHKERRQ(ierr);
3356c8587f34SStefano Zampini     }
3357c8587f34SStefano Zampini     /* check coarse problem residual error */
3358c8587f34SStefano Zampini     ierr = VecAXPY(check_vec,-1.0,pcbddc->coarse_vec);CHKERRQ(ierr);
3359c8587f34SStefano Zampini     ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3360fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3361c8587f34SStefano Zampini     ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
3362c8587f34SStefano Zampini     ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
3363e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem (%s) details\n",((PetscObject)(pcbddc->coarse_ksp))->prefix);CHKERRQ(ierr);
3364e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
3365e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
3366f9eb5b7dSStefano Zampini     /* get eigenvalue estimation if preonly has not been requested */
33672b510759SStefano Zampini     if (!ispreonly) {
3368c8587f34SStefano Zampini       ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
336920a2ab83SStefano Zampini       ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
3370f9eb5b7dSStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem eigenvalues (estimated with %d iterations of %s): %1.6e %1.6e\n",its,check_ksp_type,lambda_min,lambda_max);CHKERRQ(ierr);
3371c8587f34SStefano Zampini     }
33722b510759SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3373c8587f34SStefano Zampini     ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
3374c8587f34SStefano Zampini   }
33752b510759SStefano Zampini   /* free memory */
3376c8587f34SStefano Zampini   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
3377fdc635d7SStefano Zampini   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
3378c8587f34SStefano Zampini   PetscFunctionReturn(0);
3379c8587f34SStefano Zampini }
3380674ae819SStefano Zampini 
3381f34684f1SStefano Zampini #undef __FUNCT__
3382f34684f1SStefano Zampini #define __FUNCT__ "PCBDDCComputePrimalNumbering"
3383f34684f1SStefano Zampini PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
3384f34684f1SStefano Zampini {
3385f34684f1SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3386f34684f1SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
3387f34684f1SStefano Zampini   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
3388727cdba6SStefano Zampini   PetscInt       i,coarse_size;
3389727cdba6SStefano Zampini   PetscInt       *local_primal_indices;
3390f34684f1SStefano Zampini   PetscErrorCode ierr;
3391f34684f1SStefano Zampini 
3392f34684f1SStefano Zampini   PetscFunctionBegin;
3393f34684f1SStefano Zampini   /* Compute global number of coarse dofs */
3394727cdba6SStefano Zampini   if (!pcbddc->primal_indices_local_idxs) {
3395727cdba6SStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Constraint matrix has not been created");
3396727cdba6SStefano Zampini   }
3397727cdba6SStefano 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);
3398f34684f1SStefano Zampini 
3399f34684f1SStefano Zampini   /* check numbering */
3400f34684f1SStefano Zampini   if (pcbddc->dbg_flag) {
3401f34684f1SStefano Zampini     PetscScalar coarsesum,*array;
3402f34684f1SStefano Zampini 
3403f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3404f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3405f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
3406f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
3407f34684f1SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
3408727cdba6SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
3409f34684f1SStefano Zampini     }
3410f34684f1SStefano Zampini     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
3411f34684f1SStefano Zampini     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
3412f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3413f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3414f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3415f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3416f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3417f34684f1SStefano Zampini     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3418f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3419f34684f1SStefano Zampini       if (array[i] == 1.0) {
3420f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %d owned by a single process!\n",PetscGlobalRank,i);CHKERRQ(ierr);
3421f34684f1SStefano Zampini       }
3422f34684f1SStefano Zampini     }
3423f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3424f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3425f34684f1SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
3426f34684f1SStefano Zampini     }
3427f34684f1SStefano Zampini     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3428f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3429f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3430f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3431f34684f1SStefano Zampini     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
3432f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
3433f34684f1SStefano Zampini     if (pcbddc->dbg_flag > 1) {
3434f34684f1SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
3435f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3436f34684f1SStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
3437f34684f1SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
3438727cdba6SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_primal_indices[%d]=%d (%d)\n",i,local_primal_indices[i],pcbddc->primal_indices_local_idxs[i]);
3439f34684f1SStefano Zampini       }
3440f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3441f34684f1SStefano Zampini     }
3442f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3443f34684f1SStefano Zampini   }
3444f34684f1SStefano Zampini   /* get back data */
3445f34684f1SStefano Zampini   *coarse_size_n = coarse_size;
3446f34684f1SStefano Zampini   *local_primal_indices_n = local_primal_indices;
3447674ae819SStefano Zampini   PetscFunctionReturn(0);
3448674ae819SStefano Zampini }
3449674ae819SStefano Zampini 
3450