xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 85c4d30342a77aaa058e80c0f21364f302bd83b5)
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 
17c8587f34SStefano Zampini   /* Allocate needed vectors */
18c8587f34SStefano Zampini   ierr = PCBDDCCreateWorkVectors(pc);CHKERRQ(ierr);
19c8587f34SStefano Zampini 
20c8587f34SStefano Zampini   /* Setup local scatters R_to_B and (optionally) R_to_D : PCBDDCCreateWorkVectors should be called first! */
21c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
22c8587f34SStefano Zampini 
23c8587f34SStefano Zampini   /* Setup local solvers ksp_D and ksp_R */
24c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalSolvers(pc);CHKERRQ(ierr);
25c8587f34SStefano Zampini 
26c8587f34SStefano Zampini   /* Change global null space passed in by the user if change of basis has been requested */
27c8587f34SStefano Zampini   if (pcbddc->NullSpace && pcbddc->use_change_of_basis) {
28c8587f34SStefano Zampini     ierr = PCBDDCNullSpaceAdaptGlobal(pc);CHKERRQ(ierr);
29c8587f34SStefano Zampini   }
30c8587f34SStefano Zampini 
318629588bSStefano Zampini   /*
328629588bSStefano Zampini      Setup local correction and local part of coarse basis.
338629588bSStefano Zampini      Gives back the dense local part of the coarse matrix in column major ordering
348629588bSStefano Zampini   */
358629588bSStefano Zampini   ierr = PCBDDCSetUpCoarseLocal(pc,&coarse_submat_vals);CHKERRQ(ierr);
368629588bSStefano Zampini 
378629588bSStefano Zampini   /* Compute total number of coarse nodes and setup coarse solver */
388629588bSStefano Zampini   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
398629588bSStefano Zampini 
408629588bSStefano Zampini   /* free */
418629588bSStefano Zampini   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
42c8587f34SStefano Zampini   PetscFunctionReturn(0);
43c8587f34SStefano Zampini }
44c8587f34SStefano Zampini 
45c8587f34SStefano Zampini #undef __FUNCT__
46674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetCustomization"
47674ae819SStefano Zampini PetscErrorCode PCBDDCResetCustomization(PC pc)
48674ae819SStefano Zampini {
49674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
50674ae819SStefano Zampini   PetscInt       i;
51674ae819SStefano Zampini   PetscErrorCode ierr;
52674ae819SStefano Zampini 
53674ae819SStefano Zampini   PetscFunctionBegin;
54674ae819SStefano Zampini   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
55674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
56674ae819SStefano Zampini   ierr = MatNullSpaceDestroy(&pcbddc->NullSpace);CHKERRQ(ierr);
57674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
58674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
59674ae819SStefano Zampini   for (i=0;i<pcbddc->n_ISForDofs;i++) {
60674ae819SStefano Zampini     ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
61674ae819SStefano Zampini   }
62674ae819SStefano Zampini   ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
63674ae819SStefano Zampini   PetscFunctionReturn(0);
64674ae819SStefano Zampini }
65674ae819SStefano Zampini 
66674ae819SStefano Zampini #undef __FUNCT__
67674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetTopography"
68674ae819SStefano Zampini PetscErrorCode PCBDDCResetTopography(PC pc)
69674ae819SStefano Zampini {
70674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
71674ae819SStefano Zampini   PetscErrorCode ierr;
72674ae819SStefano Zampini 
73674ae819SStefano Zampini   PetscFunctionBegin;
74674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
75674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
76674ae819SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
77674ae819SStefano Zampini   PetscFunctionReturn(0);
78674ae819SStefano Zampini }
79674ae819SStefano Zampini 
80674ae819SStefano Zampini #undef __FUNCT__
81674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetSolvers"
82674ae819SStefano Zampini PetscErrorCode PCBDDCResetSolvers(PC pc)
83674ae819SStefano Zampini {
84674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
85674ae819SStefano Zampini   PetscErrorCode ierr;
86674ae819SStefano Zampini 
87674ae819SStefano Zampini   PetscFunctionBegin;
88674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
89674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_rhs);CHKERRQ(ierr);
90674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
91674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
9215aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
9315aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
94674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
95674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
96674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
97674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
98674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
99674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
100674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec4_D);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);
105674ae819SStefano Zampini   PetscFunctionReturn(0);
106674ae819SStefano Zampini }
107674ae819SStefano Zampini 
108674ae819SStefano Zampini #undef __FUNCT__
1096bfb1811SStefano Zampini #define __FUNCT__ "PCBDDCCreateWorkVectors"
1106bfb1811SStefano Zampini PetscErrorCode PCBDDCCreateWorkVectors(PC pc)
1116bfb1811SStefano Zampini {
1126bfb1811SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1136bfb1811SStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
1146bfb1811SStefano Zampini   VecType        impVecType;
1156bfb1811SStefano Zampini   PetscInt       n_vertices,n_constraints,local_primal_size,n_R;
1166bfb1811SStefano Zampini   PetscErrorCode ierr;
1176bfb1811SStefano Zampini 
1186bfb1811SStefano Zampini   PetscFunctionBegin;
1196bfb1811SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,NULL);CHKERRQ(ierr);
1206bfb1811SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&n_constraints,NULL);CHKERRQ(ierr);
1216bfb1811SStefano Zampini   local_primal_size = n_constraints+n_vertices;
1226bfb1811SStefano Zampini   n_R = pcis->n-n_vertices;
1236bfb1811SStefano Zampini   /* local work vectors */
1246bfb1811SStefano Zampini   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
1256bfb1811SStefano Zampini   ierr = VecDuplicate(pcis->vec1_D,&pcbddc->vec4_D);CHKERRQ(ierr);
1266bfb1811SStefano Zampini   ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
1276bfb1811SStefano Zampini   ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
1286bfb1811SStefano Zampini   ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
1296bfb1811SStefano Zampini   ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
13083b7ccabSStefano Zampini   ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
1316bfb1811SStefano Zampini   ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,local_primal_size);CHKERRQ(ierr);
1326bfb1811SStefano Zampini   ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
13383b7ccabSStefano Zampini   if (n_constraints) {
13483b7ccabSStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
13583b7ccabSStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
13683b7ccabSStefano Zampini     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
13783b7ccabSStefano Zampini   }
1386bfb1811SStefano Zampini   PetscFunctionReturn(0);
1396bfb1811SStefano Zampini }
1406bfb1811SStefano Zampini 
1416bfb1811SStefano Zampini #undef __FUNCT__
1424a78082cSStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseLocal"
1438629588bSStefano Zampini PetscErrorCode PCBDDCSetUpCoarseLocal(PC pc, PetscScalar **coarse_submat_vals_n)
14488ebb749SStefano Zampini {
14525084f0cSStefano Zampini   PetscErrorCode         ierr;
14625084f0cSStefano Zampini   /* pointers to pcis and pcbddc */
14788ebb749SStefano Zampini   PC_IS*                 pcis = (PC_IS*)pc->data;
14888ebb749SStefano Zampini   PC_BDDC*               pcbddc = (PC_BDDC*)pc->data;
14925084f0cSStefano Zampini   /* submatrices of local problem */
15088ebb749SStefano Zampini   Mat                    A_RV,A_VR,A_VV;
15125084f0cSStefano Zampini   /* working matrices */
15225084f0cSStefano Zampini   Mat                    M1,M2,M3,C_CR;
15325084f0cSStefano Zampini   /* working vectors */
15425084f0cSStefano Zampini   Vec                    vec1_C,vec2_C,vec1_V,vec2_V;
15525084f0cSStefano Zampini   /* additional working stuff */
15625084f0cSStefano Zampini   IS                     is_aux;
15788ebb749SStefano Zampini   ISLocalToGlobalMapping BtoNmap;
15825084f0cSStefano Zampini   PetscScalar            *coarse_submat_vals; /* TODO: use a PETSc matrix */
15925084f0cSStefano Zampini   const PetscScalar      *array,*row_cmat_values;
16025084f0cSStefano Zampini   const PetscInt         *row_cmat_indices,*idx_R_local;
16125084f0cSStefano Zampini   PetscInt               *vertices,*idx_V_B,*auxindices;
16225084f0cSStefano Zampini   PetscInt               n_vertices,n_constraints,size_of_constraint;
16325084f0cSStefano Zampini   PetscInt               i,j,n_R,n_D,n_B;
16488ebb749SStefano Zampini   PetscBool              setsym=PETSC_FALSE,issym=PETSC_FALSE;
16525084f0cSStefano Zampini   /* Vector and matrix types */
16688ebb749SStefano Zampini   VecType                impVecType;
16788ebb749SStefano Zampini   MatType                impMatType;
16825084f0cSStefano Zampini   /* some shortcuts to scalars */
16925084f0cSStefano Zampini   PetscScalar            zero=0.0,one=1.0,m_one=-1.0;
17025084f0cSStefano Zampini   /* for debugging purposes */
17188ebb749SStefano Zampini   PetscReal              *coarsefunctions_errors,*constraints_errors;
17288ebb749SStefano Zampini 
17388ebb749SStefano Zampini   PetscFunctionBegin;
17425084f0cSStefano Zampini   /* get number of vertices and their local indices */
17525084f0cSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
17688ebb749SStefano Zampini   n_constraints = pcbddc->local_primal_size-n_vertices;
17788ebb749SStefano Zampini   /* Set Non-overlapping dimensions */
17888ebb749SStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
17988ebb749SStefano Zampini   n_R = pcis->n-n_vertices;
18088ebb749SStefano Zampini 
18188ebb749SStefano Zampini   /* Set types for local objects needed by BDDC precondtioner */
18288ebb749SStefano Zampini   impMatType = MATSEQDENSE;
18325084f0cSStefano Zampini   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
18488ebb749SStefano Zampini 
18588ebb749SStefano Zampini   /* Allocating some extra storage just to be safe */
18688ebb749SStefano Zampini   ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&auxindices);CHKERRQ(ierr);
18788ebb749SStefano Zampini   for (i=0;i<pcis->n;i++) auxindices[i]=i;
18888ebb749SStefano Zampini 
18988ebb749SStefano Zampini   /* vertices in boundary numbering */
19088ebb749SStefano Zampini   ierr = PetscMalloc(n_vertices*sizeof(PetscInt),&idx_V_B);CHKERRQ(ierr);
19188ebb749SStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(pcis->is_B_local,&BtoNmap);CHKERRQ(ierr);
19288ebb749SStefano Zampini   ierr = ISGlobalToLocalMappingApply(BtoNmap,IS_GTOLM_DROP,n_vertices,vertices,&i,idx_V_B);CHKERRQ(ierr);
19388ebb749SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&BtoNmap);CHKERRQ(ierr);
19488ebb749SStefano Zampini   if (i != n_vertices) {
19588ebb749SStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %d != %d\n",n_vertices,i);
19688ebb749SStefano Zampini   }
19788ebb749SStefano Zampini 
19888ebb749SStefano Zampini   /* some work vectors on vertices and/or constraints */
19988ebb749SStefano Zampini   if (n_vertices) {
20088ebb749SStefano Zampini     ierr = VecCreate(PETSC_COMM_SELF,&vec1_V);CHKERRQ(ierr);
20188ebb749SStefano Zampini     ierr = VecSetSizes(vec1_V,n_vertices,n_vertices);CHKERRQ(ierr);
20288ebb749SStefano Zampini     ierr = VecSetType(vec1_V,impVecType);CHKERRQ(ierr);
20388ebb749SStefano Zampini     ierr = VecDuplicate(vec1_V,&vec2_V);CHKERRQ(ierr);
20488ebb749SStefano Zampini   }
20588ebb749SStefano Zampini   if (n_constraints) {
20688ebb749SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec1_C);CHKERRQ(ierr);
20788ebb749SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec2_C);CHKERRQ(ierr);
20888ebb749SStefano Zampini   }
20925084f0cSStefano Zampini 
21088ebb749SStefano Zampini   /* Precompute stuffs needed for preprocessing and application of BDDC*/
21188ebb749SStefano Zampini   if (n_constraints) {
21288ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->local_auxmat2);CHKERRQ(ierr);
21325084f0cSStefano Zampini     ierr = MatSetSizes(pcbddc->local_auxmat2,n_R,n_constraints,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
21488ebb749SStefano Zampini     ierr = MatSetType(pcbddc->local_auxmat2,impMatType);CHKERRQ(ierr);
21525084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->local_auxmat2);CHKERRQ(ierr);
21688ebb749SStefano Zampini 
21725084f0cSStefano Zampini     /* Extract constraints on R nodes: C_{CR}  */
21825084f0cSStefano Zampini     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
2198ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
22025084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
22188ebb749SStefano Zampini 
22288ebb749SStefano Zampini     /* Assemble local_auxmat2 = - A_{RR}^{-1} C^T_{CR} needed by BDDC application */
22388ebb749SStefano Zampini     for (i=0;i<n_constraints;i++) {
22488ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
22588ebb749SStefano Zampini       /* Get row of constraint matrix in R numbering */
22625084f0cSStefano Zampini       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
22725084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_R,size_of_constraint,row_cmat_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
22825084f0cSStefano Zampini       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
22925084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_R);CHKERRQ(ierr);
23025084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_R);CHKERRQ(ierr);
23188ebb749SStefano Zampini       /* Solve for row of constraint matrix in R numbering */
23288ebb749SStefano Zampini       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
23325084f0cSStefano Zampini       /* Set values in local_auxmat2 */
23425084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
23588ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->local_auxmat2,n_R,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
23625084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
23788ebb749SStefano Zampini     }
23888ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
23988ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
24025084f0cSStefano Zampini     ierr = MatScale(pcbddc->local_auxmat2,m_one);CHKERRQ(ierr);
24188ebb749SStefano Zampini 
24288ebb749SStefano Zampini     /* Assemble explicitly M1 = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1} needed in preproc  */
24325084f0cSStefano Zampini     ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
24425084f0cSStefano Zampini     ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
24588ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&M1);CHKERRQ(ierr);
24688ebb749SStefano Zampini     ierr = MatSetSizes(M1,n_constraints,n_constraints,n_constraints,n_constraints);CHKERRQ(ierr);
24788ebb749SStefano Zampini     ierr = MatSetType(M1,impMatType);CHKERRQ(ierr);
24825084f0cSStefano Zampini     ierr = MatSetUp(M1);CHKERRQ(ierr);
24925084f0cSStefano Zampini     ierr = MatDuplicate(M1,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
25025084f0cSStefano Zampini     ierr = MatZeroEntries(M2);CHKERRQ(ierr);
25125084f0cSStefano Zampini     ierr = VecSet(vec1_C,m_one);CHKERRQ(ierr);
25225084f0cSStefano Zampini     ierr = MatDiagonalSet(M2,vec1_C,INSERT_VALUES);CHKERRQ(ierr);
25325084f0cSStefano Zampini     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
25425084f0cSStefano Zampini     ierr = MatDestroy(&M2);CHKERRQ(ierr);
25525084f0cSStefano Zampini     ierr = MatDestroy(&M3);CHKERRQ(ierr);
25688ebb749SStefano Zampini     /* Assemble local_auxmat1 = M1*C_{CR} needed by BDDC application in KSP and in preproc */
25788ebb749SStefano Zampini     ierr = MatMatMult(M1,C_CR,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
25888ebb749SStefano Zampini   }
25988ebb749SStefano Zampini 
26088ebb749SStefano Zampini   /* Get submatrices from subdomain matrix */
26188ebb749SStefano Zampini   if (n_vertices) {
26225084f0cSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,n_vertices,vertices,PETSC_COPY_VALUES,&is_aux);CHKERRQ(ierr);
2638ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
2648ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
26525084f0cSStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
26625084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
26788ebb749SStefano Zampini   }
26888ebb749SStefano Zampini 
26988ebb749SStefano Zampini   /* Matrix of coarse basis functions (local) */
27088ebb749SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
27188ebb749SStefano Zampini   ierr = MatSetSizes(pcbddc->coarse_phi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
27288ebb749SStefano Zampini   ierr = MatSetType(pcbddc->coarse_phi_B,impMatType);CHKERRQ(ierr);
27325084f0cSStefano Zampini   ierr = MatSetUp(pcbddc->coarse_phi_B);CHKERRQ(ierr);
2748eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
27588ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
27688ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_phi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
27788ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_phi_D,impMatType);CHKERRQ(ierr);
27825084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_phi_D);CHKERRQ(ierr);
27988ebb749SStefano Zampini   }
28088ebb749SStefano Zampini 
28125084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
2828ce42a96SStefano Zampini     ierr = ISGetIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
28388ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*coarsefunctions_errors),&coarsefunctions_errors);CHKERRQ(ierr);
28488ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*constraints_errors),&constraints_errors);CHKERRQ(ierr);
28588ebb749SStefano Zampini   }
28688ebb749SStefano Zampini   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
28788ebb749SStefano Zampini   ierr = PetscMalloc((pcbddc->local_primal_size)*(pcbddc->local_primal_size)*sizeof(PetscScalar),&coarse_submat_vals);CHKERRQ(ierr);
28888ebb749SStefano Zampini 
28988ebb749SStefano Zampini   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
29025084f0cSStefano Zampini 
29125084f0cSStefano Zampini   /* vertices */
29288ebb749SStefano Zampini   for (i=0;i<n_vertices;i++) {
29388ebb749SStefano Zampini     ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
29488ebb749SStefano Zampini     ierr = VecSetValue(vec1_V,i,one,INSERT_VALUES);CHKERRQ(ierr);
29588ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
29688ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
29725084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on constraints multipliers */
29888ebb749SStefano Zampini     ierr = MatMult(A_RV,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
29988ebb749SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
30088ebb749SStefano Zampini     ierr = VecScale(pcbddc->vec1_R,m_one);CHKERRQ(ierr);
30188ebb749SStefano Zampini     if (n_constraints) {
30288ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec1_R,vec1_C);CHKERRQ(ierr);
30388ebb749SStefano Zampini       ierr = MatMultAdd(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
30488ebb749SStefano Zampini       ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
30588ebb749SStefano Zampini     }
30688ebb749SStefano Zampini     ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
30788ebb749SStefano Zampini     ierr = MatMultAdd(A_VV,vec1_V,vec2_V,vec2_V);CHKERRQ(ierr);
30888ebb749SStefano Zampini 
30988ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
31088ebb749SStefano Zampini     /* coarse basis functions */
31188ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
31288ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
31388ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
31425084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
31588ebb749SStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
31625084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
31788ebb749SStefano Zampini     ierr = MatSetValue(pcbddc->coarse_phi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
3188eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
31988ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
32088ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
32125084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
32288ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
32325084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
32488ebb749SStefano Zampini     }
32525084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
32625084f0cSStefano Zampini     ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
32725084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
32825084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
32988ebb749SStefano Zampini     if (n_constraints) {
33025084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
33125084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
33225084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
33388ebb749SStefano Zampini     }
33488ebb749SStefano Zampini 
33525084f0cSStefano Zampini     /* check */
33625084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
33725084f0cSStefano Zampini       /* assemble subdomain vector on local nodes */
33888ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
33925084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
34025084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
34125084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
34225084f0cSStefano Zampini       ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
34325084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
34425084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
34588ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers (i.e. primal nodes) */
34688ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
34725084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
34825084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
34925084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
35088ebb749SStefano Zampini       if (n_constraints) {
35125084f0cSStefano Zampini         ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
35225084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
35325084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
35488ebb749SStefano Zampini       }
35525084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
35625084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
35788ebb749SStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
35888ebb749SStefano Zampini       /* check saddle point solution */
35988ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
36088ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
36188ebb749SStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i]);CHKERRQ(ierr);
36288ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
36325084f0cSStefano Zampini       /* shift by the identity matrix */
36425084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
36525084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
36625084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
36788ebb749SStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i]);CHKERRQ(ierr);
36888ebb749SStefano Zampini     }
36988ebb749SStefano Zampini   }
37088ebb749SStefano Zampini 
37125084f0cSStefano Zampini   /* constraints */
37288ebb749SStefano Zampini   for (i=0;i<n_constraints;i++) {
37388ebb749SStefano Zampini     ierr = VecSet(vec2_C,zero);CHKERRQ(ierr);
37488ebb749SStefano Zampini     ierr = VecSetValue(vec2_C,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
37588ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec2_C);CHKERRQ(ierr);
37688ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec2_C);CHKERRQ(ierr);
37725084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on vertices multipliers */
37888ebb749SStefano Zampini     ierr = MatMult(M1,vec2_C,vec1_C);CHKERRQ(ierr);
37988ebb749SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
38088ebb749SStefano Zampini     ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
38125084f0cSStefano Zampini     if (n_vertices) {
38225084f0cSStefano Zampini       ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
38325084f0cSStefano Zampini     }
38488ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
38588ebb749SStefano Zampini     /* coarse basis functions */
38625084f0cSStefano Zampini     j = i+n_vertices; /* don't touch this! */
38788ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
38888ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
38988ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
39025084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
39125084f0cSStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
39225084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
3938eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
39488ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
39588ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
39625084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
39725084f0cSStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
39825084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
39988ebb749SStefano Zampini     }
40025084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
40188ebb749SStefano Zampini     if (n_vertices) {
40225084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
40325084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
40425084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
40588ebb749SStefano Zampini     }
40625084f0cSStefano Zampini     ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
40725084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
40825084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
40988ebb749SStefano Zampini 
41025084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
41188ebb749SStefano Zampini       /* assemble subdomain vector on nodes */
41288ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
41325084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
41425084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
41525084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
41625084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
41725084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
41888ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers */
41988ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
42088ebb749SStefano Zampini       if (n_vertices) {
42125084f0cSStefano Zampini         ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
42225084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
42325084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
42488ebb749SStefano Zampini       }
42525084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
42625084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
42725084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
42825084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
42925084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
43025084f0cSStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
43188ebb749SStefano Zampini       /* check saddle point solution */
43288ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
43388ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
43425084f0cSStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[j]);CHKERRQ(ierr);
43588ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
43625084f0cSStefano Zampini       /* shift by the identity matrix */
43725084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,j,m_one,ADD_VALUES);CHKERRQ(ierr);
43825084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
43925084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
44025084f0cSStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[j]);CHKERRQ(ierr);
44188ebb749SStefano Zampini     }
44288ebb749SStefano Zampini   }
44325084f0cSStefano Zampini   /* call assembling routines for local coarse basis */
44488ebb749SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
44588ebb749SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4468eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
44788ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
44888ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
44988ebb749SStefano Zampini   }
45025084f0cSStefano Zampini 
45188ebb749SStefano Zampini   /* compute other basis functions for non-symmetric problems */
45288ebb749SStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
45388ebb749SStefano Zampini   if (!setsym || (setsym && !issym)) {
45488ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
45588ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_psi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
45688ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_psi_B,impMatType);CHKERRQ(ierr);
45725084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_psi_B);CHKERRQ(ierr);
4588eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
45988ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
46088ebb749SStefano Zampini       ierr = MatSetSizes(pcbddc->coarse_psi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
46188ebb749SStefano Zampini       ierr = MatSetType(pcbddc->coarse_psi_D,impMatType);CHKERRQ(ierr);
46225084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->coarse_psi_D);CHKERRQ(ierr);
46388ebb749SStefano Zampini     }
46488ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
46588ebb749SStefano Zampini       if (n_constraints) {
46688ebb749SStefano Zampini         ierr = VecSet(vec1_C,zero);CHKERRQ(ierr);
46788ebb749SStefano Zampini         for (j=0;j<n_constraints;j++) {
46825084f0cSStefano Zampini           ierr = VecSetValue(vec1_C,j,coarse_submat_vals[(j+n_vertices)*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
46988ebb749SStefano Zampini         }
47025084f0cSStefano Zampini         ierr = VecAssemblyBegin(vec1_C);CHKERRQ(ierr);
47125084f0cSStefano Zampini         ierr = VecAssemblyEnd(vec1_C);CHKERRQ(ierr);
47288ebb749SStefano Zampini       }
47388ebb749SStefano Zampini       if (i<n_vertices) {
47488ebb749SStefano Zampini         ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
47588ebb749SStefano Zampini         ierr = VecSetValue(vec1_V,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
47688ebb749SStefano Zampini         ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
47788ebb749SStefano Zampini         ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
47888ebb749SStefano Zampini         ierr = MatMultTranspose(A_VR,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
47988ebb749SStefano Zampini         if (n_constraints) {
48088ebb749SStefano Zampini           ierr = MatMultTransposeAdd(C_CR,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
48188ebb749SStefano Zampini         }
48288ebb749SStefano Zampini       } else {
48388ebb749SStefano Zampini         ierr = MatMultTranspose(C_CR,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
48488ebb749SStefano Zampini       }
48588ebb749SStefano Zampini       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
48688ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
48788ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
48888ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
48925084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
49088ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_psi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
49125084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
49288ebb749SStefano Zampini       if (i<n_vertices) {
49388ebb749SStefano Zampini         ierr = MatSetValue(pcbddc->coarse_psi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
49488ebb749SStefano Zampini       }
4958eeda7d8SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
49688ebb749SStefano Zampini         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
49788ebb749SStefano Zampini         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
49825084f0cSStefano Zampini         ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
49988ebb749SStefano Zampini         ierr = MatSetValues(pcbddc->coarse_psi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
50025084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
50188ebb749SStefano Zampini       }
50288ebb749SStefano Zampini 
50325084f0cSStefano Zampini       if (pcbddc->dbg_flag) {
50488ebb749SStefano Zampini         /* assemble subdomain vector on nodes */
50588ebb749SStefano Zampini         ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
50625084f0cSStefano Zampini         ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
50725084f0cSStefano Zampini         ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
50825084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
50925084f0cSStefano Zampini         if (i<n_vertices) {
51025084f0cSStefano Zampini           ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
51188ebb749SStefano Zampini         }
51225084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
51325084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
51425084f0cSStefano Zampini         /* assemble subdomain vector of lagrange multipliers */
51525084f0cSStefano Zampini         for (j=0;j<pcbddc->local_primal_size;j++) {
51625084f0cSStefano Zampini           ierr = VecSetValue(pcbddc->vec1_P,j,-coarse_submat_vals[j*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
51725084f0cSStefano Zampini         }
51825084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
51925084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
52088ebb749SStefano Zampini         /* check saddle point solution */
52188ebb749SStefano Zampini         ierr = MatMultTranspose(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
52288ebb749SStefano Zampini         ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
52388ebb749SStefano Zampini         ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
52488ebb749SStefano Zampini         ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
52525084f0cSStefano Zampini         /* shift by the identity matrix */
52625084f0cSStefano Zampini         ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
52725084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
52825084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
52988ebb749SStefano Zampini         ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
53088ebb749SStefano Zampini       }
53188ebb749SStefano Zampini     }
53288ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
53388ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5348eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
53588ebb749SStefano Zampini       ierr = MatAssemblyBegin(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
53688ebb749SStefano Zampini       ierr = MatAssemblyEnd(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
53788ebb749SStefano Zampini     }
53888ebb749SStefano Zampini   }
53988ebb749SStefano Zampini   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
54088ebb749SStefano Zampini   /* Checking coarse_sub_mat and coarse basis functios */
54188ebb749SStefano Zampini   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
54288ebb749SStefano Zampini   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
54325084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
54488ebb749SStefano Zampini     Mat         coarse_sub_mat;
54525084f0cSStefano Zampini     Mat         AUXMAT,TM1,TM2,TM3,TM4;
54688ebb749SStefano Zampini     Mat         coarse_phi_D,coarse_phi_B;
54788ebb749SStefano Zampini     Mat         coarse_psi_D,coarse_psi_B;
54888ebb749SStefano Zampini     Mat         A_II,A_BB,A_IB,A_BI;
54988ebb749SStefano Zampini     MatType     checkmattype=MATSEQAIJ;
55088ebb749SStefano Zampini     PetscReal   real_value;
55188ebb749SStefano Zampini 
55288ebb749SStefano Zampini     ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
55388ebb749SStefano Zampini     ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
55488ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
55588ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
55688ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
55788ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
55888ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
55988ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
56088ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
56188ebb749SStefano Zampini     }
56288ebb749SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
56388ebb749SStefano Zampini 
56425084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
56525084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat and local basis functions\n");CHKERRQ(ierr);
56625084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
56788ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
56888ebb749SStefano Zampini       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
56988ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
57088ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
57188ebb749SStefano Zampini       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
57288ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
57388ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
57488ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
57588ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
57688ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
57788ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
57888ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
57988ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
58088ebb749SStefano Zampini     } else {
58188ebb749SStefano Zampini       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
58288ebb749SStefano Zampini       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
58388ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
58488ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
58588ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
58688ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
58788ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
58888ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
58988ebb749SStefano Zampini     }
59088ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
59188ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
59288ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
59388ebb749SStefano Zampini     ierr = MatConvert(TM1,MATSEQDENSE,MAT_REUSE_MATRIX,&TM1);CHKERRQ(ierr);
59488ebb749SStefano Zampini     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
59588ebb749SStefano Zampini     ierr = MatNorm(TM1,NORM_INFINITY,&real_value);CHKERRQ(ierr);
59625084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"----------------------------------\n");CHKERRQ(ierr);
59725084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d \n",PetscGlobalRank);CHKERRQ(ierr);
59825084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"matrix error = % 1.14e\n",real_value);CHKERRQ(ierr);
59925084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (phi) errors\n");CHKERRQ(ierr);
60088ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
60125084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,coarsefunctions_errors[i]);CHKERRQ(ierr);
60288ebb749SStefano Zampini     }
60325084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (phi) errors\n");CHKERRQ(ierr);
60488ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
60525084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,constraints_errors[i]);CHKERRQ(ierr);
60688ebb749SStefano Zampini     }
60788ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
60825084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (psi) errors\n");CHKERRQ(ierr);
60988ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
61025084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,coarsefunctions_errors[i]);CHKERRQ(ierr);
61188ebb749SStefano Zampini       }
61225084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (psi) errors\n");CHKERRQ(ierr);
61388ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
61425084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,constraints_errors[i]);CHKERRQ(ierr);
61588ebb749SStefano Zampini       }
61688ebb749SStefano Zampini     }
61725084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
61888ebb749SStefano Zampini     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
61988ebb749SStefano Zampini     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
62088ebb749SStefano Zampini     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
62188ebb749SStefano Zampini     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
62288ebb749SStefano Zampini     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
62388ebb749SStefano Zampini     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
62488ebb749SStefano Zampini     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
62588ebb749SStefano Zampini     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
62688ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
62788ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
62888ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
62988ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
63088ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
63188ebb749SStefano Zampini     }
63288ebb749SStefano Zampini     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
6338ce42a96SStefano Zampini     ierr = ISRestoreIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
63488ebb749SStefano Zampini     ierr = PetscFree(coarsefunctions_errors);CHKERRQ(ierr);
63588ebb749SStefano Zampini     ierr = PetscFree(constraints_errors);CHKERRQ(ierr);
63688ebb749SStefano Zampini   }
63788ebb749SStefano Zampini   /* free memory */
63888ebb749SStefano Zampini   if (n_vertices) {
63988ebb749SStefano Zampini     ierr = PetscFree(vertices);CHKERRQ(ierr);
64088ebb749SStefano Zampini     ierr = VecDestroy(&vec1_V);CHKERRQ(ierr);
64188ebb749SStefano Zampini     ierr = VecDestroy(&vec2_V);CHKERRQ(ierr);
64288ebb749SStefano Zampini     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
64388ebb749SStefano Zampini     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
64488ebb749SStefano Zampini     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
64588ebb749SStefano Zampini   }
64688ebb749SStefano Zampini   if (n_constraints) {
64788ebb749SStefano Zampini     ierr = VecDestroy(&vec1_C);CHKERRQ(ierr);
64888ebb749SStefano Zampini     ierr = VecDestroy(&vec2_C);CHKERRQ(ierr);
64988ebb749SStefano Zampini     ierr = MatDestroy(&M1);CHKERRQ(ierr);
65088ebb749SStefano Zampini     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
65188ebb749SStefano Zampini   }
65288ebb749SStefano Zampini   ierr = PetscFree(auxindices);CHKERRQ(ierr);
6538629588bSStefano Zampini   /* get back data */
6548629588bSStefano Zampini   *coarse_submat_vals_n = coarse_submat_vals;
65588ebb749SStefano Zampini   PetscFunctionReturn(0);
65688ebb749SStefano Zampini }
65788ebb749SStefano Zampini 
65888ebb749SStefano Zampini #undef __FUNCT__
659aa0d41d4SStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalMatrices"
660aa0d41d4SStefano Zampini PetscErrorCode PCBDDCSetUpLocalMatrices(PC pc)
661aa0d41d4SStefano Zampini {
662aa0d41d4SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
663aa0d41d4SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
664aa0d41d4SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
665aa0d41d4SStefano Zampini   /* manage repeated solves */
666aa0d41d4SStefano Zampini   MatReuse          reuse;
667aa0d41d4SStefano Zampini   MatStructure      matstruct;
668aa0d41d4SStefano Zampini   PetscErrorCode    ierr;
669aa0d41d4SStefano Zampini 
670aa0d41d4SStefano Zampini   PetscFunctionBegin;
671aa0d41d4SStefano Zampini   /* get mat flags */
672aa0d41d4SStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
673aa0d41d4SStefano Zampini   reuse = MAT_INITIAL_MATRIX;
674aa0d41d4SStefano Zampini   if (pc->setupcalled) {
675aa0d41d4SStefano Zampini     /* when matstruct is SAME_PRECONDITIONER, we shouldn't be here */
676aa0d41d4SStefano Zampini     if (matstruct == SAME_PRECONDITIONER) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen");
677aa0d41d4SStefano Zampini     if (matstruct == SAME_NONZERO_PATTERN) {
678aa0d41d4SStefano Zampini       reuse = MAT_REUSE_MATRIX;
679aa0d41d4SStefano Zampini     } else {
680aa0d41d4SStefano Zampini       reuse = MAT_INITIAL_MATRIX;
681aa0d41d4SStefano Zampini     }
682aa0d41d4SStefano Zampini   }
683aa0d41d4SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
684aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
685aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
686aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
687aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BB);CHKERRQ(ierr);
688aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
689aa0d41d4SStefano Zampini   }
690aa0d41d4SStefano Zampini 
691aa0d41d4SStefano Zampini   /* transform local matrices if needed */
692aa0d41d4SStefano Zampini   if (pcbddc->use_change_of_basis) {
693aa0d41d4SStefano Zampini     Mat         change_mat_all;
694aa0d41d4SStefano Zampini     PetscScalar *row_cmat_values;
695aa0d41d4SStefano Zampini     PetscInt    *row_cmat_indices;
696aa0d41d4SStefano Zampini     PetscInt    *nnz,*is_indices,*temp_indices;
697aa0d41d4SStefano Zampini     PetscInt    i,j,k,n_D,n_B;
698aa0d41d4SStefano Zampini 
699aa0d41d4SStefano Zampini     /* Get Non-overlapping dimensions */
700aa0d41d4SStefano Zampini     n_B = pcis->n_B;
701aa0d41d4SStefano Zampini     n_D = pcis->n-n_B;
702aa0d41d4SStefano Zampini 
703aa0d41d4SStefano Zampini     /* compute nonzero structure of change of basis on all local nodes */
704aa0d41d4SStefano Zampini     ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
705aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
706aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) nnz[is_indices[i]] = 1;
707aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
708aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
709aa0d41d4SStefano Zampini     k=1;
710aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
711aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
712aa0d41d4SStefano Zampini       nnz[is_indices[i]]=j;
713aa0d41d4SStefano Zampini       if (k < j) k = j;
714aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
715aa0d41d4SStefano Zampini     }
716aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
717aa0d41d4SStefano Zampini     /* assemble change of basis matrix on the whole set of local dofs */
718aa0d41d4SStefano Zampini     ierr = PetscMalloc(k*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
719aa0d41d4SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&change_mat_all);CHKERRQ(ierr);
720aa0d41d4SStefano Zampini     ierr = MatSetSizes(change_mat_all,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
721aa0d41d4SStefano Zampini     ierr = MatSetType(change_mat_all,MATSEQAIJ);CHKERRQ(ierr);
722aa0d41d4SStefano Zampini     ierr = MatSeqAIJSetPreallocation(change_mat_all,0,nnz);CHKERRQ(ierr);
723aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
724aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) {
725aa0d41d4SStefano Zampini       ierr = MatSetValue(change_mat_all,is_indices[i],is_indices[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
726aa0d41d4SStefano Zampini     }
727aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
728aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
729aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
730aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
731aa0d41d4SStefano Zampini       for (k=0; k<j; k++) temp_indices[k]=is_indices[row_cmat_indices[k]];
732aa0d41d4SStefano Zampini       ierr = MatSetValues(change_mat_all,1,&is_indices[i],j,temp_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
733aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
734aa0d41d4SStefano Zampini     }
735aa0d41d4SStefano Zampini     ierr = MatAssemblyBegin(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
736aa0d41d4SStefano Zampini     ierr = MatAssemblyEnd(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
737aa0d41d4SStefano Zampini     /* TODO: HOW TO WORK WITH BAIJ? PtAP not provided */
738aa0d41d4SStefano Zampini     ierr = MatGetBlockSize(matis->A,&i);CHKERRQ(ierr);
739aa0d41d4SStefano Zampini     if (i==1) {
740aa0d41d4SStefano Zampini       ierr = MatPtAP(matis->A,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
741aa0d41d4SStefano Zampini     } else {
742aa0d41d4SStefano Zampini       Mat work_mat;
743aa0d41d4SStefano Zampini       ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
744aa0d41d4SStefano Zampini       ierr = MatPtAP(work_mat,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
745aa0d41d4SStefano Zampini       ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
746aa0d41d4SStefano Zampini     }
747aa0d41d4SStefano Zampini     ierr = MatDestroy(&change_mat_all);CHKERRQ(ierr);
748aa0d41d4SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
749aa0d41d4SStefano Zampini     ierr = PetscFree(temp_indices);CHKERRQ(ierr);
750aa0d41d4SStefano Zampini   } else {
751aa0d41d4SStefano Zampini     /* without change of basis, the local matrix is unchanged */
752aa0d41d4SStefano Zampini     if (!pcbddc->local_mat) {
753aa0d41d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)matis->A);CHKERRQ(ierr);
754aa0d41d4SStefano Zampini       pcbddc->local_mat = matis->A;
755aa0d41d4SStefano Zampini     }
756aa0d41d4SStefano Zampini   }
757aa0d41d4SStefano Zampini 
758aa0d41d4SStefano Zampini   /* get submatrices */
759aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_I_local,reuse,&pcis->A_II);CHKERRQ(ierr);
760aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
761aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
762aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_B_local,reuse,&pcis->A_BB);CHKERRQ(ierr);
763aa0d41d4SStefano Zampini   PetscFunctionReturn(0);
764aa0d41d4SStefano Zampini }
765aa0d41d4SStefano Zampini 
766aa0d41d4SStefano Zampini #undef __FUNCT__
767a64d13efSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalScatters"
7688ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
769a64d13efSStefano Zampini {
770a64d13efSStefano Zampini   PC_IS*         pcis = (PC_IS*)(pc->data);
771a64d13efSStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
7728ce42a96SStefano Zampini   IS             is_aux1,is_aux2;
773a64d13efSStefano Zampini   PetscInt       *vertices,*aux_array1,*aux_array2,*is_indices,*idx_R_local;
774a64d13efSStefano Zampini   PetscInt       n_vertices,n_constraints,i,j,n_R,n_D,n_B;
7754641a718SStefano Zampini   PetscBT        bitmask;
776a64d13efSStefano Zampini   PetscErrorCode ierr;
777a64d13efSStefano Zampini 
778a64d13efSStefano Zampini   PetscFunctionBegin;
779a64d13efSStefano Zampini   /* Set Non-overlapping dimensions */
780a64d13efSStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
781a64d13efSStefano Zampini   /* get vertex indices from constraint matrix */
782a64d13efSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
783a64d13efSStefano Zampini   /* Set number of constraints */
784a64d13efSStefano Zampini   n_constraints = pcbddc->local_primal_size-n_vertices;
7854641a718SStefano Zampini   /* create auxiliary bitmask */
7864641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
7874641a718SStefano Zampini   for (i=0;i<n_vertices;i++) {
7884641a718SStefano Zampini     ierr = PetscBTSet(bitmask,vertices[i]);CHKERRQ(ierr);
7894641a718SStefano Zampini   }
790a64d13efSStefano Zampini   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
791a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n-n_vertices)*sizeof(PetscInt),&idx_R_local);CHKERRQ(ierr);
792a64d13efSStefano Zampini   for (i=0, n_R=0; i<pcis->n; i++) {
7934641a718SStefano Zampini     if (!PetscBTLookup(bitmask,i)) {
794a64d13efSStefano Zampini       idx_R_local[n_R] = i;
795a64d13efSStefano Zampini       n_R++;
796a64d13efSStefano Zampini     }
797a64d13efSStefano Zampini   }
798a64d13efSStefano Zampini   ierr = PetscFree(vertices);CHKERRQ(ierr);
7998ce42a96SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_R,idx_R_local,PETSC_OWN_POINTER,&pcbddc->is_R_local);CHKERRQ(ierr);
800a64d13efSStefano Zampini 
801a64d13efSStefano Zampini   /* print some info if requested */
802a64d13efSStefano Zampini   if (pcbddc->dbg_flag) {
803a64d13efSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
804a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
805a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
806a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
807a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"r_size = %d, v_size = %d, constraints = %d, local_primal_size = %d\n",n_R,n_vertices,n_constraints,pcbddc->local_primal_size);CHKERRQ(ierr);
808a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr);
809a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
810a64d13efSStefano Zampini   }
811a64d13efSStefano Zampini 
812a64d13efSStefano Zampini   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
813a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
814a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array2);CHKERRQ(ierr);
815a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
8164641a718SStefano Zampini   for (i=0; i<n_D; i++) {
8174641a718SStefano Zampini     ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
8184641a718SStefano Zampini   }
819a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
820a64d13efSStefano Zampini   for (i=0, j=0; i<n_R; i++) {
8214641a718SStefano Zampini     if (!PetscBTLookup(bitmask,idx_R_local[i])) {
8224641a718SStefano Zampini       aux_array1[j++] = i;
823a64d13efSStefano Zampini     }
824a64d13efSStefano Zampini   }
825a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
826a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
827a64d13efSStefano Zampini   for (i=0, j=0; i<n_B; i++) {
8284641a718SStefano Zampini     if (!PetscBTLookup(bitmask,is_indices[i])) {
8294641a718SStefano Zampini       aux_array2[j++] = i;
830a64d13efSStefano Zampini     }
831a64d13efSStefano Zampini   }
832a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
833a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
834a64d13efSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
835a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
836a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
837a64d13efSStefano Zampini 
8388eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
839a64d13efSStefano Zampini     ierr = PetscMalloc(n_D*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
840a64d13efSStefano Zampini     for (i=0, j=0; i<n_R; i++) {
8414641a718SStefano Zampini       if (PetscBTLookup(bitmask,idx_R_local[i])) {
8424641a718SStefano Zampini         aux_array1[j++] = i;
843a64d13efSStefano Zampini       }
844a64d13efSStefano Zampini     }
845a64d13efSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
846a64d13efSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
847a64d13efSStefano Zampini     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
848a64d13efSStefano Zampini   }
8494641a718SStefano Zampini   ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
850a64d13efSStefano Zampini   PetscFunctionReturn(0);
851a64d13efSStefano Zampini }
852a64d13efSStefano Zampini 
853304d26faSStefano Zampini 
854304d26faSStefano Zampini #undef __FUNCT__
855304d26faSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
8568ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc)
857304d26faSStefano Zampini {
858304d26faSStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
859304d26faSStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
860304d26faSStefano Zampini   PC             pc_temp;
861304d26faSStefano Zampini   Mat            A_RR;
862304d26faSStefano Zampini   Vec            vec1,vec2,vec3;
863304d26faSStefano Zampini   MatStructure   matstruct;
864304d26faSStefano Zampini   PetscScalar    m_one = -1.0;
865304d26faSStefano Zampini   PetscReal      value;
866b8ffe317SStefano Zampini   PetscInt       n_D,n_R;
867b8ffe317SStefano Zampini   PetscBool      use_exact,use_exact_reduced;
868304d26faSStefano Zampini   PetscErrorCode ierr;
869e604994aSStefano Zampini   /* prefixes stuff */
870e604994aSStefano Zampini   char           dir_prefix[256],neu_prefix[256],str_level[3];
871e604994aSStefano Zampini   size_t         len;
872304d26faSStefano Zampini 
873304d26faSStefano Zampini   PetscFunctionBegin;
874304d26faSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
875304d26faSStefano Zampini 
876e604994aSStefano Zampini   /* compute prefixes */
877e604994aSStefano Zampini   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
878e604994aSStefano Zampini   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
879e604994aSStefano Zampini   if (!pcbddc->current_level) {
880e604994aSStefano Zampini     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
881e604994aSStefano Zampini     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
882e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
883e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
884e604994aSStefano Zampini   } else {
885e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
886e604994aSStefano Zampini     sprintf(str_level,"%d_",(int)(pcbddc->current_level));
887e604994aSStefano Zampini     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
888e604994aSStefano Zampini     len -= 15; /* remove "pc_bddc_coarse_" */
889e604994aSStefano Zampini     if (pcbddc->current_level>1) len -= 2; /* remove "X_" with X level number (works with 9 levels max) */
890e604994aSStefano Zampini     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
891e604994aSStefano Zampini     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
892e604994aSStefano Zampini     *(dir_prefix+len)='\0';
893e604994aSStefano Zampini     *(neu_prefix+len)='\0';
894e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
895e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
896e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
897e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
898e604994aSStefano Zampini   }
899e604994aSStefano Zampini 
900304d26faSStefano Zampini   /* DIRICHLET PROBLEM */
901ac78edfcSStefano Zampini   /* Matrix for Dirichlet problem is pcis->A_II */
9028ce42a96SStefano Zampini   ierr = ISGetSize(pcis->is_I_local,&n_D);CHKERRQ(ierr);
903304d26faSStefano Zampini   if (!pcbddc->ksp_D) { /* create object if not yet build */
904304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
905304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
906304d26faSStefano Zampini     /* default */
907304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
908e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
909304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
910304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
911304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
912304d26faSStefano Zampini   }
913304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II,matstruct);CHKERRQ(ierr);
914304d26faSStefano Zampini   /* Allow user's customization */
915304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
916304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
917304d26faSStefano Zampini   if (!n_D) {
918304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
919304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
920304d26faSStefano Zampini   }
921304d26faSStefano Zampini   /* Set Up KSP for Dirichlet problem of BDDC */
922304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
923304d26faSStefano Zampini   /* set ksp_D into pcis data */
924304d26faSStefano Zampini   ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
925304d26faSStefano Zampini   ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
926304d26faSStefano Zampini   pcis->ksp_D = pcbddc->ksp_D;
927304d26faSStefano Zampini 
928304d26faSStefano Zampini   /* NEUMANN PROBLEM */
929304d26faSStefano Zampini   /* Matrix for Neumann problem is A_RR -> we need to create it */
9308ce42a96SStefano Zampini   ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
9318ce42a96SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
932304d26faSStefano Zampini   if (!pcbddc->ksp_R) { /* create object if not yet build */
933304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
934304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
935304d26faSStefano Zampini     /* default */
936304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
937e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
938304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
939304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
940304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
941304d26faSStefano Zampini   }
942304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR,matstruct);CHKERRQ(ierr);
943304d26faSStefano Zampini   /* Allow user's customization */
944304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
945304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
946304d26faSStefano Zampini   if (!n_R) {
947304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
948304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
949304d26faSStefano Zampini   }
950304d26faSStefano Zampini   /* Set Up KSP for Neumann problem of BDDC */
951304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
952304d26faSStefano Zampini 
953304d26faSStefano Zampini   /* check Dirichlet and Neumann solvers and adapt them if a nullspace correction is needed */
954304d26faSStefano Zampini 
955304d26faSStefano Zampini   /* Dirichlet */
956304d26faSStefano Zampini   ierr = MatGetVecs(pcis->A_II,&vec1,&vec2);CHKERRQ(ierr);
957304d26faSStefano Zampini   ierr = VecDuplicate(vec1,&vec3);CHKERRQ(ierr);
958304d26faSStefano Zampini   ierr = VecSetRandom(vec1,NULL);CHKERRQ(ierr);
959304d26faSStefano Zampini   ierr = MatMult(pcis->A_II,vec1,vec2);CHKERRQ(ierr);
960304d26faSStefano Zampini   ierr = KSPSolve(pcbddc->ksp_D,vec2,vec3);CHKERRQ(ierr);
961304d26faSStefano Zampini   ierr = VecAXPY(vec3,m_one,vec1);CHKERRQ(ierr);
962304d26faSStefano Zampini   ierr = VecNorm(vec3,NORM_INFINITY,&value);CHKERRQ(ierr);
963304d26faSStefano Zampini   ierr = VecDestroy(&vec1);CHKERRQ(ierr);
964304d26faSStefano Zampini   ierr = VecDestroy(&vec2);CHKERRQ(ierr);
965304d26faSStefano Zampini   ierr = VecDestroy(&vec3);CHKERRQ(ierr);
966304d26faSStefano Zampini   /* need to be adapted? */
967b8ffe317SStefano Zampini   use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
968b8ffe317SStefano Zampini   ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
969b8ffe317SStefano Zampini   ierr = PCBDDCSetUseExactDirichlet(pc,use_exact_reduced);CHKERRQ(ierr);
970304d26faSStefano Zampini   /* print info */
971304d26faSStefano Zampini   if (pcbddc->dbg_flag) {
972304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
973304d26faSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
974304d26faSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Checking solution of Dirichlet and Neumann problems\n");CHKERRQ(ierr);
975e604994aSStefano 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);
976304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
977304d26faSStefano Zampini   }
978b8ffe317SStefano Zampini   if (pcbddc->NullSpace && !use_exact_reduced && !pcbddc->switch_static) {
9798ce42a96SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcis->is_I_local);CHKERRQ(ierr);
980304d26faSStefano Zampini   }
981304d26faSStefano Zampini 
982304d26faSStefano Zampini   /* Neumann */
983304d26faSStefano Zampini   ierr = MatGetVecs(A_RR,&vec1,&vec2);CHKERRQ(ierr);
984304d26faSStefano Zampini   ierr = VecDuplicate(vec1,&vec3);CHKERRQ(ierr);
985304d26faSStefano Zampini   ierr = VecSetRandom(vec1,NULL);CHKERRQ(ierr);
986304d26faSStefano Zampini   ierr = MatMult(A_RR,vec1,vec2);CHKERRQ(ierr);
987304d26faSStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,vec2,vec3);CHKERRQ(ierr);
988304d26faSStefano Zampini   ierr = VecAXPY(vec3,m_one,vec1);CHKERRQ(ierr);
989304d26faSStefano Zampini   ierr = VecNorm(vec3,NORM_INFINITY,&value);CHKERRQ(ierr);
990304d26faSStefano Zampini   ierr = VecDestroy(&vec1);CHKERRQ(ierr);
991304d26faSStefano Zampini   ierr = VecDestroy(&vec2);CHKERRQ(ierr);
992304d26faSStefano Zampini   ierr = VecDestroy(&vec3);CHKERRQ(ierr);
993304d26faSStefano Zampini   /* need to be adapted? */
994b8ffe317SStefano Zampini   use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
995b8ffe317SStefano Zampini   ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
996304d26faSStefano Zampini   /* print info */
997304d26faSStefano Zampini   if (pcbddc->dbg_flag) {
998e604994aSStefano 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);
999304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1000304d26faSStefano Zampini   }
1001b8ffe317SStefano Zampini   if (pcbddc->NullSpace && !use_exact_reduced) { /* is it the right logic? */
10028ce42a96SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcbddc->is_R_local);CHKERRQ(ierr);
1003304d26faSStefano Zampini   }
1004304d26faSStefano Zampini   /* free Neumann problem's matrix */
1005304d26faSStefano Zampini   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1006304d26faSStefano Zampini   PetscFunctionReturn(0);
1007304d26faSStefano Zampini }
1008304d26faSStefano Zampini 
1009304d26faSStefano Zampini #undef __FUNCT__
1010674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSolveSaddlePoint"
1011674ae819SStefano Zampini static PetscErrorCode  PCBDDCSolveSaddlePoint(PC pc)
1012674ae819SStefano Zampini {
1013674ae819SStefano Zampini   PetscErrorCode ierr;
1014674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1015674ae819SStefano Zampini 
1016674ae819SStefano Zampini   PetscFunctionBegin;
1017674ae819SStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
1018674ae819SStefano Zampini   if (pcbddc->local_auxmat1) {
1019674ae819SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec2_R,pcbddc->vec1_C);CHKERRQ(ierr);
1020674ae819SStefano Zampini     ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
1021674ae819SStefano Zampini   }
1022674ae819SStefano Zampini   PetscFunctionReturn(0);
1023674ae819SStefano Zampini }
1024674ae819SStefano Zampini 
1025674ae819SStefano Zampini #undef __FUNCT__
1026674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
1027674ae819SStefano Zampini PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc)
1028674ae819SStefano Zampini {
1029674ae819SStefano Zampini   PetscErrorCode ierr;
1030674ae819SStefano Zampini   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
1031674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)  (pc->data);
1032674ae819SStefano Zampini   const PetscScalar zero = 0.0;
1033674ae819SStefano Zampini 
1034674ae819SStefano Zampini   PetscFunctionBegin;
103515aaf578SStefano Zampini   /* Application of PHI^T (or PSI^T)  */
103615aaf578SStefano Zampini   if (pcbddc->coarse_psi_B) {
103715aaf578SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
10388eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
103915aaf578SStefano Zampini   } else {
1040674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
10418eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
104215aaf578SStefano Zampini   }
1043674ae819SStefano Zampini   /* Scatter data of coarse_rhs */
1044674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { ierr = VecSet(pcbddc->coarse_rhs,zero);CHKERRQ(ierr); }
1045674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1046674ae819SStefano Zampini 
1047674ae819SStefano Zampini   /* Local solution on R nodes */
1048674ae819SStefano Zampini   ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
1049674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1050674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
10518eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1052674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1053674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1054674ae819SStefano Zampini   }
1055674ae819SStefano Zampini   ierr = PCBDDCSolveSaddlePoint(pc);CHKERRQ(ierr);
1056674ae819SStefano Zampini   ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1057674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1058674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
10598eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1060674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1061674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1062674ae819SStefano Zampini   }
1063674ae819SStefano Zampini 
1064674ae819SStefano Zampini   /* Coarse solution */
1065674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1066674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { /* TODO remove null space when doing multilevel */
1067674ae819SStefano Zampini     ierr = KSPSolve(pcbddc->coarse_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
1068674ae819SStefano Zampini   }
1069674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1070674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd  (pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1071674ae819SStefano Zampini 
1072674ae819SStefano Zampini   /* Sum contributions from two levels */
1073674ae819SStefano Zampini   ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
10748eeda7d8SStefano Zampini   if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1075674ae819SStefano Zampini   PetscFunctionReturn(0);
1076674ae819SStefano Zampini }
1077674ae819SStefano Zampini 
1078674ae819SStefano Zampini #undef __FUNCT__
1079674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
1080674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1081674ae819SStefano Zampini {
1082674ae819SStefano Zampini   PetscErrorCode ierr;
1083674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1084674ae819SStefano Zampini 
1085674ae819SStefano Zampini   PetscFunctionBegin;
1086674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1087674ae819SStefano Zampini   PetscFunctionReturn(0);
1088674ae819SStefano Zampini }
1089674ae819SStefano Zampini 
1090674ae819SStefano Zampini #undef __FUNCT__
1091674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
1092674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1093674ae819SStefano Zampini {
1094674ae819SStefano Zampini   PetscErrorCode ierr;
1095674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1096674ae819SStefano Zampini 
1097674ae819SStefano Zampini   PetscFunctionBegin;
1098674ae819SStefano Zampini   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1099674ae819SStefano Zampini   PetscFunctionReturn(0);
1100674ae819SStefano Zampini }
1101674ae819SStefano Zampini 
1102984c4197SStefano Zampini /* uncomment for testing purposes */
1103984c4197SStefano Zampini /* #define PETSC_MISSING_LAPACK_GESVD 1 */
1104674ae819SStefano Zampini #undef __FUNCT__
1105674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp"
1106674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
1107674ae819SStefano Zampini {
1108674ae819SStefano Zampini   PetscErrorCode    ierr;
1109674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
1110674ae819SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
1111674ae819SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
1112984c4197SStefano Zampini   /* constraint and (optionally) change of basis matrix implemented as SeqAIJ */
1113674ae819SStefano Zampini   MatType           impMatType=MATSEQAIJ;
1114984c4197SStefano Zampini   /* one and zero */
1115984c4197SStefano Zampini   PetscScalar       one=1.0,zero=0.0;
1116984c4197SStefano Zampini   /* space to store constraints and their local indices */
1117984c4197SStefano Zampini   PetscScalar       *temp_quadrature_constraint;
1118984c4197SStefano Zampini   PetscInt          *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B;
1119984c4197SStefano Zampini   /* iterators */
1120984c4197SStefano Zampini   PetscInt          i,j,k,total_counts,temp_start_ptr;
1121984c4197SStefano Zampini   /* stuff to store connected components stored in pcbddc->mat_graph */
1122984c4197SStefano Zampini   IS                ISForVertices,*ISForFaces,*ISForEdges,*used_IS;
1123984c4197SStefano Zampini   PetscInt          n_ISForFaces,n_ISForEdges;
1124984c4197SStefano Zampini   /* near null space stuff */
1125674ae819SStefano Zampini   MatNullSpace      nearnullsp;
1126674ae819SStefano Zampini   const Vec         *nearnullvecs;
1127674ae819SStefano Zampini   Vec               *localnearnullsp;
1128984c4197SStefano Zampini   PetscBool         nnsp_has_cnst;
1129984c4197SStefano Zampini   PetscInt          nnsp_size;
1130984c4197SStefano Zampini   PetscScalar       *array;
1131984c4197SStefano Zampini   /* BLAS integers */
1132e310c8b4SStefano Zampini   PetscBLASInt      lwork,lierr;
1133e310c8b4SStefano Zampini   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
1134c4303822SStefano Zampini   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
1135984c4197SStefano Zampini   /* LAPACK working arrays for SVD or POD */
1136242a89d7SStefano Zampini   PetscBool         skip_lapack;
1137984c4197SStefano Zampini   PetscScalar       *work;
1138984c4197SStefano Zampini   PetscReal         *singular_vals;
1139984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1140984c4197SStefano Zampini   PetscReal         *rwork;
1141674ae819SStefano Zampini #endif
1142984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1143e310c8b4SStefano Zampini   PetscBLASInt      Blas_one_2=1;
1144984c4197SStefano Zampini   PetscScalar       *temp_basis,*correlation_mat;
1145b7d8b9f8SStefano Zampini #else
1146b7d8b9f8SStefano Zampini   PetscBLASInt      dummy_int_1=1,dummy_int_2=1;
1147b7d8b9f8SStefano Zampini   PetscScalar       dummy_scalar_1=0.0,dummy_scalar_2=0.0;
1148984c4197SStefano Zampini #endif
1149984c4197SStefano Zampini   /* change of basis */
1150984c4197SStefano Zampini   PetscInt          *aux_primal_numbering,*aux_primal_minloc,*global_indices;
11514641a718SStefano Zampini   PetscBool         boolforchange;
11524641a718SStefano Zampini   PetscBT           touched,change_basis;
1153984c4197SStefano Zampini   /* auxiliary stuff */
1154984c4197SStefano Zampini   PetscInt          *nnz,*is_indices,*local_to_B;
1155984c4197SStefano Zampini   /* some quantities */
1156984c4197SStefano Zampini   PetscInt          n_vertices,total_primal_vertices;
1157984c4197SStefano Zampini   PetscInt          size_of_constraint,max_size_of_constraint,max_constraints,temp_constraints;
1158984c4197SStefano Zampini 
1159674ae819SStefano Zampini 
1160674ae819SStefano Zampini   PetscFunctionBegin;
1161674ae819SStefano Zampini   /* Get index sets for faces, edges and vertices from graph */
11628eeda7d8SStefano Zampini   if (!pcbddc->use_faces && !pcbddc->use_edges && !pcbddc->use_vertices) {
11638eeda7d8SStefano Zampini     pcbddc->use_vertices = PETSC_TRUE;
1164674ae819SStefano Zampini   }
11658eeda7d8SStefano Zampini   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,pcbddc->use_faces,pcbddc->use_edges,pcbddc->use_vertices,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);
1166b8ffe317SStefano Zampini   /* HACK: provide functions to set change of basis */
1167b8ffe317SStefano Zampini   if (!ISForVertices && pcbddc->NullSpace) {
1168b8ffe317SStefano Zampini     pcbddc->use_change_of_basis = PETSC_TRUE;
1169b8ffe317SStefano Zampini     pcbddc->use_change_on_faces = PETSC_FALSE;
1170b8ffe317SStefano Zampini   }
1171984c4197SStefano Zampini   /* print some info */
1172674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
1173674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1174674ae819SStefano Zampini     i = 0;
1175674ae819SStefano Zampini     if (ISForVertices) {
1176674ae819SStefano Zampini       ierr = ISGetSize(ISForVertices,&i);CHKERRQ(ierr);
1177674ae819SStefano Zampini     }
1178674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices\n",PetscGlobalRank,i);CHKERRQ(ierr);
1179674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges\n",PetscGlobalRank,n_ISForEdges);CHKERRQ(ierr);
118015aaf578SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces\n",PetscGlobalRank,n_ISForFaces);CHKERRQ(ierr);
1181674ae819SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1182674ae819SStefano Zampini   }
1183674ae819SStefano Zampini   /* check if near null space is attached to global mat */
1184674ae819SStefano Zampini   ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
1185674ae819SStefano Zampini   if (nearnullsp) {
1186674ae819SStefano Zampini     ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
1187984c4197SStefano Zampini   } else { /* if near null space is not provided BDDC uses constants by default */
1188984c4197SStefano Zampini     nnsp_size = 0;
1189674ae819SStefano Zampini     nnsp_has_cnst = PETSC_TRUE;
1190674ae819SStefano Zampini   }
1191984c4197SStefano Zampini   /* get max number of constraints on a single cc */
1192984c4197SStefano Zampini   max_constraints = nnsp_size;
1193984c4197SStefano Zampini   if (nnsp_has_cnst) max_constraints++;
1194984c4197SStefano Zampini 
1195674ae819SStefano Zampini   /*
1196674ae819SStefano Zampini        Evaluate maximum storage size needed by the procedure
1197674ae819SStefano Zampini        - temp_indices will contain start index of each constraint stored as follows
1198674ae819SStefano 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
1199674ae819SStefano 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
1200674ae819SStefano Zampini        - temp_quadrature_constraint  [temp_indices[i],...,temp[indices[i+1]-1] will contain the scalars representing the constraint itself
1201674ae819SStefano Zampini                                                                                                                                                          */
1202674ae819SStefano Zampini   total_counts = n_ISForFaces+n_ISForEdges;
1203984c4197SStefano Zampini   total_counts *= max_constraints;
1204674ae819SStefano Zampini   n_vertices = 0;
1205674ae819SStefano Zampini   if (ISForVertices) {
1206674ae819SStefano Zampini     ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
1207674ae819SStefano Zampini   }
1208674ae819SStefano Zampini   total_counts += n_vertices;
1209674ae819SStefano Zampini   ierr = PetscMalloc((total_counts+1)*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
12104641a718SStefano Zampini   ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
1211674ae819SStefano Zampini   total_counts = 0;
1212674ae819SStefano Zampini   max_size_of_constraint = 0;
1213674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1214674ae819SStefano Zampini     if (i<n_ISForEdges) {
1215674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1216674ae819SStefano Zampini     } else {
1217674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1218674ae819SStefano Zampini     }
1219674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
1220674ae819SStefano Zampini     total_counts += j;
1221674ae819SStefano Zampini     max_size_of_constraint = PetscMax(j,max_size_of_constraint);
1222674ae819SStefano Zampini   }
1223984c4197SStefano Zampini   total_counts *= max_constraints;
1224674ae819SStefano Zampini   total_counts += n_vertices;
1225674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&temp_quadrature_constraint);CHKERRQ(ierr);
1226674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint);CHKERRQ(ierr);
1227674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint_B);CHKERRQ(ierr);
1228984c4197SStefano Zampini   /* local to boundary numbering */
1229674ae819SStefano Zampini   ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&local_to_B);CHKERRQ(ierr);
1230674ae819SStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1231984c4197SStefano Zampini   for (i=0;i<pcis->n;i++) local_to_B[i]=-1;
1232984c4197SStefano Zampini   for (i=0;i<pcis->n_B;i++) local_to_B[is_indices[i]]=i;
1233674ae819SStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1234984c4197SStefano Zampini   /* get local part of global near null space vectors */
1235984c4197SStefano Zampini   ierr = PetscMalloc(nnsp_size*sizeof(Vec),&localnearnullsp);CHKERRQ(ierr);
1236984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1237984c4197SStefano Zampini     ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
1238984c4197SStefano Zampini     ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1239984c4197SStefano Zampini     ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1240984c4197SStefano Zampini   }
1241674ae819SStefano Zampini 
1242242a89d7SStefano Zampini   /* whether or not to skip lapack calls */
1243242a89d7SStefano Zampini   skip_lapack = PETSC_TRUE;
1244242a89d7SStefano Zampini   if (n_ISForFaces+n_ISForEdges) skip_lapack = PETSC_FALSE;
1245242a89d7SStefano Zampini 
1246984c4197SStefano Zampini   /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
1247242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1248674ae819SStefano Zampini     PetscScalar temp_work;
1249674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1250984c4197SStefano Zampini     /* Proper Orthogonal Decomposition (POD) using the snapshot method */
1251984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*max_constraints*sizeof(PetscScalar),&correlation_mat);CHKERRQ(ierr);
1252984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1253984c4197SStefano Zampini     ierr = PetscMalloc(max_size_of_constraint*max_constraints*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr);
1254674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1255984c4197SStefano Zampini     ierr = PetscMalloc(3*max_constraints*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1256674ae819SStefano Zampini #endif
1257674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1258c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
1259c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
1260674ae819SStefano Zampini     lwork = -1;
1261674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1262674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1263c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
1264674ae819SStefano Zampini #else
1265c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
1266674ae819SStefano Zampini #endif
1267674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1268984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
1269674ae819SStefano Zampini #else /* on missing GESVD */
1270674ae819SStefano Zampini     /* SVD */
1271674ae819SStefano Zampini     PetscInt max_n,min_n;
1272674ae819SStefano Zampini     max_n = max_size_of_constraint;
1273984c4197SStefano Zampini     min_n = max_constraints;
1274984c4197SStefano Zampini     if (max_size_of_constraint < max_constraints) {
1275674ae819SStefano Zampini       min_n = max_size_of_constraint;
1276984c4197SStefano Zampini       max_n = max_constraints;
1277674ae819SStefano Zampini     }
1278674ae819SStefano Zampini     ierr = PetscMalloc(min_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1279674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1280674ae819SStefano Zampini     ierr = PetscMalloc(5*min_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1281674ae819SStefano Zampini #endif
1282674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1283674ae819SStefano Zampini     lwork = -1;
1284e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
1285e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
1286b7d8b9f8SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
1287674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1288674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1289e310c8b4SStefano 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));
1290674ae819SStefano Zampini #else
1291e310c8b4SStefano 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));
1292674ae819SStefano Zampini #endif
1293674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1294984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
1295984c4197SStefano Zampini #endif /* on missing GESVD */
1296674ae819SStefano Zampini     /* Allocate optimal workspace */
1297674ae819SStefano Zampini     ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
1298984c4197SStefano Zampini     ierr = PetscMalloc((PetscInt)lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
1299674ae819SStefano Zampini   }
1300674ae819SStefano Zampini   /* Now we can loop on constraining sets */
1301674ae819SStefano Zampini   total_counts = 0;
1302674ae819SStefano Zampini   temp_indices[0] = 0;
1303674ae819SStefano Zampini   /* vertices */
1304674ae819SStefano Zampini   if (ISForVertices) {
1305674ae819SStefano Zampini     ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1306674ae819SStefano Zampini     if (nnsp_has_cnst) { /* consider all vertices */
1307674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1308674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1309674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
1310674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1311674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1312674ae819SStefano Zampini         total_counts++;
1313674ae819SStefano Zampini       }
1314674ae819SStefano Zampini     } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
1315984c4197SStefano Zampini       PetscBool used_vertex;
1316674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1317674ae819SStefano Zampini         used_vertex = PETSC_FALSE;
1318674ae819SStefano Zampini         k = 0;
1319674ae819SStefano Zampini         while (!used_vertex && k<nnsp_size) {
1320984c4197SStefano Zampini           ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1321984c4197SStefano Zampini           if (PetscAbsScalar(array[is_indices[i]])>0.0) {
1322674ae819SStefano Zampini             temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1323674ae819SStefano Zampini             temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
1324674ae819SStefano Zampini             temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1325674ae819SStefano Zampini             temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1326674ae819SStefano Zampini             total_counts++;
1327674ae819SStefano Zampini             used_vertex = PETSC_TRUE;
1328674ae819SStefano Zampini           }
1329984c4197SStefano Zampini           ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1330674ae819SStefano Zampini           k++;
1331674ae819SStefano Zampini         }
1332674ae819SStefano Zampini       }
1333674ae819SStefano Zampini     }
1334674ae819SStefano Zampini     ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1335674ae819SStefano Zampini     n_vertices = total_counts;
1336674ae819SStefano Zampini   }
1337984c4197SStefano Zampini 
1338674ae819SStefano Zampini   /* edges and faces */
1339674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1340674ae819SStefano Zampini     if (i<n_ISForEdges) {
1341674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1342984c4197SStefano Zampini       boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
1343674ae819SStefano Zampini     } else {
1344674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1345984c4197SStefano Zampini       boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
1346674ae819SStefano Zampini     }
1347674ae819SStefano Zampini     temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
1348674ae819SStefano Zampini     temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
1349674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
1350674ae819SStefano Zampini     ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1351984c4197SStefano Zampini     /* change of basis should not be performed on local periodic nodes */
1352984c4197SStefano Zampini     if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
1353674ae819SStefano Zampini     if (nnsp_has_cnst) {
13545b08dc53SStefano Zampini       PetscScalar quad_value;
1355674ae819SStefano Zampini       temp_constraints++;
1356674ae819SStefano Zampini       quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
1357674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1358674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
1359674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
1360674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
1361674ae819SStefano Zampini       }
1362674ae819SStefano Zampini       temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
13634641a718SStefano Zampini       if (boolforchange) {
13644641a718SStefano Zampini         ierr = PetscBTSet(change_basis,total_counts);CHKERRQ(ierr);
13654641a718SStefano Zampini       }
1366674ae819SStefano Zampini       total_counts++;
1367674ae819SStefano Zampini     }
1368674ae819SStefano Zampini     for (k=0;k<nnsp_size;k++) {
1369984c4197SStefano Zampini       PetscReal real_value;
1370984c4197SStefano Zampini       ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1371674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1372674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
1373674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
1374984c4197SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=array[is_indices[j]];
1375674ae819SStefano Zampini       }
1376984c4197SStefano Zampini       ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1377984c4197SStefano Zampini       /* check if array is null on the connected component */
1378e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1379e310c8b4SStefano Zampini       PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_one));
13805b08dc53SStefano Zampini       if (real_value > 0.0) { /* keep indices and values */
1381674ae819SStefano Zampini         temp_constraints++;
1382674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
13834641a718SStefano Zampini         if (boolforchange) {
13844641a718SStefano Zampini           ierr = PetscBTSet(change_basis,total_counts);CHKERRQ(ierr);
13854641a718SStefano Zampini         }
1386674ae819SStefano Zampini         total_counts++;
1387674ae819SStefano Zampini       }
1388674ae819SStefano Zampini     }
1389674ae819SStefano Zampini     ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1390984c4197SStefano Zampini     /* perform SVD on the constraints if use_nnsp_true has not be requested by the user */
1391984c4197SStefano Zampini     if (!pcbddc->use_nnsp_true) {
1392984c4197SStefano Zampini       PetscReal tol = 1.0e-8; /* tolerance for retaining eigenmodes */
1393674ae819SStefano Zampini 
1394674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1395984c4197SStefano Zampini       /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
1396984c4197SStefano Zampini          POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
1397984c4197SStefano Zampini          -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
1398984c4197SStefano Zampini             the constraints basis will differ (by a complex factor with absolute value equal to 1)
1399984c4197SStefano Zampini             from that computed using LAPACKgesvd
1400984c4197SStefano Zampini          -> This is due to a different computation of eigenvectors in LAPACKheev
1401984c4197SStefano Zampini          -> The quality of the POD-computed basis will be the same */
1402984c4197SStefano Zampini       ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
1403674ae819SStefano Zampini       /* Store upper triangular part of correlation matrix */
1404e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1405984c4197SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1406674ae819SStefano Zampini       for (j=0;j<temp_constraints;j++) {
1407674ae819SStefano Zampini         for (k=0;k<j+1;k++) {
1408e310c8b4SStefano 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));
1409674ae819SStefano Zampini         }
1410674ae819SStefano Zampini       }
1411e310c8b4SStefano Zampini       /* compute eigenvalues and eigenvectors of correlation matrix */
1412e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1413e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
1414674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1415c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
1416674ae819SStefano Zampini #else
1417c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
1418674ae819SStefano Zampini #endif
1419674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1420984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
1421984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
1422674ae819SStefano Zampini       j=0;
1423984c4197SStefano Zampini       while (j < temp_constraints && singular_vals[j] < tol) j++;
1424674ae819SStefano Zampini       total_counts=total_counts-j;
1425e310c8b4SStefano Zampini       /* scale and copy POD basis into used quadrature memory */
1426c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1427c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1428c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
1429c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1430c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
1431c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1432674ae819SStefano Zampini       if (j<temp_constraints) {
1433984c4197SStefano Zampini         PetscInt ii;
1434984c4197SStefano Zampini         for (k=j;k<temp_constraints;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]);
1435674ae819SStefano Zampini         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1436c4303822SStefano 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));
1437674ae819SStefano Zampini         ierr = PetscFPTrapPop();CHKERRQ(ierr);
1438984c4197SStefano Zampini         for (k=0;k<temp_constraints-j;k++) {
1439674ae819SStefano Zampini           for (ii=0;ii<size_of_constraint;ii++) {
1440984c4197SStefano 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];
1441674ae819SStefano Zampini           }
1442674ae819SStefano Zampini         }
1443674ae819SStefano Zampini       }
1444674ae819SStefano Zampini #else  /* on missing GESVD */
1445e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1446e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1447b7d8b9f8SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1448674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1449674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1450e310c8b4SStefano 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));
1451674ae819SStefano Zampini #else
1452e310c8b4SStefano 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));
1453674ae819SStefano Zampini #endif
1454984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
1455674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1456984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
1457e310c8b4SStefano Zampini       k = temp_constraints;
1458e310c8b4SStefano Zampini       if (k > size_of_constraint) k = size_of_constraint;
1459674ae819SStefano Zampini       j = 0;
1460e310c8b4SStefano Zampini       while (j < k && singular_vals[k-j-1] < tol) j++;
1461e310c8b4SStefano Zampini       total_counts = total_counts-temp_constraints+k-j;
1462984c4197SStefano Zampini #endif /* on missing GESVD */
1463674ae819SStefano Zampini     }
1464674ae819SStefano Zampini   }
1465674ae819SStefano Zampini   /* free index sets of faces, edges and vertices */
1466674ae819SStefano Zampini   for (i=0;i<n_ISForFaces;i++) {
1467674ae819SStefano Zampini     ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
1468674ae819SStefano Zampini   }
1469674ae819SStefano Zampini   ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
1470674ae819SStefano Zampini   for (i=0;i<n_ISForEdges;i++) {
1471674ae819SStefano Zampini     ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
1472674ae819SStefano Zampini   }
1473674ae819SStefano Zampini   ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
1474674ae819SStefano Zampini   ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
1475674ae819SStefano Zampini 
1476984c4197SStefano Zampini   /* free workspace */
1477242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1478984c4197SStefano Zampini     ierr = PetscFree(work);CHKERRQ(ierr);
1479984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1480984c4197SStefano Zampini     ierr = PetscFree(rwork);CHKERRQ(ierr);
1481984c4197SStefano Zampini #endif
1482984c4197SStefano Zampini     ierr = PetscFree(singular_vals);CHKERRQ(ierr);
1483984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1484984c4197SStefano Zampini     ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
1485984c4197SStefano Zampini     ierr = PetscFree(temp_basis);CHKERRQ(ierr);
1486984c4197SStefano Zampini #endif
1487984c4197SStefano Zampini   }
1488984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1489984c4197SStefano Zampini     ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
1490984c4197SStefano Zampini   }
1491984c4197SStefano Zampini   ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
1492984c4197SStefano Zampini 
1493674ae819SStefano Zampini   /* set quantities in pcbddc data structure */
1494984c4197SStefano Zampini   /* n_vertices defines the number of subdomain corners in the primal space */
1495674ae819SStefano Zampini   /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */
1496984c4197SStefano Zampini   pcbddc->local_primal_size = total_counts;
1497674ae819SStefano Zampini   pcbddc->n_vertices = n_vertices;
1498984c4197SStefano Zampini   pcbddc->n_constraints = pcbddc->local_primal_size-pcbddc->n_vertices;
1499674ae819SStefano Zampini 
1500674ae819SStefano Zampini   /* Create constraint matrix */
1501674ae819SStefano Zampini   /* The constraint matrix is used to compute the l2g map of primal dofs */
1502674ae819SStefano Zampini   /* so we need to set it up properly either with or without change of basis */
1503674ae819SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1504674ae819SStefano Zampini   ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr);
1505984c4197SStefano Zampini   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
1506984c4197SStefano Zampini   /* array to compute a local numbering of constraints : vertices first then constraints */
1507984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_numbering);CHKERRQ(ierr);
1508984c4197SStefano Zampini   /* array to select the proper local node (of minimum index with respect to global ordering) when changing the basis */
1509984c4197SStefano 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 */
1510984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_minloc);CHKERRQ(ierr);
1511984c4197SStefano Zampini   /* auxiliary stuff for basis change */
1512984c4197SStefano Zampini   ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&global_indices);CHKERRQ(ierr);
15134641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n_B,&touched);CHKERRQ(ierr);
1514984c4197SStefano Zampini 
1515984c4197SStefano Zampini   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
1516984c4197SStefano Zampini   total_primal_vertices=0;
1517984c4197SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
1518674ae819SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
1519984c4197SStefano Zampini     if (size_of_constraint == 1) {
15204641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]]);CHKERRQ(ierr);
1521984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]];
1522984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=0;
1523984c4197SStefano Zampini       total_primal_vertices++;
15244641a718SStefano Zampini     } else if (PetscBTLookup(change_basis,i)) { /* Same procedure used in PCBDDCGetPrimalConstraintsLocalIdx */
1525984c4197SStefano Zampini       PetscInt min_loc,min_index;
1526984c4197SStefano Zampini       ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],global_indices);CHKERRQ(ierr);
1527984c4197SStefano Zampini       /* find first untouched local node */
1528674ae819SStefano Zampini       k = 0;
15294641a718SStefano Zampini       while (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) k++;
1530984c4197SStefano Zampini       min_index = global_indices[k];
1531984c4197SStefano Zampini       min_loc = k;
1532984c4197SStefano Zampini       /* search the minimum among global nodes already untouched on the cc */
1533984c4197SStefano Zampini       for (k=1;k<size_of_constraint;k++) {
1534984c4197SStefano Zampini         /* there can be more than one constraint on a single connected component */
15354641a718SStefano Zampini         if (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k]) && min_index > global_indices[k]) {
1536984c4197SStefano Zampini           min_index = global_indices[k];
1537984c4197SStefano Zampini           min_loc = k;
1538674ae819SStefano Zampini         }
1539674ae819SStefano Zampini       }
15404641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]+min_loc]);CHKERRQ(ierr);
1541984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]+min_loc];
1542984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=min_loc;
1543984c4197SStefano Zampini       total_primal_vertices++;
1544984c4197SStefano Zampini     }
1545984c4197SStefano Zampini   }
1546984c4197SStefano Zampini   /* free workspace */
1547984c4197SStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
15484641a718SStefano Zampini   ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
1549674ae819SStefano Zampini   /* permute indices in order to have a sorted set of vertices */
1550984c4197SStefano Zampini   ierr = PetscSortInt(total_primal_vertices,aux_primal_numbering);
1551984c4197SStefano Zampini 
1552984c4197SStefano Zampini   /* nonzero structure of constraint matrix */
1553984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1554984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) nnz[i]=1;
1555984c4197SStefano Zampini   j=total_primal_vertices;
1556984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
15574641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1558674ae819SStefano Zampini       nnz[j]=temp_indices[i+1]-temp_indices[i];
1559674ae819SStefano Zampini       j++;
1560674ae819SStefano Zampini     }
1561674ae819SStefano Zampini   }
1562674ae819SStefano Zampini   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
1563674ae819SStefano Zampini   ierr = PetscFree(nnz);CHKERRQ(ierr);
1564674ae819SStefano Zampini   /* set values in constraint matrix */
1565984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) {
1566984c4197SStefano Zampini     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,aux_primal_numbering[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
1567674ae819SStefano Zampini   }
1568984c4197SStefano Zampini   total_counts = total_primal_vertices;
1569984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
15704641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1571674ae819SStefano Zampini       size_of_constraint=temp_indices[i+1]-temp_indices[i];
1572674ae819SStefano 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);
1573674ae819SStefano Zampini       total_counts++;
1574674ae819SStefano Zampini     }
1575674ae819SStefano Zampini   }
1576674ae819SStefano Zampini   /* assembling */
1577674ae819SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1578674ae819SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1579984c4197SStefano Zampini   /*
1580984c4197SStefano Zampini   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
1581984c4197SStefano Zampini   */
1582674ae819SStefano Zampini   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
1583674ae819SStefano Zampini   if (pcbddc->use_change_of_basis) {
1584984c4197SStefano Zampini     PetscBool qr_needed = PETSC_FALSE;
1585984c4197SStefano Zampini     /* change of basis acts on local interfaces -> dimension is n_B x n_B */
1586674ae819SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
1587674ae819SStefano Zampini     ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr);
1588674ae819SStefano Zampini     ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr);
1589674ae819SStefano Zampini     /* work arrays */
1590674ae819SStefano Zampini     ierr = PetscMalloc(pcis->n_B*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1591984c4197SStefano Zampini     for (i=0;i<pcis->n_B;i++) nnz[i]=1;
1592984c4197SStefano Zampini     /* nonzeros per row */
1593984c4197SStefano Zampini     for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
15944641a718SStefano Zampini       if (PetscBTLookup(change_basis,i)) {
1595984c4197SStefano Zampini         qr_needed = PETSC_TRUE;
1596674ae819SStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
1597984c4197SStefano Zampini         for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1598674ae819SStefano Zampini       }
1599674ae819SStefano Zampini     }
1600674ae819SStefano Zampini     ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
1601674ae819SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
1602674ae819SStefano Zampini     /* Set initial identity in the matrix */
1603674ae819SStefano Zampini     for (i=0;i<pcis->n_B;i++) {
1604674ae819SStefano Zampini       ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
1605674ae819SStefano Zampini     }
1606984c4197SStefano Zampini 
1607674ae819SStefano Zampini     /* Now we loop on the constraints which need a change of basis */
1608674ae819SStefano Zampini     /* Change of basis matrix is evaluated as the FIRST APPROACH in */
1609984c4197SStefano Zampini     /* Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1) */
1610984c4197SStefano Zampini     /* Change of basis matrix T computed via QR decomposition of constraints */
1611984c4197SStefano Zampini     if (qr_needed) {
1612026de310SStefano Zampini       /* dual and primal dofs on a single cc */
1613984c4197SStefano Zampini       PetscInt     dual_dofs,primal_dofs;
1614026de310SStefano Zampini       /* iterator on aux_primal_minloc (ordered as read from nearnullspace: vertices, edges and then constraints) */
1615026de310SStefano Zampini       PetscInt     primal_counter;
1616984c4197SStefano Zampini       /* working stuff for GEQRF */
1617984c4197SStefano Zampini       PetscScalar  *qr_basis,*qr_tau,*qr_work,lqr_work_t;
1618984c4197SStefano Zampini       PetscBLASInt lqr_work;
1619984c4197SStefano Zampini       /* working stuff for UNGQR */
1620984c4197SStefano Zampini       PetscScalar  *gqr_work,lgqr_work_t;
1621984c4197SStefano Zampini       PetscBLASInt lgqr_work;
1622984c4197SStefano Zampini       /* working stuff for TRTRS */
1623984c4197SStefano Zampini       PetscScalar  *trs_rhs;
16243f08241aSStefano Zampini       PetscBLASInt Blas_NRHS;
1625984c4197SStefano Zampini       /* pointers for values insertion into change of basis matrix */
1626984c4197SStefano Zampini       PetscInt     *start_rows,*start_cols;
1627984c4197SStefano Zampini       PetscScalar  *start_vals;
1628984c4197SStefano Zampini       /* working stuff for values insertion */
16294641a718SStefano Zampini       PetscBT      is_primal;
1630984c4197SStefano Zampini 
1631984c4197SStefano Zampini       /* space to store Q */
1632984c4197SStefano Zampini       ierr = PetscMalloc((max_size_of_constraint)*(max_size_of_constraint)*sizeof(PetscScalar),&qr_basis);CHKERRQ(ierr);
1633984c4197SStefano Zampini       /* first we issue queries for optimal work */
16343f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
16353f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
16363f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1637984c4197SStefano Zampini       lqr_work = -1;
16383f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
1639984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
1640984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
1641984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lqr_work_t)*sizeof(*qr_work),&qr_work);CHKERRQ(ierr);
1642984c4197SStefano Zampini       lgqr_work = -1;
16433f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
16443f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
16453f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
16463f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
16473f08241aSStefano Zampini       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
16483f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
1649984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
1650984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
1651984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lgqr_work_t)*sizeof(*gqr_work),&gqr_work);CHKERRQ(ierr);
1652984c4197SStefano Zampini       /* array to store scaling factors for reflectors */
1653984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*sizeof(*qr_tau),&qr_tau);CHKERRQ(ierr);
1654984c4197SStefano Zampini       /* array to store rhs and solution of triangular solver */
1655984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*max_constraints*sizeof(*trs_rhs),&trs_rhs);CHKERRQ(ierr);
1656984c4197SStefano Zampini       /* array to store whether a node is primal or not */
16574641a718SStefano Zampini       ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
16584641a718SStefano Zampini       for (i=0;i<total_primal_vertices;i++) {
16594641a718SStefano Zampini         ierr = PetscBTSet(is_primal,local_to_B[aux_primal_numbering[i]]);CHKERRQ(ierr);
16604641a718SStefano Zampini       }
1661984c4197SStefano Zampini 
1662984c4197SStefano Zampini       /* allocating workspace for check */
1663984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
1664984c4197SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1665984c4197SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
1666984c4197SStefano Zampini         ierr = PetscMalloc(max_size_of_constraint*(max_constraints+max_size_of_constraint)*sizeof(*work),&work);CHKERRQ(ierr);
1667674ae819SStefano Zampini       }
1668984c4197SStefano Zampini 
1669026de310SStefano Zampini       /* loop on constraints and see whether or not they need a change of basis */
1670026de310SStefano Zampini       /* -> using implicit ordering contained in temp_indices data */
1671026de310SStefano Zampini       total_counts = pcbddc->n_vertices;
1672026de310SStefano Zampini       primal_counter = total_counts;
1673026de310SStefano Zampini       while (total_counts<pcbddc->local_primal_size) {
1674026de310SStefano Zampini         primal_dofs = 1;
16754641a718SStefano Zampini         if (PetscBTLookup(change_basis,total_counts)) {
1676026de310SStefano Zampini           /* get all constraints with same support: if more then one constraint is present on the cc then surely indices are stored contiguosly */
1677026de310SStefano 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]]) {
1678026de310SStefano Zampini             primal_dofs++;
1679674ae819SStefano Zampini           }
1680984c4197SStefano Zampini           /* get constraint info */
1681026de310SStefano Zampini           size_of_constraint = temp_indices[total_counts+1]-temp_indices[total_counts];
1682984c4197SStefano Zampini           dual_dofs = size_of_constraint-primal_dofs;
1683984c4197SStefano Zampini 
1684984c4197SStefano Zampini           /* copy quadrature constraints for change of basis check */
1685984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
1686026de310SStefano Zampini             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d to %d need a change of basis (size %d)\n",total_counts,total_counts+primal_dofs,size_of_constraint);CHKERRQ(ierr);
1687026de310SStefano Zampini             ierr = PetscMemcpy(work,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1688674ae819SStefano Zampini           }
1689984c4197SStefano Zampini 
1690984c4197SStefano Zampini           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
1691026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1692984c4197SStefano Zampini 
1693984c4197SStefano Zampini           /* compute QR decomposition of constraints */
16943f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
16953f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
16963f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1697674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
16983f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
1699984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
1700674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1701984c4197SStefano Zampini 
1702984c4197SStefano Zampini           /* explictly compute R^-T */
1703984c4197SStefano Zampini           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
1704984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
17053f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
17063f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
17073f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
17083f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
1709984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
17103f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
1711984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
1712984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1713984c4197SStefano Zampini 
1714984c4197SStefano Zampini           /* explcitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
17153f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
17163f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
17173f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
17183f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1719984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
17203f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
1721984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
1722984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1723984c4197SStefano Zampini 
1724984c4197SStefano Zampini           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
1725984c4197SStefano Zampini              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
1726984c4197SStefano Zampini              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
17273f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
17283f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
17293f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
17303f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
17313f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
17323f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1733984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1734c4303822SStefano 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));
1735984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1736026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1737984c4197SStefano Zampini 
1738984c4197SStefano Zampini           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
1739026de310SStefano Zampini           start_rows = &temp_indices_to_constraint_B[temp_indices[total_counts]];
1740984c4197SStefano Zampini           /* insert cols for primal dofs */
1741984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) {
1742984c4197SStefano Zampini             start_vals = &qr_basis[j*size_of_constraint];
1743026de310SStefano Zampini             start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter+j]];
1744984c4197SStefano Zampini             ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1745984c4197SStefano Zampini           }
1746984c4197SStefano Zampini           /* insert cols for dual dofs */
1747984c4197SStefano Zampini           for (j=0,k=0;j<dual_dofs;k++) {
17484641a718SStefano Zampini             if (!PetscBTLookup(is_primal,temp_indices_to_constraint_B[temp_indices[total_counts]+k])) {
1749984c4197SStefano Zampini               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
1750026de310SStefano Zampini               start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+k];
1751984c4197SStefano Zampini               ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1752984c4197SStefano Zampini               j++;
1753674ae819SStefano Zampini             }
1754674ae819SStefano Zampini           }
1755984c4197SStefano Zampini 
1756984c4197SStefano Zampini           /* check change of basis */
1757984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
1758984c4197SStefano Zampini             PetscInt   ii,jj;
1759984c4197SStefano Zampini             PetscBool valid_qr=PETSC_TRUE;
1760c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
1761c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1762c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
1763c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1764c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
1765c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
1766984c4197SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1767c4303822SStefano 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));
1768984c4197SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
1769984c4197SStefano Zampini             for (jj=0;jj<size_of_constraint;jj++) {
1770984c4197SStefano Zampini               for (ii=0;ii<primal_dofs;ii++) {
1771984c4197SStefano Zampini                 if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
1772984c4197SStefano Zampini                 if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
1773674ae819SStefano Zampini               }
1774674ae819SStefano Zampini             }
1775984c4197SStefano Zampini             if (!valid_qr) {
1776984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
1777984c4197SStefano Zampini               for (jj=0;jj<size_of_constraint;jj++) {
1778984c4197SStefano Zampini                 for (ii=0;ii<primal_dofs;ii++) {
1779984c4197SStefano Zampini                   if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
1780984c4197SStefano 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]));
1781674ae819SStefano Zampini                   }
1782984c4197SStefano Zampini                   if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
1783984c4197SStefano 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]));
1784984c4197SStefano Zampini                   }
1785984c4197SStefano Zampini                 }
1786984c4197SStefano Zampini               }
1787674ae819SStefano Zampini             } else {
1788984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
1789674ae819SStefano Zampini             }
1790674ae819SStefano Zampini           }
1791026de310SStefano Zampini           /* increment primal counter */
1792026de310SStefano Zampini           primal_counter += primal_dofs;
1793984c4197SStefano Zampini         } else {
1794984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
1795026de310SStefano 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);
1796674ae819SStefano Zampini           }
1797674ae819SStefano Zampini         }
1798026de310SStefano Zampini         /* increment constraint counter total_counts */
1799026de310SStefano Zampini         total_counts += primal_dofs;
1800674ae819SStefano Zampini       }
1801984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
1802984c4197SStefano Zampini         ierr = PetscFree(work);CHKERRQ(ierr);
1803984c4197SStefano Zampini       }
1804984c4197SStefano Zampini       /* free workspace */
1805984c4197SStefano Zampini       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
1806984c4197SStefano Zampini       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
1807984c4197SStefano Zampini       ierr = PetscFree(qr_work);CHKERRQ(ierr);
1808984c4197SStefano Zampini       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
18094641a718SStefano Zampini       ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
1810984c4197SStefano Zampini       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
1811674ae819SStefano Zampini     }
1812674ae819SStefano Zampini     /* assembling */
1813674ae819SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1814674ae819SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1815984c4197SStefano Zampini     /*
1816984c4197SStefano Zampini     ierr = MatView(pcbddc->ChangeOfBasisMatrix,(PetscViewer)0);CHKERRQ(ierr);
1817984c4197SStefano Zampini     */
1818674ae819SStefano Zampini   }
1819b8ffe317SStefano Zampini   if (pcbddc->dbg_flag) {
1820b8ffe317SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1821b8ffe317SStefano Zampini   }
1822e310c8b4SStefano Zampini   /* free workspace */
1823984c4197SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
1824984c4197SStefano Zampini   ierr = PetscFree(aux_primal_minloc);CHKERRQ(ierr);
1825674ae819SStefano Zampini   ierr = PetscFree(temp_indices);CHKERRQ(ierr);
18264641a718SStefano Zampini   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
1827674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr);
1828674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
1829674ae819SStefano Zampini   ierr = PetscFree(local_to_B);CHKERRQ(ierr);
1830674ae819SStefano Zampini   ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr);
1831674ae819SStefano Zampini   PetscFunctionReturn(0);
1832674ae819SStefano Zampini }
1833674ae819SStefano Zampini 
1834674ae819SStefano Zampini #undef __FUNCT__
1835674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
1836674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
1837674ae819SStefano Zampini {
1838674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
1839674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
1840674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
1841674ae819SStefano Zampini   PetscInt    bs,ierr,i,vertex_size;
1842674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
1843674ae819SStefano Zampini 
1844674ae819SStefano Zampini   PetscFunctionBegin;
1845674ae819SStefano Zampini   /* Init local Graph struct */
1846674ae819SStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr);
1847674ae819SStefano Zampini 
1848575ad6abSStefano Zampini   /* Check validity of the csr graph passed in by the user */
1849575ad6abSStefano Zampini   if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) {
1850575ad6abSStefano Zampini     ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1851575ad6abSStefano Zampini   }
1852674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
1853674ae819SStefano Zampini   if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) {
1854674ae819SStefano Zampini     Mat mat_adj;
1855674ae819SStefano Zampini     const PetscInt *xadj,*adjncy;
1856674ae819SStefano Zampini     PetscBool flg_row=PETSC_TRUE;
1857674ae819SStefano Zampini 
1858674ae819SStefano Zampini     ierr = MatConvert(matis->A,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr);
1859674ae819SStefano Zampini     ierr = MatGetRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
1860674ae819SStefano Zampini     if (!flg_row) {
1861674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ called in %s\n",__FUNCT__);
1862674ae819SStefano Zampini     }
1863674ae819SStefano Zampini     ierr = PCBDDCSetLocalAdjacencyGraph(pc,i,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
1864674ae819SStefano Zampini     ierr = MatRestoreRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
1865674ae819SStefano Zampini     if (!flg_row) {
1866674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__);
1867674ae819SStefano Zampini     }
1868674ae819SStefano Zampini     ierr = MatDestroy(&mat_adj);CHKERRQ(ierr);
1869674ae819SStefano Zampini   }
1870674ae819SStefano Zampini 
1871674ae819SStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting */
1872674ae819SStefano Zampini   vertex_size = 1;
1873674ae819SStefano Zampini   if (!pcbddc->n_ISForDofs) {
1874674ae819SStefano Zampini     IS *custom_ISForDofs;
1875674ae819SStefano Zampini 
1876674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&bs);CHKERRQ(ierr);
1877674ae819SStefano Zampini     ierr = PetscMalloc(bs*sizeof(IS),&custom_ISForDofs);CHKERRQ(ierr);
1878674ae819SStefano Zampini     for (i=0;i<bs;i++) {
1879674ae819SStefano Zampini       ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n/bs,i,bs,&custom_ISForDofs[i]);CHKERRQ(ierr);
1880674ae819SStefano Zampini     }
1881674ae819SStefano Zampini     ierr = PCBDDCSetDofsSplitting(pc,bs,custom_ISForDofs);CHKERRQ(ierr);
1882674ae819SStefano Zampini     /* remove my references to IS objects */
1883674ae819SStefano Zampini     for (i=0;i<bs;i++) {
1884674ae819SStefano Zampini       ierr = ISDestroy(&custom_ISForDofs[i]);CHKERRQ(ierr);
1885674ae819SStefano Zampini     }
1886674ae819SStefano Zampini     ierr = PetscFree(custom_ISForDofs);CHKERRQ(ierr);
1887674ae819SStefano Zampini   } else { /* mat block size as vertex size (used for elasticity) */
1888674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
1889674ae819SStefano Zampini   }
1890674ae819SStefano Zampini 
1891674ae819SStefano Zampini   /* Setup of Graph */
1892674ae819SStefano Zampini   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundaries,pcbddc->DirichletBoundaries,pcbddc->n_ISForDofs,pcbddc->ISForDofs,pcbddc->user_primal_vertices);
1893674ae819SStefano Zampini 
1894674ae819SStefano Zampini   /* Graph's connected components analysis */
1895674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
1896674ae819SStefano Zampini 
1897674ae819SStefano Zampini   /* print some info to stdout */
1898674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
1899e49050b4SStefano Zampini     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer);
1900674ae819SStefano Zampini   }
1901674ae819SStefano Zampini   PetscFunctionReturn(0);
1902674ae819SStefano Zampini }
1903674ae819SStefano Zampini 
1904674ae819SStefano Zampini #undef __FUNCT__
1905674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx"
1906f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt **vertices_idx)
1907674ae819SStefano Zampini {
1908674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
1909674ae819SStefano Zampini   PetscInt       *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size;
1910674ae819SStefano Zampini   PetscErrorCode ierr;
1911674ae819SStefano Zampini 
1912674ae819SStefano Zampini   PetscFunctionBegin;
1913674ae819SStefano Zampini   n = 0;
1914674ae819SStefano Zampini   vertices = 0;
1915674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
1916674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr);
1917b120a5c6SStefano Zampini     for (i=0;i<local_primal_size;i++) {
1918b120a5c6SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
1919b120a5c6SStefano Zampini       if (size_of_constraint == 1) n++;
1920b120a5c6SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
1921b120a5c6SStefano Zampini     }
1922811e8ca2SStefano Zampini     if (vertices_idx) {
1923b120a5c6SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&vertices);CHKERRQ(ierr);
1924b120a5c6SStefano Zampini       n = 0;
1925674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
1926674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
1927674ae819SStefano Zampini         if (size_of_constraint == 1) {
1928674ae819SStefano Zampini           vertices[n++]=row_cmat_indices[0];
1929674ae819SStefano Zampini         }
1930674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
1931674ae819SStefano Zampini       }
1932674ae819SStefano Zampini     }
1933811e8ca2SStefano Zampini   }
1934674ae819SStefano Zampini   *n_vertices = n;
1935811e8ca2SStefano Zampini   if (vertices_idx) *vertices_idx = vertices;
1936674ae819SStefano Zampini   PetscFunctionReturn(0);
1937674ae819SStefano Zampini }
1938674ae819SStefano Zampini 
1939674ae819SStefano Zampini #undef __FUNCT__
1940674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx"
1941f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt **constraints_idx)
1942674ae819SStefano Zampini {
1943674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
1944674ae819SStefano Zampini   PetscInt       *constraints_index,*row_cmat_indices,*row_cmat_global_indices;
1945674ae819SStefano Zampini   PetscInt       n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc;
19464641a718SStefano Zampini   PetscBT        touched;
1947674ae819SStefano Zampini   PetscErrorCode ierr;
1948674ae819SStefano Zampini 
1949f34684f1SStefano Zampini     /* This function assumes that the number of local constraints per connected component
1950f34684f1SStefano Zampini        is not greater than the number of nodes defined for the connected component
1951f34684f1SStefano Zampini        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
1952674ae819SStefano Zampini   PetscFunctionBegin;
1953674ae819SStefano Zampini   n = 0;
1954674ae819SStefano Zampini   constraints_index = 0;
1955674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
1956674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr);
1957674ae819SStefano Zampini     max_size_of_constraint = 0;
1958674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
1959674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
1960674ae819SStefano Zampini       if (size_of_constraint > 1) {
1961674ae819SStefano Zampini         n++;
1962674ae819SStefano Zampini       }
1963674ae819SStefano Zampini       max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint);
1964674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
1965674ae819SStefano Zampini     }
1966811e8ca2SStefano Zampini     if (constraints_idx) {
1967674ae819SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&constraints_index);CHKERRQ(ierr);
1968674ae819SStefano Zampini       ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&row_cmat_global_indices);CHKERRQ(ierr);
19694641a718SStefano Zampini       ierr = PetscBTCreate(local_size,&touched);CHKERRQ(ierr);
1970674ae819SStefano Zampini       n = 0;
1971674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
1972674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
1973674ae819SStefano Zampini         if (size_of_constraint > 1) {
1974674ae819SStefano Zampini           ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr);
197582d3d8afSStefano Zampini           /* find first untouched local node */
197682d3d8afSStefano Zampini           j = 0;
19774641a718SStefano Zampini           while (PetscBTLookup(touched,row_cmat_indices[j])) j++;
197882d3d8afSStefano Zampini           min_index = row_cmat_global_indices[j];
197982d3d8afSStefano Zampini           min_loc = j;
198082d3d8afSStefano Zampini           /* search the minimum among nodes not yet touched on the connected component
198182d3d8afSStefano Zampini              since there can be more than one constraint on a single cc */
1982674ae819SStefano Zampini           for (j=1;j<size_of_constraint;j++) {
19834641a718SStefano Zampini             if (!PetscBTLookup(touched,row_cmat_indices[j]) && min_index > row_cmat_global_indices[j]) {
1984674ae819SStefano Zampini               min_index = row_cmat_global_indices[j];
1985674ae819SStefano Zampini               min_loc = j;
1986674ae819SStefano Zampini             }
1987674ae819SStefano Zampini           }
19884641a718SStefano Zampini           ierr = PetscBTSet(touched,row_cmat_indices[min_loc]);CHKERRQ(ierr);
1989674ae819SStefano Zampini           constraints_index[n++] = row_cmat_indices[min_loc];
1990674ae819SStefano Zampini         }
1991674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
1992674ae819SStefano Zampini       }
19934641a718SStefano Zampini       ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
1994674ae819SStefano Zampini       ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr);
1995811e8ca2SStefano Zampini     }
1996811e8ca2SStefano Zampini   }
1997674ae819SStefano Zampini   *n_constraints = n;
1998811e8ca2SStefano Zampini   if (constraints_idx) *constraints_idx = constraints_index;
1999674ae819SStefano Zampini   PetscFunctionReturn(0);
2000674ae819SStefano Zampini }
2001674ae819SStefano Zampini 
2002674ae819SStefano Zampini /* the next two functions has been adapted from pcis.c */
2003674ae819SStefano Zampini #undef __FUNCT__
2004674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchur"
2005674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchur(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2006674ae819SStefano Zampini {
2007674ae819SStefano Zampini   PetscErrorCode ierr;
2008674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2009674ae819SStefano Zampini 
2010674ae819SStefano Zampini   PetscFunctionBegin;
2011674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2012674ae819SStefano Zampini   ierr = MatMult(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2013674ae819SStefano Zampini   ierr = MatMult(pcis->A_IB,v,vec1_D);CHKERRQ(ierr);
2014674ae819SStefano Zampini   ierr = KSPSolve(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2015674ae819SStefano Zampini   ierr = MatMult(pcis->A_BI,vec2_D,vec2_B);CHKERRQ(ierr);
2016674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2017674ae819SStefano Zampini   PetscFunctionReturn(0);
2018674ae819SStefano Zampini }
2019674ae819SStefano Zampini 
2020674ae819SStefano Zampini #undef __FUNCT__
2021674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchurTranspose"
2022674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchurTranspose(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2023674ae819SStefano Zampini {
2024674ae819SStefano Zampini   PetscErrorCode ierr;
2025674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2026674ae819SStefano Zampini 
2027674ae819SStefano Zampini   PetscFunctionBegin;
2028674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2029674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2030674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BI,v,vec1_D);CHKERRQ(ierr);
2031674ae819SStefano Zampini   ierr = KSPSolveTranspose(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2032674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_IB,vec2_D,vec2_B);CHKERRQ(ierr);
2033674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2034674ae819SStefano Zampini   PetscFunctionReturn(0);
2035674ae819SStefano Zampini }
2036674ae819SStefano Zampini 
2037674ae819SStefano Zampini #undef __FUNCT__
2038674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
2039674ae819SStefano 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[])
2040674ae819SStefano Zampini {
2041674ae819SStefano Zampini   Vec            local_vec,global_vec;
2042674ae819SStefano Zampini   IS             seqis,paris;
2043674ae819SStefano Zampini   VecScatter     scatter_ctx;
2044674ae819SStefano Zampini   PetscScalar    *array;
2045674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
2046674ae819SStefano Zampini   PetscScalar    globalsum;
2047674ae819SStefano Zampini   PetscInt       i,j,s;
2048674ae819SStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local;
2049674ae819SStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm,max_global;
2050674ae819SStefano Zampini   PetscMPIInt    *dof_sizes,*dof_displs;
2051674ae819SStefano Zampini   PetscBool      first_found;
2052674ae819SStefano Zampini   PetscErrorCode ierr;
2053674ae819SStefano Zampini 
2054674ae819SStefano Zampini   PetscFunctionBegin;
2055674ae819SStefano Zampini   /* mpi buffers */
2056674ae819SStefano Zampini   MPI_Comm_size(comm,&size_prec_comm);
2057674ae819SStefano Zampini   MPI_Comm_rank(comm,&rank_prec_comm);
2058674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
2059674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_sizes),&dof_sizes);CHKERRQ(ierr);
2060674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_displs),&dof_displs);CHKERRQ(ierr);
2061674ae819SStefano Zampini   /* get maximum size of subset */
2062674ae819SStefano Zampini   ierr = PetscMalloc(n_local_dofs*sizeof(PetscInt),&temp_global_dofs);CHKERRQ(ierr);
2063674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
2064674ae819SStefano Zampini   max_local = 0;
2065674ae819SStefano Zampini   if (n_local_dofs) {
2066674ae819SStefano Zampini     max_local = temp_global_dofs[0];
2067674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2068674ae819SStefano Zampini       if (max_local < temp_global_dofs[i] ) {
2069674ae819SStefano Zampini         max_local = temp_global_dofs[i];
2070674ae819SStefano Zampini       }
2071674ae819SStefano Zampini     }
2072674ae819SStefano Zampini   }
2073674ae819SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);
2074674ae819SStefano Zampini   max_global++;
2075674ae819SStefano Zampini   max_local = 0;
2076674ae819SStefano Zampini   if (n_local_dofs) {
2077674ae819SStefano Zampini     max_local = local_dofs[0];
2078674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2079674ae819SStefano Zampini       if (max_local < local_dofs[i] ) {
2080674ae819SStefano Zampini         max_local = local_dofs[i];
2081674ae819SStefano Zampini       }
2082674ae819SStefano Zampini     }
2083674ae819SStefano Zampini   }
2084674ae819SStefano Zampini   max_local++;
2085674ae819SStefano Zampini   /* allocate workspace */
2086674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
2087674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
2088674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
2089674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
2090674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
2091674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
2092674ae819SStefano Zampini   /* create scatter */
2093674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
2094674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
2095674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
2096674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
2097674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
2098674ae819SStefano Zampini   /* init array */
2099674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
2100674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2101674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2102674ae819SStefano Zampini   if (local_dofs_mult) {
2103674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2104674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
2105674ae819SStefano Zampini     }
2106674ae819SStefano Zampini   } else {
2107674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2108674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
2109674ae819SStefano Zampini     }
2110674ae819SStefano Zampini   }
2111674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2112674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
2113674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2114674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2115674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
21165b08dc53SStefano Zampini   *n_global_subset = (PetscInt)PetscRealPart(globalsum);
2117674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
2118674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
2119674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
2120674ae819SStefano Zampini   nlocals = 0;
2121674ae819SStefano Zampini   first_index = -1;
2122674ae819SStefano Zampini   first_found = PETSC_FALSE;
2123674ae819SStefano Zampini   for (i=0;i<s;i++) {
21245b08dc53SStefano Zampini     if (!first_found && PetscRealPart(array[i]) > 0.0) {
2125674ae819SStefano Zampini       first_found = PETSC_TRUE;
2126674ae819SStefano Zampini       first_index = i;
2127674ae819SStefano Zampini     }
21285b08dc53SStefano Zampini     nlocals += (PetscInt)PetscRealPart(array[i]);
2129674ae819SStefano Zampini   }
2130674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2131674ae819SStefano Zampini   if (!rank_prec_comm) {
2132674ae819SStefano Zampini     dof_displs[0]=0;
2133674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
2134674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
2135674ae819SStefano Zampini     }
2136674ae819SStefano Zampini   }
2137674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2138674ae819SStefano Zampini   if (first_found) {
2139674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
2140674ae819SStefano Zampini     old_index = first_index;
2141674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
21425b08dc53SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) {
2143674ae819SStefano Zampini         array[i] += array[old_index];
2144674ae819SStefano Zampini         old_index = i;
2145674ae819SStefano Zampini       }
2146674ae819SStefano Zampini     }
2147674ae819SStefano Zampini   }
2148674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
2149674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2150674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2151674ae819SStefano Zampini   ierr = VecScatterEnd  (scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2152674ae819SStefano Zampini   /* get global ordering of local dofs */
2153674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2154674ae819SStefano Zampini   if (local_dofs_mult) {
2155674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
21565b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i];
2157674ae819SStefano Zampini     }
2158674ae819SStefano Zampini   } else {
2159674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
21605b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1;
2161674ae819SStefano Zampini     }
2162674ae819SStefano Zampini   }
2163674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2164674ae819SStefano Zampini   /* free workspace */
2165674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
2166674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
2167674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
2168674ae819SStefano Zampini   ierr = PetscFree(dof_sizes);CHKERRQ(ierr);
2169674ae819SStefano Zampini   ierr = PetscFree(dof_displs);CHKERRQ(ierr);
2170674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
2171674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
2172674ae819SStefano Zampini   PetscFunctionReturn(0);
2173674ae819SStefano Zampini }
21749a7d3425SStefano Zampini 
21759a7d3425SStefano Zampini #undef __FUNCT__
21769a7d3425SStefano Zampini #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
21779a7d3425SStefano Zampini PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
21789a7d3425SStefano Zampini {
21799a7d3425SStefano Zampini   PetscInt       i,j;
21809a7d3425SStefano Zampini   PetscScalar    *alphas;
21819a7d3425SStefano Zampini   PetscErrorCode ierr;
21829a7d3425SStefano Zampini 
21839a7d3425SStefano Zampini   PetscFunctionBegin;
21849a7d3425SStefano Zampini   /* this implements stabilized Gram-Schmidt */
21859a7d3425SStefano Zampini   ierr = PetscMalloc(n*sizeof(PetscScalar),&alphas);CHKERRQ(ierr);
21869a7d3425SStefano Zampini   for (i=0;i<n;i++) {
21879a7d3425SStefano Zampini     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
21889a7d3425SStefano Zampini     if (i<n) { ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],&alphas[i+1]);CHKERRQ(ierr); }
21899a7d3425SStefano Zampini     for (j=i+1;j<n;j++) { ierr = VecAXPY(vecs[j],PetscConj(-alphas[j]),vecs[i]);CHKERRQ(ierr); }
21909a7d3425SStefano Zampini   }
21919a7d3425SStefano Zampini   ierr = PetscFree(alphas);CHKERRQ(ierr);
21929a7d3425SStefano Zampini   PetscFunctionReturn(0);
21939a7d3425SStefano Zampini }
21949a7d3425SStefano Zampini 
2195a57a6d2fSStefano Zampini /* Currently support MAT_INITIAL_MATRIX only, with partial support to block matrices */
2196a57a6d2fSStefano Zampini #undef __FUNCT__
2197a57a6d2fSStefano Zampini #define __FUNCT__ "MatConvert_IS_AIJ"
2198a57a6d2fSStefano Zampini static PetscErrorCode MatConvert_IS_AIJ(Mat mat, MatType newtype,MatReuse reuse,Mat *M)
2199a57a6d2fSStefano Zampini {
2200a57a6d2fSStefano Zampini   Mat new_mat;
2201a57a6d2fSStefano Zampini   Mat_IS *matis = (Mat_IS*)(mat->data);
2202a57a6d2fSStefano Zampini   /* info on mat */
2203a57a6d2fSStefano Zampini   PetscInt bs,rows,cols;
2204a57a6d2fSStefano Zampini   PetscInt lrows,lcols;
2205a57a6d2fSStefano Zampini   PetscInt local_rows,local_cols;
2206e7931f94SStefano Zampini   PetscMPIInt nsubdomains;
2207a57a6d2fSStefano Zampini   /* preallocation */
2208a57a6d2fSStefano Zampini   Vec vec_dnz,vec_onz;
2209a57a6d2fSStefano Zampini   PetscScalar *my_dnz,*my_onz,*array;
2210a57a6d2fSStefano Zampini   PetscInt *dnz,*onz,*mat_ranges,*row_ownership;
2211a57a6d2fSStefano Zampini   PetscInt  index_row,index_col,owner;
2212a57a6d2fSStefano Zampini   PetscInt  *local_indices,*global_indices;
2213a57a6d2fSStefano Zampini   /* work */
2214a57a6d2fSStefano Zampini   PetscInt i,j;
2215a57a6d2fSStefano Zampini   PetscErrorCode ierr;
2216a57a6d2fSStefano Zampini 
2217a57a6d2fSStefano Zampini   PetscFunctionBegin;
2218a57a6d2fSStefano Zampini   /* CHECKS */
2219a57a6d2fSStefano Zampini   /* get info from mat */
2220a57a6d2fSStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
2221a57a6d2fSStefano Zampini   ierr = MatGetBlockSize(mat,&bs);CHKERRQ(ierr);
2222a57a6d2fSStefano Zampini   ierr = MatGetSize(matis->A,&local_rows,&local_cols);CHKERRQ(ierr);
2223a57a6d2fSStefano Zampini   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&nsubdomains);CHKERRQ(ierr);
2224a57a6d2fSStefano Zampini 
2225a57a6d2fSStefano Zampini   /* MAT_INITIAL_MATRIX */
2226a57a6d2fSStefano Zampini   ierr = MatCreate(PetscObjectComm((PetscObject)mat),&new_mat);CHKERRQ(ierr);
2227a57a6d2fSStefano Zampini   ierr = MatSetSizes(new_mat,PETSC_DECIDE,PETSC_DECIDE,rows,cols);CHKERRQ(ierr);
2228a57a6d2fSStefano Zampini   ierr = MatSetBlockSize(new_mat,bs);CHKERRQ(ierr);
2229a57a6d2fSStefano Zampini   ierr = MatSetType(new_mat,newtype);CHKERRQ(ierr);
2230a57a6d2fSStefano Zampini   ierr = MatSetUp(new_mat);CHKERRQ(ierr);
2231a57a6d2fSStefano Zampini   ierr = MatGetLocalSize(new_mat,&lrows,&lcols);CHKERRQ(ierr);
2232a57a6d2fSStefano Zampini 
2233a57a6d2fSStefano Zampini   /*
2234a57a6d2fSStefano Zampini     preallocation
2235a57a6d2fSStefano Zampini   */
2236a57a6d2fSStefano Zampini 
2237a57a6d2fSStefano Zampini   ierr = MatPreallocateInitialize(PetscObjectComm((PetscObject)new_mat),lrows,lcols,dnz,onz);CHKERRQ(ierr);
2238a57a6d2fSStefano Zampini   /*
2239a57a6d2fSStefano Zampini      Some vectors are needed to sum up properly on shared interface dofs.
2240a57a6d2fSStefano Zampini      Note that preallocation is not exact, since it overestimates nonzeros
2241a57a6d2fSStefano Zampini   */
2242a57a6d2fSStefano Zampini /*
2243a57a6d2fSStefano Zampini   ierr = VecCreate(PetscObjectComm((PetscObject)mat),&vec_dnz);CHKERRQ(ierr);
2244a57a6d2fSStefano Zampini   ierr = VecSetBlockSize(vec_dnz,bs);CHKERRQ(ierr);
2245a57a6d2fSStefano Zampini   ierr = VecSetSizes(vec_dnz,PETSC_DECIDE,rows);CHKERRQ(ierr);
2246a57a6d2fSStefano Zampini   ierr = VecSetType(vec_dnz,VECSTANDARD);CHKERRQ(ierr);
2247a57a6d2fSStefano Zampini */
2248a57a6d2fSStefano Zampini   ierr = MatGetVecs(new_mat,NULL,&vec_dnz);CHKERRQ(ierr);
2249a57a6d2fSStefano Zampini   ierr = VecDuplicate(vec_dnz,&vec_onz);CHKERRQ(ierr);
2250e7931f94SStefano Zampini   /* All processes need to compute entire row ownership */
2251a57a6d2fSStefano Zampini   ierr = PetscMalloc(rows*sizeof(*row_ownership),&row_ownership);CHKERRQ(ierr);
2252a57a6d2fSStefano Zampini   ierr = MatGetOwnershipRanges(new_mat,(const PetscInt**)&mat_ranges);CHKERRQ(ierr);
2253a57a6d2fSStefano Zampini   for (i=0;i<nsubdomains;i++) {
2254a57a6d2fSStefano Zampini     for (j=mat_ranges[i];j<mat_ranges[i+1];j++) {
2255a57a6d2fSStefano Zampini       row_ownership[j]=i;
2256a57a6d2fSStefano Zampini     }
2257a57a6d2fSStefano Zampini   }
2258a57a6d2fSStefano Zampini   /* map indices of local mat to global values */
2259a57a6d2fSStefano Zampini   ierr = PetscMalloc(PetscMax(local_cols,local_rows)*sizeof(*global_indices),&global_indices);CHKERRQ(ierr);
2260a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*local_indices),&local_indices);CHKERRQ(ierr);
2261a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) local_indices[i]=i;
2262a57a6d2fSStefano Zampini   ierr = ISLocalToGlobalMappingApply(matis->mapping,local_rows,local_indices,global_indices);CHKERRQ(ierr);
2263a57a6d2fSStefano Zampini   ierr = PetscFree(local_indices);CHKERRQ(ierr);
2264a57a6d2fSStefano Zampini 
2265e7931f94SStefano Zampini   /*
2266e7931f94SStefano Zampini      my_dnz and my_onz contains exact contribution to preallocation from each local mat
2267e7931f94SStefano Zampini      then, they will be summed up properly. This way, preallocation is always sufficient
2268e7931f94SStefano Zampini   */
2269a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*my_dnz),&my_dnz);CHKERRQ(ierr);
2270a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*my_onz),&my_onz);CHKERRQ(ierr);
2271a57a6d2fSStefano Zampini   ierr = PetscMemzero(my_dnz,local_rows*sizeof(*my_dnz));CHKERRQ(ierr);
2272a57a6d2fSStefano Zampini   ierr = PetscMemzero(my_onz,local_rows*sizeof(*my_onz));CHKERRQ(ierr);
2273a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) {
2274a57a6d2fSStefano Zampini     index_row = global_indices[i];
2275a57a6d2fSStefano Zampini     for (j=i;j<local_rows;j++) {
2276a57a6d2fSStefano Zampini       owner = row_ownership[index_row];
2277a57a6d2fSStefano Zampini       index_col = global_indices[j];
2278a57a6d2fSStefano Zampini       if (index_col > mat_ranges[owner]-1 && index_col < mat_ranges[owner+1] ) { /* diag block */
2279a57a6d2fSStefano Zampini         my_dnz[i] += 1.0;
2280a57a6d2fSStefano Zampini       } else { /* offdiag block */
2281a57a6d2fSStefano Zampini         my_onz[i] += 1.0;
2282a57a6d2fSStefano Zampini       }
2283a57a6d2fSStefano Zampini       /* same as before, interchanging rows and cols */
2284a57a6d2fSStefano Zampini       if (i != j) {
2285a57a6d2fSStefano Zampini         owner = row_ownership[index_col];
2286a57a6d2fSStefano Zampini         if (index_row > mat_ranges[owner]-1 && index_row < mat_ranges[owner+1] ) {
2287a57a6d2fSStefano Zampini           my_dnz[j] += 1.0;
2288a57a6d2fSStefano Zampini         } else {
2289a57a6d2fSStefano Zampini           my_onz[j] += 1.0;
2290a57a6d2fSStefano Zampini         }
2291a57a6d2fSStefano Zampini       }
2292a57a6d2fSStefano Zampini     }
2293a57a6d2fSStefano Zampini   }
2294a57a6d2fSStefano Zampini   ierr = VecSet(vec_dnz,0.0);CHKERRQ(ierr);
2295a57a6d2fSStefano Zampini   ierr = VecSet(vec_onz,0.0);CHKERRQ(ierr);
229620a2ab83SStefano Zampini   if (local_rows) { /* multilevel guard */
2297a57a6d2fSStefano Zampini     ierr = VecSetValues(vec_dnz,local_rows,global_indices,my_dnz,ADD_VALUES);CHKERRQ(ierr);
2298a57a6d2fSStefano Zampini     ierr = VecSetValues(vec_onz,local_rows,global_indices,my_onz,ADD_VALUES);CHKERRQ(ierr);
2299a57a6d2fSStefano Zampini   }
2300a57a6d2fSStefano Zampini   ierr = VecAssemblyBegin(vec_dnz);CHKERRQ(ierr);
2301a57a6d2fSStefano Zampini   ierr = VecAssemblyBegin(vec_onz);CHKERRQ(ierr);
2302a57a6d2fSStefano Zampini   ierr = VecAssemblyEnd(vec_dnz);CHKERRQ(ierr);
2303a57a6d2fSStefano Zampini   ierr = VecAssemblyEnd(vec_onz);CHKERRQ(ierr);
2304a57a6d2fSStefano Zampini   ierr = PetscFree(my_dnz);CHKERRQ(ierr);
2305a57a6d2fSStefano Zampini   ierr = PetscFree(my_onz);CHKERRQ(ierr);
2306a57a6d2fSStefano Zampini   ierr = PetscFree(row_ownership);CHKERRQ(ierr);
2307a57a6d2fSStefano Zampini 
2308a57a6d2fSStefano Zampini   /* set computed preallocation in dnz and onz */
2309a57a6d2fSStefano Zampini   ierr = VecGetArray(vec_dnz,&array);CHKERRQ(ierr);
2310a57a6d2fSStefano Zampini   for (i=0; i<lrows; i++) dnz[i] = (PetscInt)PetscRealPart(array[i]);
2311a57a6d2fSStefano Zampini   ierr = VecRestoreArray(vec_dnz,&array);CHKERRQ(ierr);
2312a57a6d2fSStefano Zampini   ierr = VecGetArray(vec_onz,&array);CHKERRQ(ierr);
2313a57a6d2fSStefano Zampini   for (i=0;i<lrows;i++) onz[i] = (PetscInt)PetscRealPart(array[i]);
2314a57a6d2fSStefano Zampini   ierr = VecRestoreArray(vec_onz,&array);CHKERRQ(ierr);
2315a57a6d2fSStefano Zampini   ierr = VecDestroy(&vec_dnz);CHKERRQ(ierr);
2316a57a6d2fSStefano Zampini   ierr = VecDestroy(&vec_onz);CHKERRQ(ierr);
2317a57a6d2fSStefano Zampini 
2318e7931f94SStefano Zampini   /* Resize preallocation if overestimated */
2319a57a6d2fSStefano Zampini   for (i=0;i<lrows;i++) {
2320a57a6d2fSStefano Zampini     dnz[i] = PetscMin(dnz[i],lcols);
2321a57a6d2fSStefano Zampini     onz[i] = PetscMin(onz[i],cols-lcols);
2322a57a6d2fSStefano Zampini   }
2323a57a6d2fSStefano Zampini   ierr = MatMPIAIJSetPreallocation(new_mat,0,dnz,0,onz);CHKERRQ(ierr);
2324a57a6d2fSStefano Zampini   ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
2325a57a6d2fSStefano Zampini 
2326a57a6d2fSStefano Zampini   /*
2327e7931f94SStefano Zampini     Set values. Very Basic.
2328a57a6d2fSStefano Zampini   */
2329a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) {
2330a57a6d2fSStefano Zampini     ierr = MatGetRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2331a57a6d2fSStefano Zampini     ierr = ISLocalToGlobalMappingApply(matis->mapping,j,local_indices,global_indices);CHKERRQ(ierr);
2332a57a6d2fSStefano Zampini     ierr = ISLocalToGlobalMappingApply(matis->mapping,1,&i,&index_row);CHKERRQ(ierr);
2333a57a6d2fSStefano Zampini     ierr = MatSetValues(new_mat,1,&index_row,j,global_indices,array,ADD_VALUES);CHKERRQ(ierr);
2334a57a6d2fSStefano Zampini     ierr = MatRestoreRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2335a57a6d2fSStefano Zampini   }
233620a2ab83SStefano Zampini   ierr = MatAssemblyBegin(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2337a57a6d2fSStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
233820a2ab83SStefano Zampini   ierr = MatAssemblyEnd(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2339a57a6d2fSStefano Zampini 
2340a57a6d2fSStefano Zampini   /* get back mat */
2341a57a6d2fSStefano Zampini   *M = new_mat;
2342a57a6d2fSStefano Zampini   PetscFunctionReturn(0);
2343a57a6d2fSStefano Zampini }
2344a57a6d2fSStefano Zampini 
2345e7931f94SStefano Zampini #undef __FUNCT__
2346e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble_Private"
2347e7931f94SStefano Zampini PetscErrorCode MatISSubassemble_Private(Mat mat, PetscInt coarsening_ratio, IS* is_sends)
2348e7931f94SStefano Zampini {
2349e7931f94SStefano Zampini   Mat             subdomain_adj;
2350e7931f94SStefano Zampini   IS              new_ranks,ranks_send_to;
2351e7931f94SStefano Zampini   MatPartitioning partitioner;
2352e7931f94SStefano Zampini   Mat_IS          *matis;
2353e7931f94SStefano Zampini   PetscInt        n_neighs,*neighs,*n_shared,**shared;
2354e7931f94SStefano Zampini   PetscInt        prank;
2355e7931f94SStefano Zampini   PetscMPIInt     size,rank,color;
2356e7931f94SStefano Zampini   PetscInt        *xadj,*adjncy,*oldranks;
2357e7931f94SStefano Zampini   PetscInt        *adjncy_wgt,*v_wgt,*is_indices,*ranks_send_to_idx;
2358e7931f94SStefano Zampini   PetscInt        i,j,n_subdomains,local_size,threshold=0;
2359e7931f94SStefano Zampini   PetscErrorCode  ierr;
23602b510759SStefano Zampini   PetscBool       use_vwgt=PETSC_FALSE,use_square=PETSC_FALSE;
2361e7931f94SStefano Zampini   PetscSubcomm    subcomm;
2362a57a6d2fSStefano Zampini 
2363e7931f94SStefano Zampini   PetscFunctionBegin;
23642b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_square",&use_square,NULL);CHKERRQ(ierr);
23652b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
23662b510759SStefano Zampini   ierr = PetscOptionsGetInt(NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
2367e7931f94SStefano Zampini 
2368e7931f94SStefano Zampini   /* Get info on mapping */
2369e7931f94SStefano Zampini   matis = (Mat_IS*)(mat->data);
2370e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&local_size);CHKERRQ(ierr);
2371e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2372e7931f94SStefano Zampini 
2373e7931f94SStefano Zampini   /* build local CSR graph of subdomains' connectivity */
2374e7931f94SStefano Zampini   ierr = PetscMalloc(2*sizeof(*xadj),&xadj);CHKERRQ(ierr);
2375e7931f94SStefano Zampini   xadj[0] = 0;
2376e7931f94SStefano Zampini   xadj[1] = PetscMax(n_neighs-1,0);
2377e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy),&adjncy);CHKERRQ(ierr);
2378e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy_wgt),&adjncy_wgt);CHKERRQ(ierr);
2379e7931f94SStefano Zampini 
23802b510759SStefano Zampini   if (threshold) {
23812b510759SStefano Zampini     PetscInt* count,min_threshold;
2382e7931f94SStefano Zampini     ierr = PetscMalloc(local_size*sizeof(PetscInt),&count);CHKERRQ(ierr);
2383e7931f94SStefano Zampini     ierr = PetscMemzero(count,local_size*sizeof(PetscInt));CHKERRQ(ierr);
2384e7931f94SStefano Zampini     for (i=1;i<n_neighs;i++) {/* i=1 so I don't count myself -> faces nodes counts to 1 */
2385e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2386e7931f94SStefano Zampini         count[shared[i][j]] += 1;
2387e7931f94SStefano Zampini       }
2388e7931f94SStefano Zampini     }
23892b510759SStefano Zampini     /* adapt threshold since we dont want to lose significant connections */
23902b510759SStefano Zampini     min_threshold = n_neighs;
23912b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
23922b510759SStefano Zampini       for (j=0;j<n_shared[i];j++) {
23932b510759SStefano Zampini         min_threshold = PetscMin(count[shared[i][j]],min_threshold);
23942b510759SStefano Zampini       }
23952b510759SStefano Zampini     }
23962b510759SStefano Zampini     PetscPrintf(PETSC_COMM_SELF,"PASSED THRESHOLD %d\n",threshold);
23972b510759SStefano Zampini     threshold = PetscMax(min_threshold+1,threshold);
23982b510759SStefano Zampini     PetscPrintf(PETSC_COMM_SELF,"USING THRESHOLD %d (min %d)\n",threshold,min_threshold);
2399e7931f94SStefano Zampini     xadj[1] = 0;
24002b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
2401e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2402e7931f94SStefano Zampini         if (count[shared[i][j]] < threshold) {
2403e7931f94SStefano Zampini           adjncy[xadj[1]] = neighs[i];
2404e7931f94SStefano Zampini           adjncy_wgt[xadj[1]] = n_shared[i];
2405e7931f94SStefano Zampini           xadj[1]++;
2406e7931f94SStefano Zampini           break;
2407e7931f94SStefano Zampini         }
2408e7931f94SStefano Zampini       }
2409e7931f94SStefano Zampini     }
2410e7931f94SStefano Zampini     ierr = PetscFree(count);CHKERRQ(ierr);
2411e7931f94SStefano Zampini   } else {
2412e7931f94SStefano Zampini     if (xadj[1]) {
2413e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy,&neighs[1],xadj[1]*sizeof(*adjncy));CHKERRQ(ierr);
2414e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy_wgt,&n_shared[1],xadj[1]*sizeof(*adjncy_wgt));CHKERRQ(ierr);
2415e7931f94SStefano Zampini     }
2416e7931f94SStefano Zampini   }
2417e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingRestoreInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2418e7931f94SStefano Zampini   if (use_square) {
2419e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2420e7931f94SStefano Zampini       adjncy_wgt[i] = adjncy_wgt[i]*adjncy_wgt[i];
2421e7931f94SStefano Zampini     }
2422e7931f94SStefano Zampini   }
2423e7931f94SStefano Zampini   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2424e7931f94SStefano Zampini 
2425e7931f94SStefano Zampini   ierr = PetscMalloc(sizeof(PetscInt),&ranks_send_to_idx);CHKERRQ(ierr);
2426e7931f94SStefano Zampini 
2427e7931f94SStefano Zampini   /*
2428e7931f94SStefano Zampini     Restrict work on active processes only.
2429e7931f94SStefano Zampini   */
2430e7931f94SStefano Zampini   ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&subcomm);CHKERRQ(ierr);
2431e7931f94SStefano Zampini   ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
2432e7931f94SStefano Zampini   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
24332b510759SStefano Zampini   ierr = PetscMPIIntCast(!local_size,&color);CHKERRQ(ierr);
2434e7931f94SStefano Zampini   ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank,rank);CHKERRQ(ierr);
2435e7931f94SStefano Zampini   if (color) {
2436e7931f94SStefano Zampini     ierr = PetscFree(xadj);CHKERRQ(ierr);
2437e7931f94SStefano Zampini     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2438e7931f94SStefano Zampini     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
2439e7931f94SStefano Zampini   } else {
2440e7931f94SStefano Zampini     ierr = MPI_Comm_size(subcomm->comm,&size);CHKERRQ(ierr);
2441e7931f94SStefano Zampini     ierr = PetscMalloc(size*sizeof(*oldranks),&oldranks);CHKERRQ(ierr);
2442e7931f94SStefano Zampini     prank = rank;
2443e7931f94SStefano Zampini     ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm->comm);CHKERRQ(ierr);
2444e7931f94SStefano Zampini     for (i=0;i<size;i++) {
2445e7931f94SStefano Zampini       PetscPrintf(subcomm->comm,"oldranks[%d] = %d\n",i,oldranks[i]);
2446e7931f94SStefano Zampini     }
2447e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2448e7931f94SStefano Zampini       ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
2449e7931f94SStefano Zampini     }
2450e7931f94SStefano Zampini     ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2451e7931f94SStefano Zampini     ierr = MatCreateMPIAdj(subcomm->comm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
2452e7931f94SStefano Zampini     n_subdomains = (PetscInt)size;
2453e7931f94SStefano Zampini     ierr = MatView(subdomain_adj,0);CHKERRQ(ierr);
2454e7931f94SStefano Zampini 
2455e7931f94SStefano Zampini     /* Partition */
2456e7931f94SStefano Zampini     ierr = MatPartitioningCreate(subcomm->comm,&partitioner);CHKERRQ(ierr);
2457e7931f94SStefano Zampini     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
2458e7931f94SStefano Zampini     if (use_vwgt) {
2459e7931f94SStefano Zampini       ierr = PetscMalloc(sizeof(*v_wgt),&v_wgt);CHKERRQ(ierr);
2460e7931f94SStefano Zampini       v_wgt[0] = local_size;
2461e7931f94SStefano Zampini       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
2462e7931f94SStefano Zampini     }
2463e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)partitioner),"NPARTS %d\n",n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2464e7931f94SStefano Zampini     ierr = MatPartitioningSetNParts(partitioner,n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2465e7931f94SStefano Zampini     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
2466e7931f94SStefano Zampini     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
2467e7931f94SStefano Zampini     ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr);
2468e7931f94SStefano Zampini 
2469e7931f94SStefano Zampini     ierr = ISGetIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2470e7931f94SStefano Zampini     ranks_send_to_idx[0] = oldranks[is_indices[0]];
2471e7931f94SStefano Zampini     ierr = ISRestoreIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2472e7931f94SStefano Zampini     /* clean up */
2473e7931f94SStefano Zampini     ierr = PetscFree(oldranks);CHKERRQ(ierr);
2474e7931f94SStefano Zampini     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
2475e7931f94SStefano Zampini     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
2476e7931f94SStefano Zampini     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
2477e7931f94SStefano Zampini   }
2478e7931f94SStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
2479e7931f94SStefano Zampini 
2480e7931f94SStefano Zampini   /* assemble parallel IS for sends */
2481e7931f94SStefano Zampini   i = 1;
2482e7931f94SStefano Zampini   if (color) i=0;
2483e7931f94SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,&ranks_send_to);CHKERRQ(ierr);
2484e7931f94SStefano Zampini   ierr = ISView(ranks_send_to,0);CHKERRQ(ierr);
2485e7931f94SStefano Zampini 
2486e7931f94SStefano Zampini   /* get back IS */
2487e7931f94SStefano Zampini   *is_sends = ranks_send_to;
2488e7931f94SStefano Zampini   PetscFunctionReturn(0);
2489e7931f94SStefano Zampini }
2490e7931f94SStefano Zampini 
2491e7931f94SStefano Zampini typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
2492e7931f94SStefano Zampini 
2493e7931f94SStefano Zampini #undef __FUNCT__
2494e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble"
2495e7931f94SStefano Zampini PetscErrorCode MatISSubassemble(Mat mat, IS is_sends, PetscInt coarsening_ratio, Mat *mat_n)
2496e7931f94SStefano Zampini {
2497e7931f94SStefano Zampini   Mat                    local_mat,new_mat;
2498e7931f94SStefano Zampini   Mat_IS                 *matis;
2499e7931f94SStefano Zampini   IS                     is_sends_internal;
2500e7931f94SStefano Zampini   PetscInt               rows,cols;
2501e7931f94SStefano Zampini   PetscInt               i,bs,buf_size_idxs,buf_size_vals;
2502e7931f94SStefano Zampini   PetscBool              ismatis,isdense;
2503e7931f94SStefano Zampini   ISLocalToGlobalMapping l2gmap;
2504e7931f94SStefano Zampini   PetscInt*              l2gmap_indices;
2505e7931f94SStefano Zampini   const PetscInt*        is_indices;
2506e7931f94SStefano Zampini   MatType                new_local_type;
2507e7931f94SStefano Zampini   MatTypePrivate         new_local_type_private;
2508e7931f94SStefano Zampini   /* buffers */
2509e7931f94SStefano Zampini   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
2510e7931f94SStefano Zampini   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
2511e7931f94SStefano Zampini   /* MPI */
2512e7931f94SStefano Zampini   MPI_Comm               comm;
2513e7931f94SStefano Zampini   PetscMPIInt            n_sends,n_recvs,commsize;
2514e7931f94SStefano Zampini   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals;
2515e7931f94SStefano Zampini   PetscMPIInt            *onodes,*olengths_idxs,*olengths_vals;
2516e7931f94SStefano Zampini   PetscMPIInt            len,tag_idxs,tag_vals,source_dest;
2517e7931f94SStefano Zampini   MPI_Request            *send_req_idxs,*send_req_vals,*recv_req_idxs,*recv_req_vals;
2518e7931f94SStefano Zampini   PetscErrorCode         ierr;
2519e7931f94SStefano Zampini 
2520e7931f94SStefano Zampini   PetscFunctionBegin;
2521e7931f94SStefano Zampini   /* checks */
2522e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
2523e7931f94SStefano Zampini   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on an matrix object which is not of type MATIS",__FUNCT__);
2524e7931f94SStefano Zampini   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2525e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
2526e7931f94SStefano Zampini   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
2527e7931f94SStefano Zampini   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
2528e7931f94SStefano Zampini   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
2529e7931f94SStefano Zampini   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
2530e7931f94SStefano Zampini   PetscValidLogicalCollectiveInt(mat,bs,0);
2531e7931f94SStefano Zampini   /* prepare IS for sending if not provided */
2532e7931f94SStefano Zampini   if (!is_sends) {
2533e7931f94SStefano Zampini     if (!coarsening_ratio) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a coarsening ratio");
2534e7931f94SStefano Zampini     ierr = MatISSubassemble_Private(mat,coarsening_ratio,&is_sends_internal);CHKERRQ(ierr);
2535e7931f94SStefano Zampini   } else {
2536e7931f94SStefano Zampini     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
2537e7931f94SStefano Zampini     is_sends_internal = is_sends;
2538e7931f94SStefano Zampini   }
2539e7931f94SStefano Zampini 
2540e7931f94SStefano Zampini   /* get pointer of MATIS data */
2541e7931f94SStefano Zampini   matis = (Mat_IS*)mat->data;
2542e7931f94SStefano Zampini 
2543e7931f94SStefano Zampini   /* get comm */
2544e7931f94SStefano Zampini   comm = PetscObjectComm((PetscObject)mat);
2545e7931f94SStefano Zampini 
2546e7931f94SStefano Zampini   /* compute number of sends */
2547e7931f94SStefano Zampini   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
2548e7931f94SStefano Zampini   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
2549e7931f94SStefano Zampini 
2550e7931f94SStefano Zampini   /* compute number of receives */
2551e7931f94SStefano Zampini   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
2552e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*iflags),&iflags);CHKERRQ(ierr);
2553e7931f94SStefano Zampini   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
2554e7931f94SStefano Zampini   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2555e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
2556e7931f94SStefano Zampini   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
2557e7931f94SStefano Zampini   ierr = PetscFree(iflags);CHKERRQ(ierr);
2558e7931f94SStefano Zampini 
2559e7931f94SStefano Zampini   /* prepare send/receive buffers */
2560e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_idxs),&ilengths_idxs);CHKERRQ(ierr);
2561e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
2562e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_vals),&ilengths_vals);CHKERRQ(ierr);
2563e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
2564e7931f94SStefano Zampini 
2565e7931f94SStefano Zampini   /* Get data from local mat */
2566e7931f94SStefano Zampini   if (!isdense) {
2567e7931f94SStefano Zampini     /* TODO: See below some guidelines on how to prepare the local buffers */
2568e7931f94SStefano Zampini     /*
2569e7931f94SStefano Zampini        send_buffer_vals should contain the raw values of the local matrix
2570e7931f94SStefano Zampini        send_buffer_idxs should contain:
2571e7931f94SStefano Zampini        - MatType_PRIVATE type
2572e7931f94SStefano Zampini        - PetscInt        size_of_l2gmap
2573e7931f94SStefano Zampini        - PetscInt        global_row_indices[size_of_l2gmap]
2574e7931f94SStefano Zampini        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
2575e7931f94SStefano Zampini     */
2576e7931f94SStefano Zampini   } else {
2577e7931f94SStefano Zampini     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
2578e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&i);CHKERRQ(ierr);
2579e7931f94SStefano Zampini     ierr = PetscMalloc((i+2)*sizeof(PetscInt),&send_buffer_idxs);CHKERRQ(ierr);
2580e7931f94SStefano Zampini     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
2581e7931f94SStefano Zampini     send_buffer_idxs[1] = i;
2582e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2583e7931f94SStefano Zampini     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
2584e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingRestoreIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2585e7931f94SStefano Zampini     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
2586e7931f94SStefano Zampini     for (i=0;i<n_sends;i++) {
2587e7931f94SStefano Zampini       ilengths_vals[is_indices[i]] = len*len;
2588e7931f94SStefano Zampini       ilengths_idxs[is_indices[i]] = len+2;
2589e7931f94SStefano Zampini     }
2590e7931f94SStefano Zampini   }
2591e7931f94SStefano Zampini   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
2592e7931f94SStefano Zampini   buf_size_idxs = 0;
2593e7931f94SStefano Zampini   buf_size_vals = 0;
2594e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2595e7931f94SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
2596e7931f94SStefano Zampini     buf_size_vals += (PetscInt)olengths_vals[i];
2597e7931f94SStefano Zampini   }
2598e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&recv_buffer_idxs);CHKERRQ(ierr);
2599e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_vals*sizeof(PetscScalar),&recv_buffer_vals);CHKERRQ(ierr);
2600e7931f94SStefano Zampini 
2601e7931f94SStefano Zampini   /* get new tags for clean communications */
2602e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
2603e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
2604e7931f94SStefano Zampini 
2605e7931f94SStefano Zampini   /* allocate for requests */
2606e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_idxs);CHKERRQ(ierr);
2607e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_vals);CHKERRQ(ierr);
2608e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_idxs);CHKERRQ(ierr);
2609e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_vals);CHKERRQ(ierr);
2610e7931f94SStefano Zampini 
2611e7931f94SStefano Zampini   /* communications */
2612e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2613e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
2614e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2615e7931f94SStefano Zampini     source_dest = onodes[i];
2616e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
2617e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
2618e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2619e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
2620e7931f94SStefano Zampini   }
2621e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) {
2622e7931f94SStefano Zampini     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
2623e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
2624e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
2625e7931f94SStefano Zampini   }
2626e7931f94SStefano Zampini   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2627e7931f94SStefano Zampini   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
2628e7931f94SStefano Zampini 
2629e7931f94SStefano Zampini   /* assemble new l2g map */
2630e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2631e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2632e7931f94SStefano Zampini   buf_size_idxs = 0;
2633e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2634e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
2635e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2636e7931f94SStefano Zampini   }
2637e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&l2gmap_indices);CHKERRQ(ierr);
2638e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2639e7931f94SStefano Zampini   buf_size_idxs = 0;
2640e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2641e7931f94SStefano Zampini     ierr = PetscMemcpy(&l2gmap_indices[buf_size_idxs],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
2642e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
2643e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2644e7931f94SStefano Zampini   }
2645e7931f94SStefano Zampini   ierr = PetscSortRemoveDupsInt(&buf_size_idxs,l2gmap_indices);CHKERRQ(ierr);
2646e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingCreate(comm,buf_size_idxs,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
2647e7931f94SStefano Zampini   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
2648e7931f94SStefano Zampini 
2649e7931f94SStefano Zampini   /* infer new local matrix type from received local matrices type */
2650e7931f94SStefano Zampini   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
2651e7931f94SStefano 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) */
2652e7931f94SStefano Zampini   new_local_type_private = MATAIJ_PRIVATE;
2653e7931f94SStefano Zampini   new_local_type = MATSEQAIJ;
2654e7931f94SStefano Zampini   if (n_recvs) {
2655e7931f94SStefano Zampini     new_local_type_private = send_buffer_idxs[0];
2656e7931f94SStefano Zampini     ptr_idxs = recv_buffer_idxs;
2657e7931f94SStefano Zampini     for (i=0;i<n_recvs;i++) {
2658e7931f94SStefano Zampini       if ((PetscInt)new_local_type_private != *ptr_idxs) {
2659e7931f94SStefano Zampini         new_local_type_private = MATAIJ_PRIVATE;
2660e7931f94SStefano Zampini         break;
2661e7931f94SStefano Zampini       }
2662e7931f94SStefano Zampini       ptr_idxs += olengths_idxs[i];
2663e7931f94SStefano Zampini     }
2664e7931f94SStefano Zampini     switch (new_local_type_private) {
2665e7931f94SStefano Zampini       case MATDENSE_PRIVATE: /* subassembling of dense matrices does not give a dense matrix! */
2666e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
2667e7931f94SStefano Zampini         bs = 1;
2668e7931f94SStefano Zampini         break;
2669e7931f94SStefano Zampini       case MATAIJ_PRIVATE:
2670e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
2671e7931f94SStefano Zampini         bs = 1;
2672e7931f94SStefano Zampini         break;
2673e7931f94SStefano Zampini       case MATBAIJ_PRIVATE:
2674e7931f94SStefano Zampini         new_local_type = MATSEQBAIJ;
2675e7931f94SStefano Zampini         break;
2676e7931f94SStefano Zampini       case MATSBAIJ_PRIVATE:
2677e7931f94SStefano Zampini         new_local_type = MATSEQSBAIJ;
2678e7931f94SStefano Zampini         break;
2679e7931f94SStefano Zampini       default:
2680e7931f94SStefano Zampini         SETERRQ2(comm,PETSC_ERR_LIB,"Unkwown private type %d in %s",new_local_type_private,__FUNCT__);
2681e7931f94SStefano Zampini         break;
2682e7931f94SStefano Zampini     }
2683e7931f94SStefano Zampini   }
2684e7931f94SStefano Zampini 
2685e7931f94SStefano Zampini   /* create MATIS object */
2686e7931f94SStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
2687e7931f94SStefano Zampini   ierr = MatCreateIS(comm,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,&new_mat);CHKERRQ(ierr);
2688e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
2689e7931f94SStefano Zampini   ierr = MatISGetLocalMat(new_mat,&local_mat);CHKERRQ(ierr);
2690e7931f94SStefano Zampini   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
2691e7931f94SStefano Zampini   ierr = MatSetUp(local_mat);CHKERRQ(ierr); /* WARNING -> no preallocation yet */
2692e7931f94SStefano Zampini 
2693e7931f94SStefano Zampini   /* set values */
2694e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2695e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
2696e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2697e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2698e7931f94SStefano Zampini     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
2699e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
2700e7931f94SStefano Zampini       ierr = MatSetValues(new_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
2701e7931f94SStefano Zampini       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
2702e7931f94SStefano Zampini       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
2703e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
2704e7931f94SStefano Zampini     }
2705e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2706e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
2707e7931f94SStefano Zampini   }
2708e7931f94SStefano Zampini   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2709e7931f94SStefano Zampini   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2710e7931f94SStefano Zampini   ierr = MatAssemblyBegin(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2711e7931f94SStefano Zampini   ierr = MatAssemblyEnd(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2712e7931f94SStefano Zampini 
2713e7931f94SStefano Zampini   { /* check */
2714e7931f94SStefano Zampini     Vec       lvec,rvec;
2715e7931f94SStefano Zampini     PetscReal infty_error;
2716e7931f94SStefano Zampini 
2717e7931f94SStefano Zampini     ierr = MatGetVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
2718e7931f94SStefano Zampini     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
2719e7931f94SStefano Zampini     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
2720e7931f94SStefano Zampini     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
2721e7931f94SStefano Zampini     ierr = MatMultAdd(new_mat,rvec,lvec,lvec);CHKERRQ(ierr);
2722e7931f94SStefano Zampini     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
2723e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
2724e7931f94SStefano Zampini     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
2725e7931f94SStefano Zampini     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
2726e7931f94SStefano Zampini   }
2727e7931f94SStefano Zampini 
2728e7931f94SStefano Zampini   /* free workspace */
2729e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
2730e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
2731e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2732e7931f94SStefano Zampini   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
2733e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2734e7931f94SStefano Zampini   if (isdense) {
2735e7931f94SStefano Zampini     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2736e7931f94SStefano Zampini     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
2737e7931f94SStefano Zampini   } else {
2738e7931f94SStefano Zampini     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
2739e7931f94SStefano Zampini   }
2740e7931f94SStefano Zampini   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
2741e7931f94SStefano Zampini   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
2742e7931f94SStefano Zampini   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
2743e7931f94SStefano Zampini   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
2744e7931f94SStefano Zampini   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
2745e7931f94SStefano Zampini   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
2746e7931f94SStefano Zampini   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
2747e7931f94SStefano Zampini   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
2748e7931f94SStefano Zampini   ierr = PetscFree(onodes);CHKERRQ(ierr);
2749e7931f94SStefano Zampini   /* get back new mat */
2750e7931f94SStefano Zampini   *mat_n = new_mat;
2751e7931f94SStefano Zampini   PetscFunctionReturn(0);
2752e7931f94SStefano Zampini }
2753a57a6d2fSStefano Zampini 
2754c8587f34SStefano Zampini #undef __FUNCT__
27558629588bSStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
27568629588bSStefano Zampini PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
2757c8587f34SStefano Zampini {
2758c8587f34SStefano Zampini   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
2759c8587f34SStefano Zampini   PC_IS                  *pcis = (PC_IS*)pc->data;
276020a2ab83SStefano Zampini   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
27619881197aSStefano Zampini   MatNullSpace           CoarseNullSpace=NULL;
276220a2ab83SStefano Zampini   ISLocalToGlobalMapping coarse_islg;
276320a2ab83SStefano Zampini   IS                     coarse_is;
2764f9eb5b7dSStefano Zampini   PetscInt               max_it,coarse_size,*local_primal_indices=NULL;
2765f9eb5b7dSStefano Zampini   PetscInt               im_active=-1,active_procs=-1;
2766f9eb5b7dSStefano Zampini   PC                     pc_temp;
2767c8587f34SStefano Zampini   PCType                 coarse_pc_type;
2768c8587f34SStefano Zampini   KSPType                coarse_ksp_type;
2769f9eb5b7dSStefano Zampini   PetscBool              multilevel_requested,multilevel_allowed;
2770f9eb5b7dSStefano Zampini   PetscBool              setsym,issym,isbddc,isnn;
2771f9eb5b7dSStefano Zampini   MatStructure           matstruct;
27729881197aSStefano Zampini   PetscErrorCode         ierr;
2773fdc09c96SStefano Zampini 
2774c8587f34SStefano Zampini   PetscFunctionBegin;
2775c8587f34SStefano Zampini   /* Assign global numbering to coarse dofs */
2776f34684f1SStefano Zampini   ierr = PCBDDCComputePrimalNumbering(pc,&coarse_size,&local_primal_indices);CHKERRQ(ierr);
2777c8587f34SStefano Zampini 
2778f9eb5b7dSStefano Zampini   /* infer some info from user */
2779f9eb5b7dSStefano Zampini   issym = PETSC_FALSE;
2780f9eb5b7dSStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
2781f9eb5b7dSStefano Zampini   multilevel_allowed = PETSC_FALSE;
2782f9eb5b7dSStefano Zampini   multilevel_requested = PETSC_FALSE;
2783f9eb5b7dSStefano Zampini   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
2784f9eb5b7dSStefano Zampini   if (multilevel_requested) {
27852b510759SStefano Zampini     /* count "active processes" */
27862b510759SStefano Zampini     im_active = !!(pcis->n);
27872b510759SStefano Zampini     ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
27882b510759SStefano Zampini     if (active_procs/pcbddc->coarsening_ratio < 2) {
2789f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_FALSE;
27902b510759SStefano Zampini     } else {
2791f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_TRUE;
2792c8587f34SStefano Zampini     }
2793c8587f34SStefano Zampini   }
2794e7931f94SStefano Zampini 
2795f9eb5b7dSStefano Zampini   /* set defaults for coarse KSP and PC */
2796f9eb5b7dSStefano Zampini   if (multilevel_allowed) {
2797f9eb5b7dSStefano Zampini     if (issym) {
2798f9eb5b7dSStefano Zampini       coarse_ksp_type = KSPRICHARDSON;
2799f9eb5b7dSStefano Zampini     } else {
2800f9eb5b7dSStefano Zampini       coarse_ksp_type = KSPCHEBYSHEV;
2801f9eb5b7dSStefano Zampini     }
2802f9eb5b7dSStefano Zampini     coarse_pc_type = PCBDDC;
2803f9eb5b7dSStefano Zampini   } else {
2804f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPPREONLY;
2805f9eb5b7dSStefano Zampini     coarse_pc_type = PCREDUNDANT;
2806f9eb5b7dSStefano Zampini   }
2807f9eb5b7dSStefano Zampini 
2808f9eb5b7dSStefano Zampini   /* create the coarse KSP object only once with defaults */
2809f9eb5b7dSStefano Zampini   if (!pcbddc->coarse_ksp) {
2810e604994aSStefano Zampini     char prefix[256],str_level[3];
2811e604994aSStefano Zampini     size_t len;
2812f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_ksp);CHKERRQ(ierr);
2813f9eb5b7dSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
2814f9eb5b7dSStefano Zampini     ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
2815f9eb5b7dSStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
2816f9eb5b7dSStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
2817f9eb5b7dSStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
2818e604994aSStefano Zampini     /* prefix */
2819e604994aSStefano Zampini     ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
2820e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
2821e604994aSStefano Zampini     if (!pcbddc->current_level) {
2822e604994aSStefano Zampini       ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
2823e604994aSStefano Zampini       ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
2824e604994aSStefano Zampini     } else {
2825e604994aSStefano Zampini       ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
2826e604994aSStefano Zampini       if (pcbddc->current_level>1) len -= 2;
2827e604994aSStefano Zampini       ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
2828e604994aSStefano Zampini       *(prefix+len)='\0';
2829e604994aSStefano Zampini       sprintf(str_level,"%d_",(int)(pcbddc->current_level));
2830e604994aSStefano Zampini       ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
2831e604994aSStefano Zampini     }
2832e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
2833f9eb5b7dSStefano Zampini   }
2834f9eb5b7dSStefano Zampini   /* allow user customization */
2835*85c4d303SStefano 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); */
2836f9eb5b7dSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
2837*85c4d303SStefano 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); */
2838f9eb5b7dSStefano Zampini 
2839f9eb5b7dSStefano Zampini   /* get some info after set from options */
2840f9eb5b7dSStefano Zampini   ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
2841f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
2842f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
2843f9eb5b7dSStefano Zampini   if (isbddc && !multilevel_allowed) { /* prevent from infinite loop if user as requested bddc pc for coarse solver */
2844f9eb5b7dSStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
2845f9eb5b7dSStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
2846f9eb5b7dSStefano Zampini     isbddc = PETSC_FALSE;
2847f9eb5b7dSStefano Zampini   }
2848f9eb5b7dSStefano Zampini 
2849f9eb5b7dSStefano Zampini   /* propagate BDDC info to the next level */
2850f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
2851f9eb5b7dSStefano Zampini   ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
2852f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
2853f9eb5b7dSStefano Zampini 
2854f9eb5b7dSStefano Zampini   /* creates temporary MATIS object for coarse matrix */
2855a57a6d2fSStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,local_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
2856a57a6d2fSStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
2857a57a6d2fSStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
2858a57a6d2fSStefano Zampini   ierr = MatCreateIS(PetscObjectComm((PetscObject)pc),1,PETSC_DECIDE,PETSC_DECIDE,coarse_size,coarse_size,coarse_islg,&coarse_mat_is);CHKERRQ(ierr);
2859a57a6d2fSStefano Zampini   ierr = MatISSetLocalMat(coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
2860e7931f94SStefano Zampini   ierr = MatAssemblyBegin(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2861e7931f94SStefano Zampini   ierr = MatAssemblyEnd(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
286220a2ab83SStefano Zampini   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
286320a2ab83SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
286420a2ab83SStefano Zampini   ierr = PetscFree(local_primal_indices);CHKERRQ(ierr);
2865fdc09c96SStefano Zampini 
2866f9eb5b7dSStefano Zampini   /* assemble coarse matrix */
2867f9eb5b7dSStefano Zampini   if (isbddc || isnn) {
2868f9eb5b7dSStefano Zampini     ierr = MatISSubassemble(coarse_mat_is,NULL,pcbddc->coarsening_ratio,&coarse_mat);CHKERRQ(ierr);
2869f9eb5b7dSStefano Zampini   } else {
28702b510759SStefano Zampini     ierr = MatConvert_IS_AIJ(coarse_mat_is,MATAIJ,MAT_INITIAL_MATRIX,&coarse_mat);CHKERRQ(ierr);
2871c8587f34SStefano Zampini   }
28722b510759SStefano Zampini   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
28739881197aSStefano Zampini 
2874f9eb5b7dSStefano Zampini   /* create local to global scatters for coarse problem */
2875f9eb5b7dSStefano Zampini   ierr = MatGetVecs(coarse_mat,&pcbddc->coarse_vec,&pcbddc->coarse_rhs);CHKERRQ(ierr);
2876f9eb5b7dSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
2877f9eb5b7dSStefano Zampini   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
2878f9eb5b7dSStefano Zampini 
2879f9eb5b7dSStefano Zampini   /* propagate symmetry info to coarse matrix */
2880f9eb5b7dSStefano Zampini   ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,issym);CHKERRQ(ierr);
2881f9eb5b7dSStefano Zampini 
2882b8ffe317SStefano Zampini   /* Compute coarse null space (special handling by BDDC only) */
2883b8ffe317SStefano Zampini   if (pcbddc->NullSpace) {
2884b8ffe317SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCoarse(pc,coarse_mat,&CoarseNullSpace);CHKERRQ(ierr);
2885b8ffe317SStefano Zampini     if (isbddc) {
2886b8ffe317SStefano Zampini       ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
2887b8ffe317SStefano Zampini     } else {
2888b8ffe317SStefano Zampini       ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
2889b8ffe317SStefano Zampini     }
2890b8ffe317SStefano Zampini   }
2891b8ffe317SStefano Zampini 
2892f9eb5b7dSStefano Zampini   /* set operators */
2893f9eb5b7dSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
2894f9eb5b7dSStefano Zampini   ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat,matstruct);CHKERRQ(ierr);
2895f9eb5b7dSStefano Zampini 
2896f9eb5b7dSStefano Zampini   /* additional KSP customization */
2897f9eb5b7dSStefano Zampini   ierr = KSPGetTolerances(pcbddc->coarse_ksp,NULL,NULL,NULL,&max_it);CHKERRQ(ierr);
2898f9eb5b7dSStefano Zampini   if (max_it < 5) {
2899f9eb5b7dSStefano Zampini     ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
2900f9eb5b7dSStefano Zampini   }
2901b8ffe317SStefano Zampini   /* ierr = KSPChebyshevSetEstimateEigenvalues(pcbddc->coarse_ksp,1.0,0.0,0.0,1.1);CHKERRQ(ierr); */
2902f9eb5b7dSStefano Zampini 
2903f9eb5b7dSStefano Zampini 
2904f9eb5b7dSStefano Zampini   /* print some info if requested */
2905f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
2906f9eb5b7dSStefano Zampini     ierr = KSPGetType(pcbddc->coarse_ksp,&coarse_ksp_type);CHKERRQ(ierr);
2907f9eb5b7dSStefano Zampini     ierr = PCGetType(pc_temp,&coarse_pc_type);CHKERRQ(ierr);
2908f9eb5b7dSStefano Zampini     if (!multilevel_allowed) {
2909f9eb5b7dSStefano Zampini       if (multilevel_requested) {
2910f9eb5b7dSStefano 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);
2911f9eb5b7dSStefano Zampini       } else if (pcbddc->max_levels) {
2912f9eb5b7dSStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
2913f9eb5b7dSStefano Zampini       }
2914f9eb5b7dSStefano Zampini     }
2915e604994aSStefano 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);
2916f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2917f9eb5b7dSStefano Zampini   }
2918f9eb5b7dSStefano Zampini 
2919f9eb5b7dSStefano Zampini   /* setup coarse ksp */
2920f9eb5b7dSStefano Zampini   ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
2921f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
2922f9eb5b7dSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
2923f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2924f9eb5b7dSStefano Zampini     ierr = KSPView(pcbddc->coarse_ksp,pcbddc->dbg_viewer);CHKERRQ(ierr);
2925f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2926f9eb5b7dSStefano Zampini   }
2927f9eb5b7dSStefano Zampini 
2928c8587f34SStefano Zampini   /* Check coarse problem if requested */
292920a2ab83SStefano Zampini   if (pcbddc->dbg_flag) {
2930c8587f34SStefano Zampini     KSP       check_ksp;
29312b510759SStefano Zampini     KSPType   check_ksp_type;
2932c8587f34SStefano Zampini     PC        check_pc;
2933c8587f34SStefano Zampini     Vec       check_vec;
2934c8587f34SStefano Zampini     PetscReal abs_infty_error,infty_error,lambda_min,lambda_max;
29352b510759SStefano Zampini     PetscInt  its;
2936f9eb5b7dSStefano Zampini     PetscBool ispreonly,compute;
2937c8587f34SStefano Zampini 
29382b510759SStefano Zampini     /* Create ksp object suitable for estimation of extreme eigenvalues */
2939f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&check_ksp);CHKERRQ(ierr);
2940fdc635d7SStefano Zampini     ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
2941f9eb5b7dSStefano Zampini     ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,coarse_size);CHKERRQ(ierr);
29422b510759SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
29432b510759SStefano Zampini     if (ispreonly) {
29442b510759SStefano Zampini       check_ksp_type = KSPPREONLY;
2945f9eb5b7dSStefano Zampini       compute = PETSC_FALSE;
29462b510759SStefano Zampini     } else {
2947c8587f34SStefano Zampini       if (issym) check_ksp_type = KSPCG;
2948c8587f34SStefano Zampini       else check_ksp_type = KSPGMRES;
2949f9eb5b7dSStefano Zampini       compute = PETSC_TRUE;
2950c8587f34SStefano Zampini     }
2951c8587f34SStefano Zampini     ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
2952f9eb5b7dSStefano Zampini     ierr = KSPSetComputeSingularValues(check_ksp,compute);CHKERRQ(ierr);
2953c8587f34SStefano Zampini     ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
2954f9eb5b7dSStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
2955f9eb5b7dSStefano Zampini     ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
2956c8587f34SStefano Zampini     /* create random vec */
2957c8587f34SStefano Zampini     ierr = VecDuplicate(pcbddc->coarse_vec,&check_vec);CHKERRQ(ierr);
2958c8587f34SStefano Zampini     ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
2959c8587f34SStefano Zampini     if (CoarseNullSpace) {
2960c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec);CHKERRQ(ierr);
2961c8587f34SStefano Zampini     }
2962fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
2963c8587f34SStefano Zampini     /* solve coarse problem */
2964c8587f34SStefano Zampini     ierr = KSPSolve(check_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
2965c8587f34SStefano Zampini     if (CoarseNullSpace) {
2966c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,pcbddc->coarse_vec);CHKERRQ(ierr);
2967c8587f34SStefano Zampini     }
2968c8587f34SStefano Zampini     /* check coarse problem residual error */
2969c8587f34SStefano Zampini     ierr = VecAXPY(check_vec,-1.0,pcbddc->coarse_vec);CHKERRQ(ierr);
2970c8587f34SStefano Zampini     ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
2971fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
2972c8587f34SStefano Zampini     ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
2973c8587f34SStefano Zampini     ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
2974e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem (%s) details\n",((PetscObject)(pcbddc->coarse_ksp))->prefix);CHKERRQ(ierr);
2975e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
2976e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
2977f9eb5b7dSStefano Zampini     /* get eigenvalue estimation if preonly has not been requested */
29782b510759SStefano Zampini     if (!ispreonly) {
2979c8587f34SStefano Zampini       ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
298020a2ab83SStefano Zampini       ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
2981f9eb5b7dSStefano 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);
2982c8587f34SStefano Zampini     }
29832b510759SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2984c8587f34SStefano Zampini     ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
2985c8587f34SStefano Zampini   }
29862b510759SStefano Zampini   /* free memory */
2987c8587f34SStefano Zampini   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
2988fdc635d7SStefano Zampini   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
2989c8587f34SStefano Zampini   PetscFunctionReturn(0);
2990c8587f34SStefano Zampini }
29919a7d3425SStefano Zampini 
2992f34684f1SStefano Zampini #undef __FUNCT__
2993f34684f1SStefano Zampini #define __FUNCT__ "PCBDDCComputePrimalNumbering"
2994f34684f1SStefano Zampini PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
2995f34684f1SStefano Zampini {
2996f34684f1SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2997f34684f1SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
2998f34684f1SStefano Zampini   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
2999f34684f1SStefano Zampini   PetscInt       i,j,coarse_size;
3000f34684f1SStefano Zampini   PetscInt       *local_primal_indices,*auxlocal_primal,*aux_idx;
3001f34684f1SStefano Zampini   PetscErrorCode ierr;
3002f34684f1SStefano Zampini 
3003f34684f1SStefano Zampini   PetscFunctionBegin;
3004f34684f1SStefano Zampini   /* get indices in local ordering for vertices and constraints */
3005f34684f1SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&auxlocal_primal);CHKERRQ(ierr);
3006f34684f1SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&i,&aux_idx);CHKERRQ(ierr);
3007f34684f1SStefano Zampini   ierr = PetscMemcpy(auxlocal_primal,aux_idx,i*sizeof(PetscInt));CHKERRQ(ierr);
3008f34684f1SStefano Zampini   ierr = PetscFree(aux_idx);CHKERRQ(ierr);
3009f34684f1SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&j,&aux_idx);CHKERRQ(ierr);
3010f34684f1SStefano Zampini   ierr = PetscMemcpy(&auxlocal_primal[i],aux_idx,j*sizeof(PetscInt));CHKERRQ(ierr);
3011f34684f1SStefano Zampini   ierr = PetscFree(aux_idx);CHKERRQ(ierr);
3012f34684f1SStefano Zampini 
3013f34684f1SStefano Zampini   /* Compute global number of coarse dofs */
3014f34684f1SStefano Zampini   ierr = PCBDDCSubsetNumbering(PetscObjectComm((PetscObject)(pc->pmat)),matis->mapping,pcbddc->local_primal_size,auxlocal_primal,NULL,&coarse_size,&local_primal_indices);CHKERRQ(ierr);
3015f34684f1SStefano Zampini 
3016f34684f1SStefano Zampini   /* check numbering */
3017f34684f1SStefano Zampini   if (pcbddc->dbg_flag) {
3018f34684f1SStefano Zampini     PetscScalar coarsesum,*array;
3019f34684f1SStefano Zampini 
3020f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3021f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3022f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
3023f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
3024f34684f1SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
3025f34684f1SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,auxlocal_primal[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
3026f34684f1SStefano Zampini     }
3027f34684f1SStefano Zampini     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
3028f34684f1SStefano Zampini     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
3029f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3030f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3031f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3032f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3033f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3034f34684f1SStefano Zampini     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3035f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3036f34684f1SStefano Zampini       if (array[i] == 1.0) {
3037f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %d owned by a single process!\n",PetscGlobalRank,i);CHKERRQ(ierr);
3038f34684f1SStefano Zampini       }
3039f34684f1SStefano Zampini     }
3040f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3041f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3042f34684f1SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
3043f34684f1SStefano Zampini     }
3044f34684f1SStefano Zampini     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3045f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3046f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3047f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3048f34684f1SStefano Zampini     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
3049f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
3050f34684f1SStefano Zampini     if (pcbddc->dbg_flag > 1) {
3051f34684f1SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
3052f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3053f34684f1SStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
3054f34684f1SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
3055f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_primal_indices[%d]=%d \n",i,local_primal_indices[i]);
3056f34684f1SStefano Zampini       }
3057f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3058f34684f1SStefano Zampini     }
3059f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3060f34684f1SStefano Zampini   }
3061f34684f1SStefano Zampini   ierr = PetscFree(auxlocal_primal);CHKERRQ(ierr);
3062f34684f1SStefano Zampini   /* get back data */
3063f34684f1SStefano Zampini   *coarse_size_n = coarse_size;
3064f34684f1SStefano Zampini   *local_primal_indices_n = local_primal_indices;
3065f34684f1SStefano Zampini   PetscFunctionReturn(0);
3066f34684f1SStefano Zampini }
3067f34684f1SStefano Zampini 
3068