xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision a717540c0c323699cd8e947d4c3ca8eb3daefbe6)
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) {
262af732b37SStefano Zampini     PetscInt ibs,iibs,mbs;
26325084f0cSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,n_vertices,vertices,PETSC_COPY_VALUES,&is_aux);CHKERRQ(ierr);
264af732b37SStefano Zampini     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
265af732b37SStefano Zampini     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
266af732b37SStefano Zampini     ierr = ISGetBlockSize(is_aux,&iibs);CHKERRQ(ierr);
267af732b37SStefano Zampini     if (ibs != mbs || iibs != mbs) { /* TODO BAIJ */
268af732b37SStefano Zampini       Mat newmat;
269af732b37SStefano Zampini       ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
270af732b37SStefano Zampini       ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
271af732b37SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
272af732b37SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
273af732b37SStefano Zampini       ierr = MatDestroy(&newmat);CHKERRQ(ierr);
274af732b37SStefano Zampini     } else {
2758ce42a96SStefano Zampini       ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
2768ce42a96SStefano Zampini       ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
27725084f0cSStefano Zampini       ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
278af732b37SStefano Zampini     }
27925084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
28088ebb749SStefano Zampini   }
28188ebb749SStefano Zampini 
28288ebb749SStefano Zampini   /* Matrix of coarse basis functions (local) */
28388ebb749SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
28488ebb749SStefano Zampini   ierr = MatSetSizes(pcbddc->coarse_phi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
28588ebb749SStefano Zampini   ierr = MatSetType(pcbddc->coarse_phi_B,impMatType);CHKERRQ(ierr);
28625084f0cSStefano Zampini   ierr = MatSetUp(pcbddc->coarse_phi_B);CHKERRQ(ierr);
2878eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
28888ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
28988ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_phi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
29088ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_phi_D,impMatType);CHKERRQ(ierr);
29125084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_phi_D);CHKERRQ(ierr);
29288ebb749SStefano Zampini   }
29388ebb749SStefano Zampini 
29425084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
2958ce42a96SStefano Zampini     ierr = ISGetIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
29688ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*coarsefunctions_errors),&coarsefunctions_errors);CHKERRQ(ierr);
29788ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*constraints_errors),&constraints_errors);CHKERRQ(ierr);
29888ebb749SStefano Zampini   }
29988ebb749SStefano Zampini   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
30088ebb749SStefano Zampini   ierr = PetscMalloc((pcbddc->local_primal_size)*(pcbddc->local_primal_size)*sizeof(PetscScalar),&coarse_submat_vals);CHKERRQ(ierr);
30188ebb749SStefano Zampini 
30288ebb749SStefano Zampini   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
30325084f0cSStefano Zampini 
30425084f0cSStefano Zampini   /* vertices */
30588ebb749SStefano Zampini   for (i=0;i<n_vertices;i++) {
30688ebb749SStefano Zampini     ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
30788ebb749SStefano Zampini     ierr = VecSetValue(vec1_V,i,one,INSERT_VALUES);CHKERRQ(ierr);
30888ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
30988ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
31025084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on constraints multipliers */
31188ebb749SStefano Zampini     ierr = MatMult(A_RV,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
31288ebb749SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
31388ebb749SStefano Zampini     ierr = VecScale(pcbddc->vec1_R,m_one);CHKERRQ(ierr);
31488ebb749SStefano Zampini     if (n_constraints) {
31588ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec1_R,vec1_C);CHKERRQ(ierr);
31688ebb749SStefano Zampini       ierr = MatMultAdd(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
31788ebb749SStefano Zampini       ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
31888ebb749SStefano Zampini     }
31988ebb749SStefano Zampini     ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
32088ebb749SStefano Zampini     ierr = MatMultAdd(A_VV,vec1_V,vec2_V,vec2_V);CHKERRQ(ierr);
32188ebb749SStefano Zampini 
32288ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
32388ebb749SStefano Zampini     /* coarse basis functions */
32488ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
32588ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
32688ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
32725084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
32888ebb749SStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
32925084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
33088ebb749SStefano Zampini     ierr = MatSetValue(pcbddc->coarse_phi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
3318eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
33288ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
33388ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
33425084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
33588ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
33625084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
33788ebb749SStefano Zampini     }
33825084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
33925084f0cSStefano Zampini     ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
34025084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
34125084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
34288ebb749SStefano Zampini     if (n_constraints) {
34325084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
34425084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
34525084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
34688ebb749SStefano Zampini     }
34788ebb749SStefano Zampini 
34825084f0cSStefano Zampini     /* check */
34925084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
35025084f0cSStefano Zampini       /* assemble subdomain vector on local nodes */
35188ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
35225084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
35325084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
35425084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
35525084f0cSStefano Zampini       ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
35625084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
35725084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
35888ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers (i.e. primal nodes) */
35988ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
36025084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
36125084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
36225084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
36388ebb749SStefano Zampini       if (n_constraints) {
36425084f0cSStefano Zampini         ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
36525084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
36625084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
36788ebb749SStefano Zampini       }
36825084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
36925084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
37088ebb749SStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
37188ebb749SStefano Zampini       /* check saddle point solution */
37288ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
37388ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
37488ebb749SStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i]);CHKERRQ(ierr);
37588ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
37625084f0cSStefano Zampini       /* shift by the identity matrix */
37725084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
37825084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
37925084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
38088ebb749SStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i]);CHKERRQ(ierr);
38188ebb749SStefano Zampini     }
38288ebb749SStefano Zampini   }
38388ebb749SStefano Zampini 
38425084f0cSStefano Zampini   /* constraints */
38588ebb749SStefano Zampini   for (i=0;i<n_constraints;i++) {
38688ebb749SStefano Zampini     ierr = VecSet(vec2_C,zero);CHKERRQ(ierr);
38788ebb749SStefano Zampini     ierr = VecSetValue(vec2_C,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
38888ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec2_C);CHKERRQ(ierr);
38988ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec2_C);CHKERRQ(ierr);
39025084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on vertices multipliers */
39188ebb749SStefano Zampini     ierr = MatMult(M1,vec2_C,vec1_C);CHKERRQ(ierr);
39288ebb749SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
39388ebb749SStefano Zampini     ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
39425084f0cSStefano Zampini     if (n_vertices) {
39525084f0cSStefano Zampini       ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
39625084f0cSStefano Zampini     }
39788ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
39888ebb749SStefano Zampini     /* coarse basis functions */
39925084f0cSStefano Zampini     j = i+n_vertices; /* don't touch this! */
40088ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
40188ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40288ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40325084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
40425084f0cSStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
40525084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
4068eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
40788ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40888ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40925084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
41025084f0cSStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
41125084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
41288ebb749SStefano Zampini     }
41325084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
41488ebb749SStefano Zampini     if (n_vertices) {
41525084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
41625084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
41725084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
41888ebb749SStefano Zampini     }
41925084f0cSStefano Zampini     ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
42025084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
42125084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
42288ebb749SStefano Zampini 
42325084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
42488ebb749SStefano Zampini       /* assemble subdomain vector on nodes */
42588ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
42625084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
42725084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
42825084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
42925084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
43025084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
43188ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers */
43288ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
43388ebb749SStefano Zampini       if (n_vertices) {
43425084f0cSStefano Zampini         ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
43525084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
43625084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
43788ebb749SStefano Zampini       }
43825084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
43925084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
44025084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
44125084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
44225084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
44325084f0cSStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
44488ebb749SStefano Zampini       /* check saddle point solution */
44588ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
44688ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
44725084f0cSStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[j]);CHKERRQ(ierr);
44888ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
44925084f0cSStefano Zampini       /* shift by the identity matrix */
45025084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,j,m_one,ADD_VALUES);CHKERRQ(ierr);
45125084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
45225084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
45325084f0cSStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[j]);CHKERRQ(ierr);
45488ebb749SStefano Zampini     }
45588ebb749SStefano Zampini   }
45625084f0cSStefano Zampini   /* call assembling routines for local coarse basis */
45788ebb749SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
45888ebb749SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4598eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
46088ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
46188ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
46288ebb749SStefano Zampini   }
46325084f0cSStefano Zampini 
46488ebb749SStefano Zampini   /* compute other basis functions for non-symmetric problems */
46588ebb749SStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
46688ebb749SStefano Zampini   if (!setsym || (setsym && !issym)) {
46788ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
46888ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_psi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
46988ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_psi_B,impMatType);CHKERRQ(ierr);
47025084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_psi_B);CHKERRQ(ierr);
4718eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
47288ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
47388ebb749SStefano Zampini       ierr = MatSetSizes(pcbddc->coarse_psi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
47488ebb749SStefano Zampini       ierr = MatSetType(pcbddc->coarse_psi_D,impMatType);CHKERRQ(ierr);
47525084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->coarse_psi_D);CHKERRQ(ierr);
47688ebb749SStefano Zampini     }
47788ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
47888ebb749SStefano Zampini       if (n_constraints) {
47988ebb749SStefano Zampini         ierr = VecSet(vec1_C,zero);CHKERRQ(ierr);
48088ebb749SStefano Zampini         for (j=0;j<n_constraints;j++) {
48125084f0cSStefano Zampini           ierr = VecSetValue(vec1_C,j,coarse_submat_vals[(j+n_vertices)*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
48288ebb749SStefano Zampini         }
48325084f0cSStefano Zampini         ierr = VecAssemblyBegin(vec1_C);CHKERRQ(ierr);
48425084f0cSStefano Zampini         ierr = VecAssemblyEnd(vec1_C);CHKERRQ(ierr);
48588ebb749SStefano Zampini       }
48688ebb749SStefano Zampini       if (i<n_vertices) {
48788ebb749SStefano Zampini         ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
48888ebb749SStefano Zampini         ierr = VecSetValue(vec1_V,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
48988ebb749SStefano Zampini         ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
49088ebb749SStefano Zampini         ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
49188ebb749SStefano Zampini         ierr = MatMultTranspose(A_VR,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
49288ebb749SStefano Zampini         if (n_constraints) {
49388ebb749SStefano Zampini           ierr = MatMultTransposeAdd(C_CR,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
49488ebb749SStefano Zampini         }
49588ebb749SStefano Zampini       } else {
49688ebb749SStefano Zampini         ierr = MatMultTranspose(C_CR,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
49788ebb749SStefano Zampini       }
49888ebb749SStefano Zampini       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
49988ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
50088ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
50188ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
50225084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
50388ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_psi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
50425084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
50588ebb749SStefano Zampini       if (i<n_vertices) {
50688ebb749SStefano Zampini         ierr = MatSetValue(pcbddc->coarse_psi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
50788ebb749SStefano Zampini       }
5088eeda7d8SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
50988ebb749SStefano Zampini         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
51088ebb749SStefano Zampini         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
51125084f0cSStefano Zampini         ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
51288ebb749SStefano Zampini         ierr = MatSetValues(pcbddc->coarse_psi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
51325084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
51488ebb749SStefano Zampini       }
51588ebb749SStefano Zampini 
51625084f0cSStefano Zampini       if (pcbddc->dbg_flag) {
51788ebb749SStefano Zampini         /* assemble subdomain vector on nodes */
51888ebb749SStefano Zampini         ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
51925084f0cSStefano Zampini         ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
52025084f0cSStefano Zampini         ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
52125084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
52225084f0cSStefano Zampini         if (i<n_vertices) {
52325084f0cSStefano Zampini           ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
52488ebb749SStefano Zampini         }
52525084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
52625084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
52725084f0cSStefano Zampini         /* assemble subdomain vector of lagrange multipliers */
52825084f0cSStefano Zampini         for (j=0;j<pcbddc->local_primal_size;j++) {
52925084f0cSStefano Zampini           ierr = VecSetValue(pcbddc->vec1_P,j,-coarse_submat_vals[j*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
53025084f0cSStefano Zampini         }
53125084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
53225084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
53388ebb749SStefano Zampini         /* check saddle point solution */
53488ebb749SStefano Zampini         ierr = MatMultTranspose(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
53588ebb749SStefano Zampini         ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
53688ebb749SStefano Zampini         ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
53788ebb749SStefano Zampini         ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
53825084f0cSStefano Zampini         /* shift by the identity matrix */
53925084f0cSStefano Zampini         ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
54025084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
54125084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
54288ebb749SStefano Zampini         ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
54388ebb749SStefano Zampini       }
54488ebb749SStefano Zampini     }
54588ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
54688ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5478eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
54888ebb749SStefano Zampini       ierr = MatAssemblyBegin(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
54988ebb749SStefano Zampini       ierr = MatAssemblyEnd(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
55088ebb749SStefano Zampini     }
55188ebb749SStefano Zampini   }
55288ebb749SStefano Zampini   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
55388ebb749SStefano Zampini   /* Checking coarse_sub_mat and coarse basis functios */
55488ebb749SStefano Zampini   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
55588ebb749SStefano Zampini   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
55625084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
55788ebb749SStefano Zampini     Mat         coarse_sub_mat;
55825084f0cSStefano Zampini     Mat         AUXMAT,TM1,TM2,TM3,TM4;
55988ebb749SStefano Zampini     Mat         coarse_phi_D,coarse_phi_B;
56088ebb749SStefano Zampini     Mat         coarse_psi_D,coarse_psi_B;
56188ebb749SStefano Zampini     Mat         A_II,A_BB,A_IB,A_BI;
56288ebb749SStefano Zampini     MatType     checkmattype=MATSEQAIJ;
56388ebb749SStefano Zampini     PetscReal   real_value;
56488ebb749SStefano Zampini 
56588ebb749SStefano Zampini     ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
56688ebb749SStefano Zampini     ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
56788ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
56888ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
56988ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
57088ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
57188ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
57288ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
57388ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
57488ebb749SStefano Zampini     }
57588ebb749SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
57688ebb749SStefano Zampini 
57725084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
57825084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat and local basis functions\n");CHKERRQ(ierr);
57925084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
58088ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
58188ebb749SStefano Zampini       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
58288ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
58388ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
58488ebb749SStefano Zampini       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
58588ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
58688ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
58788ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
58888ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
58988ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
59088ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
59188ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
59288ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
59388ebb749SStefano Zampini     } else {
59488ebb749SStefano Zampini       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
59588ebb749SStefano Zampini       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
59688ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
59788ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
59888ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
59988ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
60088ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
60188ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
60288ebb749SStefano Zampini     }
60388ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
60488ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
60588ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
60688ebb749SStefano Zampini     ierr = MatConvert(TM1,MATSEQDENSE,MAT_REUSE_MATRIX,&TM1);CHKERRQ(ierr);
60788ebb749SStefano Zampini     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
60888ebb749SStefano Zampini     ierr = MatNorm(TM1,NORM_INFINITY,&real_value);CHKERRQ(ierr);
60925084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"----------------------------------\n");CHKERRQ(ierr);
61025084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d \n",PetscGlobalRank);CHKERRQ(ierr);
61125084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"matrix error = % 1.14e\n",real_value);CHKERRQ(ierr);
61225084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (phi) errors\n");CHKERRQ(ierr);
61388ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
61425084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,coarsefunctions_errors[i]);CHKERRQ(ierr);
61588ebb749SStefano Zampini     }
61625084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (phi) errors\n");CHKERRQ(ierr);
61788ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
61825084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,constraints_errors[i]);CHKERRQ(ierr);
61988ebb749SStefano Zampini     }
62088ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
62125084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (psi) errors\n");CHKERRQ(ierr);
62288ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
62325084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,coarsefunctions_errors[i]);CHKERRQ(ierr);
62488ebb749SStefano Zampini       }
62525084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (psi) errors\n");CHKERRQ(ierr);
62688ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
62725084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,constraints_errors[i]);CHKERRQ(ierr);
62888ebb749SStefano Zampini       }
62988ebb749SStefano Zampini     }
63025084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
63188ebb749SStefano Zampini     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
63288ebb749SStefano Zampini     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
63388ebb749SStefano Zampini     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
63488ebb749SStefano Zampini     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
63588ebb749SStefano Zampini     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
63688ebb749SStefano Zampini     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
63788ebb749SStefano Zampini     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
63888ebb749SStefano Zampini     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
63988ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
64088ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
64188ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
64288ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
64388ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
64488ebb749SStefano Zampini     }
64588ebb749SStefano Zampini     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
6468ce42a96SStefano Zampini     ierr = ISRestoreIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
64788ebb749SStefano Zampini     ierr = PetscFree(coarsefunctions_errors);CHKERRQ(ierr);
64888ebb749SStefano Zampini     ierr = PetscFree(constraints_errors);CHKERRQ(ierr);
64988ebb749SStefano Zampini   }
65088ebb749SStefano Zampini   /* free memory */
65188ebb749SStefano Zampini   if (n_vertices) {
65288ebb749SStefano Zampini     ierr = PetscFree(vertices);CHKERRQ(ierr);
65388ebb749SStefano Zampini     ierr = VecDestroy(&vec1_V);CHKERRQ(ierr);
65488ebb749SStefano Zampini     ierr = VecDestroy(&vec2_V);CHKERRQ(ierr);
65588ebb749SStefano Zampini     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
65688ebb749SStefano Zampini     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
65788ebb749SStefano Zampini     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
65888ebb749SStefano Zampini   }
65988ebb749SStefano Zampini   if (n_constraints) {
66088ebb749SStefano Zampini     ierr = VecDestroy(&vec1_C);CHKERRQ(ierr);
66188ebb749SStefano Zampini     ierr = VecDestroy(&vec2_C);CHKERRQ(ierr);
66288ebb749SStefano Zampini     ierr = MatDestroy(&M1);CHKERRQ(ierr);
66388ebb749SStefano Zampini     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
66488ebb749SStefano Zampini   }
66588ebb749SStefano Zampini   ierr = PetscFree(auxindices);CHKERRQ(ierr);
6668629588bSStefano Zampini   /* get back data */
6678629588bSStefano Zampini   *coarse_submat_vals_n = coarse_submat_vals;
66888ebb749SStefano Zampini   PetscFunctionReturn(0);
66988ebb749SStefano Zampini }
67088ebb749SStefano Zampini 
67188ebb749SStefano Zampini #undef __FUNCT__
672aa0d41d4SStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalMatrices"
673aa0d41d4SStefano Zampini PetscErrorCode PCBDDCSetUpLocalMatrices(PC pc)
674aa0d41d4SStefano Zampini {
675aa0d41d4SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
676aa0d41d4SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
677aa0d41d4SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
678aa0d41d4SStefano Zampini   /* manage repeated solves */
679aa0d41d4SStefano Zampini   MatReuse          reuse;
680aa0d41d4SStefano Zampini   MatStructure      matstruct;
681aa0d41d4SStefano Zampini   PetscErrorCode    ierr;
682aa0d41d4SStefano Zampini 
683aa0d41d4SStefano Zampini   PetscFunctionBegin;
684aa0d41d4SStefano Zampini   /* get mat flags */
685aa0d41d4SStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
686aa0d41d4SStefano Zampini   reuse = MAT_INITIAL_MATRIX;
687aa0d41d4SStefano Zampini   if (pc->setupcalled) {
688aa0d41d4SStefano Zampini     /* when matstruct is SAME_PRECONDITIONER, we shouldn't be here */
689aa0d41d4SStefano Zampini     if (matstruct == SAME_PRECONDITIONER) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen");
690aa0d41d4SStefano Zampini     if (matstruct == SAME_NONZERO_PATTERN) {
691aa0d41d4SStefano Zampini       reuse = MAT_REUSE_MATRIX;
692aa0d41d4SStefano Zampini     } else {
693aa0d41d4SStefano Zampini       reuse = MAT_INITIAL_MATRIX;
694aa0d41d4SStefano Zampini     }
695aa0d41d4SStefano Zampini   }
696aa0d41d4SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
697aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
698aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
699aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
700aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BB);CHKERRQ(ierr);
701aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
702aa0d41d4SStefano Zampini   }
703aa0d41d4SStefano Zampini 
704aa0d41d4SStefano Zampini   /* transform local matrices if needed */
705aa0d41d4SStefano Zampini   if (pcbddc->use_change_of_basis) {
706aa0d41d4SStefano Zampini     Mat         change_mat_all;
707aa0d41d4SStefano Zampini     PetscScalar *row_cmat_values;
708aa0d41d4SStefano Zampini     PetscInt    *row_cmat_indices;
709aa0d41d4SStefano Zampini     PetscInt    *nnz,*is_indices,*temp_indices;
710aa0d41d4SStefano Zampini     PetscInt    i,j,k,n_D,n_B;
711aa0d41d4SStefano Zampini 
712aa0d41d4SStefano Zampini     /* Get Non-overlapping dimensions */
713aa0d41d4SStefano Zampini     n_B = pcis->n_B;
714aa0d41d4SStefano Zampini     n_D = pcis->n-n_B;
715aa0d41d4SStefano Zampini 
716aa0d41d4SStefano Zampini     /* compute nonzero structure of change of basis on all local nodes */
717aa0d41d4SStefano Zampini     ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
718aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
719aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) nnz[is_indices[i]] = 1;
720aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
721aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
722aa0d41d4SStefano Zampini     k=1;
723aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
724aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
725aa0d41d4SStefano Zampini       nnz[is_indices[i]]=j;
726aa0d41d4SStefano Zampini       if (k < j) k = j;
727aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
728aa0d41d4SStefano Zampini     }
729aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
730aa0d41d4SStefano Zampini     /* assemble change of basis matrix on the whole set of local dofs */
731aa0d41d4SStefano Zampini     ierr = PetscMalloc(k*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
732aa0d41d4SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&change_mat_all);CHKERRQ(ierr);
733aa0d41d4SStefano Zampini     ierr = MatSetSizes(change_mat_all,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
734aa0d41d4SStefano Zampini     ierr = MatSetType(change_mat_all,MATSEQAIJ);CHKERRQ(ierr);
735aa0d41d4SStefano Zampini     ierr = MatSeqAIJSetPreallocation(change_mat_all,0,nnz);CHKERRQ(ierr);
736aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
737aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) {
738aa0d41d4SStefano Zampini       ierr = MatSetValue(change_mat_all,is_indices[i],is_indices[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
739aa0d41d4SStefano Zampini     }
740aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
741aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
742aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
743aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
744aa0d41d4SStefano Zampini       for (k=0; k<j; k++) temp_indices[k]=is_indices[row_cmat_indices[k]];
745aa0d41d4SStefano Zampini       ierr = MatSetValues(change_mat_all,1,&is_indices[i],j,temp_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
746aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
747aa0d41d4SStefano Zampini     }
748aa0d41d4SStefano Zampini     ierr = MatAssemblyBegin(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
749aa0d41d4SStefano Zampini     ierr = MatAssemblyEnd(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
750aa0d41d4SStefano Zampini     /* TODO: HOW TO WORK WITH BAIJ? PtAP not provided */
751aa0d41d4SStefano Zampini     ierr = MatGetBlockSize(matis->A,&i);CHKERRQ(ierr);
752aa0d41d4SStefano Zampini     if (i==1) {
753aa0d41d4SStefano Zampini       ierr = MatPtAP(matis->A,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
754aa0d41d4SStefano Zampini     } else {
755aa0d41d4SStefano Zampini       Mat work_mat;
756aa0d41d4SStefano Zampini       ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
757aa0d41d4SStefano Zampini       ierr = MatPtAP(work_mat,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
758aa0d41d4SStefano Zampini       ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
759aa0d41d4SStefano Zampini     }
760aa0d41d4SStefano Zampini     ierr = MatDestroy(&change_mat_all);CHKERRQ(ierr);
761aa0d41d4SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
762aa0d41d4SStefano Zampini     ierr = PetscFree(temp_indices);CHKERRQ(ierr);
763aa0d41d4SStefano Zampini   } else {
764aa0d41d4SStefano Zampini     /* without change of basis, the local matrix is unchanged */
765aa0d41d4SStefano Zampini     if (!pcbddc->local_mat) {
766aa0d41d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)matis->A);CHKERRQ(ierr);
767aa0d41d4SStefano Zampini       pcbddc->local_mat = matis->A;
768aa0d41d4SStefano Zampini     }
769aa0d41d4SStefano Zampini   }
770aa0d41d4SStefano Zampini 
771aa0d41d4SStefano Zampini   /* get submatrices */
772aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_I_local,reuse,&pcis->A_II);CHKERRQ(ierr);
773aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
774aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
775aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_B_local,reuse,&pcis->A_BB);CHKERRQ(ierr);
776aa0d41d4SStefano Zampini   PetscFunctionReturn(0);
777aa0d41d4SStefano Zampini }
778aa0d41d4SStefano Zampini 
779aa0d41d4SStefano Zampini #undef __FUNCT__
780a64d13efSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalScatters"
7818ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
782a64d13efSStefano Zampini {
783a64d13efSStefano Zampini   PC_IS*         pcis = (PC_IS*)(pc->data);
784a64d13efSStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
7858ce42a96SStefano Zampini   IS             is_aux1,is_aux2;
786a64d13efSStefano Zampini   PetscInt       *vertices,*aux_array1,*aux_array2,*is_indices,*idx_R_local;
787a64d13efSStefano Zampini   PetscInt       n_vertices,n_constraints,i,j,n_R,n_D,n_B;
7884641a718SStefano Zampini   PetscBT        bitmask;
789a64d13efSStefano Zampini   PetscErrorCode ierr;
790a64d13efSStefano Zampini 
791a64d13efSStefano Zampini   PetscFunctionBegin;
792a64d13efSStefano Zampini   /* Set Non-overlapping dimensions */
793a64d13efSStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
794a64d13efSStefano Zampini   /* get vertex indices from constraint matrix */
795a64d13efSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
796a64d13efSStefano Zampini   /* Set number of constraints */
797a64d13efSStefano Zampini   n_constraints = pcbddc->local_primal_size-n_vertices;
7984641a718SStefano Zampini   /* create auxiliary bitmask */
7994641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
8004641a718SStefano Zampini   for (i=0;i<n_vertices;i++) {
8014641a718SStefano Zampini     ierr = PetscBTSet(bitmask,vertices[i]);CHKERRQ(ierr);
8024641a718SStefano Zampini   }
803a64d13efSStefano Zampini   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
804a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n-n_vertices)*sizeof(PetscInt),&idx_R_local);CHKERRQ(ierr);
805a64d13efSStefano Zampini   for (i=0, n_R=0; i<pcis->n; i++) {
8064641a718SStefano Zampini     if (!PetscBTLookup(bitmask,i)) {
807a64d13efSStefano Zampini       idx_R_local[n_R] = i;
808a64d13efSStefano Zampini       n_R++;
809a64d13efSStefano Zampini     }
810a64d13efSStefano Zampini   }
811a64d13efSStefano Zampini   ierr = PetscFree(vertices);CHKERRQ(ierr);
8128ce42a96SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_R,idx_R_local,PETSC_OWN_POINTER,&pcbddc->is_R_local);CHKERRQ(ierr);
813a64d13efSStefano Zampini 
814a64d13efSStefano Zampini   /* print some info if requested */
815a64d13efSStefano Zampini   if (pcbddc->dbg_flag) {
816a64d13efSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
817a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
818a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
819a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
820a64d13efSStefano 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);
821a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr);
822a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
823a64d13efSStefano Zampini   }
824a64d13efSStefano Zampini 
825a64d13efSStefano Zampini   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
826a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
827a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array2);CHKERRQ(ierr);
828a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
8294641a718SStefano Zampini   for (i=0; i<n_D; i++) {
8304641a718SStefano Zampini     ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
8314641a718SStefano Zampini   }
832a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
833a64d13efSStefano Zampini   for (i=0, j=0; i<n_R; i++) {
8344641a718SStefano Zampini     if (!PetscBTLookup(bitmask,idx_R_local[i])) {
8354641a718SStefano Zampini       aux_array1[j++] = i;
836a64d13efSStefano Zampini     }
837a64d13efSStefano Zampini   }
838a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
839a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
840a64d13efSStefano Zampini   for (i=0, j=0; i<n_B; i++) {
8414641a718SStefano Zampini     if (!PetscBTLookup(bitmask,is_indices[i])) {
8424641a718SStefano Zampini       aux_array2[j++] = i;
843a64d13efSStefano Zampini     }
844a64d13efSStefano Zampini   }
845a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
846a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
847a64d13efSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
848a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
849a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
850a64d13efSStefano Zampini 
8518eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
852a64d13efSStefano Zampini     ierr = PetscMalloc(n_D*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
853a64d13efSStefano Zampini     for (i=0, j=0; i<n_R; i++) {
8544641a718SStefano Zampini       if (PetscBTLookup(bitmask,idx_R_local[i])) {
8554641a718SStefano Zampini         aux_array1[j++] = i;
856a64d13efSStefano Zampini       }
857a64d13efSStefano Zampini     }
858a64d13efSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
859a64d13efSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
860a64d13efSStefano Zampini     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
861a64d13efSStefano Zampini   }
8624641a718SStefano Zampini   ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
863a64d13efSStefano Zampini   PetscFunctionReturn(0);
864a64d13efSStefano Zampini }
865a64d13efSStefano Zampini 
866304d26faSStefano Zampini 
867304d26faSStefano Zampini #undef __FUNCT__
868304d26faSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
8698ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc)
870304d26faSStefano Zampini {
871304d26faSStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
872304d26faSStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
873304d26faSStefano Zampini   PC             pc_temp;
874304d26faSStefano Zampini   Mat            A_RR;
875304d26faSStefano Zampini   Vec            vec1,vec2,vec3;
876304d26faSStefano Zampini   MatStructure   matstruct;
877304d26faSStefano Zampini   PetscScalar    m_one = -1.0;
878304d26faSStefano Zampini   PetscReal      value;
879af732b37SStefano Zampini   PetscInt       n_D,n_R,ibs,mbs;
880b8ffe317SStefano Zampini   PetscBool      use_exact,use_exact_reduced;
881304d26faSStefano Zampini   PetscErrorCode ierr;
882e604994aSStefano Zampini   /* prefixes stuff */
883e604994aSStefano Zampini   char           dir_prefix[256],neu_prefix[256],str_level[3];
884e604994aSStefano Zampini   size_t         len;
885304d26faSStefano Zampini 
886304d26faSStefano Zampini   PetscFunctionBegin;
887304d26faSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
888304d26faSStefano Zampini 
889e604994aSStefano Zampini   /* compute prefixes */
890e604994aSStefano Zampini   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
891e604994aSStefano Zampini   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
892e604994aSStefano Zampini   if (!pcbddc->current_level) {
893e604994aSStefano Zampini     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
894e604994aSStefano Zampini     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
895e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
896e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
897e604994aSStefano Zampini   } else {
898e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
899e604994aSStefano Zampini     sprintf(str_level,"%d_",(int)(pcbddc->current_level));
900e604994aSStefano Zampini     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
901e604994aSStefano Zampini     len -= 15; /* remove "pc_bddc_coarse_" */
902e604994aSStefano Zampini     if (pcbddc->current_level>1) len -= 2; /* remove "X_" with X level number (works with 9 levels max) */
903e604994aSStefano Zampini     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
904e604994aSStefano Zampini     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
905e604994aSStefano Zampini     *(dir_prefix+len)='\0';
906e604994aSStefano Zampini     *(neu_prefix+len)='\0';
907e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
908e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
909e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
910e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
911e604994aSStefano Zampini   }
912e604994aSStefano Zampini 
913304d26faSStefano Zampini   /* DIRICHLET PROBLEM */
914ac78edfcSStefano Zampini   /* Matrix for Dirichlet problem is pcis->A_II */
9158ce42a96SStefano Zampini   ierr = ISGetSize(pcis->is_I_local,&n_D);CHKERRQ(ierr);
916304d26faSStefano Zampini   if (!pcbddc->ksp_D) { /* create object if not yet build */
917304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
918304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
919304d26faSStefano Zampini     /* default */
920304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
921e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
922304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
923304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
924304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
925304d26faSStefano Zampini   }
926304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II,matstruct);CHKERRQ(ierr);
927304d26faSStefano Zampini   /* Allow user's customization */
928304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
929304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
930304d26faSStefano Zampini   if (!n_D) {
931304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
932304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
933304d26faSStefano Zampini   }
934304d26faSStefano Zampini   /* Set Up KSP for Dirichlet problem of BDDC */
935304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
936304d26faSStefano Zampini   /* set ksp_D into pcis data */
937304d26faSStefano Zampini   ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
938304d26faSStefano Zampini   ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
939304d26faSStefano Zampini   pcis->ksp_D = pcbddc->ksp_D;
940304d26faSStefano Zampini 
941304d26faSStefano Zampini   /* NEUMANN PROBLEM */
942304d26faSStefano Zampini   /* Matrix for Neumann problem is A_RR -> we need to create it */
9438ce42a96SStefano Zampini   ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
944af732b37SStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
945af732b37SStefano Zampini   ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
946af732b37SStefano Zampini   if (ibs != mbs) { /* TODO BAIJ: see if this can be avoided */
947af732b37SStefano Zampini     Mat newmat;
948af732b37SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
949af732b37SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
950af732b37SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
951af732b37SStefano Zampini   } else {
9528ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
953af732b37SStefano Zampini   }
954304d26faSStefano Zampini   if (!pcbddc->ksp_R) { /* create object if not yet build */
955304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
956304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
957304d26faSStefano Zampini     /* default */
958304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
959e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
960304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
961304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
962304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
963304d26faSStefano Zampini   }
964304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR,matstruct);CHKERRQ(ierr);
965304d26faSStefano Zampini   /* Allow user's customization */
966304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
967304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
968304d26faSStefano Zampini   if (!n_R) {
969304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
970304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
971304d26faSStefano Zampini   }
972304d26faSStefano Zampini   /* Set Up KSP for Neumann problem of BDDC */
973304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
974304d26faSStefano Zampini 
975304d26faSStefano Zampini   /* check Dirichlet and Neumann solvers and adapt them if a nullspace correction is needed */
976304d26faSStefano Zampini 
977304d26faSStefano Zampini   /* Dirichlet */
978304d26faSStefano Zampini   ierr = MatGetVecs(pcis->A_II,&vec1,&vec2);CHKERRQ(ierr);
979304d26faSStefano Zampini   ierr = VecDuplicate(vec1,&vec3);CHKERRQ(ierr);
980304d26faSStefano Zampini   ierr = VecSetRandom(vec1,NULL);CHKERRQ(ierr);
981304d26faSStefano Zampini   ierr = MatMult(pcis->A_II,vec1,vec2);CHKERRQ(ierr);
982304d26faSStefano Zampini   ierr = KSPSolve(pcbddc->ksp_D,vec2,vec3);CHKERRQ(ierr);
983304d26faSStefano Zampini   ierr = VecAXPY(vec3,m_one,vec1);CHKERRQ(ierr);
984304d26faSStefano Zampini   ierr = VecNorm(vec3,NORM_INFINITY,&value);CHKERRQ(ierr);
985304d26faSStefano Zampini   ierr = VecDestroy(&vec1);CHKERRQ(ierr);
986304d26faSStefano Zampini   ierr = VecDestroy(&vec2);CHKERRQ(ierr);
987304d26faSStefano Zampini   ierr = VecDestroy(&vec3);CHKERRQ(ierr);
988304d26faSStefano Zampini   /* need to be adapted? */
989b8ffe317SStefano Zampini   use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
990b8ffe317SStefano Zampini   ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
991b8ffe317SStefano Zampini   ierr = PCBDDCSetUseExactDirichlet(pc,use_exact_reduced);CHKERRQ(ierr);
992304d26faSStefano Zampini   /* print info */
993304d26faSStefano Zampini   if (pcbddc->dbg_flag) {
994304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
995304d26faSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
996304d26faSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Checking solution of Dirichlet and Neumann problems\n");CHKERRQ(ierr);
997e604994aSStefano 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);
998304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
999304d26faSStefano Zampini   }
1000b8ffe317SStefano Zampini   if (pcbddc->NullSpace && !use_exact_reduced && !pcbddc->switch_static) {
10018ce42a96SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcis->is_I_local);CHKERRQ(ierr);
1002304d26faSStefano Zampini   }
1003304d26faSStefano Zampini 
1004304d26faSStefano Zampini   /* Neumann */
1005304d26faSStefano Zampini   ierr = MatGetVecs(A_RR,&vec1,&vec2);CHKERRQ(ierr);
1006304d26faSStefano Zampini   ierr = VecDuplicate(vec1,&vec3);CHKERRQ(ierr);
1007304d26faSStefano Zampini   ierr = VecSetRandom(vec1,NULL);CHKERRQ(ierr);
1008304d26faSStefano Zampini   ierr = MatMult(A_RR,vec1,vec2);CHKERRQ(ierr);
1009304d26faSStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,vec2,vec3);CHKERRQ(ierr);
1010304d26faSStefano Zampini   ierr = VecAXPY(vec3,m_one,vec1);CHKERRQ(ierr);
1011304d26faSStefano Zampini   ierr = VecNorm(vec3,NORM_INFINITY,&value);CHKERRQ(ierr);
1012304d26faSStefano Zampini   ierr = VecDestroy(&vec1);CHKERRQ(ierr);
1013304d26faSStefano Zampini   ierr = VecDestroy(&vec2);CHKERRQ(ierr);
1014304d26faSStefano Zampini   ierr = VecDestroy(&vec3);CHKERRQ(ierr);
1015304d26faSStefano Zampini   /* need to be adapted? */
1016b8ffe317SStefano Zampini   use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1017b8ffe317SStefano Zampini   ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1018304d26faSStefano Zampini   /* print info */
1019304d26faSStefano Zampini   if (pcbddc->dbg_flag) {
1020e604994aSStefano 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);
1021304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1022304d26faSStefano Zampini   }
1023b8ffe317SStefano Zampini   if (pcbddc->NullSpace && !use_exact_reduced) { /* is it the right logic? */
10248ce42a96SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcbddc->is_R_local);CHKERRQ(ierr);
1025304d26faSStefano Zampini   }
1026304d26faSStefano Zampini   /* free Neumann problem's matrix */
1027304d26faSStefano Zampini   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1028304d26faSStefano Zampini   PetscFunctionReturn(0);
1029304d26faSStefano Zampini }
1030304d26faSStefano Zampini 
1031304d26faSStefano Zampini #undef __FUNCT__
1032674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSolveSaddlePoint"
1033674ae819SStefano Zampini static PetscErrorCode  PCBDDCSolveSaddlePoint(PC pc)
1034674ae819SStefano Zampini {
1035674ae819SStefano Zampini   PetscErrorCode ierr;
1036674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1037674ae819SStefano Zampini 
1038674ae819SStefano Zampini   PetscFunctionBegin;
1039674ae819SStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
1040674ae819SStefano Zampini   if (pcbddc->local_auxmat1) {
1041674ae819SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec2_R,pcbddc->vec1_C);CHKERRQ(ierr);
1042674ae819SStefano Zampini     ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
1043674ae819SStefano Zampini   }
1044674ae819SStefano Zampini   PetscFunctionReturn(0);
1045674ae819SStefano Zampini }
1046674ae819SStefano Zampini 
1047674ae819SStefano Zampini #undef __FUNCT__
1048674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
1049674ae819SStefano Zampini PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc)
1050674ae819SStefano Zampini {
1051674ae819SStefano Zampini   PetscErrorCode ierr;
1052674ae819SStefano Zampini   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
1053674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)  (pc->data);
1054674ae819SStefano Zampini   const PetscScalar zero = 0.0;
1055674ae819SStefano Zampini 
1056674ae819SStefano Zampini   PetscFunctionBegin;
105715aaf578SStefano Zampini   /* Application of PHI^T (or PSI^T)  */
105815aaf578SStefano Zampini   if (pcbddc->coarse_psi_B) {
105915aaf578SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
10608eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
106115aaf578SStefano Zampini   } else {
1062674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
10638eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
106415aaf578SStefano Zampini   }
1065674ae819SStefano Zampini   /* Scatter data of coarse_rhs */
1066674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { ierr = VecSet(pcbddc->coarse_rhs,zero);CHKERRQ(ierr); }
1067674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1068674ae819SStefano Zampini 
1069674ae819SStefano Zampini   /* Local solution on R nodes */
1070674ae819SStefano Zampini   ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
1071674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1072674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
10738eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1074674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1075674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1076674ae819SStefano Zampini   }
1077674ae819SStefano Zampini   ierr = PCBDDCSolveSaddlePoint(pc);CHKERRQ(ierr);
1078674ae819SStefano Zampini   ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1079674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1080674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
10818eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1082674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1083674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1084674ae819SStefano Zampini   }
1085674ae819SStefano Zampini 
1086674ae819SStefano Zampini   /* Coarse solution */
1087674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1088674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { /* TODO remove null space when doing multilevel */
1089674ae819SStefano Zampini     ierr = KSPSolve(pcbddc->coarse_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
1090674ae819SStefano Zampini   }
1091674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1092674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd  (pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1093674ae819SStefano Zampini 
1094674ae819SStefano Zampini   /* Sum contributions from two levels */
1095674ae819SStefano Zampini   ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
10968eeda7d8SStefano Zampini   if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1097674ae819SStefano Zampini   PetscFunctionReturn(0);
1098674ae819SStefano Zampini }
1099674ae819SStefano Zampini 
1100674ae819SStefano Zampini #undef __FUNCT__
1101674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
1102674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1103674ae819SStefano Zampini {
1104674ae819SStefano Zampini   PetscErrorCode ierr;
1105674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1106674ae819SStefano Zampini 
1107674ae819SStefano Zampini   PetscFunctionBegin;
1108674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1109674ae819SStefano Zampini   PetscFunctionReturn(0);
1110674ae819SStefano Zampini }
1111674ae819SStefano Zampini 
1112674ae819SStefano Zampini #undef __FUNCT__
1113674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
1114674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1115674ae819SStefano Zampini {
1116674ae819SStefano Zampini   PetscErrorCode ierr;
1117674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1118674ae819SStefano Zampini 
1119674ae819SStefano Zampini   PetscFunctionBegin;
1120674ae819SStefano Zampini   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1121674ae819SStefano Zampini   PetscFunctionReturn(0);
1122674ae819SStefano Zampini }
1123674ae819SStefano Zampini 
1124984c4197SStefano Zampini /* uncomment for testing purposes */
1125984c4197SStefano Zampini /* #define PETSC_MISSING_LAPACK_GESVD 1 */
1126674ae819SStefano Zampini #undef __FUNCT__
1127674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp"
1128674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
1129674ae819SStefano Zampini {
1130674ae819SStefano Zampini   PetscErrorCode    ierr;
1131674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
1132674ae819SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
1133674ae819SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
1134984c4197SStefano Zampini   /* constraint and (optionally) change of basis matrix implemented as SeqAIJ */
1135674ae819SStefano Zampini   MatType           impMatType=MATSEQAIJ;
1136984c4197SStefano Zampini   /* one and zero */
1137984c4197SStefano Zampini   PetscScalar       one=1.0,zero=0.0;
1138984c4197SStefano Zampini   /* space to store constraints and their local indices */
1139984c4197SStefano Zampini   PetscScalar       *temp_quadrature_constraint;
1140984c4197SStefano Zampini   PetscInt          *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B;
1141984c4197SStefano Zampini   /* iterators */
1142984c4197SStefano Zampini   PetscInt          i,j,k,total_counts,temp_start_ptr;
1143984c4197SStefano Zampini   /* stuff to store connected components stored in pcbddc->mat_graph */
1144984c4197SStefano Zampini   IS                ISForVertices,*ISForFaces,*ISForEdges,*used_IS;
1145984c4197SStefano Zampini   PetscInt          n_ISForFaces,n_ISForEdges;
1146984c4197SStefano Zampini   /* near null space stuff */
1147674ae819SStefano Zampini   MatNullSpace      nearnullsp;
1148674ae819SStefano Zampini   const Vec         *nearnullvecs;
1149674ae819SStefano Zampini   Vec               *localnearnullsp;
1150984c4197SStefano Zampini   PetscBool         nnsp_has_cnst;
1151984c4197SStefano Zampini   PetscInt          nnsp_size;
1152984c4197SStefano Zampini   PetscScalar       *array;
1153984c4197SStefano Zampini   /* BLAS integers */
1154e310c8b4SStefano Zampini   PetscBLASInt      lwork,lierr;
1155e310c8b4SStefano Zampini   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
1156c4303822SStefano Zampini   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
1157984c4197SStefano Zampini   /* LAPACK working arrays for SVD or POD */
1158242a89d7SStefano Zampini   PetscBool         skip_lapack;
1159984c4197SStefano Zampini   PetscScalar       *work;
1160984c4197SStefano Zampini   PetscReal         *singular_vals;
1161984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1162984c4197SStefano Zampini   PetscReal         *rwork;
1163674ae819SStefano Zampini #endif
1164984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1165e310c8b4SStefano Zampini   PetscBLASInt      Blas_one_2=1;
1166984c4197SStefano Zampini   PetscScalar       *temp_basis,*correlation_mat;
1167b7d8b9f8SStefano Zampini #else
1168b7d8b9f8SStefano Zampini   PetscBLASInt      dummy_int_1=1,dummy_int_2=1;
1169b7d8b9f8SStefano Zampini   PetscScalar       dummy_scalar_1=0.0,dummy_scalar_2=0.0;
1170984c4197SStefano Zampini #endif
1171984c4197SStefano Zampini   /* change of basis */
1172984c4197SStefano Zampini   PetscInt          *aux_primal_numbering,*aux_primal_minloc,*global_indices;
1173*a717540cSStefano Zampini   PetscBool         boolforchange,qr_needed;
1174*a717540cSStefano Zampini   PetscBT           touched,change_basis,qr_needed_idx;
1175984c4197SStefano Zampini   /* auxiliary stuff */
1176984c4197SStefano Zampini   PetscInt          *nnz,*is_indices,*local_to_B;
1177984c4197SStefano Zampini   /* some quantities */
1178984c4197SStefano Zampini   PetscInt          n_vertices,total_primal_vertices;
1179984c4197SStefano Zampini   PetscInt          size_of_constraint,max_size_of_constraint,max_constraints,temp_constraints;
1180984c4197SStefano Zampini 
1181674ae819SStefano Zampini 
1182674ae819SStefano Zampini   PetscFunctionBegin;
1183674ae819SStefano Zampini   /* Get index sets for faces, edges and vertices from graph */
11848eeda7d8SStefano Zampini   if (!pcbddc->use_faces && !pcbddc->use_edges && !pcbddc->use_vertices) {
11858eeda7d8SStefano Zampini     pcbddc->use_vertices = PETSC_TRUE;
1186674ae819SStefano Zampini   }
11878eeda7d8SStefano Zampini   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,pcbddc->use_faces,pcbddc->use_edges,pcbddc->use_vertices,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);
1188b8ffe317SStefano Zampini   /* HACK: provide functions to set change of basis */
1189b8ffe317SStefano Zampini   if (!ISForVertices && pcbddc->NullSpace) {
1190b8ffe317SStefano Zampini     pcbddc->use_change_of_basis = PETSC_TRUE;
1191b8ffe317SStefano Zampini     pcbddc->use_change_on_faces = PETSC_FALSE;
1192b8ffe317SStefano Zampini   }
1193984c4197SStefano Zampini   /* print some info */
1194674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
1195674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1196674ae819SStefano Zampini     i = 0;
1197674ae819SStefano Zampini     if (ISForVertices) {
1198674ae819SStefano Zampini       ierr = ISGetSize(ISForVertices,&i);CHKERRQ(ierr);
1199674ae819SStefano Zampini     }
1200674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices\n",PetscGlobalRank,i);CHKERRQ(ierr);
1201674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges\n",PetscGlobalRank,n_ISForEdges);CHKERRQ(ierr);
120215aaf578SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces\n",PetscGlobalRank,n_ISForFaces);CHKERRQ(ierr);
1203674ae819SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1204674ae819SStefano Zampini   }
1205674ae819SStefano Zampini   /* check if near null space is attached to global mat */
1206674ae819SStefano Zampini   ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
1207674ae819SStefano Zampini   if (nearnullsp) {
1208674ae819SStefano Zampini     ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
1209984c4197SStefano Zampini   } else { /* if near null space is not provided BDDC uses constants by default */
1210984c4197SStefano Zampini     nnsp_size = 0;
1211674ae819SStefano Zampini     nnsp_has_cnst = PETSC_TRUE;
1212674ae819SStefano Zampini   }
1213984c4197SStefano Zampini   /* get max number of constraints on a single cc */
1214984c4197SStefano Zampini   max_constraints = nnsp_size;
1215984c4197SStefano Zampini   if (nnsp_has_cnst) max_constraints++;
1216984c4197SStefano Zampini 
1217674ae819SStefano Zampini   /*
1218674ae819SStefano Zampini        Evaluate maximum storage size needed by the procedure
1219674ae819SStefano Zampini        - temp_indices will contain start index of each constraint stored as follows
1220674ae819SStefano 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
1221674ae819SStefano 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
1222674ae819SStefano Zampini        - temp_quadrature_constraint  [temp_indices[i],...,temp[indices[i+1]-1] will contain the scalars representing the constraint itself
1223674ae819SStefano Zampini                                                                                                                                                          */
1224674ae819SStefano Zampini   total_counts = n_ISForFaces+n_ISForEdges;
1225984c4197SStefano Zampini   total_counts *= max_constraints;
1226674ae819SStefano Zampini   n_vertices = 0;
1227674ae819SStefano Zampini   if (ISForVertices) {
1228674ae819SStefano Zampini     ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
1229674ae819SStefano Zampini   }
1230674ae819SStefano Zampini   total_counts += n_vertices;
1231674ae819SStefano Zampini   ierr = PetscMalloc((total_counts+1)*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
12324641a718SStefano Zampini   ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
1233674ae819SStefano Zampini   total_counts = 0;
1234674ae819SStefano Zampini   max_size_of_constraint = 0;
1235674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1236674ae819SStefano Zampini     if (i<n_ISForEdges) {
1237674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1238674ae819SStefano Zampini     } else {
1239674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1240674ae819SStefano Zampini     }
1241674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
1242674ae819SStefano Zampini     total_counts += j;
1243674ae819SStefano Zampini     max_size_of_constraint = PetscMax(j,max_size_of_constraint);
1244674ae819SStefano Zampini   }
1245984c4197SStefano Zampini   total_counts *= max_constraints;
1246674ae819SStefano Zampini   total_counts += n_vertices;
1247674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&temp_quadrature_constraint);CHKERRQ(ierr);
1248674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint);CHKERRQ(ierr);
1249674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint_B);CHKERRQ(ierr);
1250984c4197SStefano Zampini   /* local to boundary numbering */
1251674ae819SStefano Zampini   ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&local_to_B);CHKERRQ(ierr);
1252674ae819SStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1253984c4197SStefano Zampini   for (i=0;i<pcis->n;i++) local_to_B[i]=-1;
1254984c4197SStefano Zampini   for (i=0;i<pcis->n_B;i++) local_to_B[is_indices[i]]=i;
1255674ae819SStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1256984c4197SStefano Zampini   /* get local part of global near null space vectors */
1257984c4197SStefano Zampini   ierr = PetscMalloc(nnsp_size*sizeof(Vec),&localnearnullsp);CHKERRQ(ierr);
1258984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1259984c4197SStefano Zampini     ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
1260984c4197SStefano Zampini     ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1261984c4197SStefano Zampini     ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1262984c4197SStefano Zampini   }
1263674ae819SStefano Zampini 
1264242a89d7SStefano Zampini   /* whether or not to skip lapack calls */
1265242a89d7SStefano Zampini   skip_lapack = PETSC_TRUE;
1266242a89d7SStefano Zampini   if (n_ISForFaces+n_ISForEdges) skip_lapack = PETSC_FALSE;
1267242a89d7SStefano Zampini 
1268984c4197SStefano Zampini   /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
1269242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1270674ae819SStefano Zampini     PetscScalar temp_work;
1271674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1272984c4197SStefano Zampini     /* Proper Orthogonal Decomposition (POD) using the snapshot method */
1273984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*max_constraints*sizeof(PetscScalar),&correlation_mat);CHKERRQ(ierr);
1274984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1275984c4197SStefano Zampini     ierr = PetscMalloc(max_size_of_constraint*max_constraints*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr);
1276674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1277984c4197SStefano Zampini     ierr = PetscMalloc(3*max_constraints*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1278674ae819SStefano Zampini #endif
1279674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1280c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
1281c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
1282674ae819SStefano Zampini     lwork = -1;
1283674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1284674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1285c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
1286674ae819SStefano Zampini #else
1287c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
1288674ae819SStefano Zampini #endif
1289674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1290984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
1291674ae819SStefano Zampini #else /* on missing GESVD */
1292674ae819SStefano Zampini     /* SVD */
1293674ae819SStefano Zampini     PetscInt max_n,min_n;
1294674ae819SStefano Zampini     max_n = max_size_of_constraint;
1295984c4197SStefano Zampini     min_n = max_constraints;
1296984c4197SStefano Zampini     if (max_size_of_constraint < max_constraints) {
1297674ae819SStefano Zampini       min_n = max_size_of_constraint;
1298984c4197SStefano Zampini       max_n = max_constraints;
1299674ae819SStefano Zampini     }
1300674ae819SStefano Zampini     ierr = PetscMalloc(min_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1301674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1302674ae819SStefano Zampini     ierr = PetscMalloc(5*min_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1303674ae819SStefano Zampini #endif
1304674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1305674ae819SStefano Zampini     lwork = -1;
1306e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
1307e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
1308b7d8b9f8SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
1309674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1310674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1311e310c8b4SStefano 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));
1312674ae819SStefano Zampini #else
1313e310c8b4SStefano 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));
1314674ae819SStefano Zampini #endif
1315674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1316984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
1317984c4197SStefano Zampini #endif /* on missing GESVD */
1318674ae819SStefano Zampini     /* Allocate optimal workspace */
1319674ae819SStefano Zampini     ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
1320984c4197SStefano Zampini     ierr = PetscMalloc((PetscInt)lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
1321674ae819SStefano Zampini   }
1322674ae819SStefano Zampini   /* Now we can loop on constraining sets */
1323674ae819SStefano Zampini   total_counts = 0;
1324674ae819SStefano Zampini   temp_indices[0] = 0;
1325674ae819SStefano Zampini   /* vertices */
1326674ae819SStefano Zampini   if (ISForVertices) {
1327674ae819SStefano Zampini     ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1328674ae819SStefano Zampini     if (nnsp_has_cnst) { /* consider all vertices */
1329674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1330674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1331674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
1332674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1333674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1334674ae819SStefano Zampini         total_counts++;
1335674ae819SStefano Zampini       }
1336674ae819SStefano Zampini     } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
1337984c4197SStefano Zampini       PetscBool used_vertex;
1338674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1339674ae819SStefano Zampini         used_vertex = PETSC_FALSE;
1340674ae819SStefano Zampini         k = 0;
1341674ae819SStefano Zampini         while (!used_vertex && k<nnsp_size) {
1342984c4197SStefano Zampini           ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1343984c4197SStefano Zampini           if (PetscAbsScalar(array[is_indices[i]])>0.0) {
1344674ae819SStefano Zampini             temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1345674ae819SStefano Zampini             temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
1346674ae819SStefano Zampini             temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1347674ae819SStefano Zampini             temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1348674ae819SStefano Zampini             total_counts++;
1349674ae819SStefano Zampini             used_vertex = PETSC_TRUE;
1350674ae819SStefano Zampini           }
1351984c4197SStefano Zampini           ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1352674ae819SStefano Zampini           k++;
1353674ae819SStefano Zampini         }
1354674ae819SStefano Zampini       }
1355674ae819SStefano Zampini     }
1356674ae819SStefano Zampini     ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1357674ae819SStefano Zampini     n_vertices = total_counts;
1358674ae819SStefano Zampini   }
1359984c4197SStefano Zampini 
1360674ae819SStefano Zampini   /* edges and faces */
1361674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1362674ae819SStefano Zampini     if (i<n_ISForEdges) {
1363674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1364984c4197SStefano Zampini       boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
1365674ae819SStefano Zampini     } else {
1366674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1367984c4197SStefano Zampini       boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
1368674ae819SStefano Zampini     }
1369674ae819SStefano Zampini     temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
1370674ae819SStefano Zampini     temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
1371674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
1372674ae819SStefano Zampini     ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1373984c4197SStefano Zampini     /* change of basis should not be performed on local periodic nodes */
1374984c4197SStefano Zampini     if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
1375674ae819SStefano Zampini     if (nnsp_has_cnst) {
13765b08dc53SStefano Zampini       PetscScalar quad_value;
1377674ae819SStefano Zampini       temp_constraints++;
1378674ae819SStefano Zampini       quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
1379674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1380674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
1381674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
1382674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
1383674ae819SStefano Zampini       }
1384674ae819SStefano Zampini       temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
13854641a718SStefano Zampini       if (boolforchange) {
13864641a718SStefano Zampini         ierr = PetscBTSet(change_basis,total_counts);CHKERRQ(ierr);
13874641a718SStefano Zampini       }
1388674ae819SStefano Zampini       total_counts++;
1389674ae819SStefano Zampini     }
1390674ae819SStefano Zampini     for (k=0;k<nnsp_size;k++) {
1391984c4197SStefano Zampini       PetscReal real_value;
1392984c4197SStefano Zampini       ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1393674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1394674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
1395674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
1396984c4197SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=array[is_indices[j]];
1397674ae819SStefano Zampini       }
1398984c4197SStefano Zampini       ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1399984c4197SStefano Zampini       /* check if array is null on the connected component */
1400e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1401e310c8b4SStefano Zampini       PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_one));
14025b08dc53SStefano Zampini       if (real_value > 0.0) { /* keep indices and values */
1403674ae819SStefano Zampini         temp_constraints++;
1404674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
14054641a718SStefano Zampini         if (boolforchange) {
14064641a718SStefano Zampini           ierr = PetscBTSet(change_basis,total_counts);CHKERRQ(ierr);
14074641a718SStefano Zampini         }
1408674ae819SStefano Zampini         total_counts++;
1409674ae819SStefano Zampini       }
1410674ae819SStefano Zampini     }
1411674ae819SStefano Zampini     ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1412984c4197SStefano Zampini     /* perform SVD on the constraints if use_nnsp_true has not be requested by the user */
1413984c4197SStefano Zampini     if (!pcbddc->use_nnsp_true) {
1414984c4197SStefano Zampini       PetscReal tol = 1.0e-8; /* tolerance for retaining eigenmodes */
1415674ae819SStefano Zampini 
1416674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1417984c4197SStefano Zampini       /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
1418984c4197SStefano Zampini          POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
1419984c4197SStefano Zampini          -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
1420984c4197SStefano Zampini             the constraints basis will differ (by a complex factor with absolute value equal to 1)
1421984c4197SStefano Zampini             from that computed using LAPACKgesvd
1422984c4197SStefano Zampini          -> This is due to a different computation of eigenvectors in LAPACKheev
1423984c4197SStefano Zampini          -> The quality of the POD-computed basis will be the same */
1424984c4197SStefano Zampini       ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
1425674ae819SStefano Zampini       /* Store upper triangular part of correlation matrix */
1426e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1427984c4197SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1428674ae819SStefano Zampini       for (j=0;j<temp_constraints;j++) {
1429674ae819SStefano Zampini         for (k=0;k<j+1;k++) {
1430e310c8b4SStefano 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));
1431674ae819SStefano Zampini         }
1432674ae819SStefano Zampini       }
1433e310c8b4SStefano Zampini       /* compute eigenvalues and eigenvectors of correlation matrix */
1434e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1435e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
1436674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1437c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
1438674ae819SStefano Zampini #else
1439c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
1440674ae819SStefano Zampini #endif
1441674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1442984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
1443984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
1444674ae819SStefano Zampini       j=0;
1445984c4197SStefano Zampini       while (j < temp_constraints && singular_vals[j] < tol) j++;
1446674ae819SStefano Zampini       total_counts=total_counts-j;
1447e310c8b4SStefano Zampini       /* scale and copy POD basis into used quadrature memory */
1448c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1449c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1450c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
1451c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1452c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
1453c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1454674ae819SStefano Zampini       if (j<temp_constraints) {
1455984c4197SStefano Zampini         PetscInt ii;
1456984c4197SStefano Zampini         for (k=j;k<temp_constraints;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]);
1457674ae819SStefano Zampini         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1458c4303822SStefano 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));
1459674ae819SStefano Zampini         ierr = PetscFPTrapPop();CHKERRQ(ierr);
1460984c4197SStefano Zampini         for (k=0;k<temp_constraints-j;k++) {
1461674ae819SStefano Zampini           for (ii=0;ii<size_of_constraint;ii++) {
1462984c4197SStefano 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];
1463674ae819SStefano Zampini           }
1464674ae819SStefano Zampini         }
1465674ae819SStefano Zampini       }
1466674ae819SStefano Zampini #else  /* on missing GESVD */
1467e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1468e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1469b7d8b9f8SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1470674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1471674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1472e310c8b4SStefano 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));
1473674ae819SStefano Zampini #else
1474e310c8b4SStefano 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));
1475674ae819SStefano Zampini #endif
1476984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
1477674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1478984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
1479e310c8b4SStefano Zampini       k = temp_constraints;
1480e310c8b4SStefano Zampini       if (k > size_of_constraint) k = size_of_constraint;
1481674ae819SStefano Zampini       j = 0;
1482e310c8b4SStefano Zampini       while (j < k && singular_vals[k-j-1] < tol) j++;
1483e310c8b4SStefano Zampini       total_counts = total_counts-temp_constraints+k-j;
1484984c4197SStefano Zampini #endif /* on missing GESVD */
1485674ae819SStefano Zampini     }
1486674ae819SStefano Zampini   }
1487674ae819SStefano Zampini   /* free index sets of faces, edges and vertices */
1488674ae819SStefano Zampini   for (i=0;i<n_ISForFaces;i++) {
1489674ae819SStefano Zampini     ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
1490674ae819SStefano Zampini   }
1491674ae819SStefano Zampini   ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
1492674ae819SStefano Zampini   for (i=0;i<n_ISForEdges;i++) {
1493674ae819SStefano Zampini     ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
1494674ae819SStefano Zampini   }
1495674ae819SStefano Zampini   ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
1496674ae819SStefano Zampini   ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
1497674ae819SStefano Zampini 
1498984c4197SStefano Zampini   /* free workspace */
1499242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1500984c4197SStefano Zampini     ierr = PetscFree(work);CHKERRQ(ierr);
1501984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1502984c4197SStefano Zampini     ierr = PetscFree(rwork);CHKERRQ(ierr);
1503984c4197SStefano Zampini #endif
1504984c4197SStefano Zampini     ierr = PetscFree(singular_vals);CHKERRQ(ierr);
1505984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1506984c4197SStefano Zampini     ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
1507984c4197SStefano Zampini     ierr = PetscFree(temp_basis);CHKERRQ(ierr);
1508984c4197SStefano Zampini #endif
1509984c4197SStefano Zampini   }
1510984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1511984c4197SStefano Zampini     ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
1512984c4197SStefano Zampini   }
1513984c4197SStefano Zampini   ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
1514984c4197SStefano Zampini 
1515674ae819SStefano Zampini   /* set quantities in pcbddc data structure */
1516984c4197SStefano Zampini   /* n_vertices defines the number of subdomain corners in the primal space */
1517674ae819SStefano Zampini   /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */
1518984c4197SStefano Zampini   pcbddc->local_primal_size = total_counts;
1519674ae819SStefano Zampini   pcbddc->n_vertices = n_vertices;
1520984c4197SStefano Zampini   pcbddc->n_constraints = pcbddc->local_primal_size-pcbddc->n_vertices;
1521674ae819SStefano Zampini 
1522674ae819SStefano Zampini   /* Create constraint matrix */
1523674ae819SStefano Zampini   /* The constraint matrix is used to compute the l2g map of primal dofs */
1524674ae819SStefano Zampini   /* so we need to set it up properly either with or without change of basis */
1525674ae819SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1526674ae819SStefano Zampini   ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr);
1527984c4197SStefano Zampini   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
1528984c4197SStefano Zampini   /* array to compute a local numbering of constraints : vertices first then constraints */
1529984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_numbering);CHKERRQ(ierr);
1530984c4197SStefano Zampini   /* array to select the proper local node (of minimum index with respect to global ordering) when changing the basis */
1531984c4197SStefano 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 */
1532984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_minloc);CHKERRQ(ierr);
1533984c4197SStefano Zampini   /* auxiliary stuff for basis change */
1534984c4197SStefano Zampini   ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&global_indices);CHKERRQ(ierr);
15354641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n_B,&touched);CHKERRQ(ierr);
1536984c4197SStefano Zampini 
1537984c4197SStefano Zampini   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
1538984c4197SStefano Zampini   total_primal_vertices=0;
1539984c4197SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
1540674ae819SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
1541984c4197SStefano Zampini     if (size_of_constraint == 1) {
15424641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]]);CHKERRQ(ierr);
1543984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]];
1544984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=0;
1545984c4197SStefano Zampini       total_primal_vertices++;
15464641a718SStefano Zampini     } else if (PetscBTLookup(change_basis,i)) { /* Same procedure used in PCBDDCGetPrimalConstraintsLocalIdx */
1547984c4197SStefano Zampini       PetscInt min_loc,min_index;
1548984c4197SStefano Zampini       ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],global_indices);CHKERRQ(ierr);
1549984c4197SStefano Zampini       /* find first untouched local node */
1550674ae819SStefano Zampini       k = 0;
15514641a718SStefano Zampini       while (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) k++;
1552984c4197SStefano Zampini       min_index = global_indices[k];
1553984c4197SStefano Zampini       min_loc = k;
1554984c4197SStefano Zampini       /* search the minimum among global nodes already untouched on the cc */
1555984c4197SStefano Zampini       for (k=1;k<size_of_constraint;k++) {
1556984c4197SStefano Zampini         /* there can be more than one constraint on a single connected component */
15574641a718SStefano Zampini         if (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k]) && min_index > global_indices[k]) {
1558984c4197SStefano Zampini           min_index = global_indices[k];
1559984c4197SStefano Zampini           min_loc = k;
1560674ae819SStefano Zampini         }
1561674ae819SStefano Zampini       }
15624641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]+min_loc]);CHKERRQ(ierr);
1563984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]+min_loc];
1564984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=min_loc;
1565984c4197SStefano Zampini       total_primal_vertices++;
1566984c4197SStefano Zampini     }
1567984c4197SStefano Zampini   }
1568*a717540cSStefano Zampini   /* determine if a QR strategy is needed for change of basis */
1569*a717540cSStefano Zampini   qr_needed = PETSC_FALSE;
1570*a717540cSStefano Zampini   ierr = PetscBTCreate(pcbddc->local_primal_size,&qr_needed_idx);CHKERRQ(ierr);
1571*a717540cSStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1572*a717540cSStefano Zampini     if (PetscBTLookup(change_basis,i)) {
1573*a717540cSStefano Zampini       size_of_constraint = temp_indices[i+1]-temp_indices[i];
1574*a717540cSStefano Zampini       j = 0;
1575*a717540cSStefano Zampini       for (k=0;k<size_of_constraint;k++) {
1576*a717540cSStefano Zampini         if (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) {
1577*a717540cSStefano Zampini           j++;
1578*a717540cSStefano Zampini         }
1579*a717540cSStefano Zampini       }
1580*a717540cSStefano Zampini       /* found more than one primal dof on the cc */
1581*a717540cSStefano Zampini       if (j > 1) {
1582*a717540cSStefano Zampini         PetscBTSet(qr_needed_idx,i);
1583*a717540cSStefano Zampini         qr_needed = PETSC_TRUE;
1584*a717540cSStefano Zampini       }
1585*a717540cSStefano Zampini     }
1586*a717540cSStefano Zampini   }
1587984c4197SStefano Zampini   /* free workspace */
1588984c4197SStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
1589674ae819SStefano Zampini   /* permute indices in order to have a sorted set of vertices */
1590*a717540cSStefano Zampini   ierr = PetscSortInt(total_primal_vertices,aux_primal_numbering);CHKERRQ(ierr);
1591984c4197SStefano Zampini 
1592984c4197SStefano Zampini   /* nonzero structure of constraint matrix */
1593984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1594984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) nnz[i]=1;
1595984c4197SStefano Zampini   j=total_primal_vertices;
1596984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
15974641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1598674ae819SStefano Zampini       nnz[j]=temp_indices[i+1]-temp_indices[i];
1599674ae819SStefano Zampini       j++;
1600674ae819SStefano Zampini     }
1601674ae819SStefano Zampini   }
1602674ae819SStefano Zampini   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
1603674ae819SStefano Zampini   ierr = PetscFree(nnz);CHKERRQ(ierr);
1604674ae819SStefano Zampini   /* set values in constraint matrix */
1605984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) {
1606984c4197SStefano Zampini     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,aux_primal_numbering[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
1607674ae819SStefano Zampini   }
1608984c4197SStefano Zampini   total_counts = total_primal_vertices;
1609984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
16104641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1611674ae819SStefano Zampini       size_of_constraint=temp_indices[i+1]-temp_indices[i];
1612674ae819SStefano 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);
1613674ae819SStefano Zampini       total_counts++;
1614674ae819SStefano Zampini     }
1615674ae819SStefano Zampini   }
1616674ae819SStefano Zampini   /* assembling */
1617674ae819SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1618674ae819SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1619984c4197SStefano Zampini   /*
1620984c4197SStefano Zampini   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
1621984c4197SStefano Zampini   */
1622674ae819SStefano Zampini   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
1623674ae819SStefano Zampini   if (pcbddc->use_change_of_basis) {
1624026de310SStefano Zampini     /* dual and primal dofs on a single cc */
1625984c4197SStefano Zampini     PetscInt     dual_dofs,primal_dofs;
1626026de310SStefano Zampini     /* iterator on aux_primal_minloc (ordered as read from nearnullspace: vertices, edges and then constraints) */
1627026de310SStefano Zampini     PetscInt     primal_counter;
1628984c4197SStefano Zampini     /* working stuff for GEQRF */
1629984c4197SStefano Zampini     PetscScalar  *qr_basis,*qr_tau,*qr_work,lqr_work_t;
1630984c4197SStefano Zampini     PetscBLASInt lqr_work;
1631984c4197SStefano Zampini     /* working stuff for UNGQR */
1632984c4197SStefano Zampini     PetscScalar  *gqr_work,lgqr_work_t;
1633984c4197SStefano Zampini     PetscBLASInt lgqr_work;
1634984c4197SStefano Zampini     /* working stuff for TRTRS */
1635984c4197SStefano Zampini     PetscScalar  *trs_rhs;
16363f08241aSStefano Zampini     PetscBLASInt Blas_NRHS;
1637984c4197SStefano Zampini     /* pointers for values insertion into change of basis matrix */
1638984c4197SStefano Zampini     PetscInt     *start_rows,*start_cols;
1639984c4197SStefano Zampini     PetscScalar  *start_vals;
1640984c4197SStefano Zampini     /* working stuff for values insertion */
16414641a718SStefano Zampini     PetscBT      is_primal;
1642984c4197SStefano Zampini 
1643*a717540cSStefano Zampini     /* change of basis acts on local interfaces -> dimension is n_B x n_B */
1644*a717540cSStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
1645*a717540cSStefano Zampini     ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr);
1646*a717540cSStefano Zampini     ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr);
1647*a717540cSStefano Zampini     /* work arrays */
1648*a717540cSStefano Zampini     ierr = PetscMalloc(pcis->n_B*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1649*a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) nnz[i]=1;
1650*a717540cSStefano Zampini     /* nonzeros per row */
1651*a717540cSStefano Zampini     for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1652*a717540cSStefano Zampini       if (PetscBTLookup(change_basis,i)) {
1653*a717540cSStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
1654*a717540cSStefano Zampini         if (PetscBTLookup(qr_needed_idx,i)) {
1655*a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1656*a717540cSStefano Zampini         } else {
1657*a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = 2;
1658*a717540cSStefano Zampini           /* get local primal index on the cc */
1659*a717540cSStefano Zampini           j = 0;
1660*a717540cSStefano Zampini           while (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+j])) j++;
1661*a717540cSStefano Zampini           nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1662*a717540cSStefano Zampini         }
1663*a717540cSStefano Zampini       }
1664*a717540cSStefano Zampini     }
1665*a717540cSStefano Zampini     ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
1666*a717540cSStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
1667*a717540cSStefano Zampini     /* Set initial identity in the matrix */
1668*a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) {
1669*a717540cSStefano Zampini       ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
1670*a717540cSStefano Zampini     }
1671*a717540cSStefano Zampini 
1672*a717540cSStefano Zampini     if (pcbddc->dbg_flag) {
1673*a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1674*a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
1675*a717540cSStefano Zampini     }
1676*a717540cSStefano Zampini 
1677*a717540cSStefano Zampini 
1678*a717540cSStefano Zampini     /* Now we loop on the constraints which need a change of basis */
1679*a717540cSStefano Zampini     /*
1680*a717540cSStefano Zampini        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
1681*a717540cSStefano Zampini        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
1682*a717540cSStefano Zampini 
1683*a717540cSStefano Zampini        Basic blocks of change of basis matrix T computed
1684*a717540cSStefano Zampini 
1685*a717540cSStefano Zampini           - Using the following block transformation if there is only a primal dof on the cc
1686*a717540cSStefano Zampini             (in the example, primal dof is the last one of the edge in LOCAL ordering
1687*a717540cSStefano Zampini              in this code, primal dof is the first one of the edge in GLOBAL ordering)
1688*a717540cSStefano Zampini             | 1        0   ...        0     1 |
1689*a717540cSStefano Zampini             | 0        1   ...        0     1 |
1690*a717540cSStefano Zampini             |              ...                |
1691*a717540cSStefano Zampini             | 0        ...            1     1 |
1692*a717540cSStefano Zampini             | -s_1/s_n ...    -s_{n-1}/-s_n 1 |
1693*a717540cSStefano Zampini 
1694*a717540cSStefano Zampini           - via QR decomposition of constraints otherwise
1695*a717540cSStefano Zampini     */
1696*a717540cSStefano Zampini     if (qr_needed) {
1697984c4197SStefano Zampini       /* space to store Q */
1698984c4197SStefano Zampini       ierr = PetscMalloc((max_size_of_constraint)*(max_size_of_constraint)*sizeof(PetscScalar),&qr_basis);CHKERRQ(ierr);
1699984c4197SStefano Zampini       /* first we issue queries for optimal work */
17003f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
17013f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
17023f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1703984c4197SStefano Zampini       lqr_work = -1;
17043f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
1705984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
1706984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
1707984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lqr_work_t)*sizeof(*qr_work),&qr_work);CHKERRQ(ierr);
1708984c4197SStefano Zampini       lgqr_work = -1;
17093f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
17103f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
17113f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
17123f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
17133f08241aSStefano Zampini       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
17143f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
1715984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
1716984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
1717984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lgqr_work_t)*sizeof(*gqr_work),&gqr_work);CHKERRQ(ierr);
1718984c4197SStefano Zampini       /* array to store scaling factors for reflectors */
1719984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*sizeof(*qr_tau),&qr_tau);CHKERRQ(ierr);
1720984c4197SStefano Zampini       /* array to store rhs and solution of triangular solver */
1721984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*max_constraints*sizeof(*trs_rhs),&trs_rhs);CHKERRQ(ierr);
1722*a717540cSStefano Zampini       /* allocating workspace for check */
1723*a717540cSStefano Zampini       if (pcbddc->dbg_flag) {
1724*a717540cSStefano Zampini         ierr = PetscMalloc(max_size_of_constraint*(max_constraints+max_size_of_constraint)*sizeof(*work),&work);CHKERRQ(ierr);
1725*a717540cSStefano Zampini       }
1726*a717540cSStefano Zampini     }
1727984c4197SStefano Zampini     /* array to store whether a node is primal or not */
17284641a718SStefano Zampini     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
17294641a718SStefano Zampini     for (i=0;i<total_primal_vertices;i++) {
17304641a718SStefano Zampini       ierr = PetscBTSet(is_primal,local_to_B[aux_primal_numbering[i]]);CHKERRQ(ierr);
17314641a718SStefano Zampini     }
1732984c4197SStefano Zampini 
1733*a717540cSStefano Zampini     /* loop on constraints and see whether or not they need a change of basis and compute it */
1734026de310SStefano Zampini     /* -> using implicit ordering contained in temp_indices data */
1735026de310SStefano Zampini     total_counts = pcbddc->n_vertices;
1736026de310SStefano Zampini     primal_counter = total_counts;
1737026de310SStefano Zampini     while (total_counts<pcbddc->local_primal_size) {
1738026de310SStefano Zampini       primal_dofs = 1;
17394641a718SStefano Zampini       if (PetscBTLookup(change_basis,total_counts)) {
1740026de310SStefano Zampini         /* get all constraints with same support: if more then one constraint is present on the cc then surely indices are stored contiguosly */
1741026de310SStefano 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]]) {
1742026de310SStefano Zampini           primal_dofs++;
1743674ae819SStefano Zampini         }
1744984c4197SStefano Zampini         /* get constraint info */
1745026de310SStefano Zampini         size_of_constraint = temp_indices[total_counts+1]-temp_indices[total_counts];
1746984c4197SStefano Zampini         dual_dofs = size_of_constraint-primal_dofs;
1747984c4197SStefano Zampini 
1748984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
1749*a717540cSStefano Zampini           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraints %d to %d (incl) need a change of basis (size %d)\n",total_counts,total_counts+primal_dofs-1,size_of_constraint);CHKERRQ(ierr);
1750674ae819SStefano Zampini         }
1751984c4197SStefano Zampini 
1752*a717540cSStefano Zampini         if (primal_dofs > 1) { /* QR */
1753*a717540cSStefano Zampini 
1754*a717540cSStefano Zampini           /* copy quadrature constraints for change of basis check */
1755*a717540cSStefano Zampini           if (pcbddc->dbg_flag) {
1756*a717540cSStefano Zampini             ierr = PetscMemcpy(work,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1757*a717540cSStefano Zampini           }
1758984c4197SStefano Zampini           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
1759026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1760984c4197SStefano Zampini 
1761984c4197SStefano Zampini           /* compute QR decomposition of constraints */
17623f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
17633f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
17643f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1765674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
17663f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
1767984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
1768674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1769984c4197SStefano Zampini 
1770984c4197SStefano Zampini           /* explictly compute R^-T */
1771984c4197SStefano Zampini           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
1772984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
17733f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
17743f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
17753f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
17763f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
1777984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
17783f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
1779984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
1780984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1781984c4197SStefano Zampini 
1782*a717540cSStefano Zampini           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
17833f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
17843f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
17853f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
17863f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1787984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
17883f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
1789984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
1790984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1791984c4197SStefano Zampini 
1792984c4197SStefano Zampini           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
1793984c4197SStefano Zampini              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
1794984c4197SStefano Zampini              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
17953f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
17963f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
17973f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
17983f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
17993f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
18003f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1801984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1802c4303822SStefano 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));
1803984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1804026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1805984c4197SStefano Zampini 
1806984c4197SStefano Zampini           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
1807026de310SStefano Zampini           start_rows = &temp_indices_to_constraint_B[temp_indices[total_counts]];
1808984c4197SStefano Zampini           /* insert cols for primal dofs */
1809984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) {
1810984c4197SStefano Zampini             start_vals = &qr_basis[j*size_of_constraint];
1811026de310SStefano Zampini             start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter+j]];
1812984c4197SStefano Zampini             ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1813984c4197SStefano Zampini           }
1814984c4197SStefano Zampini           /* insert cols for dual dofs */
1815984c4197SStefano Zampini           for (j=0,k=0;j<dual_dofs;k++) {
18164641a718SStefano Zampini             if (!PetscBTLookup(is_primal,temp_indices_to_constraint_B[temp_indices[total_counts]+k])) {
1817984c4197SStefano Zampini               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
1818026de310SStefano Zampini               start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+k];
1819984c4197SStefano Zampini               ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1820984c4197SStefano Zampini               j++;
1821674ae819SStefano Zampini             }
1822674ae819SStefano Zampini           }
1823984c4197SStefano Zampini 
1824984c4197SStefano Zampini           /* check change of basis */
1825984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
1826984c4197SStefano Zampini             PetscInt   ii,jj;
1827984c4197SStefano Zampini             PetscBool valid_qr=PETSC_TRUE;
1828c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
1829c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1830c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
1831c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1832c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
1833c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
1834984c4197SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1835c4303822SStefano 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));
1836984c4197SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
1837984c4197SStefano Zampini             for (jj=0;jj<size_of_constraint;jj++) {
1838984c4197SStefano Zampini               for (ii=0;ii<primal_dofs;ii++) {
1839984c4197SStefano Zampini                 if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
1840984c4197SStefano Zampini                 if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
1841674ae819SStefano Zampini               }
1842674ae819SStefano Zampini             }
1843984c4197SStefano Zampini             if (!valid_qr) {
1844984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
1845984c4197SStefano Zampini               for (jj=0;jj<size_of_constraint;jj++) {
1846984c4197SStefano Zampini                 for (ii=0;ii<primal_dofs;ii++) {
1847984c4197SStefano Zampini                   if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
1848984c4197SStefano 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]));
1849674ae819SStefano Zampini                   }
1850984c4197SStefano Zampini                   if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
1851984c4197SStefano 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]));
1852984c4197SStefano Zampini                   }
1853984c4197SStefano Zampini                 }
1854984c4197SStefano Zampini               }
1855674ae819SStefano Zampini             } else {
1856984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
1857674ae819SStefano Zampini             }
1858674ae819SStefano Zampini           }
1859*a717540cSStefano Zampini         } else { /* simple transformation block */
1860*a717540cSStefano Zampini           PetscInt row,col;
1861*a717540cSStefano Zampini           PetscScalar val;
1862*a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) {
1863*a717540cSStefano Zampini             row = temp_indices_to_constraint_B[temp_indices[total_counts]+j];
1864*a717540cSStefano Zampini             if (!PetscBTLookup(is_primal,row)) {
1865*a717540cSStefano Zampini               col = temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
1866*a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
1867*a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,1.0,INSERT_VALUES);CHKERRQ(ierr);
1868*a717540cSStefano Zampini             } else {
1869*a717540cSStefano Zampini               for (k=0;k<size_of_constraint;k++) {
1870*a717540cSStefano Zampini                 col = temp_indices_to_constraint_B[temp_indices[total_counts]+k];
1871*a717540cSStefano Zampini                 if (row != col) {
1872*a717540cSStefano Zampini                   val = -temp_quadrature_constraint[temp_indices[total_counts]+k]/temp_quadrature_constraint[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
1873*a717540cSStefano Zampini                 } else {
1874*a717540cSStefano Zampini                   val = 1.0;
1875*a717540cSStefano Zampini                 }
1876*a717540cSStefano Zampini                 ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
1877*a717540cSStefano Zampini               }
1878*a717540cSStefano Zampini             }
1879*a717540cSStefano Zampini           }
1880*a717540cSStefano Zampini         }
1881026de310SStefano Zampini         /* increment primal counter */
1882026de310SStefano Zampini         primal_counter += primal_dofs;
1883984c4197SStefano Zampini       } else {
1884984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
1885026de310SStefano 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);
1886674ae819SStefano Zampini         }
1887674ae819SStefano Zampini       }
1888026de310SStefano Zampini       /* increment constraint counter total_counts */
1889026de310SStefano Zampini       total_counts += primal_dofs;
1890674ae819SStefano Zampini     }
1891*a717540cSStefano Zampini 
1892*a717540cSStefano Zampini     /* free workspace */
1893*a717540cSStefano Zampini     if (qr_needed) {
1894984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
1895984c4197SStefano Zampini         ierr = PetscFree(work);CHKERRQ(ierr);
1896984c4197SStefano Zampini       }
1897984c4197SStefano Zampini       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
1898984c4197SStefano Zampini       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
1899984c4197SStefano Zampini       ierr = PetscFree(qr_work);CHKERRQ(ierr);
1900984c4197SStefano Zampini       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
1901984c4197SStefano Zampini       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
1902674ae819SStefano Zampini     }
1903*a717540cSStefano Zampini     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
1904674ae819SStefano Zampini     /* assembling */
1905674ae819SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1906674ae819SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1907984c4197SStefano Zampini     /*
1908984c4197SStefano Zampini     ierr = MatView(pcbddc->ChangeOfBasisMatrix,(PetscViewer)0);CHKERRQ(ierr);
1909984c4197SStefano Zampini     */
1910674ae819SStefano Zampini   }
1911*a717540cSStefano Zampini 
1912*a717540cSStefano Zampini   /* flush dbg viewer */
1913b8ffe317SStefano Zampini   if (pcbddc->dbg_flag) {
1914b8ffe317SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1915b8ffe317SStefano Zampini   }
1916*a717540cSStefano Zampini 
1917e310c8b4SStefano Zampini   /* free workspace */
1918*a717540cSStefano Zampini   ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
1919*a717540cSStefano Zampini   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
1920984c4197SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
1921984c4197SStefano Zampini   ierr = PetscFree(aux_primal_minloc);CHKERRQ(ierr);
1922674ae819SStefano Zampini   ierr = PetscFree(temp_indices);CHKERRQ(ierr);
19234641a718SStefano Zampini   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
1924674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr);
1925674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
1926674ae819SStefano Zampini   ierr = PetscFree(local_to_B);CHKERRQ(ierr);
1927674ae819SStefano Zampini   ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr);
1928674ae819SStefano Zampini   PetscFunctionReturn(0);
1929674ae819SStefano Zampini }
1930674ae819SStefano Zampini 
1931674ae819SStefano Zampini #undef __FUNCT__
1932674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
1933674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
1934674ae819SStefano Zampini {
1935674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
1936674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
1937674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
1938674ae819SStefano Zampini   PetscInt    bs,ierr,i,vertex_size;
1939674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
1940674ae819SStefano Zampini 
1941674ae819SStefano Zampini   PetscFunctionBegin;
1942674ae819SStefano Zampini   /* Init local Graph struct */
1943674ae819SStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr);
1944674ae819SStefano Zampini 
1945575ad6abSStefano Zampini   /* Check validity of the csr graph passed in by the user */
1946575ad6abSStefano Zampini   if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) {
1947575ad6abSStefano Zampini     ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1948575ad6abSStefano Zampini   }
1949674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
1950674ae819SStefano Zampini   if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) {
1951674ae819SStefano Zampini     Mat mat_adj;
1952674ae819SStefano Zampini     const PetscInt *xadj,*adjncy;
1953674ae819SStefano Zampini     PetscBool flg_row=PETSC_TRUE;
1954674ae819SStefano Zampini 
1955674ae819SStefano Zampini     ierr = MatConvert(matis->A,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr);
1956674ae819SStefano Zampini     ierr = MatGetRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
1957674ae819SStefano Zampini     if (!flg_row) {
1958674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ called in %s\n",__FUNCT__);
1959674ae819SStefano Zampini     }
1960674ae819SStefano Zampini     ierr = PCBDDCSetLocalAdjacencyGraph(pc,i,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
1961674ae819SStefano Zampini     ierr = MatRestoreRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
1962674ae819SStefano Zampini     if (!flg_row) {
1963674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__);
1964674ae819SStefano Zampini     }
1965674ae819SStefano Zampini     ierr = MatDestroy(&mat_adj);CHKERRQ(ierr);
1966674ae819SStefano Zampini   }
1967674ae819SStefano Zampini 
1968674ae819SStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting */
1969674ae819SStefano Zampini   vertex_size = 1;
1970674ae819SStefano Zampini   if (!pcbddc->n_ISForDofs) {
1971674ae819SStefano Zampini     IS *custom_ISForDofs;
1972674ae819SStefano Zampini 
1973674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&bs);CHKERRQ(ierr);
1974674ae819SStefano Zampini     ierr = PetscMalloc(bs*sizeof(IS),&custom_ISForDofs);CHKERRQ(ierr);
1975674ae819SStefano Zampini     for (i=0;i<bs;i++) {
1976674ae819SStefano Zampini       ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n/bs,i,bs,&custom_ISForDofs[i]);CHKERRQ(ierr);
1977674ae819SStefano Zampini     }
1978674ae819SStefano Zampini     ierr = PCBDDCSetDofsSplitting(pc,bs,custom_ISForDofs);CHKERRQ(ierr);
1979674ae819SStefano Zampini     /* remove my references to IS objects */
1980674ae819SStefano Zampini     for (i=0;i<bs;i++) {
1981674ae819SStefano Zampini       ierr = ISDestroy(&custom_ISForDofs[i]);CHKERRQ(ierr);
1982674ae819SStefano Zampini     }
1983674ae819SStefano Zampini     ierr = PetscFree(custom_ISForDofs);CHKERRQ(ierr);
1984674ae819SStefano Zampini   } else { /* mat block size as vertex size (used for elasticity) */
1985674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
1986674ae819SStefano Zampini   }
1987674ae819SStefano Zampini 
1988674ae819SStefano Zampini   /* Setup of Graph */
1989674ae819SStefano Zampini   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundaries,pcbddc->DirichletBoundaries,pcbddc->n_ISForDofs,pcbddc->ISForDofs,pcbddc->user_primal_vertices);
1990674ae819SStefano Zampini 
1991674ae819SStefano Zampini   /* Graph's connected components analysis */
1992674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
1993674ae819SStefano Zampini 
1994674ae819SStefano Zampini   /* print some info to stdout */
1995674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
1996e49050b4SStefano Zampini     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer);
1997674ae819SStefano Zampini   }
1998674ae819SStefano Zampini   PetscFunctionReturn(0);
1999674ae819SStefano Zampini }
2000674ae819SStefano Zampini 
2001674ae819SStefano Zampini #undef __FUNCT__
2002674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx"
2003f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt **vertices_idx)
2004674ae819SStefano Zampini {
2005674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2006674ae819SStefano Zampini   PetscInt       *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size;
2007674ae819SStefano Zampini   PetscErrorCode ierr;
2008674ae819SStefano Zampini 
2009674ae819SStefano Zampini   PetscFunctionBegin;
2010674ae819SStefano Zampini   n = 0;
2011674ae819SStefano Zampini   vertices = 0;
2012674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2013674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr);
2014b120a5c6SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2015b120a5c6SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2016b120a5c6SStefano Zampini       if (size_of_constraint == 1) n++;
2017b120a5c6SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2018b120a5c6SStefano Zampini     }
2019811e8ca2SStefano Zampini     if (vertices_idx) {
2020b120a5c6SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&vertices);CHKERRQ(ierr);
2021b120a5c6SStefano Zampini       n = 0;
2022674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2023674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2024674ae819SStefano Zampini         if (size_of_constraint == 1) {
2025674ae819SStefano Zampini           vertices[n++]=row_cmat_indices[0];
2026674ae819SStefano Zampini         }
2027674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2028674ae819SStefano Zampini       }
2029674ae819SStefano Zampini     }
2030811e8ca2SStefano Zampini   }
2031674ae819SStefano Zampini   *n_vertices = n;
2032811e8ca2SStefano Zampini   if (vertices_idx) *vertices_idx = vertices;
2033674ae819SStefano Zampini   PetscFunctionReturn(0);
2034674ae819SStefano Zampini }
2035674ae819SStefano Zampini 
2036674ae819SStefano Zampini #undef __FUNCT__
2037674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx"
2038f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt **constraints_idx)
2039674ae819SStefano Zampini {
2040674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2041674ae819SStefano Zampini   PetscInt       *constraints_index,*row_cmat_indices,*row_cmat_global_indices;
2042674ae819SStefano Zampini   PetscInt       n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc;
20434641a718SStefano Zampini   PetscBT        touched;
2044674ae819SStefano Zampini   PetscErrorCode ierr;
2045674ae819SStefano Zampini 
2046f34684f1SStefano Zampini     /* This function assumes that the number of local constraints per connected component
2047f34684f1SStefano Zampini        is not greater than the number of nodes defined for the connected component
2048f34684f1SStefano Zampini        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
2049674ae819SStefano Zampini   PetscFunctionBegin;
2050674ae819SStefano Zampini   n = 0;
2051674ae819SStefano Zampini   constraints_index = 0;
2052674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2053674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr);
2054674ae819SStefano Zampini     max_size_of_constraint = 0;
2055674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2056674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2057674ae819SStefano Zampini       if (size_of_constraint > 1) {
2058674ae819SStefano Zampini         n++;
2059674ae819SStefano Zampini       }
2060674ae819SStefano Zampini       max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint);
2061674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2062674ae819SStefano Zampini     }
2063811e8ca2SStefano Zampini     if (constraints_idx) {
2064674ae819SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&constraints_index);CHKERRQ(ierr);
2065674ae819SStefano Zampini       ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&row_cmat_global_indices);CHKERRQ(ierr);
20664641a718SStefano Zampini       ierr = PetscBTCreate(local_size,&touched);CHKERRQ(ierr);
2067674ae819SStefano Zampini       n = 0;
2068674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2069674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2070674ae819SStefano Zampini         if (size_of_constraint > 1) {
2071674ae819SStefano Zampini           ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr);
207282d3d8afSStefano Zampini           /* find first untouched local node */
207382d3d8afSStefano Zampini           j = 0;
20744641a718SStefano Zampini           while (PetscBTLookup(touched,row_cmat_indices[j])) j++;
207582d3d8afSStefano Zampini           min_index = row_cmat_global_indices[j];
207682d3d8afSStefano Zampini           min_loc = j;
207782d3d8afSStefano Zampini           /* search the minimum among nodes not yet touched on the connected component
207882d3d8afSStefano Zampini              since there can be more than one constraint on a single cc */
2079674ae819SStefano Zampini           for (j=1;j<size_of_constraint;j++) {
20804641a718SStefano Zampini             if (!PetscBTLookup(touched,row_cmat_indices[j]) && min_index > row_cmat_global_indices[j]) {
2081674ae819SStefano Zampini               min_index = row_cmat_global_indices[j];
2082674ae819SStefano Zampini               min_loc = j;
2083674ae819SStefano Zampini             }
2084674ae819SStefano Zampini           }
20854641a718SStefano Zampini           ierr = PetscBTSet(touched,row_cmat_indices[min_loc]);CHKERRQ(ierr);
2086674ae819SStefano Zampini           constraints_index[n++] = row_cmat_indices[min_loc];
2087674ae819SStefano Zampini         }
2088674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2089674ae819SStefano Zampini       }
20904641a718SStefano Zampini       ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2091674ae819SStefano Zampini       ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr);
2092811e8ca2SStefano Zampini     }
2093811e8ca2SStefano Zampini   }
2094674ae819SStefano Zampini   *n_constraints = n;
2095811e8ca2SStefano Zampini   if (constraints_idx) *constraints_idx = constraints_index;
2096674ae819SStefano Zampini   PetscFunctionReturn(0);
2097674ae819SStefano Zampini }
2098674ae819SStefano Zampini 
2099674ae819SStefano Zampini /* the next two functions has been adapted from pcis.c */
2100674ae819SStefano Zampini #undef __FUNCT__
2101674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchur"
2102674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchur(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2103674ae819SStefano Zampini {
2104674ae819SStefano Zampini   PetscErrorCode ierr;
2105674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2106674ae819SStefano Zampini 
2107674ae819SStefano Zampini   PetscFunctionBegin;
2108674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2109674ae819SStefano Zampini   ierr = MatMult(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2110674ae819SStefano Zampini   ierr = MatMult(pcis->A_IB,v,vec1_D);CHKERRQ(ierr);
2111674ae819SStefano Zampini   ierr = KSPSolve(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2112674ae819SStefano Zampini   ierr = MatMult(pcis->A_BI,vec2_D,vec2_B);CHKERRQ(ierr);
2113674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2114674ae819SStefano Zampini   PetscFunctionReturn(0);
2115674ae819SStefano Zampini }
2116674ae819SStefano Zampini 
2117674ae819SStefano Zampini #undef __FUNCT__
2118674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchurTranspose"
2119674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchurTranspose(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2120674ae819SStefano Zampini {
2121674ae819SStefano Zampini   PetscErrorCode ierr;
2122674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2123674ae819SStefano Zampini 
2124674ae819SStefano Zampini   PetscFunctionBegin;
2125674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2126674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2127674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BI,v,vec1_D);CHKERRQ(ierr);
2128674ae819SStefano Zampini   ierr = KSPSolveTranspose(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2129674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_IB,vec2_D,vec2_B);CHKERRQ(ierr);
2130674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2131674ae819SStefano Zampini   PetscFunctionReturn(0);
2132674ae819SStefano Zampini }
2133674ae819SStefano Zampini 
2134674ae819SStefano Zampini #undef __FUNCT__
2135674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
2136674ae819SStefano 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[])
2137674ae819SStefano Zampini {
2138674ae819SStefano Zampini   Vec            local_vec,global_vec;
2139674ae819SStefano Zampini   IS             seqis,paris;
2140674ae819SStefano Zampini   VecScatter     scatter_ctx;
2141674ae819SStefano Zampini   PetscScalar    *array;
2142674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
2143674ae819SStefano Zampini   PetscScalar    globalsum;
2144674ae819SStefano Zampini   PetscInt       i,j,s;
2145674ae819SStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local;
2146674ae819SStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm,max_global;
2147674ae819SStefano Zampini   PetscMPIInt    *dof_sizes,*dof_displs;
2148674ae819SStefano Zampini   PetscBool      first_found;
2149674ae819SStefano Zampini   PetscErrorCode ierr;
2150674ae819SStefano Zampini 
2151674ae819SStefano Zampini   PetscFunctionBegin;
2152674ae819SStefano Zampini   /* mpi buffers */
2153674ae819SStefano Zampini   MPI_Comm_size(comm,&size_prec_comm);
2154674ae819SStefano Zampini   MPI_Comm_rank(comm,&rank_prec_comm);
2155674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
2156674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_sizes),&dof_sizes);CHKERRQ(ierr);
2157674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_displs),&dof_displs);CHKERRQ(ierr);
2158674ae819SStefano Zampini   /* get maximum size of subset */
2159674ae819SStefano Zampini   ierr = PetscMalloc(n_local_dofs*sizeof(PetscInt),&temp_global_dofs);CHKERRQ(ierr);
2160674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
2161674ae819SStefano Zampini   max_local = 0;
2162674ae819SStefano Zampini   if (n_local_dofs) {
2163674ae819SStefano Zampini     max_local = temp_global_dofs[0];
2164674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2165674ae819SStefano Zampini       if (max_local < temp_global_dofs[i] ) {
2166674ae819SStefano Zampini         max_local = temp_global_dofs[i];
2167674ae819SStefano Zampini       }
2168674ae819SStefano Zampini     }
2169674ae819SStefano Zampini   }
2170674ae819SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);
2171674ae819SStefano Zampini   max_global++;
2172674ae819SStefano Zampini   max_local = 0;
2173674ae819SStefano Zampini   if (n_local_dofs) {
2174674ae819SStefano Zampini     max_local = local_dofs[0];
2175674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2176674ae819SStefano Zampini       if (max_local < local_dofs[i] ) {
2177674ae819SStefano Zampini         max_local = local_dofs[i];
2178674ae819SStefano Zampini       }
2179674ae819SStefano Zampini     }
2180674ae819SStefano Zampini   }
2181674ae819SStefano Zampini   max_local++;
2182674ae819SStefano Zampini   /* allocate workspace */
2183674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
2184674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
2185674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
2186674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
2187674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
2188674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
2189674ae819SStefano Zampini   /* create scatter */
2190674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
2191674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
2192674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
2193674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
2194674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
2195674ae819SStefano Zampini   /* init array */
2196674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
2197674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2198674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2199674ae819SStefano Zampini   if (local_dofs_mult) {
2200674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2201674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
2202674ae819SStefano Zampini     }
2203674ae819SStefano Zampini   } else {
2204674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2205674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
2206674ae819SStefano Zampini     }
2207674ae819SStefano Zampini   }
2208674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2209674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
2210674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2211674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2212674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
22135b08dc53SStefano Zampini   *n_global_subset = (PetscInt)PetscRealPart(globalsum);
2214674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
2215674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
2216674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
2217674ae819SStefano Zampini   nlocals = 0;
2218674ae819SStefano Zampini   first_index = -1;
2219674ae819SStefano Zampini   first_found = PETSC_FALSE;
2220674ae819SStefano Zampini   for (i=0;i<s;i++) {
22215b08dc53SStefano Zampini     if (!first_found && PetscRealPart(array[i]) > 0.0) {
2222674ae819SStefano Zampini       first_found = PETSC_TRUE;
2223674ae819SStefano Zampini       first_index = i;
2224674ae819SStefano Zampini     }
22255b08dc53SStefano Zampini     nlocals += (PetscInt)PetscRealPart(array[i]);
2226674ae819SStefano Zampini   }
2227674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2228674ae819SStefano Zampini   if (!rank_prec_comm) {
2229674ae819SStefano Zampini     dof_displs[0]=0;
2230674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
2231674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
2232674ae819SStefano Zampini     }
2233674ae819SStefano Zampini   }
2234674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2235674ae819SStefano Zampini   if (first_found) {
2236674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
2237674ae819SStefano Zampini     old_index = first_index;
2238674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
22395b08dc53SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) {
2240674ae819SStefano Zampini         array[i] += array[old_index];
2241674ae819SStefano Zampini         old_index = i;
2242674ae819SStefano Zampini       }
2243674ae819SStefano Zampini     }
2244674ae819SStefano Zampini   }
2245674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
2246674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2247674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2248674ae819SStefano Zampini   ierr = VecScatterEnd  (scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2249674ae819SStefano Zampini   /* get global ordering of local dofs */
2250674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2251674ae819SStefano Zampini   if (local_dofs_mult) {
2252674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
22535b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i];
2254674ae819SStefano Zampini     }
2255674ae819SStefano Zampini   } else {
2256674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
22575b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1;
2258674ae819SStefano Zampini     }
2259674ae819SStefano Zampini   }
2260674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2261674ae819SStefano Zampini   /* free workspace */
2262674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
2263674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
2264674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
2265674ae819SStefano Zampini   ierr = PetscFree(dof_sizes);CHKERRQ(ierr);
2266674ae819SStefano Zampini   ierr = PetscFree(dof_displs);CHKERRQ(ierr);
2267674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
2268674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
2269674ae819SStefano Zampini   PetscFunctionReturn(0);
2270674ae819SStefano Zampini }
22719a7d3425SStefano Zampini 
22729a7d3425SStefano Zampini #undef __FUNCT__
22739a7d3425SStefano Zampini #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
22749a7d3425SStefano Zampini PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
22759a7d3425SStefano Zampini {
22769a7d3425SStefano Zampini   PetscInt       i,j;
22779a7d3425SStefano Zampini   PetscScalar    *alphas;
22789a7d3425SStefano Zampini   PetscErrorCode ierr;
22799a7d3425SStefano Zampini 
22809a7d3425SStefano Zampini   PetscFunctionBegin;
22819a7d3425SStefano Zampini   /* this implements stabilized Gram-Schmidt */
22829a7d3425SStefano Zampini   ierr = PetscMalloc(n*sizeof(PetscScalar),&alphas);CHKERRQ(ierr);
22839a7d3425SStefano Zampini   for (i=0;i<n;i++) {
22849a7d3425SStefano Zampini     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
22859a7d3425SStefano Zampini     if (i<n) { ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],&alphas[i+1]);CHKERRQ(ierr); }
22869a7d3425SStefano Zampini     for (j=i+1;j<n;j++) { ierr = VecAXPY(vecs[j],PetscConj(-alphas[j]),vecs[i]);CHKERRQ(ierr); }
22879a7d3425SStefano Zampini   }
22889a7d3425SStefano Zampini   ierr = PetscFree(alphas);CHKERRQ(ierr);
22899a7d3425SStefano Zampini   PetscFunctionReturn(0);
22909a7d3425SStefano Zampini }
22919a7d3425SStefano Zampini 
2292a57a6d2fSStefano Zampini /* Currently support MAT_INITIAL_MATRIX only, with partial support to block matrices */
2293a57a6d2fSStefano Zampini #undef __FUNCT__
2294a57a6d2fSStefano Zampini #define __FUNCT__ "MatConvert_IS_AIJ"
2295a57a6d2fSStefano Zampini static PetscErrorCode MatConvert_IS_AIJ(Mat mat, MatType newtype,MatReuse reuse,Mat *M)
2296a57a6d2fSStefano Zampini {
2297a57a6d2fSStefano Zampini   Mat new_mat;
2298a57a6d2fSStefano Zampini   Mat_IS *matis = (Mat_IS*)(mat->data);
2299a57a6d2fSStefano Zampini   /* info on mat */
2300a57a6d2fSStefano Zampini   PetscInt bs,rows,cols;
2301a57a6d2fSStefano Zampini   PetscInt lrows,lcols;
2302a57a6d2fSStefano Zampini   PetscInt local_rows,local_cols;
2303e7931f94SStefano Zampini   PetscMPIInt nsubdomains;
2304a57a6d2fSStefano Zampini   /* preallocation */
2305a57a6d2fSStefano Zampini   Vec vec_dnz,vec_onz;
2306a57a6d2fSStefano Zampini   PetscScalar *my_dnz,*my_onz,*array;
2307a57a6d2fSStefano Zampini   PetscInt *dnz,*onz,*mat_ranges,*row_ownership;
2308a57a6d2fSStefano Zampini   PetscInt  index_row,index_col,owner;
2309a57a6d2fSStefano Zampini   PetscInt  *local_indices,*global_indices;
2310a57a6d2fSStefano Zampini   /* work */
2311a57a6d2fSStefano Zampini   PetscInt i,j;
2312a57a6d2fSStefano Zampini   PetscErrorCode ierr;
2313a57a6d2fSStefano Zampini 
2314a57a6d2fSStefano Zampini   PetscFunctionBegin;
2315a57a6d2fSStefano Zampini   /* CHECKS */
2316a57a6d2fSStefano Zampini   /* get info from mat */
2317a57a6d2fSStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
2318a57a6d2fSStefano Zampini   ierr = MatGetBlockSize(mat,&bs);CHKERRQ(ierr);
2319a57a6d2fSStefano Zampini   ierr = MatGetSize(matis->A,&local_rows,&local_cols);CHKERRQ(ierr);
2320a57a6d2fSStefano Zampini   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&nsubdomains);CHKERRQ(ierr);
2321a57a6d2fSStefano Zampini 
2322a57a6d2fSStefano Zampini   /* MAT_INITIAL_MATRIX */
2323a57a6d2fSStefano Zampini   ierr = MatCreate(PetscObjectComm((PetscObject)mat),&new_mat);CHKERRQ(ierr);
2324a57a6d2fSStefano Zampini   ierr = MatSetSizes(new_mat,PETSC_DECIDE,PETSC_DECIDE,rows,cols);CHKERRQ(ierr);
2325a57a6d2fSStefano Zampini   ierr = MatSetBlockSize(new_mat,bs);CHKERRQ(ierr);
2326a57a6d2fSStefano Zampini   ierr = MatSetType(new_mat,newtype);CHKERRQ(ierr);
2327a57a6d2fSStefano Zampini   ierr = MatSetUp(new_mat);CHKERRQ(ierr);
2328a57a6d2fSStefano Zampini   ierr = MatGetLocalSize(new_mat,&lrows,&lcols);CHKERRQ(ierr);
2329a57a6d2fSStefano Zampini 
2330a57a6d2fSStefano Zampini   /*
2331a57a6d2fSStefano Zampini     preallocation
2332a57a6d2fSStefano Zampini   */
2333a57a6d2fSStefano Zampini 
2334a57a6d2fSStefano Zampini   ierr = MatPreallocateInitialize(PetscObjectComm((PetscObject)new_mat),lrows,lcols,dnz,onz);CHKERRQ(ierr);
2335a57a6d2fSStefano Zampini   /*
2336a57a6d2fSStefano Zampini      Some vectors are needed to sum up properly on shared interface dofs.
2337a57a6d2fSStefano Zampini      Note that preallocation is not exact, since it overestimates nonzeros
2338a57a6d2fSStefano Zampini   */
2339a57a6d2fSStefano Zampini /*
2340a57a6d2fSStefano Zampini   ierr = VecCreate(PetscObjectComm((PetscObject)mat),&vec_dnz);CHKERRQ(ierr);
2341a57a6d2fSStefano Zampini   ierr = VecSetBlockSize(vec_dnz,bs);CHKERRQ(ierr);
2342a57a6d2fSStefano Zampini   ierr = VecSetSizes(vec_dnz,PETSC_DECIDE,rows);CHKERRQ(ierr);
2343a57a6d2fSStefano Zampini   ierr = VecSetType(vec_dnz,VECSTANDARD);CHKERRQ(ierr);
2344a57a6d2fSStefano Zampini */
2345a57a6d2fSStefano Zampini   ierr = MatGetVecs(new_mat,NULL,&vec_dnz);CHKERRQ(ierr);
2346a57a6d2fSStefano Zampini   ierr = VecDuplicate(vec_dnz,&vec_onz);CHKERRQ(ierr);
2347e7931f94SStefano Zampini   /* All processes need to compute entire row ownership */
2348a57a6d2fSStefano Zampini   ierr = PetscMalloc(rows*sizeof(*row_ownership),&row_ownership);CHKERRQ(ierr);
2349a57a6d2fSStefano Zampini   ierr = MatGetOwnershipRanges(new_mat,(const PetscInt**)&mat_ranges);CHKERRQ(ierr);
2350a57a6d2fSStefano Zampini   for (i=0;i<nsubdomains;i++) {
2351a57a6d2fSStefano Zampini     for (j=mat_ranges[i];j<mat_ranges[i+1];j++) {
2352a57a6d2fSStefano Zampini       row_ownership[j]=i;
2353a57a6d2fSStefano Zampini     }
2354a57a6d2fSStefano Zampini   }
2355a57a6d2fSStefano Zampini   /* map indices of local mat to global values */
2356a57a6d2fSStefano Zampini   ierr = PetscMalloc(PetscMax(local_cols,local_rows)*sizeof(*global_indices),&global_indices);CHKERRQ(ierr);
2357a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*local_indices),&local_indices);CHKERRQ(ierr);
2358a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) local_indices[i]=i;
2359a57a6d2fSStefano Zampini   ierr = ISLocalToGlobalMappingApply(matis->mapping,local_rows,local_indices,global_indices);CHKERRQ(ierr);
2360a57a6d2fSStefano Zampini   ierr = PetscFree(local_indices);CHKERRQ(ierr);
2361a57a6d2fSStefano Zampini 
2362e7931f94SStefano Zampini   /*
2363e7931f94SStefano Zampini      my_dnz and my_onz contains exact contribution to preallocation from each local mat
2364e7931f94SStefano Zampini      then, they will be summed up properly. This way, preallocation is always sufficient
2365e7931f94SStefano Zampini   */
2366a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*my_dnz),&my_dnz);CHKERRQ(ierr);
2367a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*my_onz),&my_onz);CHKERRQ(ierr);
2368a57a6d2fSStefano Zampini   ierr = PetscMemzero(my_dnz,local_rows*sizeof(*my_dnz));CHKERRQ(ierr);
2369a57a6d2fSStefano Zampini   ierr = PetscMemzero(my_onz,local_rows*sizeof(*my_onz));CHKERRQ(ierr);
2370a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) {
2371a57a6d2fSStefano Zampini     index_row = global_indices[i];
2372a57a6d2fSStefano Zampini     for (j=i;j<local_rows;j++) {
2373a57a6d2fSStefano Zampini       owner = row_ownership[index_row];
2374a57a6d2fSStefano Zampini       index_col = global_indices[j];
2375a57a6d2fSStefano Zampini       if (index_col > mat_ranges[owner]-1 && index_col < mat_ranges[owner+1] ) { /* diag block */
2376a57a6d2fSStefano Zampini         my_dnz[i] += 1.0;
2377a57a6d2fSStefano Zampini       } else { /* offdiag block */
2378a57a6d2fSStefano Zampini         my_onz[i] += 1.0;
2379a57a6d2fSStefano Zampini       }
2380a57a6d2fSStefano Zampini       /* same as before, interchanging rows and cols */
2381a57a6d2fSStefano Zampini       if (i != j) {
2382a57a6d2fSStefano Zampini         owner = row_ownership[index_col];
2383a57a6d2fSStefano Zampini         if (index_row > mat_ranges[owner]-1 && index_row < mat_ranges[owner+1] ) {
2384a57a6d2fSStefano Zampini           my_dnz[j] += 1.0;
2385a57a6d2fSStefano Zampini         } else {
2386a57a6d2fSStefano Zampini           my_onz[j] += 1.0;
2387a57a6d2fSStefano Zampini         }
2388a57a6d2fSStefano Zampini       }
2389a57a6d2fSStefano Zampini     }
2390a57a6d2fSStefano Zampini   }
2391a57a6d2fSStefano Zampini   ierr = VecSet(vec_dnz,0.0);CHKERRQ(ierr);
2392a57a6d2fSStefano Zampini   ierr = VecSet(vec_onz,0.0);CHKERRQ(ierr);
239320a2ab83SStefano Zampini   if (local_rows) { /* multilevel guard */
2394a57a6d2fSStefano Zampini     ierr = VecSetValues(vec_dnz,local_rows,global_indices,my_dnz,ADD_VALUES);CHKERRQ(ierr);
2395a57a6d2fSStefano Zampini     ierr = VecSetValues(vec_onz,local_rows,global_indices,my_onz,ADD_VALUES);CHKERRQ(ierr);
2396a57a6d2fSStefano Zampini   }
2397a57a6d2fSStefano Zampini   ierr = VecAssemblyBegin(vec_dnz);CHKERRQ(ierr);
2398a57a6d2fSStefano Zampini   ierr = VecAssemblyBegin(vec_onz);CHKERRQ(ierr);
2399a57a6d2fSStefano Zampini   ierr = VecAssemblyEnd(vec_dnz);CHKERRQ(ierr);
2400a57a6d2fSStefano Zampini   ierr = VecAssemblyEnd(vec_onz);CHKERRQ(ierr);
2401a57a6d2fSStefano Zampini   ierr = PetscFree(my_dnz);CHKERRQ(ierr);
2402a57a6d2fSStefano Zampini   ierr = PetscFree(my_onz);CHKERRQ(ierr);
2403a57a6d2fSStefano Zampini   ierr = PetscFree(row_ownership);CHKERRQ(ierr);
2404a57a6d2fSStefano Zampini 
2405a57a6d2fSStefano Zampini   /* set computed preallocation in dnz and onz */
2406a57a6d2fSStefano Zampini   ierr = VecGetArray(vec_dnz,&array);CHKERRQ(ierr);
2407a57a6d2fSStefano Zampini   for (i=0; i<lrows; i++) dnz[i] = (PetscInt)PetscRealPart(array[i]);
2408a57a6d2fSStefano Zampini   ierr = VecRestoreArray(vec_dnz,&array);CHKERRQ(ierr);
2409a57a6d2fSStefano Zampini   ierr = VecGetArray(vec_onz,&array);CHKERRQ(ierr);
2410a57a6d2fSStefano Zampini   for (i=0;i<lrows;i++) onz[i] = (PetscInt)PetscRealPart(array[i]);
2411a57a6d2fSStefano Zampini   ierr = VecRestoreArray(vec_onz,&array);CHKERRQ(ierr);
2412a57a6d2fSStefano Zampini   ierr = VecDestroy(&vec_dnz);CHKERRQ(ierr);
2413a57a6d2fSStefano Zampini   ierr = VecDestroy(&vec_onz);CHKERRQ(ierr);
2414a57a6d2fSStefano Zampini 
2415e7931f94SStefano Zampini   /* Resize preallocation if overestimated */
2416a57a6d2fSStefano Zampini   for (i=0;i<lrows;i++) {
2417a57a6d2fSStefano Zampini     dnz[i] = PetscMin(dnz[i],lcols);
2418a57a6d2fSStefano Zampini     onz[i] = PetscMin(onz[i],cols-lcols);
2419a57a6d2fSStefano Zampini   }
2420a57a6d2fSStefano Zampini   ierr = MatMPIAIJSetPreallocation(new_mat,0,dnz,0,onz);CHKERRQ(ierr);
2421a57a6d2fSStefano Zampini   ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
2422a57a6d2fSStefano Zampini 
2423a57a6d2fSStefano Zampini   /*
2424e7931f94SStefano Zampini     Set values. Very Basic.
2425a57a6d2fSStefano Zampini   */
2426a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) {
2427a57a6d2fSStefano Zampini     ierr = MatGetRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2428a57a6d2fSStefano Zampini     ierr = ISLocalToGlobalMappingApply(matis->mapping,j,local_indices,global_indices);CHKERRQ(ierr);
2429a57a6d2fSStefano Zampini     ierr = ISLocalToGlobalMappingApply(matis->mapping,1,&i,&index_row);CHKERRQ(ierr);
2430a57a6d2fSStefano Zampini     ierr = MatSetValues(new_mat,1,&index_row,j,global_indices,array,ADD_VALUES);CHKERRQ(ierr);
2431a57a6d2fSStefano Zampini     ierr = MatRestoreRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2432a57a6d2fSStefano Zampini   }
243320a2ab83SStefano Zampini   ierr = MatAssemblyBegin(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2434a57a6d2fSStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
243520a2ab83SStefano Zampini   ierr = MatAssemblyEnd(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2436a57a6d2fSStefano Zampini 
2437a57a6d2fSStefano Zampini   /* get back mat */
2438a57a6d2fSStefano Zampini   *M = new_mat;
2439a57a6d2fSStefano Zampini   PetscFunctionReturn(0);
2440a57a6d2fSStefano Zampini }
2441a57a6d2fSStefano Zampini 
2442e7931f94SStefano Zampini #undef __FUNCT__
2443e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble_Private"
2444e7931f94SStefano Zampini PetscErrorCode MatISSubassemble_Private(Mat mat, PetscInt coarsening_ratio, IS* is_sends)
2445e7931f94SStefano Zampini {
2446e7931f94SStefano Zampini   Mat             subdomain_adj;
2447e7931f94SStefano Zampini   IS              new_ranks,ranks_send_to;
2448e7931f94SStefano Zampini   MatPartitioning partitioner;
2449e7931f94SStefano Zampini   Mat_IS          *matis;
2450e7931f94SStefano Zampini   PetscInt        n_neighs,*neighs,*n_shared,**shared;
2451e7931f94SStefano Zampini   PetscInt        prank;
2452e7931f94SStefano Zampini   PetscMPIInt     size,rank,color;
2453e7931f94SStefano Zampini   PetscInt        *xadj,*adjncy,*oldranks;
2454e7931f94SStefano Zampini   PetscInt        *adjncy_wgt,*v_wgt,*is_indices,*ranks_send_to_idx;
2455e7931f94SStefano Zampini   PetscInt        i,j,n_subdomains,local_size,threshold=0;
2456e7931f94SStefano Zampini   PetscErrorCode  ierr;
24572b510759SStefano Zampini   PetscBool       use_vwgt=PETSC_FALSE,use_square=PETSC_FALSE;
2458e7931f94SStefano Zampini   PetscSubcomm    subcomm;
2459a57a6d2fSStefano Zampini 
2460e7931f94SStefano Zampini   PetscFunctionBegin;
24612b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_square",&use_square,NULL);CHKERRQ(ierr);
24622b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
24632b510759SStefano Zampini   ierr = PetscOptionsGetInt(NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
2464e7931f94SStefano Zampini 
2465e7931f94SStefano Zampini   /* Get info on mapping */
2466e7931f94SStefano Zampini   matis = (Mat_IS*)(mat->data);
2467e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&local_size);CHKERRQ(ierr);
2468e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2469e7931f94SStefano Zampini 
2470e7931f94SStefano Zampini   /* build local CSR graph of subdomains' connectivity */
2471e7931f94SStefano Zampini   ierr = PetscMalloc(2*sizeof(*xadj),&xadj);CHKERRQ(ierr);
2472e7931f94SStefano Zampini   xadj[0] = 0;
2473e7931f94SStefano Zampini   xadj[1] = PetscMax(n_neighs-1,0);
2474e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy),&adjncy);CHKERRQ(ierr);
2475e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy_wgt),&adjncy_wgt);CHKERRQ(ierr);
2476e7931f94SStefano Zampini 
24772b510759SStefano Zampini   if (threshold) {
24782b510759SStefano Zampini     PetscInt* count,min_threshold;
2479e7931f94SStefano Zampini     ierr = PetscMalloc(local_size*sizeof(PetscInt),&count);CHKERRQ(ierr);
2480e7931f94SStefano Zampini     ierr = PetscMemzero(count,local_size*sizeof(PetscInt));CHKERRQ(ierr);
2481e7931f94SStefano Zampini     for (i=1;i<n_neighs;i++) {/* i=1 so I don't count myself -> faces nodes counts to 1 */
2482e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2483e7931f94SStefano Zampini         count[shared[i][j]] += 1;
2484e7931f94SStefano Zampini       }
2485e7931f94SStefano Zampini     }
24862b510759SStefano Zampini     /* adapt threshold since we dont want to lose significant connections */
24872b510759SStefano Zampini     min_threshold = n_neighs;
24882b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
24892b510759SStefano Zampini       for (j=0;j<n_shared[i];j++) {
24902b510759SStefano Zampini         min_threshold = PetscMin(count[shared[i][j]],min_threshold);
24912b510759SStefano Zampini       }
24922b510759SStefano Zampini     }
24932b510759SStefano Zampini     PetscPrintf(PETSC_COMM_SELF,"PASSED THRESHOLD %d\n",threshold);
24942b510759SStefano Zampini     threshold = PetscMax(min_threshold+1,threshold);
24952b510759SStefano Zampini     PetscPrintf(PETSC_COMM_SELF,"USING THRESHOLD %d (min %d)\n",threshold,min_threshold);
2496e7931f94SStefano Zampini     xadj[1] = 0;
24972b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
2498e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2499e7931f94SStefano Zampini         if (count[shared[i][j]] < threshold) {
2500e7931f94SStefano Zampini           adjncy[xadj[1]] = neighs[i];
2501e7931f94SStefano Zampini           adjncy_wgt[xadj[1]] = n_shared[i];
2502e7931f94SStefano Zampini           xadj[1]++;
2503e7931f94SStefano Zampini           break;
2504e7931f94SStefano Zampini         }
2505e7931f94SStefano Zampini       }
2506e7931f94SStefano Zampini     }
2507e7931f94SStefano Zampini     ierr = PetscFree(count);CHKERRQ(ierr);
2508e7931f94SStefano Zampini   } else {
2509e7931f94SStefano Zampini     if (xadj[1]) {
2510e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy,&neighs[1],xadj[1]*sizeof(*adjncy));CHKERRQ(ierr);
2511e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy_wgt,&n_shared[1],xadj[1]*sizeof(*adjncy_wgt));CHKERRQ(ierr);
2512e7931f94SStefano Zampini     }
2513e7931f94SStefano Zampini   }
2514e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingRestoreInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2515e7931f94SStefano Zampini   if (use_square) {
2516e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2517e7931f94SStefano Zampini       adjncy_wgt[i] = adjncy_wgt[i]*adjncy_wgt[i];
2518e7931f94SStefano Zampini     }
2519e7931f94SStefano Zampini   }
2520e7931f94SStefano Zampini   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2521e7931f94SStefano Zampini 
2522e7931f94SStefano Zampini   ierr = PetscMalloc(sizeof(PetscInt),&ranks_send_to_idx);CHKERRQ(ierr);
2523e7931f94SStefano Zampini 
2524e7931f94SStefano Zampini   /*
2525e7931f94SStefano Zampini     Restrict work on active processes only.
2526e7931f94SStefano Zampini   */
2527e7931f94SStefano Zampini   ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&subcomm);CHKERRQ(ierr);
2528e7931f94SStefano Zampini   ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
2529e7931f94SStefano Zampini   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
25302b510759SStefano Zampini   ierr = PetscMPIIntCast(!local_size,&color);CHKERRQ(ierr);
2531e7931f94SStefano Zampini   ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank,rank);CHKERRQ(ierr);
2532e7931f94SStefano Zampini   if (color) {
2533e7931f94SStefano Zampini     ierr = PetscFree(xadj);CHKERRQ(ierr);
2534e7931f94SStefano Zampini     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2535e7931f94SStefano Zampini     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
2536e7931f94SStefano Zampini   } else {
2537e7931f94SStefano Zampini     ierr = MPI_Comm_size(subcomm->comm,&size);CHKERRQ(ierr);
2538e7931f94SStefano Zampini     ierr = PetscMalloc(size*sizeof(*oldranks),&oldranks);CHKERRQ(ierr);
2539e7931f94SStefano Zampini     prank = rank;
2540e7931f94SStefano Zampini     ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm->comm);CHKERRQ(ierr);
2541e7931f94SStefano Zampini     for (i=0;i<size;i++) {
2542e7931f94SStefano Zampini       PetscPrintf(subcomm->comm,"oldranks[%d] = %d\n",i,oldranks[i]);
2543e7931f94SStefano Zampini     }
2544e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2545e7931f94SStefano Zampini       ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
2546e7931f94SStefano Zampini     }
2547e7931f94SStefano Zampini     ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2548e7931f94SStefano Zampini     ierr = MatCreateMPIAdj(subcomm->comm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
2549e7931f94SStefano Zampini     n_subdomains = (PetscInt)size;
2550e7931f94SStefano Zampini     ierr = MatView(subdomain_adj,0);CHKERRQ(ierr);
2551e7931f94SStefano Zampini 
2552e7931f94SStefano Zampini     /* Partition */
2553e7931f94SStefano Zampini     ierr = MatPartitioningCreate(subcomm->comm,&partitioner);CHKERRQ(ierr);
2554e7931f94SStefano Zampini     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
2555e7931f94SStefano Zampini     if (use_vwgt) {
2556e7931f94SStefano Zampini       ierr = PetscMalloc(sizeof(*v_wgt),&v_wgt);CHKERRQ(ierr);
2557e7931f94SStefano Zampini       v_wgt[0] = local_size;
2558e7931f94SStefano Zampini       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
2559e7931f94SStefano Zampini     }
2560e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)partitioner),"NPARTS %d\n",n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2561e7931f94SStefano Zampini     ierr = MatPartitioningSetNParts(partitioner,n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2562e7931f94SStefano Zampini     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
2563e7931f94SStefano Zampini     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
2564e7931f94SStefano Zampini     ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr);
2565e7931f94SStefano Zampini 
2566e7931f94SStefano Zampini     ierr = ISGetIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2567e7931f94SStefano Zampini     ranks_send_to_idx[0] = oldranks[is_indices[0]];
2568e7931f94SStefano Zampini     ierr = ISRestoreIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2569e7931f94SStefano Zampini     /* clean up */
2570e7931f94SStefano Zampini     ierr = PetscFree(oldranks);CHKERRQ(ierr);
2571e7931f94SStefano Zampini     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
2572e7931f94SStefano Zampini     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
2573e7931f94SStefano Zampini     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
2574e7931f94SStefano Zampini   }
2575e7931f94SStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
2576e7931f94SStefano Zampini 
2577e7931f94SStefano Zampini   /* assemble parallel IS for sends */
2578e7931f94SStefano Zampini   i = 1;
2579e7931f94SStefano Zampini   if (color) i=0;
2580e7931f94SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,&ranks_send_to);CHKERRQ(ierr);
2581e7931f94SStefano Zampini   ierr = ISView(ranks_send_to,0);CHKERRQ(ierr);
2582e7931f94SStefano Zampini 
2583e7931f94SStefano Zampini   /* get back IS */
2584e7931f94SStefano Zampini   *is_sends = ranks_send_to;
2585e7931f94SStefano Zampini   PetscFunctionReturn(0);
2586e7931f94SStefano Zampini }
2587e7931f94SStefano Zampini 
2588e7931f94SStefano Zampini typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
2589e7931f94SStefano Zampini 
2590e7931f94SStefano Zampini #undef __FUNCT__
2591e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble"
2592e7931f94SStefano Zampini PetscErrorCode MatISSubassemble(Mat mat, IS is_sends, PetscInt coarsening_ratio, Mat *mat_n)
2593e7931f94SStefano Zampini {
2594e7931f94SStefano Zampini   Mat                    local_mat,new_mat;
2595e7931f94SStefano Zampini   Mat_IS                 *matis;
2596e7931f94SStefano Zampini   IS                     is_sends_internal;
2597e7931f94SStefano Zampini   PetscInt               rows,cols;
2598e7931f94SStefano Zampini   PetscInt               i,bs,buf_size_idxs,buf_size_vals;
2599e7931f94SStefano Zampini   PetscBool              ismatis,isdense;
2600e7931f94SStefano Zampini   ISLocalToGlobalMapping l2gmap;
2601e7931f94SStefano Zampini   PetscInt*              l2gmap_indices;
2602e7931f94SStefano Zampini   const PetscInt*        is_indices;
2603e7931f94SStefano Zampini   MatType                new_local_type;
2604e7931f94SStefano Zampini   MatTypePrivate         new_local_type_private;
2605e7931f94SStefano Zampini   /* buffers */
2606e7931f94SStefano Zampini   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
2607e7931f94SStefano Zampini   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
2608e7931f94SStefano Zampini   /* MPI */
2609e7931f94SStefano Zampini   MPI_Comm               comm;
2610e7931f94SStefano Zampini   PetscMPIInt            n_sends,n_recvs,commsize;
2611e7931f94SStefano Zampini   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals;
2612e7931f94SStefano Zampini   PetscMPIInt            *onodes,*olengths_idxs,*olengths_vals;
2613e7931f94SStefano Zampini   PetscMPIInt            len,tag_idxs,tag_vals,source_dest;
2614e7931f94SStefano Zampini   MPI_Request            *send_req_idxs,*send_req_vals,*recv_req_idxs,*recv_req_vals;
2615e7931f94SStefano Zampini   PetscErrorCode         ierr;
2616e7931f94SStefano Zampini 
2617e7931f94SStefano Zampini   PetscFunctionBegin;
2618e7931f94SStefano Zampini   /* checks */
2619e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
2620e7931f94SStefano Zampini   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on an matrix object which is not of type MATIS",__FUNCT__);
2621e7931f94SStefano Zampini   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2622e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
2623e7931f94SStefano Zampini   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
2624e7931f94SStefano Zampini   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
2625e7931f94SStefano Zampini   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
2626e7931f94SStefano Zampini   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
2627e7931f94SStefano Zampini   PetscValidLogicalCollectiveInt(mat,bs,0);
2628e7931f94SStefano Zampini   /* prepare IS for sending if not provided */
2629e7931f94SStefano Zampini   if (!is_sends) {
2630e7931f94SStefano Zampini     if (!coarsening_ratio) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a coarsening ratio");
2631e7931f94SStefano Zampini     ierr = MatISSubassemble_Private(mat,coarsening_ratio,&is_sends_internal);CHKERRQ(ierr);
2632e7931f94SStefano Zampini   } else {
2633e7931f94SStefano Zampini     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
2634e7931f94SStefano Zampini     is_sends_internal = is_sends;
2635e7931f94SStefano Zampini   }
2636e7931f94SStefano Zampini 
2637e7931f94SStefano Zampini   /* get pointer of MATIS data */
2638e7931f94SStefano Zampini   matis = (Mat_IS*)mat->data;
2639e7931f94SStefano Zampini 
2640e7931f94SStefano Zampini   /* get comm */
2641e7931f94SStefano Zampini   comm = PetscObjectComm((PetscObject)mat);
2642e7931f94SStefano Zampini 
2643e7931f94SStefano Zampini   /* compute number of sends */
2644e7931f94SStefano Zampini   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
2645e7931f94SStefano Zampini   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
2646e7931f94SStefano Zampini 
2647e7931f94SStefano Zampini   /* compute number of receives */
2648e7931f94SStefano Zampini   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
2649e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*iflags),&iflags);CHKERRQ(ierr);
2650e7931f94SStefano Zampini   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
2651e7931f94SStefano Zampini   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2652e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
2653e7931f94SStefano Zampini   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
2654e7931f94SStefano Zampini   ierr = PetscFree(iflags);CHKERRQ(ierr);
2655e7931f94SStefano Zampini 
2656e7931f94SStefano Zampini   /* prepare send/receive buffers */
2657e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_idxs),&ilengths_idxs);CHKERRQ(ierr);
2658e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
2659e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_vals),&ilengths_vals);CHKERRQ(ierr);
2660e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
2661e7931f94SStefano Zampini 
2662e7931f94SStefano Zampini   /* Get data from local mat */
2663e7931f94SStefano Zampini   if (!isdense) {
2664e7931f94SStefano Zampini     /* TODO: See below some guidelines on how to prepare the local buffers */
2665e7931f94SStefano Zampini     /*
2666e7931f94SStefano Zampini        send_buffer_vals should contain the raw values of the local matrix
2667e7931f94SStefano Zampini        send_buffer_idxs should contain:
2668e7931f94SStefano Zampini        - MatType_PRIVATE type
2669e7931f94SStefano Zampini        - PetscInt        size_of_l2gmap
2670e7931f94SStefano Zampini        - PetscInt        global_row_indices[size_of_l2gmap]
2671e7931f94SStefano Zampini        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
2672e7931f94SStefano Zampini     */
2673e7931f94SStefano Zampini   } else {
2674e7931f94SStefano Zampini     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
2675e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&i);CHKERRQ(ierr);
2676e7931f94SStefano Zampini     ierr = PetscMalloc((i+2)*sizeof(PetscInt),&send_buffer_idxs);CHKERRQ(ierr);
2677e7931f94SStefano Zampini     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
2678e7931f94SStefano Zampini     send_buffer_idxs[1] = i;
2679e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2680e7931f94SStefano Zampini     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
2681e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingRestoreIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2682e7931f94SStefano Zampini     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
2683e7931f94SStefano Zampini     for (i=0;i<n_sends;i++) {
2684e7931f94SStefano Zampini       ilengths_vals[is_indices[i]] = len*len;
2685e7931f94SStefano Zampini       ilengths_idxs[is_indices[i]] = len+2;
2686e7931f94SStefano Zampini     }
2687e7931f94SStefano Zampini   }
2688e7931f94SStefano Zampini   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
2689e7931f94SStefano Zampini   buf_size_idxs = 0;
2690e7931f94SStefano Zampini   buf_size_vals = 0;
2691e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2692e7931f94SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
2693e7931f94SStefano Zampini     buf_size_vals += (PetscInt)olengths_vals[i];
2694e7931f94SStefano Zampini   }
2695e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&recv_buffer_idxs);CHKERRQ(ierr);
2696e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_vals*sizeof(PetscScalar),&recv_buffer_vals);CHKERRQ(ierr);
2697e7931f94SStefano Zampini 
2698e7931f94SStefano Zampini   /* get new tags for clean communications */
2699e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
2700e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
2701e7931f94SStefano Zampini 
2702e7931f94SStefano Zampini   /* allocate for requests */
2703e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_idxs);CHKERRQ(ierr);
2704e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_vals);CHKERRQ(ierr);
2705e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_idxs);CHKERRQ(ierr);
2706e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_vals);CHKERRQ(ierr);
2707e7931f94SStefano Zampini 
2708e7931f94SStefano Zampini   /* communications */
2709e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2710e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
2711e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2712e7931f94SStefano Zampini     source_dest = onodes[i];
2713e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
2714e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
2715e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2716e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
2717e7931f94SStefano Zampini   }
2718e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) {
2719e7931f94SStefano Zampini     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
2720e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
2721e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
2722e7931f94SStefano Zampini   }
2723e7931f94SStefano Zampini   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2724e7931f94SStefano Zampini   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
2725e7931f94SStefano Zampini 
2726e7931f94SStefano Zampini   /* assemble new l2g map */
2727e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2728e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2729e7931f94SStefano Zampini   buf_size_idxs = 0;
2730e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2731e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
2732e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2733e7931f94SStefano Zampini   }
2734e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&l2gmap_indices);CHKERRQ(ierr);
2735e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2736e7931f94SStefano Zampini   buf_size_idxs = 0;
2737e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2738e7931f94SStefano Zampini     ierr = PetscMemcpy(&l2gmap_indices[buf_size_idxs],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
2739e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
2740e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2741e7931f94SStefano Zampini   }
2742e7931f94SStefano Zampini   ierr = PetscSortRemoveDupsInt(&buf_size_idxs,l2gmap_indices);CHKERRQ(ierr);
2743e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingCreate(comm,buf_size_idxs,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
2744e7931f94SStefano Zampini   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
2745e7931f94SStefano Zampini 
2746e7931f94SStefano Zampini   /* infer new local matrix type from received local matrices type */
2747e7931f94SStefano Zampini   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
2748e7931f94SStefano 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) */
2749e7931f94SStefano Zampini   new_local_type_private = MATAIJ_PRIVATE;
2750e7931f94SStefano Zampini   new_local_type = MATSEQAIJ;
2751e7931f94SStefano Zampini   if (n_recvs) {
2752be4bc593SStefano Zampini     new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
2753e7931f94SStefano Zampini     ptr_idxs = recv_buffer_idxs;
2754e7931f94SStefano Zampini     for (i=0;i<n_recvs;i++) {
2755e7931f94SStefano Zampini       if ((PetscInt)new_local_type_private != *ptr_idxs) {
2756e7931f94SStefano Zampini         new_local_type_private = MATAIJ_PRIVATE;
2757e7931f94SStefano Zampini         break;
2758e7931f94SStefano Zampini       }
2759e7931f94SStefano Zampini       ptr_idxs += olengths_idxs[i];
2760e7931f94SStefano Zampini     }
2761e7931f94SStefano Zampini     switch (new_local_type_private) {
2762e7931f94SStefano Zampini       case MATDENSE_PRIVATE: /* subassembling of dense matrices does not give a dense matrix! */
2763e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
2764e7931f94SStefano Zampini         bs = 1;
2765e7931f94SStefano Zampini         break;
2766e7931f94SStefano Zampini       case MATAIJ_PRIVATE:
2767e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
2768e7931f94SStefano Zampini         bs = 1;
2769e7931f94SStefano Zampini         break;
2770e7931f94SStefano Zampini       case MATBAIJ_PRIVATE:
2771e7931f94SStefano Zampini         new_local_type = MATSEQBAIJ;
2772e7931f94SStefano Zampini         break;
2773e7931f94SStefano Zampini       case MATSBAIJ_PRIVATE:
2774e7931f94SStefano Zampini         new_local_type = MATSEQSBAIJ;
2775e7931f94SStefano Zampini         break;
2776e7931f94SStefano Zampini       default:
2777e7931f94SStefano Zampini         SETERRQ2(comm,PETSC_ERR_LIB,"Unkwown private type %d in %s",new_local_type_private,__FUNCT__);
2778e7931f94SStefano Zampini         break;
2779e7931f94SStefano Zampini     }
2780e7931f94SStefano Zampini   }
2781e7931f94SStefano Zampini 
2782e7931f94SStefano Zampini   /* create MATIS object */
2783e7931f94SStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
2784e7931f94SStefano Zampini   ierr = MatCreateIS(comm,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,&new_mat);CHKERRQ(ierr);
2785e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
2786e7931f94SStefano Zampini   ierr = MatISGetLocalMat(new_mat,&local_mat);CHKERRQ(ierr);
2787e7931f94SStefano Zampini   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
2788e7931f94SStefano Zampini   ierr = MatSetUp(local_mat);CHKERRQ(ierr); /* WARNING -> no preallocation yet */
2789e7931f94SStefano Zampini 
2790e7931f94SStefano Zampini   /* set values */
2791e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2792e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
2793e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2794e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2795e7931f94SStefano Zampini     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
2796e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
2797e7931f94SStefano Zampini       ierr = MatSetValues(new_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
2798e7931f94SStefano Zampini       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
2799e7931f94SStefano Zampini       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
2800e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
2801e7931f94SStefano Zampini     }
2802e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2803e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
2804e7931f94SStefano Zampini   }
2805e7931f94SStefano Zampini   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2806e7931f94SStefano Zampini   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2807e7931f94SStefano Zampini   ierr = MatAssemblyBegin(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2808e7931f94SStefano Zampini   ierr = MatAssemblyEnd(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2809e7931f94SStefano Zampini 
2810e7931f94SStefano Zampini   { /* check */
2811e7931f94SStefano Zampini     Vec       lvec,rvec;
2812e7931f94SStefano Zampini     PetscReal infty_error;
2813e7931f94SStefano Zampini 
2814e7931f94SStefano Zampini     ierr = MatGetVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
2815e7931f94SStefano Zampini     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
2816e7931f94SStefano Zampini     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
2817e7931f94SStefano Zampini     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
2818e7931f94SStefano Zampini     ierr = MatMultAdd(new_mat,rvec,lvec,lvec);CHKERRQ(ierr);
2819e7931f94SStefano Zampini     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
2820e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
2821e7931f94SStefano Zampini     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
2822e7931f94SStefano Zampini     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
2823e7931f94SStefano Zampini   }
2824e7931f94SStefano Zampini 
2825e7931f94SStefano Zampini   /* free workspace */
2826e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
2827e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
2828e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2829e7931f94SStefano Zampini   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
2830e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2831e7931f94SStefano Zampini   if (isdense) {
2832e7931f94SStefano Zampini     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2833e7931f94SStefano Zampini     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
2834e7931f94SStefano Zampini   } else {
2835e7931f94SStefano Zampini     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
2836e7931f94SStefano Zampini   }
2837e7931f94SStefano Zampini   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
2838e7931f94SStefano Zampini   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
2839e7931f94SStefano Zampini   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
2840e7931f94SStefano Zampini   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
2841e7931f94SStefano Zampini   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
2842e7931f94SStefano Zampini   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
2843e7931f94SStefano Zampini   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
2844e7931f94SStefano Zampini   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
2845e7931f94SStefano Zampini   ierr = PetscFree(onodes);CHKERRQ(ierr);
2846e7931f94SStefano Zampini   /* get back new mat */
2847e7931f94SStefano Zampini   *mat_n = new_mat;
2848e7931f94SStefano Zampini   PetscFunctionReturn(0);
2849e7931f94SStefano Zampini }
2850a57a6d2fSStefano Zampini 
2851c8587f34SStefano Zampini #undef __FUNCT__
28528629588bSStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
28538629588bSStefano Zampini PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
2854c8587f34SStefano Zampini {
2855c8587f34SStefano Zampini   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
2856c8587f34SStefano Zampini   PC_IS                  *pcis = (PC_IS*)pc->data;
285720a2ab83SStefano Zampini   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
28589881197aSStefano Zampini   MatNullSpace           CoarseNullSpace=NULL;
285920a2ab83SStefano Zampini   ISLocalToGlobalMapping coarse_islg;
286020a2ab83SStefano Zampini   IS                     coarse_is;
2861f9eb5b7dSStefano Zampini   PetscInt               max_it,coarse_size,*local_primal_indices=NULL;
2862f9eb5b7dSStefano Zampini   PetscInt               im_active=-1,active_procs=-1;
2863f9eb5b7dSStefano Zampini   PC                     pc_temp;
2864c8587f34SStefano Zampini   PCType                 coarse_pc_type;
2865c8587f34SStefano Zampini   KSPType                coarse_ksp_type;
2866f9eb5b7dSStefano Zampini   PetscBool              multilevel_requested,multilevel_allowed;
2867f9eb5b7dSStefano Zampini   PetscBool              setsym,issym,isbddc,isnn;
2868f9eb5b7dSStefano Zampini   MatStructure           matstruct;
28699881197aSStefano Zampini   PetscErrorCode         ierr;
2870fdc09c96SStefano Zampini 
2871c8587f34SStefano Zampini   PetscFunctionBegin;
2872c8587f34SStefano Zampini   /* Assign global numbering to coarse dofs */
2873f34684f1SStefano Zampini   ierr = PCBDDCComputePrimalNumbering(pc,&coarse_size,&local_primal_indices);CHKERRQ(ierr);
2874c8587f34SStefano Zampini 
2875f9eb5b7dSStefano Zampini   /* infer some info from user */
2876f9eb5b7dSStefano Zampini   issym = PETSC_FALSE;
2877f9eb5b7dSStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
2878f9eb5b7dSStefano Zampini   multilevel_allowed = PETSC_FALSE;
2879f9eb5b7dSStefano Zampini   multilevel_requested = PETSC_FALSE;
2880f9eb5b7dSStefano Zampini   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
2881f9eb5b7dSStefano Zampini   if (multilevel_requested) {
28822b510759SStefano Zampini     /* count "active processes" */
28832b510759SStefano Zampini     im_active = !!(pcis->n);
28842b510759SStefano Zampini     ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
28852b510759SStefano Zampini     if (active_procs/pcbddc->coarsening_ratio < 2) {
2886f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_FALSE;
28872b510759SStefano Zampini     } else {
2888f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_TRUE;
2889c8587f34SStefano Zampini     }
2890c8587f34SStefano Zampini   }
2891e7931f94SStefano Zampini 
2892f9eb5b7dSStefano Zampini   /* set defaults for coarse KSP and PC */
2893f9eb5b7dSStefano Zampini   if (multilevel_allowed) {
2894f9eb5b7dSStefano Zampini     if (issym) {
2895f9eb5b7dSStefano Zampini       coarse_ksp_type = KSPRICHARDSON;
2896f9eb5b7dSStefano Zampini     } else {
2897f9eb5b7dSStefano Zampini       coarse_ksp_type = KSPCHEBYSHEV;
2898f9eb5b7dSStefano Zampini     }
2899f9eb5b7dSStefano Zampini     coarse_pc_type = PCBDDC;
2900f9eb5b7dSStefano Zampini   } else {
2901f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPPREONLY;
2902f9eb5b7dSStefano Zampini     coarse_pc_type = PCREDUNDANT;
2903f9eb5b7dSStefano Zampini   }
2904f9eb5b7dSStefano Zampini 
2905f9eb5b7dSStefano Zampini   /* create the coarse KSP object only once with defaults */
2906f9eb5b7dSStefano Zampini   if (!pcbddc->coarse_ksp) {
2907e604994aSStefano Zampini     char prefix[256],str_level[3];
2908e604994aSStefano Zampini     size_t len;
2909f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_ksp);CHKERRQ(ierr);
2910f9eb5b7dSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
2911f9eb5b7dSStefano Zampini     ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
2912f9eb5b7dSStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
2913f9eb5b7dSStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
2914f9eb5b7dSStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
2915e604994aSStefano Zampini     /* prefix */
2916e604994aSStefano Zampini     ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
2917e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
2918e604994aSStefano Zampini     if (!pcbddc->current_level) {
2919e604994aSStefano Zampini       ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
2920e604994aSStefano Zampini       ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
2921e604994aSStefano Zampini     } else {
2922e604994aSStefano Zampini       ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
2923e604994aSStefano Zampini       if (pcbddc->current_level>1) len -= 2;
2924e604994aSStefano Zampini       ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
2925e604994aSStefano Zampini       *(prefix+len)='\0';
2926e604994aSStefano Zampini       sprintf(str_level,"%d_",(int)(pcbddc->current_level));
2927e604994aSStefano Zampini       ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
2928e604994aSStefano Zampini     }
2929e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
2930f9eb5b7dSStefano Zampini   }
2931f9eb5b7dSStefano Zampini   /* allow user customization */
293285c4d303SStefano 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); */
2933f9eb5b7dSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
293485c4d303SStefano 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); */
2935f9eb5b7dSStefano Zampini 
2936f9eb5b7dSStefano Zampini   /* get some info after set from options */
2937f9eb5b7dSStefano Zampini   ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
2938f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
2939f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
2940f9eb5b7dSStefano Zampini   if (isbddc && !multilevel_allowed) { /* prevent from infinite loop if user as requested bddc pc for coarse solver */
2941f9eb5b7dSStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
2942f9eb5b7dSStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
2943f9eb5b7dSStefano Zampini     isbddc = PETSC_FALSE;
2944f9eb5b7dSStefano Zampini   }
2945f9eb5b7dSStefano Zampini 
2946f9eb5b7dSStefano Zampini   /* propagate BDDC info to the next level */
2947f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
2948f9eb5b7dSStefano Zampini   ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
2949f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
2950f9eb5b7dSStefano Zampini 
2951f9eb5b7dSStefano Zampini   /* creates temporary MATIS object for coarse matrix */
2952a57a6d2fSStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,local_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
2953a57a6d2fSStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
2954a57a6d2fSStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
2955a57a6d2fSStefano Zampini   ierr = MatCreateIS(PetscObjectComm((PetscObject)pc),1,PETSC_DECIDE,PETSC_DECIDE,coarse_size,coarse_size,coarse_islg,&coarse_mat_is);CHKERRQ(ierr);
2956a57a6d2fSStefano Zampini   ierr = MatISSetLocalMat(coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
2957e7931f94SStefano Zampini   ierr = MatAssemblyBegin(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2958e7931f94SStefano Zampini   ierr = MatAssemblyEnd(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
295920a2ab83SStefano Zampini   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
296020a2ab83SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
296120a2ab83SStefano Zampini   ierr = PetscFree(local_primal_indices);CHKERRQ(ierr);
2962fdc09c96SStefano Zampini 
2963f9eb5b7dSStefano Zampini   /* assemble coarse matrix */
2964f9eb5b7dSStefano Zampini   if (isbddc || isnn) {
2965f9eb5b7dSStefano Zampini     ierr = MatISSubassemble(coarse_mat_is,NULL,pcbddc->coarsening_ratio,&coarse_mat);CHKERRQ(ierr);
2966f9eb5b7dSStefano Zampini   } else {
29672b510759SStefano Zampini     ierr = MatConvert_IS_AIJ(coarse_mat_is,MATAIJ,MAT_INITIAL_MATRIX,&coarse_mat);CHKERRQ(ierr);
2968c8587f34SStefano Zampini   }
29692b510759SStefano Zampini   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
29709881197aSStefano Zampini 
2971f9eb5b7dSStefano Zampini   /* create local to global scatters for coarse problem */
2972f9eb5b7dSStefano Zampini   ierr = MatGetVecs(coarse_mat,&pcbddc->coarse_vec,&pcbddc->coarse_rhs);CHKERRQ(ierr);
2973f9eb5b7dSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
2974f9eb5b7dSStefano Zampini   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
2975f9eb5b7dSStefano Zampini 
2976f9eb5b7dSStefano Zampini   /* propagate symmetry info to coarse matrix */
2977f9eb5b7dSStefano Zampini   ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,issym);CHKERRQ(ierr);
2978f9eb5b7dSStefano Zampini 
2979b8ffe317SStefano Zampini   /* Compute coarse null space (special handling by BDDC only) */
2980b8ffe317SStefano Zampini   if (pcbddc->NullSpace) {
2981b8ffe317SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCoarse(pc,coarse_mat,&CoarseNullSpace);CHKERRQ(ierr);
2982b8ffe317SStefano Zampini     if (isbddc) {
2983b8ffe317SStefano Zampini       ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
2984b8ffe317SStefano Zampini     } else {
2985b8ffe317SStefano Zampini       ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
2986b8ffe317SStefano Zampini     }
2987b8ffe317SStefano Zampini   }
2988b8ffe317SStefano Zampini 
2989f9eb5b7dSStefano Zampini   /* set operators */
2990f9eb5b7dSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
2991f9eb5b7dSStefano Zampini   ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat,matstruct);CHKERRQ(ierr);
2992f9eb5b7dSStefano Zampini 
2993f9eb5b7dSStefano Zampini   /* additional KSP customization */
2994f9eb5b7dSStefano Zampini   ierr = KSPGetTolerances(pcbddc->coarse_ksp,NULL,NULL,NULL,&max_it);CHKERRQ(ierr);
2995f9eb5b7dSStefano Zampini   if (max_it < 5) {
2996f9eb5b7dSStefano Zampini     ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
2997f9eb5b7dSStefano Zampini   }
2998b8ffe317SStefano Zampini   /* ierr = KSPChebyshevSetEstimateEigenvalues(pcbddc->coarse_ksp,1.0,0.0,0.0,1.1);CHKERRQ(ierr); */
2999f9eb5b7dSStefano Zampini 
3000f9eb5b7dSStefano Zampini 
3001f9eb5b7dSStefano Zampini   /* print some info if requested */
3002f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
3003f9eb5b7dSStefano Zampini     ierr = KSPGetType(pcbddc->coarse_ksp,&coarse_ksp_type);CHKERRQ(ierr);
3004f9eb5b7dSStefano Zampini     ierr = PCGetType(pc_temp,&coarse_pc_type);CHKERRQ(ierr);
3005f9eb5b7dSStefano Zampini     if (!multilevel_allowed) {
3006f9eb5b7dSStefano Zampini       if (multilevel_requested) {
3007f9eb5b7dSStefano 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);
3008f9eb5b7dSStefano Zampini       } else if (pcbddc->max_levels) {
3009f9eb5b7dSStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
3010f9eb5b7dSStefano Zampini       }
3011f9eb5b7dSStefano Zampini     }
3012e604994aSStefano 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);
3013f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3014f9eb5b7dSStefano Zampini   }
3015f9eb5b7dSStefano Zampini 
3016f9eb5b7dSStefano Zampini   /* setup coarse ksp */
3017f9eb5b7dSStefano Zampini   ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
3018f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
3019f9eb5b7dSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
3020f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3021f9eb5b7dSStefano Zampini     ierr = KSPView(pcbddc->coarse_ksp,pcbddc->dbg_viewer);CHKERRQ(ierr);
3022f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3023f9eb5b7dSStefano Zampini   }
3024f9eb5b7dSStefano Zampini 
3025c8587f34SStefano Zampini   /* Check coarse problem if requested */
302620a2ab83SStefano Zampini   if (pcbddc->dbg_flag) {
3027c8587f34SStefano Zampini     KSP       check_ksp;
30282b510759SStefano Zampini     KSPType   check_ksp_type;
3029c8587f34SStefano Zampini     PC        check_pc;
3030c8587f34SStefano Zampini     Vec       check_vec;
3031c8587f34SStefano Zampini     PetscReal abs_infty_error,infty_error,lambda_min,lambda_max;
30322b510759SStefano Zampini     PetscInt  its;
3033f9eb5b7dSStefano Zampini     PetscBool ispreonly,compute;
3034c8587f34SStefano Zampini 
30352b510759SStefano Zampini     /* Create ksp object suitable for estimation of extreme eigenvalues */
3036f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&check_ksp);CHKERRQ(ierr);
3037fdc635d7SStefano Zampini     ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
3038f9eb5b7dSStefano Zampini     ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,coarse_size);CHKERRQ(ierr);
30392b510759SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
30402b510759SStefano Zampini     if (ispreonly) {
30412b510759SStefano Zampini       check_ksp_type = KSPPREONLY;
3042f9eb5b7dSStefano Zampini       compute = PETSC_FALSE;
30432b510759SStefano Zampini     } else {
3044c8587f34SStefano Zampini       if (issym) check_ksp_type = KSPCG;
3045c8587f34SStefano Zampini       else check_ksp_type = KSPGMRES;
3046f9eb5b7dSStefano Zampini       compute = PETSC_TRUE;
3047c8587f34SStefano Zampini     }
3048c8587f34SStefano Zampini     ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
3049f9eb5b7dSStefano Zampini     ierr = KSPSetComputeSingularValues(check_ksp,compute);CHKERRQ(ierr);
3050c8587f34SStefano Zampini     ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
3051f9eb5b7dSStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
3052f9eb5b7dSStefano Zampini     ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
3053c8587f34SStefano Zampini     /* create random vec */
3054c8587f34SStefano Zampini     ierr = VecDuplicate(pcbddc->coarse_vec,&check_vec);CHKERRQ(ierr);
3055c8587f34SStefano Zampini     ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
3056c8587f34SStefano Zampini     if (CoarseNullSpace) {
3057c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec);CHKERRQ(ierr);
3058c8587f34SStefano Zampini     }
3059fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3060c8587f34SStefano Zampini     /* solve coarse problem */
3061c8587f34SStefano Zampini     ierr = KSPSolve(check_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
3062c8587f34SStefano Zampini     if (CoarseNullSpace) {
3063c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,pcbddc->coarse_vec);CHKERRQ(ierr);
3064c8587f34SStefano Zampini     }
3065c8587f34SStefano Zampini     /* check coarse problem residual error */
3066c8587f34SStefano Zampini     ierr = VecAXPY(check_vec,-1.0,pcbddc->coarse_vec);CHKERRQ(ierr);
3067c8587f34SStefano Zampini     ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3068fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3069c8587f34SStefano Zampini     ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
3070c8587f34SStefano Zampini     ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
3071e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem (%s) details\n",((PetscObject)(pcbddc->coarse_ksp))->prefix);CHKERRQ(ierr);
3072e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
3073e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
3074f9eb5b7dSStefano Zampini     /* get eigenvalue estimation if preonly has not been requested */
30752b510759SStefano Zampini     if (!ispreonly) {
3076c8587f34SStefano Zampini       ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
307720a2ab83SStefano Zampini       ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
3078f9eb5b7dSStefano 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);
3079c8587f34SStefano Zampini     }
30802b510759SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3081c8587f34SStefano Zampini     ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
3082c8587f34SStefano Zampini   }
30832b510759SStefano Zampini   /* free memory */
3084c8587f34SStefano Zampini   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
3085fdc635d7SStefano Zampini   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
3086c8587f34SStefano Zampini   PetscFunctionReturn(0);
3087c8587f34SStefano Zampini }
30889a7d3425SStefano Zampini 
3089f34684f1SStefano Zampini #undef __FUNCT__
3090f34684f1SStefano Zampini #define __FUNCT__ "PCBDDCComputePrimalNumbering"
3091f34684f1SStefano Zampini PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
3092f34684f1SStefano Zampini {
3093f34684f1SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3094f34684f1SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
3095f34684f1SStefano Zampini   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
3096f34684f1SStefano Zampini   PetscInt       i,j,coarse_size;
3097f34684f1SStefano Zampini   PetscInt       *local_primal_indices,*auxlocal_primal,*aux_idx;
3098f34684f1SStefano Zampini   PetscErrorCode ierr;
3099f34684f1SStefano Zampini 
3100f34684f1SStefano Zampini   PetscFunctionBegin;
3101f34684f1SStefano Zampini   /* get indices in local ordering for vertices and constraints */
3102f34684f1SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&auxlocal_primal);CHKERRQ(ierr);
3103f34684f1SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&i,&aux_idx);CHKERRQ(ierr);
3104f34684f1SStefano Zampini   ierr = PetscMemcpy(auxlocal_primal,aux_idx,i*sizeof(PetscInt));CHKERRQ(ierr);
3105f34684f1SStefano Zampini   ierr = PetscFree(aux_idx);CHKERRQ(ierr);
3106f34684f1SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&j,&aux_idx);CHKERRQ(ierr);
3107f34684f1SStefano Zampini   ierr = PetscMemcpy(&auxlocal_primal[i],aux_idx,j*sizeof(PetscInt));CHKERRQ(ierr);
3108f34684f1SStefano Zampini   ierr = PetscFree(aux_idx);CHKERRQ(ierr);
3109f34684f1SStefano Zampini 
3110f34684f1SStefano Zampini   /* Compute global number of coarse dofs */
3111f34684f1SStefano Zampini   ierr = PCBDDCSubsetNumbering(PetscObjectComm((PetscObject)(pc->pmat)),matis->mapping,pcbddc->local_primal_size,auxlocal_primal,NULL,&coarse_size,&local_primal_indices);CHKERRQ(ierr);
3112f34684f1SStefano Zampini 
3113f34684f1SStefano Zampini   /* check numbering */
3114f34684f1SStefano Zampini   if (pcbddc->dbg_flag) {
3115f34684f1SStefano Zampini     PetscScalar coarsesum,*array;
3116f34684f1SStefano Zampini 
3117f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3118f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3119f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
3120f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
3121f34684f1SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
3122f34684f1SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,auxlocal_primal[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
3123f34684f1SStefano Zampini     }
3124f34684f1SStefano Zampini     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
3125f34684f1SStefano Zampini     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
3126f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3127f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3128f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3129f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3130f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3131f34684f1SStefano Zampini     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3132f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3133f34684f1SStefano Zampini       if (array[i] == 1.0) {
3134f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %d owned by a single process!\n",PetscGlobalRank,i);CHKERRQ(ierr);
3135f34684f1SStefano Zampini       }
3136f34684f1SStefano Zampini     }
3137f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3138f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3139f34684f1SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
3140f34684f1SStefano Zampini     }
3141f34684f1SStefano Zampini     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3142f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3143f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3144f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3145f34684f1SStefano Zampini     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
3146f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
3147f34684f1SStefano Zampini     if (pcbddc->dbg_flag > 1) {
3148f34684f1SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
3149f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3150f34684f1SStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
3151f34684f1SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
3152f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_primal_indices[%d]=%d \n",i,local_primal_indices[i]);
3153f34684f1SStefano Zampini       }
3154f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3155f34684f1SStefano Zampini     }
3156f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3157f34684f1SStefano Zampini   }
3158f34684f1SStefano Zampini   ierr = PetscFree(auxlocal_primal);CHKERRQ(ierr);
3159f34684f1SStefano Zampini   /* get back data */
3160f34684f1SStefano Zampini   *coarse_size_n = coarse_size;
3161f34684f1SStefano Zampini   *local_primal_indices_n = local_primal_indices;
3162f34684f1SStefano Zampini   PetscFunctionReturn(0);
3163f34684f1SStefano Zampini }
3164f34684f1SStefano Zampini 
3165