xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision f9eb5b7dd9df894bdc8b7c07630553a1ab9a0cd0)
1674ae819SStefano Zampini #include "bddc.h"
2674ae819SStefano Zampini #include "bddcprivate.h"
3674ae819SStefano Zampini #include <petscblaslapack.h>
4674ae819SStefano Zampini 
5674ae819SStefano Zampini #undef __FUNCT__
6c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpSolvers"
7c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpSolvers(PC pc)
8c8587f34SStefano Zampini {
9c8587f34SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
108629588bSStefano Zampini   PetscScalar    *coarse_submat_vals;
11c8587f34SStefano Zampini   PetscErrorCode ierr;
12c8587f34SStefano Zampini 
13c8587f34SStefano Zampini   PetscFunctionBegin;
14c8587f34SStefano Zampini   /* Compute matrix after change of basis and extract local submatrices */
15c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalMatrices(pc);CHKERRQ(ierr);
16c8587f34SStefano Zampini 
17c8587f34SStefano Zampini   /* Allocate needed vectors */
18c8587f34SStefano Zampini   ierr = PCBDDCCreateWorkVectors(pc);CHKERRQ(ierr);
19c8587f34SStefano Zampini 
20c8587f34SStefano Zampini   /* Setup local scatters R_to_B and (optionally) R_to_D : PCBDDCCreateWorkVectors should be called first! */
21c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
22c8587f34SStefano Zampini 
23c8587f34SStefano Zampini   /* Setup local solvers ksp_D and ksp_R */
24c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalSolvers(pc);CHKERRQ(ierr);
25c8587f34SStefano Zampini 
26c8587f34SStefano Zampini   /* Change global null space passed in by the user if change of basis has been requested */
27c8587f34SStefano Zampini   if (pcbddc->NullSpace && pcbddc->use_change_of_basis) {
28c8587f34SStefano Zampini     ierr = PCBDDCNullSpaceAdaptGlobal(pc);CHKERRQ(ierr);
29c8587f34SStefano Zampini   }
30c8587f34SStefano Zampini 
318629588bSStefano Zampini   /*
328629588bSStefano Zampini      Setup local correction and local part of coarse basis.
338629588bSStefano Zampini      Gives back the dense local part of the coarse matrix in column major ordering
348629588bSStefano Zampini   */
358629588bSStefano Zampini   ierr = PCBDDCSetUpCoarseLocal(pc,&coarse_submat_vals);CHKERRQ(ierr);
368629588bSStefano Zampini 
378629588bSStefano Zampini   /* Compute total number of coarse nodes and setup coarse solver */
388629588bSStefano Zampini   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
398629588bSStefano Zampini 
408629588bSStefano Zampini   /* free */
418629588bSStefano Zampini   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
42c8587f34SStefano Zampini   PetscFunctionReturn(0);
43c8587f34SStefano Zampini }
44c8587f34SStefano Zampini 
45c8587f34SStefano Zampini #undef __FUNCT__
46674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetCustomization"
47674ae819SStefano Zampini PetscErrorCode PCBDDCResetCustomization(PC pc)
48674ae819SStefano Zampini {
49674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
50674ae819SStefano Zampini   PetscInt       i;
51674ae819SStefano Zampini   PetscErrorCode ierr;
52674ae819SStefano Zampini 
53674ae819SStefano Zampini   PetscFunctionBegin;
54674ae819SStefano Zampini   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
55674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
56674ae819SStefano Zampini   ierr = MatNullSpaceDestroy(&pcbddc->NullSpace);CHKERRQ(ierr);
57674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
58674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
59674ae819SStefano Zampini   for (i=0;i<pcbddc->n_ISForDofs;i++) {
60674ae819SStefano Zampini     ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
61674ae819SStefano Zampini   }
62674ae819SStefano Zampini   ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
63674ae819SStefano Zampini   PetscFunctionReturn(0);
64674ae819SStefano Zampini }
65674ae819SStefano Zampini 
66674ae819SStefano Zampini #undef __FUNCT__
67674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetTopography"
68674ae819SStefano Zampini PetscErrorCode PCBDDCResetTopography(PC pc)
69674ae819SStefano Zampini {
70674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
71674ae819SStefano Zampini   PetscErrorCode ierr;
72674ae819SStefano Zampini 
73674ae819SStefano Zampini   PetscFunctionBegin;
74674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
75674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
76674ae819SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
77674ae819SStefano Zampini   PetscFunctionReturn(0);
78674ae819SStefano Zampini }
79674ae819SStefano Zampini 
80674ae819SStefano Zampini #undef __FUNCT__
81674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetSolvers"
82674ae819SStefano Zampini PetscErrorCode PCBDDCResetSolvers(PC pc)
83674ae819SStefano Zampini {
84674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
85674ae819SStefano Zampini   PetscErrorCode ierr;
86674ae819SStefano Zampini 
87674ae819SStefano Zampini   PetscFunctionBegin;
88674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
89674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_rhs);CHKERRQ(ierr);
90674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
91674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
9215aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
9315aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
94674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
95674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
96674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
97674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
98674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
99674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
100674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec4_D);CHKERRQ(ierr);
1018ce42a96SStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
102674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
103674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
104674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
105674ae819SStefano Zampini   PetscFunctionReturn(0);
106674ae819SStefano Zampini }
107674ae819SStefano Zampini 
108674ae819SStefano Zampini #undef __FUNCT__
1096bfb1811SStefano Zampini #define __FUNCT__ "PCBDDCCreateWorkVectors"
1106bfb1811SStefano Zampini PetscErrorCode PCBDDCCreateWorkVectors(PC pc)
1116bfb1811SStefano Zampini {
1126bfb1811SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1136bfb1811SStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
1146bfb1811SStefano Zampini   VecType        impVecType;
1156bfb1811SStefano Zampini   PetscInt       n_vertices,n_constraints,local_primal_size,n_R;
1166bfb1811SStefano Zampini   PetscErrorCode ierr;
1176bfb1811SStefano Zampini 
1186bfb1811SStefano Zampini   PetscFunctionBegin;
1196bfb1811SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,NULL);CHKERRQ(ierr);
1206bfb1811SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&n_constraints,NULL);CHKERRQ(ierr);
1216bfb1811SStefano Zampini   local_primal_size = n_constraints+n_vertices;
1226bfb1811SStefano Zampini   n_R = pcis->n-n_vertices;
1236bfb1811SStefano Zampini   /* local work vectors */
1246bfb1811SStefano Zampini   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
1256bfb1811SStefano Zampini   ierr = VecDuplicate(pcis->vec1_D,&pcbddc->vec4_D);CHKERRQ(ierr);
1266bfb1811SStefano Zampini   ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
1276bfb1811SStefano Zampini   ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
1286bfb1811SStefano Zampini   ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
1296bfb1811SStefano Zampini   ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
13083b7ccabSStefano Zampini   ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
1316bfb1811SStefano Zampini   ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,local_primal_size);CHKERRQ(ierr);
1326bfb1811SStefano Zampini   ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
13383b7ccabSStefano Zampini   if (n_constraints) {
13483b7ccabSStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
13583b7ccabSStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
13683b7ccabSStefano Zampini     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
13783b7ccabSStefano Zampini   }
1386bfb1811SStefano Zampini   PetscFunctionReturn(0);
1396bfb1811SStefano Zampini }
1406bfb1811SStefano Zampini 
1416bfb1811SStefano Zampini #undef __FUNCT__
1424a78082cSStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseLocal"
1438629588bSStefano Zampini PetscErrorCode PCBDDCSetUpCoarseLocal(PC pc, PetscScalar **coarse_submat_vals_n)
14488ebb749SStefano Zampini {
14525084f0cSStefano Zampini   PetscErrorCode         ierr;
14625084f0cSStefano Zampini   /* pointers to pcis and pcbddc */
14788ebb749SStefano Zampini   PC_IS*                 pcis = (PC_IS*)pc->data;
14888ebb749SStefano Zampini   PC_BDDC*               pcbddc = (PC_BDDC*)pc->data;
14925084f0cSStefano Zampini   /* submatrices of local problem */
15088ebb749SStefano Zampini   Mat                    A_RV,A_VR,A_VV;
15125084f0cSStefano Zampini   /* working matrices */
15225084f0cSStefano Zampini   Mat                    M1,M2,M3,C_CR;
15325084f0cSStefano Zampini   /* working vectors */
15425084f0cSStefano Zampini   Vec                    vec1_C,vec2_C,vec1_V,vec2_V;
15525084f0cSStefano Zampini   /* additional working stuff */
15625084f0cSStefano Zampini   IS                     is_aux;
15788ebb749SStefano Zampini   ISLocalToGlobalMapping BtoNmap;
15825084f0cSStefano Zampini   PetscScalar            *coarse_submat_vals; /* TODO: use a PETSc matrix */
15925084f0cSStefano Zampini   const PetscScalar      *array,*row_cmat_values;
16025084f0cSStefano Zampini   const PetscInt         *row_cmat_indices,*idx_R_local;
16125084f0cSStefano Zampini   PetscInt               *vertices,*idx_V_B,*auxindices;
16225084f0cSStefano Zampini   PetscInt               n_vertices,n_constraints,size_of_constraint;
16325084f0cSStefano Zampini   PetscInt               i,j,n_R,n_D,n_B;
16488ebb749SStefano Zampini   PetscBool              setsym=PETSC_FALSE,issym=PETSC_FALSE;
16525084f0cSStefano Zampini   /* Vector and matrix types */
16688ebb749SStefano Zampini   VecType                impVecType;
16788ebb749SStefano Zampini   MatType                impMatType;
16825084f0cSStefano Zampini   /* some shortcuts to scalars */
16925084f0cSStefano Zampini   PetscScalar            zero=0.0,one=1.0,m_one=-1.0;
17025084f0cSStefano Zampini   /* for debugging purposes */
17188ebb749SStefano Zampini   PetscReal              *coarsefunctions_errors,*constraints_errors;
17288ebb749SStefano Zampini 
17388ebb749SStefano Zampini   PetscFunctionBegin;
17425084f0cSStefano Zampini   /* get number of vertices and their local indices */
17525084f0cSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
17688ebb749SStefano Zampini   n_constraints = pcbddc->local_primal_size-n_vertices;
17788ebb749SStefano Zampini   /* Set Non-overlapping dimensions */
17888ebb749SStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
17988ebb749SStefano Zampini   n_R = pcis->n-n_vertices;
18088ebb749SStefano Zampini 
18188ebb749SStefano Zampini   /* Set types for local objects needed by BDDC precondtioner */
18288ebb749SStefano Zampini   impMatType = MATSEQDENSE;
18325084f0cSStefano Zampini   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
18488ebb749SStefano Zampini 
18588ebb749SStefano Zampini   /* Allocating some extra storage just to be safe */
18688ebb749SStefano Zampini   ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&auxindices);CHKERRQ(ierr);
18788ebb749SStefano Zampini   for (i=0;i<pcis->n;i++) auxindices[i]=i;
18888ebb749SStefano Zampini 
18988ebb749SStefano Zampini   /* vertices in boundary numbering */
19088ebb749SStefano Zampini   ierr = PetscMalloc(n_vertices*sizeof(PetscInt),&idx_V_B);CHKERRQ(ierr);
19188ebb749SStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(pcis->is_B_local,&BtoNmap);CHKERRQ(ierr);
19288ebb749SStefano Zampini   ierr = ISGlobalToLocalMappingApply(BtoNmap,IS_GTOLM_DROP,n_vertices,vertices,&i,idx_V_B);CHKERRQ(ierr);
19388ebb749SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&BtoNmap);CHKERRQ(ierr);
19488ebb749SStefano Zampini   if (i != n_vertices) {
19588ebb749SStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %d != %d\n",n_vertices,i);
19688ebb749SStefano Zampini   }
19788ebb749SStefano Zampini 
19888ebb749SStefano Zampini   /* some work vectors on vertices and/or constraints */
19988ebb749SStefano Zampini   if (n_vertices) {
20088ebb749SStefano Zampini     ierr = VecCreate(PETSC_COMM_SELF,&vec1_V);CHKERRQ(ierr);
20188ebb749SStefano Zampini     ierr = VecSetSizes(vec1_V,n_vertices,n_vertices);CHKERRQ(ierr);
20288ebb749SStefano Zampini     ierr = VecSetType(vec1_V,impVecType);CHKERRQ(ierr);
20388ebb749SStefano Zampini     ierr = VecDuplicate(vec1_V,&vec2_V);CHKERRQ(ierr);
20488ebb749SStefano Zampini   }
20588ebb749SStefano Zampini   if (n_constraints) {
20688ebb749SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec1_C);CHKERRQ(ierr);
20788ebb749SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec2_C);CHKERRQ(ierr);
20888ebb749SStefano Zampini   }
20925084f0cSStefano Zampini 
21088ebb749SStefano Zampini   /* Precompute stuffs needed for preprocessing and application of BDDC*/
21188ebb749SStefano Zampini   if (n_constraints) {
21288ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->local_auxmat2);CHKERRQ(ierr);
21325084f0cSStefano Zampini     ierr = MatSetSizes(pcbddc->local_auxmat2,n_R,n_constraints,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
21488ebb749SStefano Zampini     ierr = MatSetType(pcbddc->local_auxmat2,impMatType);CHKERRQ(ierr);
21525084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->local_auxmat2);CHKERRQ(ierr);
21688ebb749SStefano Zampini 
21725084f0cSStefano Zampini     /* Extract constraints on R nodes: C_{CR}  */
21825084f0cSStefano Zampini     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
2198ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
22025084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
22188ebb749SStefano Zampini 
22288ebb749SStefano Zampini     /* Assemble local_auxmat2 = - A_{RR}^{-1} C^T_{CR} needed by BDDC application */
22388ebb749SStefano Zampini     for (i=0;i<n_constraints;i++) {
22488ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
22588ebb749SStefano Zampini       /* Get row of constraint matrix in R numbering */
22625084f0cSStefano Zampini       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
22725084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_R,size_of_constraint,row_cmat_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
22825084f0cSStefano Zampini       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
22925084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_R);CHKERRQ(ierr);
23025084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_R);CHKERRQ(ierr);
23188ebb749SStefano Zampini       /* Solve for row of constraint matrix in R numbering */
23288ebb749SStefano Zampini       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
23325084f0cSStefano Zampini       /* Set values in local_auxmat2 */
23425084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
23588ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->local_auxmat2,n_R,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
23625084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
23788ebb749SStefano Zampini     }
23888ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
23988ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
24025084f0cSStefano Zampini     ierr = MatScale(pcbddc->local_auxmat2,m_one);CHKERRQ(ierr);
24188ebb749SStefano Zampini 
24288ebb749SStefano Zampini     /* Assemble explicitly M1 = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1} needed in preproc  */
24325084f0cSStefano Zampini     ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
24425084f0cSStefano Zampini     ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
24588ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&M1);CHKERRQ(ierr);
24688ebb749SStefano Zampini     ierr = MatSetSizes(M1,n_constraints,n_constraints,n_constraints,n_constraints);CHKERRQ(ierr);
24788ebb749SStefano Zampini     ierr = MatSetType(M1,impMatType);CHKERRQ(ierr);
24825084f0cSStefano Zampini     ierr = MatSetUp(M1);CHKERRQ(ierr);
24925084f0cSStefano Zampini     ierr = MatDuplicate(M1,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
25025084f0cSStefano Zampini     ierr = MatZeroEntries(M2);CHKERRQ(ierr);
25125084f0cSStefano Zampini     ierr = VecSet(vec1_C,m_one);CHKERRQ(ierr);
25225084f0cSStefano Zampini     ierr = MatDiagonalSet(M2,vec1_C,INSERT_VALUES);CHKERRQ(ierr);
25325084f0cSStefano Zampini     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
25425084f0cSStefano Zampini     ierr = MatDestroy(&M2);CHKERRQ(ierr);
25525084f0cSStefano Zampini     ierr = MatDestroy(&M3);CHKERRQ(ierr);
25688ebb749SStefano Zampini     /* Assemble local_auxmat1 = M1*C_{CR} needed by BDDC application in KSP and in preproc */
25788ebb749SStefano Zampini     ierr = MatMatMult(M1,C_CR,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
25888ebb749SStefano Zampini   }
25988ebb749SStefano Zampini 
26088ebb749SStefano Zampini   /* Get submatrices from subdomain matrix */
26188ebb749SStefano Zampini   if (n_vertices) {
26225084f0cSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,n_vertices,vertices,PETSC_COPY_VALUES,&is_aux);CHKERRQ(ierr);
2638ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
2648ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
26525084f0cSStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
26625084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
26788ebb749SStefano Zampini   }
26888ebb749SStefano Zampini 
26988ebb749SStefano Zampini   /* Matrix of coarse basis functions (local) */
27088ebb749SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
27188ebb749SStefano Zampini   ierr = MatSetSizes(pcbddc->coarse_phi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
27288ebb749SStefano Zampini   ierr = MatSetType(pcbddc->coarse_phi_B,impMatType);CHKERRQ(ierr);
27325084f0cSStefano Zampini   ierr = MatSetUp(pcbddc->coarse_phi_B);CHKERRQ(ierr);
2748eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
27588ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
27688ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_phi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
27788ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_phi_D,impMatType);CHKERRQ(ierr);
27825084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_phi_D);CHKERRQ(ierr);
27988ebb749SStefano Zampini   }
28088ebb749SStefano Zampini 
28125084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
2828ce42a96SStefano Zampini     ierr = ISGetIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
28388ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*coarsefunctions_errors),&coarsefunctions_errors);CHKERRQ(ierr);
28488ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*constraints_errors),&constraints_errors);CHKERRQ(ierr);
28588ebb749SStefano Zampini   }
28688ebb749SStefano Zampini   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
28788ebb749SStefano Zampini   ierr = PetscMalloc((pcbddc->local_primal_size)*(pcbddc->local_primal_size)*sizeof(PetscScalar),&coarse_submat_vals);CHKERRQ(ierr);
28888ebb749SStefano Zampini 
28988ebb749SStefano Zampini   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
29025084f0cSStefano Zampini 
29125084f0cSStefano Zampini   /* vertices */
29288ebb749SStefano Zampini   for (i=0;i<n_vertices;i++) {
29388ebb749SStefano Zampini     ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
29488ebb749SStefano Zampini     ierr = VecSetValue(vec1_V,i,one,INSERT_VALUES);CHKERRQ(ierr);
29588ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
29688ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
29725084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on constraints multipliers */
29888ebb749SStefano Zampini     ierr = MatMult(A_RV,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
29988ebb749SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
30088ebb749SStefano Zampini     ierr = VecScale(pcbddc->vec1_R,m_one);CHKERRQ(ierr);
30188ebb749SStefano Zampini     if (n_constraints) {
30288ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec1_R,vec1_C);CHKERRQ(ierr);
30388ebb749SStefano Zampini       ierr = MatMultAdd(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
30488ebb749SStefano Zampini       ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
30588ebb749SStefano Zampini     }
30688ebb749SStefano Zampini     ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
30788ebb749SStefano Zampini     ierr = MatMultAdd(A_VV,vec1_V,vec2_V,vec2_V);CHKERRQ(ierr);
30888ebb749SStefano Zampini 
30988ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
31088ebb749SStefano Zampini     /* coarse basis functions */
31188ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
31288ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
31388ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
31425084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
31588ebb749SStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
31625084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
31788ebb749SStefano Zampini     ierr = MatSetValue(pcbddc->coarse_phi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
3188eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
31988ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
32088ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
32125084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
32288ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
32325084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
32488ebb749SStefano Zampini     }
32525084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
32625084f0cSStefano Zampini     ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
32725084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
32825084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
32988ebb749SStefano Zampini     if (n_constraints) {
33025084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
33125084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
33225084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
33388ebb749SStefano Zampini     }
33488ebb749SStefano Zampini 
33525084f0cSStefano Zampini     /* check */
33625084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
33725084f0cSStefano Zampini       /* assemble subdomain vector on local nodes */
33888ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
33925084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
34025084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
34125084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
34225084f0cSStefano Zampini       ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
34325084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
34425084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
34588ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers (i.e. primal nodes) */
34688ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
34725084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
34825084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
34925084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
35088ebb749SStefano Zampini       if (n_constraints) {
35125084f0cSStefano Zampini         ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
35225084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
35325084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
35488ebb749SStefano Zampini       }
35525084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
35625084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
35788ebb749SStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
35888ebb749SStefano Zampini       /* check saddle point solution */
35988ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
36088ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
36188ebb749SStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i]);CHKERRQ(ierr);
36288ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
36325084f0cSStefano Zampini       /* shift by the identity matrix */
36425084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
36525084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
36625084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
36788ebb749SStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i]);CHKERRQ(ierr);
36888ebb749SStefano Zampini     }
36988ebb749SStefano Zampini   }
37088ebb749SStefano Zampini 
37125084f0cSStefano Zampini   /* constraints */
37288ebb749SStefano Zampini   for (i=0;i<n_constraints;i++) {
37388ebb749SStefano Zampini     ierr = VecSet(vec2_C,zero);CHKERRQ(ierr);
37488ebb749SStefano Zampini     ierr = VecSetValue(vec2_C,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
37588ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec2_C);CHKERRQ(ierr);
37688ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec2_C);CHKERRQ(ierr);
37725084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on vertices multipliers */
37888ebb749SStefano Zampini     ierr = MatMult(M1,vec2_C,vec1_C);CHKERRQ(ierr);
37988ebb749SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
38088ebb749SStefano Zampini     ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
38125084f0cSStefano Zampini     if (n_vertices) {
38225084f0cSStefano Zampini       ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
38325084f0cSStefano Zampini     }
38488ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
38588ebb749SStefano Zampini     /* coarse basis functions */
38625084f0cSStefano Zampini     j = i+n_vertices; /* don't touch this! */
38788ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
38888ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
38988ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
39025084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
39125084f0cSStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
39225084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
3938eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
39488ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
39588ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
39625084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
39725084f0cSStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
39825084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
39988ebb749SStefano Zampini     }
40025084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
40188ebb749SStefano Zampini     if (n_vertices) {
40225084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
40325084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
40425084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
40588ebb749SStefano Zampini     }
40625084f0cSStefano Zampini     ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
40725084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
40825084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
40988ebb749SStefano Zampini 
41025084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
41188ebb749SStefano Zampini       /* assemble subdomain vector on nodes */
41288ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
41325084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
41425084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
41525084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
41625084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
41725084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
41888ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers */
41988ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
42088ebb749SStefano Zampini       if (n_vertices) {
42125084f0cSStefano Zampini         ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
42225084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
42325084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
42488ebb749SStefano Zampini       }
42525084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
42625084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
42725084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
42825084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
42925084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
43025084f0cSStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
43188ebb749SStefano Zampini       /* check saddle point solution */
43288ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
43388ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
43425084f0cSStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[j]);CHKERRQ(ierr);
43588ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
43625084f0cSStefano Zampini       /* shift by the identity matrix */
43725084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,j,m_one,ADD_VALUES);CHKERRQ(ierr);
43825084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
43925084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
44025084f0cSStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[j]);CHKERRQ(ierr);
44188ebb749SStefano Zampini     }
44288ebb749SStefano Zampini   }
44325084f0cSStefano Zampini   /* call assembling routines for local coarse basis */
44488ebb749SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
44588ebb749SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4468eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
44788ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
44888ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
44988ebb749SStefano Zampini   }
45025084f0cSStefano Zampini 
45188ebb749SStefano Zampini   /* compute other basis functions for non-symmetric problems */
45288ebb749SStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
45388ebb749SStefano Zampini   if (!setsym || (setsym && !issym)) {
45488ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
45588ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_psi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
45688ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_psi_B,impMatType);CHKERRQ(ierr);
45725084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_psi_B);CHKERRQ(ierr);
4588eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
45988ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
46088ebb749SStefano Zampini       ierr = MatSetSizes(pcbddc->coarse_psi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
46188ebb749SStefano Zampini       ierr = MatSetType(pcbddc->coarse_psi_D,impMatType);CHKERRQ(ierr);
46225084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->coarse_psi_D);CHKERRQ(ierr);
46388ebb749SStefano Zampini     }
46488ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
46588ebb749SStefano Zampini       if (n_constraints) {
46688ebb749SStefano Zampini         ierr = VecSet(vec1_C,zero);CHKERRQ(ierr);
46788ebb749SStefano Zampini         for (j=0;j<n_constraints;j++) {
46825084f0cSStefano Zampini           ierr = VecSetValue(vec1_C,j,coarse_submat_vals[(j+n_vertices)*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
46988ebb749SStefano Zampini         }
47025084f0cSStefano Zampini         ierr = VecAssemblyBegin(vec1_C);CHKERRQ(ierr);
47125084f0cSStefano Zampini         ierr = VecAssemblyEnd(vec1_C);CHKERRQ(ierr);
47288ebb749SStefano Zampini       }
47388ebb749SStefano Zampini       if (i<n_vertices) {
47488ebb749SStefano Zampini         ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
47588ebb749SStefano Zampini         ierr = VecSetValue(vec1_V,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
47688ebb749SStefano Zampini         ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
47788ebb749SStefano Zampini         ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
47888ebb749SStefano Zampini         ierr = MatMultTranspose(A_VR,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
47988ebb749SStefano Zampini         if (n_constraints) {
48088ebb749SStefano Zampini           ierr = MatMultTransposeAdd(C_CR,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
48188ebb749SStefano Zampini         }
48288ebb749SStefano Zampini       } else {
48388ebb749SStefano Zampini         ierr = MatMultTranspose(C_CR,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
48488ebb749SStefano Zampini       }
48588ebb749SStefano Zampini       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
48688ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
48788ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
48888ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
48925084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
49088ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_psi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
49125084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
49288ebb749SStefano Zampini       if (i<n_vertices) {
49388ebb749SStefano Zampini         ierr = MatSetValue(pcbddc->coarse_psi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
49488ebb749SStefano Zampini       }
4958eeda7d8SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
49688ebb749SStefano Zampini         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
49788ebb749SStefano Zampini         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
49825084f0cSStefano Zampini         ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
49988ebb749SStefano Zampini         ierr = MatSetValues(pcbddc->coarse_psi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
50025084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
50188ebb749SStefano Zampini       }
50288ebb749SStefano Zampini 
50325084f0cSStefano Zampini       if (pcbddc->dbg_flag) {
50488ebb749SStefano Zampini         /* assemble subdomain vector on nodes */
50588ebb749SStefano Zampini         ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
50625084f0cSStefano Zampini         ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
50725084f0cSStefano Zampini         ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
50825084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
50925084f0cSStefano Zampini         if (i<n_vertices) {
51025084f0cSStefano Zampini           ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
51188ebb749SStefano Zampini         }
51225084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
51325084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
51425084f0cSStefano Zampini         /* assemble subdomain vector of lagrange multipliers */
51525084f0cSStefano Zampini         for (j=0;j<pcbddc->local_primal_size;j++) {
51625084f0cSStefano Zampini           ierr = VecSetValue(pcbddc->vec1_P,j,-coarse_submat_vals[j*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
51725084f0cSStefano Zampini         }
51825084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
51925084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
52088ebb749SStefano Zampini         /* check saddle point solution */
52188ebb749SStefano Zampini         ierr = MatMultTranspose(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
52288ebb749SStefano Zampini         ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
52388ebb749SStefano Zampini         ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
52488ebb749SStefano Zampini         ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
52525084f0cSStefano Zampini         /* shift by the identity matrix */
52625084f0cSStefano Zampini         ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
52725084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
52825084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
52988ebb749SStefano Zampini         ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
53088ebb749SStefano Zampini       }
53188ebb749SStefano Zampini     }
53288ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
53388ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5348eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
53588ebb749SStefano Zampini       ierr = MatAssemblyBegin(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
53688ebb749SStefano Zampini       ierr = MatAssemblyEnd(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
53788ebb749SStefano Zampini     }
53888ebb749SStefano Zampini   }
53988ebb749SStefano Zampini   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
54088ebb749SStefano Zampini   /* Checking coarse_sub_mat and coarse basis functios */
54188ebb749SStefano Zampini   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
54288ebb749SStefano Zampini   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
54325084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
54488ebb749SStefano Zampini     Mat         coarse_sub_mat;
54525084f0cSStefano Zampini     Mat         AUXMAT,TM1,TM2,TM3,TM4;
54688ebb749SStefano Zampini     Mat         coarse_phi_D,coarse_phi_B;
54788ebb749SStefano Zampini     Mat         coarse_psi_D,coarse_psi_B;
54888ebb749SStefano Zampini     Mat         A_II,A_BB,A_IB,A_BI;
54988ebb749SStefano Zampini     MatType     checkmattype=MATSEQAIJ;
55088ebb749SStefano Zampini     PetscReal   real_value;
55188ebb749SStefano Zampini 
55288ebb749SStefano Zampini     ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
55388ebb749SStefano Zampini     ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
55488ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
55588ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
55688ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
55788ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
55888ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
55988ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
56088ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
56188ebb749SStefano Zampini     }
56288ebb749SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
56388ebb749SStefano Zampini 
56425084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
56525084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat and local basis functions\n");CHKERRQ(ierr);
56625084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
56788ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
56888ebb749SStefano Zampini       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
56988ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
57088ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
57188ebb749SStefano Zampini       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
57288ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
57388ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
57488ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
57588ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
57688ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
57788ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
57888ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
57988ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
58088ebb749SStefano Zampini     } else {
58188ebb749SStefano Zampini       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
58288ebb749SStefano Zampini       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
58388ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
58488ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
58588ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
58688ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
58788ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
58888ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
58988ebb749SStefano Zampini     }
59088ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
59188ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
59288ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
59388ebb749SStefano Zampini     ierr = MatConvert(TM1,MATSEQDENSE,MAT_REUSE_MATRIX,&TM1);CHKERRQ(ierr);
59488ebb749SStefano Zampini     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
59588ebb749SStefano Zampini     ierr = MatNorm(TM1,NORM_INFINITY,&real_value);CHKERRQ(ierr);
59625084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"----------------------------------\n");CHKERRQ(ierr);
59725084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d \n",PetscGlobalRank);CHKERRQ(ierr);
59825084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"matrix error = % 1.14e\n",real_value);CHKERRQ(ierr);
59925084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (phi) errors\n");CHKERRQ(ierr);
60088ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
60125084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,coarsefunctions_errors[i]);CHKERRQ(ierr);
60288ebb749SStefano Zampini     }
60325084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (phi) errors\n");CHKERRQ(ierr);
60488ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
60525084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,constraints_errors[i]);CHKERRQ(ierr);
60688ebb749SStefano Zampini     }
60788ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
60825084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (psi) errors\n");CHKERRQ(ierr);
60988ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
61025084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,coarsefunctions_errors[i]);CHKERRQ(ierr);
61188ebb749SStefano Zampini       }
61225084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (psi) errors\n");CHKERRQ(ierr);
61388ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
61425084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,constraints_errors[i]);CHKERRQ(ierr);
61588ebb749SStefano Zampini       }
61688ebb749SStefano Zampini     }
61725084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
61888ebb749SStefano Zampini     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
61988ebb749SStefano Zampini     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
62088ebb749SStefano Zampini     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
62188ebb749SStefano Zampini     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
62288ebb749SStefano Zampini     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
62388ebb749SStefano Zampini     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
62488ebb749SStefano Zampini     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
62588ebb749SStefano Zampini     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
62688ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
62788ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
62888ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
62988ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
63088ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
63188ebb749SStefano Zampini     }
63288ebb749SStefano Zampini     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
6338ce42a96SStefano Zampini     ierr = ISRestoreIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
63488ebb749SStefano Zampini     ierr = PetscFree(coarsefunctions_errors);CHKERRQ(ierr);
63588ebb749SStefano Zampini     ierr = PetscFree(constraints_errors);CHKERRQ(ierr);
63688ebb749SStefano Zampini   }
63788ebb749SStefano Zampini   /* free memory */
63888ebb749SStefano Zampini   if (n_vertices) {
63988ebb749SStefano Zampini     ierr = PetscFree(vertices);CHKERRQ(ierr);
64088ebb749SStefano Zampini     ierr = VecDestroy(&vec1_V);CHKERRQ(ierr);
64188ebb749SStefano Zampini     ierr = VecDestroy(&vec2_V);CHKERRQ(ierr);
64288ebb749SStefano Zampini     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
64388ebb749SStefano Zampini     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
64488ebb749SStefano Zampini     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
64588ebb749SStefano Zampini   }
64688ebb749SStefano Zampini   if (n_constraints) {
64788ebb749SStefano Zampini     ierr = VecDestroy(&vec1_C);CHKERRQ(ierr);
64888ebb749SStefano Zampini     ierr = VecDestroy(&vec2_C);CHKERRQ(ierr);
64988ebb749SStefano Zampini     ierr = MatDestroy(&M1);CHKERRQ(ierr);
65088ebb749SStefano Zampini     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
65188ebb749SStefano Zampini   }
65288ebb749SStefano Zampini   ierr = PetscFree(auxindices);CHKERRQ(ierr);
6538629588bSStefano Zampini   /* get back data */
6548629588bSStefano Zampini   *coarse_submat_vals_n = coarse_submat_vals;
65588ebb749SStefano Zampini   PetscFunctionReturn(0);
65688ebb749SStefano Zampini }
65788ebb749SStefano Zampini 
65888ebb749SStefano Zampini #undef __FUNCT__
659aa0d41d4SStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalMatrices"
660aa0d41d4SStefano Zampini PetscErrorCode PCBDDCSetUpLocalMatrices(PC pc)
661aa0d41d4SStefano Zampini {
662aa0d41d4SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
663aa0d41d4SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
664aa0d41d4SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
665aa0d41d4SStefano Zampini   /* manage repeated solves */
666aa0d41d4SStefano Zampini   MatReuse          reuse;
667aa0d41d4SStefano Zampini   MatStructure      matstruct;
668aa0d41d4SStefano Zampini   PetscErrorCode    ierr;
669aa0d41d4SStefano Zampini 
670aa0d41d4SStefano Zampini   PetscFunctionBegin;
671aa0d41d4SStefano Zampini   /* get mat flags */
672aa0d41d4SStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
673aa0d41d4SStefano Zampini   reuse = MAT_INITIAL_MATRIX;
674aa0d41d4SStefano Zampini   if (pc->setupcalled) {
675aa0d41d4SStefano Zampini     /* when matstruct is SAME_PRECONDITIONER, we shouldn't be here */
676aa0d41d4SStefano Zampini     if (matstruct == SAME_PRECONDITIONER) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen");
677aa0d41d4SStefano Zampini     if (matstruct == SAME_NONZERO_PATTERN) {
678aa0d41d4SStefano Zampini       reuse = MAT_REUSE_MATRIX;
679aa0d41d4SStefano Zampini     } else {
680aa0d41d4SStefano Zampini       reuse = MAT_INITIAL_MATRIX;
681aa0d41d4SStefano Zampini     }
682aa0d41d4SStefano Zampini   }
683aa0d41d4SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
684aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
685aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
686aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
687aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BB);CHKERRQ(ierr);
688aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
689aa0d41d4SStefano Zampini   }
690aa0d41d4SStefano Zampini 
691aa0d41d4SStefano Zampini   /* transform local matrices if needed */
692aa0d41d4SStefano Zampini   if (pcbddc->use_change_of_basis) {
693aa0d41d4SStefano Zampini     Mat         change_mat_all;
694aa0d41d4SStefano Zampini     PetscScalar *row_cmat_values;
695aa0d41d4SStefano Zampini     PetscInt    *row_cmat_indices;
696aa0d41d4SStefano Zampini     PetscInt    *nnz,*is_indices,*temp_indices;
697aa0d41d4SStefano Zampini     PetscInt    i,j,k,n_D,n_B;
698aa0d41d4SStefano Zampini 
699aa0d41d4SStefano Zampini     /* Get Non-overlapping dimensions */
700aa0d41d4SStefano Zampini     n_B = pcis->n_B;
701aa0d41d4SStefano Zampini     n_D = pcis->n-n_B;
702aa0d41d4SStefano Zampini 
703aa0d41d4SStefano Zampini     /* compute nonzero structure of change of basis on all local nodes */
704aa0d41d4SStefano Zampini     ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
705aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
706aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) nnz[is_indices[i]] = 1;
707aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
708aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
709aa0d41d4SStefano Zampini     k=1;
710aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
711aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
712aa0d41d4SStefano Zampini       nnz[is_indices[i]]=j;
713aa0d41d4SStefano Zampini       if (k < j) k = j;
714aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
715aa0d41d4SStefano Zampini     }
716aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
717aa0d41d4SStefano Zampini     /* assemble change of basis matrix on the whole set of local dofs */
718aa0d41d4SStefano Zampini     ierr = PetscMalloc(k*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
719aa0d41d4SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&change_mat_all);CHKERRQ(ierr);
720aa0d41d4SStefano Zampini     ierr = MatSetSizes(change_mat_all,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
721aa0d41d4SStefano Zampini     ierr = MatSetType(change_mat_all,MATSEQAIJ);CHKERRQ(ierr);
722aa0d41d4SStefano Zampini     ierr = MatSeqAIJSetPreallocation(change_mat_all,0,nnz);CHKERRQ(ierr);
723aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
724aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) {
725aa0d41d4SStefano Zampini       ierr = MatSetValue(change_mat_all,is_indices[i],is_indices[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
726aa0d41d4SStefano Zampini     }
727aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
728aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
729aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
730aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
731aa0d41d4SStefano Zampini       for (k=0; k<j; k++) temp_indices[k]=is_indices[row_cmat_indices[k]];
732aa0d41d4SStefano Zampini       ierr = MatSetValues(change_mat_all,1,&is_indices[i],j,temp_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
733aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
734aa0d41d4SStefano Zampini     }
735aa0d41d4SStefano Zampini     ierr = MatAssemblyBegin(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
736aa0d41d4SStefano Zampini     ierr = MatAssemblyEnd(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
737aa0d41d4SStefano Zampini     /* TODO: HOW TO WORK WITH BAIJ? PtAP not provided */
738aa0d41d4SStefano Zampini     ierr = MatGetBlockSize(matis->A,&i);CHKERRQ(ierr);
739aa0d41d4SStefano Zampini     if (i==1) {
740aa0d41d4SStefano Zampini       ierr = MatPtAP(matis->A,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
741aa0d41d4SStefano Zampini     } else {
742aa0d41d4SStefano Zampini       Mat work_mat;
743aa0d41d4SStefano Zampini       ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
744aa0d41d4SStefano Zampini       ierr = MatPtAP(work_mat,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
745aa0d41d4SStefano Zampini       ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
746aa0d41d4SStefano Zampini     }
747aa0d41d4SStefano Zampini     ierr = MatDestroy(&change_mat_all);CHKERRQ(ierr);
748aa0d41d4SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
749aa0d41d4SStefano Zampini     ierr = PetscFree(temp_indices);CHKERRQ(ierr);
750aa0d41d4SStefano Zampini   } else {
751aa0d41d4SStefano Zampini     /* without change of basis, the local matrix is unchanged */
752aa0d41d4SStefano Zampini     if (!pcbddc->local_mat) {
753aa0d41d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)matis->A);CHKERRQ(ierr);
754aa0d41d4SStefano Zampini       pcbddc->local_mat = matis->A;
755aa0d41d4SStefano Zampini     }
756aa0d41d4SStefano Zampini   }
757aa0d41d4SStefano Zampini 
758aa0d41d4SStefano Zampini   /* get submatrices */
759aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_I_local,reuse,&pcis->A_II);CHKERRQ(ierr);
760aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
761aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
762aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_B_local,reuse,&pcis->A_BB);CHKERRQ(ierr);
763aa0d41d4SStefano Zampini   PetscFunctionReturn(0);
764aa0d41d4SStefano Zampini }
765aa0d41d4SStefano Zampini 
766aa0d41d4SStefano Zampini #undef __FUNCT__
767a64d13efSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalScatters"
7688ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
769a64d13efSStefano Zampini {
770a64d13efSStefano Zampini   PC_IS*         pcis = (PC_IS*)(pc->data);
771a64d13efSStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
7728ce42a96SStefano Zampini   IS             is_aux1,is_aux2;
773a64d13efSStefano Zampini   PetscInt       *vertices,*aux_array1,*aux_array2,*is_indices,*idx_R_local;
774a64d13efSStefano Zampini   PetscInt       n_vertices,n_constraints,i,j,n_R,n_D,n_B;
7754641a718SStefano Zampini   PetscBT        bitmask;
776a64d13efSStefano Zampini   PetscErrorCode ierr;
777a64d13efSStefano Zampini 
778a64d13efSStefano Zampini   PetscFunctionBegin;
779a64d13efSStefano Zampini   /* Set Non-overlapping dimensions */
780a64d13efSStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
781a64d13efSStefano Zampini   /* get vertex indices from constraint matrix */
782a64d13efSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
783a64d13efSStefano Zampini   /* Set number of constraints */
784a64d13efSStefano Zampini   n_constraints = pcbddc->local_primal_size-n_vertices;
7854641a718SStefano Zampini   /* create auxiliary bitmask */
7864641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
7874641a718SStefano Zampini   for (i=0;i<n_vertices;i++) {
7884641a718SStefano Zampini     ierr = PetscBTSet(bitmask,vertices[i]);CHKERRQ(ierr);
7894641a718SStefano Zampini   }
790a64d13efSStefano Zampini   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
791a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n-n_vertices)*sizeof(PetscInt),&idx_R_local);CHKERRQ(ierr);
792a64d13efSStefano Zampini   for (i=0, n_R=0; i<pcis->n; i++) {
7934641a718SStefano Zampini     if (!PetscBTLookup(bitmask,i)) {
794a64d13efSStefano Zampini       idx_R_local[n_R] = i;
795a64d13efSStefano Zampini       n_R++;
796a64d13efSStefano Zampini     }
797a64d13efSStefano Zampini   }
798a64d13efSStefano Zampini   ierr = PetscFree(vertices);CHKERRQ(ierr);
7998ce42a96SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_R,idx_R_local,PETSC_OWN_POINTER,&pcbddc->is_R_local);CHKERRQ(ierr);
800a64d13efSStefano Zampini 
801a64d13efSStefano Zampini   /* print some info if requested */
802a64d13efSStefano Zampini   if (pcbddc->dbg_flag) {
803a64d13efSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
804a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
805a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
806a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
807a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"r_size = %d, v_size = %d, constraints = %d, local_primal_size = %d\n",n_R,n_vertices,n_constraints,pcbddc->local_primal_size);CHKERRQ(ierr);
808a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr);
809a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
810a64d13efSStefano Zampini   }
811a64d13efSStefano Zampini 
812a64d13efSStefano Zampini   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
813a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
814a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array2);CHKERRQ(ierr);
815a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
8164641a718SStefano Zampini   for (i=0; i<n_D; i++) {
8174641a718SStefano Zampini     ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
8184641a718SStefano Zampini   }
819a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
820a64d13efSStefano Zampini   for (i=0, j=0; i<n_R; i++) {
8214641a718SStefano Zampini     if (!PetscBTLookup(bitmask,idx_R_local[i])) {
8224641a718SStefano Zampini       aux_array1[j++] = i;
823a64d13efSStefano Zampini     }
824a64d13efSStefano Zampini   }
825a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
826a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
827a64d13efSStefano Zampini   for (i=0, j=0; i<n_B; i++) {
8284641a718SStefano Zampini     if (!PetscBTLookup(bitmask,is_indices[i])) {
8294641a718SStefano Zampini       aux_array2[j++] = i;
830a64d13efSStefano Zampini     }
831a64d13efSStefano Zampini   }
832a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
833a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
834a64d13efSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
835a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
836a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
837a64d13efSStefano Zampini 
8388eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
839a64d13efSStefano Zampini     ierr = PetscMalloc(n_D*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
840a64d13efSStefano Zampini     for (i=0, j=0; i<n_R; i++) {
8414641a718SStefano Zampini       if (PetscBTLookup(bitmask,idx_R_local[i])) {
8424641a718SStefano Zampini         aux_array1[j++] = i;
843a64d13efSStefano Zampini       }
844a64d13efSStefano Zampini     }
845a64d13efSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
846a64d13efSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
847a64d13efSStefano Zampini     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
848a64d13efSStefano Zampini   }
8494641a718SStefano Zampini   ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
850a64d13efSStefano Zampini   PetscFunctionReturn(0);
851a64d13efSStefano Zampini }
852a64d13efSStefano Zampini 
853a64d13efSStefano Zampini #undef __FUNCT__
854304d26faSStefano Zampini #define __FUNCT__ "PCBDDCSetUseExactDirichlet"
855304d26faSStefano Zampini PetscErrorCode PCBDDCSetUseExactDirichlet(PC pc,PetscBool use)
856304d26faSStefano Zampini {
857304d26faSStefano Zampini   PC_BDDC  *pcbddc = (PC_BDDC*)pc->data;
858304d26faSStefano Zampini 
859304d26faSStefano Zampini   PetscFunctionBegin;
860304d26faSStefano Zampini   pcbddc->use_exact_dirichlet=use;
861304d26faSStefano Zampini   PetscFunctionReturn(0);
862304d26faSStefano Zampini }
863304d26faSStefano Zampini 
864304d26faSStefano Zampini #undef __FUNCT__
865304d26faSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
8668ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc)
867304d26faSStefano Zampini {
868304d26faSStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
869304d26faSStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
870304d26faSStefano Zampini   PC             pc_temp;
871304d26faSStefano Zampini   Mat            A_RR;
872304d26faSStefano Zampini   Vec            vec1,vec2,vec3;
873304d26faSStefano Zampini   MatStructure   matstruct;
874304d26faSStefano Zampini   PetscScalar    m_one = -1.0;
875304d26faSStefano Zampini   PetscReal      value;
876304d26faSStefano Zampini   PetscInt       n_D,n_R,use_exact,use_exact_reduced;
877304d26faSStefano Zampini   PetscErrorCode ierr;
878304d26faSStefano Zampini 
879304d26faSStefano Zampini   PetscFunctionBegin;
880304d26faSStefano Zampini   /* Creating PC contexts for local Dirichlet and Neumann problems */
881304d26faSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
882304d26faSStefano Zampini 
883304d26faSStefano Zampini   /* DIRICHLET PROBLEM */
884ac78edfcSStefano Zampini   /* Matrix for Dirichlet problem is pcis->A_II */
8858ce42a96SStefano Zampini   ierr = ISGetSize(pcis->is_I_local,&n_D);CHKERRQ(ierr);
886304d26faSStefano Zampini   if (!pcbddc->ksp_D) { /* create object if not yet build */
887304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
888304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
889304d26faSStefano Zampini     /* default */
890304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
891304d26faSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,"dirichlet_");CHKERRQ(ierr);
892304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
893304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
894304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
895304d26faSStefano Zampini   }
896304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II,matstruct);CHKERRQ(ierr);
897304d26faSStefano Zampini   /* Allow user's customization */
898304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
899304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
900304d26faSStefano Zampini   if (!n_D) {
901304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
902304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
903304d26faSStefano Zampini   }
904304d26faSStefano Zampini   /* Set Up KSP for Dirichlet problem of BDDC */
905304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
906304d26faSStefano Zampini   /* set ksp_D into pcis data */
907304d26faSStefano Zampini   ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
908304d26faSStefano Zampini   ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
909304d26faSStefano Zampini   pcis->ksp_D = pcbddc->ksp_D;
910304d26faSStefano Zampini 
911304d26faSStefano Zampini   /* NEUMANN PROBLEM */
912304d26faSStefano Zampini   /* Matrix for Neumann problem is A_RR -> we need to create it */
9138ce42a96SStefano Zampini   ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
9148ce42a96SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
915304d26faSStefano Zampini   if (!pcbddc->ksp_R) { /* create object if not yet build */
916304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
917304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
918304d26faSStefano Zampini     /* default */
919304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
920304d26faSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,"neumann_");CHKERRQ(ierr);
921304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
922304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
923304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
924304d26faSStefano Zampini   }
925304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR,matstruct);CHKERRQ(ierr);
926304d26faSStefano Zampini   /* Allow user's customization */
927304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
928304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
929304d26faSStefano Zampini   if (!n_R) {
930304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
931304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
932304d26faSStefano Zampini   }
933304d26faSStefano Zampini   /* Set Up KSP for Neumann problem of BDDC */
934304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
935304d26faSStefano Zampini 
936304d26faSStefano Zampini   /* check Dirichlet and Neumann solvers and adapt them if a nullspace correction is needed */
937304d26faSStefano Zampini 
938304d26faSStefano Zampini   /* Dirichlet */
939304d26faSStefano Zampini   ierr = MatGetVecs(pcis->A_II,&vec1,&vec2);CHKERRQ(ierr);
940304d26faSStefano Zampini   ierr = VecDuplicate(vec1,&vec3);CHKERRQ(ierr);
941304d26faSStefano Zampini   ierr = VecSetRandom(vec1,NULL);CHKERRQ(ierr);
942304d26faSStefano Zampini   ierr = MatMult(pcis->A_II,vec1,vec2);CHKERRQ(ierr);
943304d26faSStefano Zampini   ierr = KSPSolve(pcbddc->ksp_D,vec2,vec3);CHKERRQ(ierr);
944304d26faSStefano Zampini   ierr = VecAXPY(vec3,m_one,vec1);CHKERRQ(ierr);
945304d26faSStefano Zampini   ierr = VecNorm(vec3,NORM_INFINITY,&value);CHKERRQ(ierr);
946304d26faSStefano Zampini   ierr = VecDestroy(&vec1);CHKERRQ(ierr);
947304d26faSStefano Zampini   ierr = VecDestroy(&vec2);CHKERRQ(ierr);
948304d26faSStefano Zampini   ierr = VecDestroy(&vec3);CHKERRQ(ierr);
949304d26faSStefano Zampini   /* need to be adapted? */
950304d26faSStefano Zampini   use_exact = (PetscAbsReal(value) > 1.e-4 ? 0 : 1);
951304d26faSStefano Zampini   ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_INT,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
952304d26faSStefano Zampini   ierr = PCBDDCSetUseExactDirichlet(pc,(PetscBool)use_exact_reduced);CHKERRQ(ierr);
953304d26faSStefano Zampini   /* print info */
954304d26faSStefano Zampini   if (pcbddc->dbg_flag) {
955304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
956304d26faSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
957304d26faSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Checking solution of Dirichlet and Neumann problems\n");CHKERRQ(ierr);
958304d26faSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Dirichlet solve = % 1.14e \n",PetscGlobalRank,value);CHKERRQ(ierr);
959304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
960304d26faSStefano Zampini   }
9618eeda7d8SStefano Zampini   if (n_D && pcbddc->NullSpace && !use_exact_reduced && !pcbddc->switch_static) {
9628ce42a96SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcis->is_I_local);CHKERRQ(ierr);
963304d26faSStefano Zampini   }
964304d26faSStefano Zampini 
965304d26faSStefano Zampini   /* Neumann */
966304d26faSStefano Zampini   ierr = MatGetVecs(A_RR,&vec1,&vec2);CHKERRQ(ierr);
967304d26faSStefano Zampini   ierr = VecDuplicate(vec1,&vec3);CHKERRQ(ierr);
968304d26faSStefano Zampini   ierr = VecSetRandom(vec1,NULL);CHKERRQ(ierr);
969304d26faSStefano Zampini   ierr = MatMult(A_RR,vec1,vec2);CHKERRQ(ierr);
970304d26faSStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,vec2,vec3);CHKERRQ(ierr);
971304d26faSStefano Zampini   ierr = VecAXPY(vec3,m_one,vec1);CHKERRQ(ierr);
972304d26faSStefano Zampini   ierr = VecNorm(vec3,NORM_INFINITY,&value);CHKERRQ(ierr);
973304d26faSStefano Zampini   ierr = VecDestroy(&vec1);CHKERRQ(ierr);
974304d26faSStefano Zampini   ierr = VecDestroy(&vec2);CHKERRQ(ierr);
975304d26faSStefano Zampini   ierr = VecDestroy(&vec3);CHKERRQ(ierr);
976304d26faSStefano Zampini   /* need to be adapted? */
977304d26faSStefano Zampini   use_exact = (PetscAbsReal(value) > 1.e-4 ? 0 : 1);
978304d26faSStefano Zampini   if (PetscAbsReal(value) > 1.e-4) use_exact = 0;
979304d26faSStefano Zampini   ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_INT,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
980304d26faSStefano Zampini   /* print info */
981304d26faSStefano Zampini   if (pcbddc->dbg_flag) {
982304d26faSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for  Neumann  solve = % 1.14e \n",PetscGlobalRank,value);CHKERRQ(ierr);
983304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
984304d26faSStefano Zampini   }
985304d26faSStefano Zampini   if (n_R && pcbddc->NullSpace && !use_exact_reduced) { /* is it the right logic? */
9868ce42a96SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcbddc->is_R_local);CHKERRQ(ierr);
987304d26faSStefano Zampini   }
988304d26faSStefano Zampini 
989304d26faSStefano Zampini   /* free Neumann problem's matrix */
990304d26faSStefano Zampini   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
991304d26faSStefano Zampini   PetscFunctionReturn(0);
992304d26faSStefano Zampini }
993304d26faSStefano Zampini 
994304d26faSStefano Zampini #undef __FUNCT__
995674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSolveSaddlePoint"
996674ae819SStefano Zampini static PetscErrorCode  PCBDDCSolveSaddlePoint(PC pc)
997674ae819SStefano Zampini {
998674ae819SStefano Zampini   PetscErrorCode ierr;
999674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1000674ae819SStefano Zampini 
1001674ae819SStefano Zampini   PetscFunctionBegin;
1002674ae819SStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
1003674ae819SStefano Zampini   if (pcbddc->local_auxmat1) {
1004674ae819SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec2_R,pcbddc->vec1_C);CHKERRQ(ierr);
1005674ae819SStefano Zampini     ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
1006674ae819SStefano Zampini   }
1007674ae819SStefano Zampini   PetscFunctionReturn(0);
1008674ae819SStefano Zampini }
1009674ae819SStefano Zampini 
1010674ae819SStefano Zampini #undef __FUNCT__
1011674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
1012674ae819SStefano Zampini PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc)
1013674ae819SStefano Zampini {
1014674ae819SStefano Zampini   PetscErrorCode ierr;
1015674ae819SStefano Zampini   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
1016674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)  (pc->data);
1017674ae819SStefano Zampini   const PetscScalar zero = 0.0;
1018674ae819SStefano Zampini 
1019674ae819SStefano Zampini   PetscFunctionBegin;
102015aaf578SStefano Zampini   /* Application of PHI^T (or PSI^T)  */
102115aaf578SStefano Zampini   if (pcbddc->coarse_psi_B) {
102215aaf578SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
10238eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
102415aaf578SStefano Zampini   } else {
1025674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
10268eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
102715aaf578SStefano Zampini   }
1028674ae819SStefano Zampini   /* Scatter data of coarse_rhs */
1029674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { ierr = VecSet(pcbddc->coarse_rhs,zero);CHKERRQ(ierr); }
1030674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1031674ae819SStefano Zampini 
1032674ae819SStefano Zampini   /* Local solution on R nodes */
1033674ae819SStefano Zampini   ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
1034674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1035674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
10368eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1037674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1038674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1039674ae819SStefano Zampini   }
1040674ae819SStefano Zampini   ierr = PCBDDCSolveSaddlePoint(pc);CHKERRQ(ierr);
1041674ae819SStefano Zampini   ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1042674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1043674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
10448eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1045674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1046674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1047674ae819SStefano Zampini   }
1048674ae819SStefano Zampini 
1049674ae819SStefano Zampini   /* Coarse solution */
1050674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1051674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { /* TODO remove null space when doing multilevel */
1052674ae819SStefano Zampini     ierr = KSPSolve(pcbddc->coarse_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
1053674ae819SStefano Zampini   }
1054674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1055674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd  (pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1056674ae819SStefano Zampini 
1057674ae819SStefano Zampini   /* Sum contributions from two levels */
1058674ae819SStefano Zampini   ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
10598eeda7d8SStefano Zampini   if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1060674ae819SStefano Zampini   PetscFunctionReturn(0);
1061674ae819SStefano Zampini }
1062674ae819SStefano Zampini 
1063674ae819SStefano Zampini #undef __FUNCT__
1064674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
1065674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1066674ae819SStefano Zampini {
1067674ae819SStefano Zampini   PetscErrorCode ierr;
1068674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1069674ae819SStefano Zampini 
1070674ae819SStefano Zampini   PetscFunctionBegin;
1071674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1072674ae819SStefano Zampini   PetscFunctionReturn(0);
1073674ae819SStefano Zampini }
1074674ae819SStefano Zampini 
1075674ae819SStefano Zampini #undef __FUNCT__
1076674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
1077674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1078674ae819SStefano Zampini {
1079674ae819SStefano Zampini   PetscErrorCode ierr;
1080674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1081674ae819SStefano Zampini 
1082674ae819SStefano Zampini   PetscFunctionBegin;
1083674ae819SStefano Zampini   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1084674ae819SStefano Zampini   PetscFunctionReturn(0);
1085674ae819SStefano Zampini }
1086674ae819SStefano Zampini 
1087984c4197SStefano Zampini /* uncomment for testing purposes */
1088984c4197SStefano Zampini /* #define PETSC_MISSING_LAPACK_GESVD 1 */
1089674ae819SStefano Zampini #undef __FUNCT__
1090674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp"
1091674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
1092674ae819SStefano Zampini {
1093674ae819SStefano Zampini   PetscErrorCode    ierr;
1094674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
1095674ae819SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
1096674ae819SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
1097984c4197SStefano Zampini   /* constraint and (optionally) change of basis matrix implemented as SeqAIJ */
1098674ae819SStefano Zampini   MatType           impMatType=MATSEQAIJ;
1099984c4197SStefano Zampini   /* one and zero */
1100984c4197SStefano Zampini   PetscScalar       one=1.0,zero=0.0;
1101984c4197SStefano Zampini   /* space to store constraints and their local indices */
1102984c4197SStefano Zampini   PetscScalar       *temp_quadrature_constraint;
1103984c4197SStefano Zampini   PetscInt          *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B;
1104984c4197SStefano Zampini   /* iterators */
1105984c4197SStefano Zampini   PetscInt          i,j,k,total_counts,temp_start_ptr;
1106984c4197SStefano Zampini   /* stuff to store connected components stored in pcbddc->mat_graph */
1107984c4197SStefano Zampini   IS                ISForVertices,*ISForFaces,*ISForEdges,*used_IS;
1108984c4197SStefano Zampini   PetscInt          n_ISForFaces,n_ISForEdges;
1109984c4197SStefano Zampini   /* near null space stuff */
1110674ae819SStefano Zampini   MatNullSpace      nearnullsp;
1111674ae819SStefano Zampini   const Vec         *nearnullvecs;
1112674ae819SStefano Zampini   Vec               *localnearnullsp;
1113984c4197SStefano Zampini   PetscBool         nnsp_has_cnst;
1114984c4197SStefano Zampini   PetscInt          nnsp_size;
1115984c4197SStefano Zampini   PetscScalar       *array;
1116984c4197SStefano Zampini   /* BLAS integers */
1117e310c8b4SStefano Zampini   PetscBLASInt      lwork,lierr;
1118e310c8b4SStefano Zampini   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
1119c4303822SStefano Zampini   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
1120984c4197SStefano Zampini   /* LAPACK working arrays for SVD or POD */
1121242a89d7SStefano Zampini   PetscBool         skip_lapack;
1122984c4197SStefano Zampini   PetscScalar       *work;
1123984c4197SStefano Zampini   PetscReal         *singular_vals;
1124984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1125984c4197SStefano Zampini   PetscReal         *rwork;
1126674ae819SStefano Zampini #endif
1127984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1128e310c8b4SStefano Zampini   PetscBLASInt      Blas_one_2=1;
1129984c4197SStefano Zampini   PetscScalar       *temp_basis,*correlation_mat;
1130b7d8b9f8SStefano Zampini #else
1131b7d8b9f8SStefano Zampini   PetscBLASInt      dummy_int_1=1,dummy_int_2=1;
1132b7d8b9f8SStefano Zampini   PetscScalar       dummy_scalar_1=0.0,dummy_scalar_2=0.0;
1133984c4197SStefano Zampini #endif
1134984c4197SStefano Zampini   /* change of basis */
1135984c4197SStefano Zampini   PetscInt          *aux_primal_numbering,*aux_primal_minloc,*global_indices;
11364641a718SStefano Zampini   PetscBool         boolforchange;
11374641a718SStefano Zampini   PetscBT           touched,change_basis;
1138984c4197SStefano Zampini   /* auxiliary stuff */
1139984c4197SStefano Zampini   PetscInt          *nnz,*is_indices,*local_to_B;
1140984c4197SStefano Zampini   /* some quantities */
1141984c4197SStefano Zampini   PetscInt          n_vertices,total_primal_vertices;
1142984c4197SStefano Zampini   PetscInt          size_of_constraint,max_size_of_constraint,max_constraints,temp_constraints;
1143984c4197SStefano Zampini 
1144674ae819SStefano Zampini 
1145674ae819SStefano Zampini   PetscFunctionBegin;
1146674ae819SStefano Zampini   /* Get index sets for faces, edges and vertices from graph */
11478eeda7d8SStefano Zampini   if (!pcbddc->use_faces && !pcbddc->use_edges && !pcbddc->use_vertices) {
11488eeda7d8SStefano Zampini     pcbddc->use_vertices = PETSC_TRUE;
1149674ae819SStefano Zampini   }
11508eeda7d8SStefano Zampini   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,pcbddc->use_faces,pcbddc->use_edges,pcbddc->use_vertices,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);
1151984c4197SStefano Zampini   /* print some info */
1152674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
1153674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1154674ae819SStefano Zampini     i = 0;
1155674ae819SStefano Zampini     if (ISForVertices) {
1156674ae819SStefano Zampini       ierr = ISGetSize(ISForVertices,&i);CHKERRQ(ierr);
1157674ae819SStefano Zampini     }
1158674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices\n",PetscGlobalRank,i);CHKERRQ(ierr);
1159674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges\n",PetscGlobalRank,n_ISForEdges);CHKERRQ(ierr);
116015aaf578SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces\n",PetscGlobalRank,n_ISForFaces);CHKERRQ(ierr);
1161674ae819SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1162674ae819SStefano Zampini   }
1163674ae819SStefano Zampini   /* check if near null space is attached to global mat */
1164674ae819SStefano Zampini   ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
1165674ae819SStefano Zampini   if (nearnullsp) {
1166674ae819SStefano Zampini     ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
1167984c4197SStefano Zampini   } else { /* if near null space is not provided BDDC uses constants by default */
1168984c4197SStefano Zampini     nnsp_size = 0;
1169674ae819SStefano Zampini     nnsp_has_cnst = PETSC_TRUE;
1170674ae819SStefano Zampini   }
1171984c4197SStefano Zampini   /* get max number of constraints on a single cc */
1172984c4197SStefano Zampini   max_constraints = nnsp_size;
1173984c4197SStefano Zampini   if (nnsp_has_cnst) max_constraints++;
1174984c4197SStefano Zampini 
1175674ae819SStefano Zampini   /*
1176674ae819SStefano Zampini        Evaluate maximum storage size needed by the procedure
1177674ae819SStefano Zampini        - temp_indices will contain start index of each constraint stored as follows
1178674ae819SStefano 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
1179674ae819SStefano 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
1180674ae819SStefano Zampini        - temp_quadrature_constraint  [temp_indices[i],...,temp[indices[i+1]-1] will contain the scalars representing the constraint itself
1181674ae819SStefano Zampini                                                                                                                                                          */
1182674ae819SStefano Zampini   total_counts = n_ISForFaces+n_ISForEdges;
1183984c4197SStefano Zampini   total_counts *= max_constraints;
1184674ae819SStefano Zampini   n_vertices = 0;
1185674ae819SStefano Zampini   if (ISForVertices) {
1186674ae819SStefano Zampini     ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
1187674ae819SStefano Zampini   }
1188674ae819SStefano Zampini   total_counts += n_vertices;
1189674ae819SStefano Zampini   ierr = PetscMalloc((total_counts+1)*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
11904641a718SStefano Zampini   ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
1191674ae819SStefano Zampini   total_counts = 0;
1192674ae819SStefano Zampini   max_size_of_constraint = 0;
1193674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1194674ae819SStefano Zampini     if (i<n_ISForEdges) {
1195674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1196674ae819SStefano Zampini     } else {
1197674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1198674ae819SStefano Zampini     }
1199674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
1200674ae819SStefano Zampini     total_counts += j;
1201674ae819SStefano Zampini     max_size_of_constraint = PetscMax(j,max_size_of_constraint);
1202674ae819SStefano Zampini   }
1203984c4197SStefano Zampini   total_counts *= max_constraints;
1204674ae819SStefano Zampini   total_counts += n_vertices;
1205674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&temp_quadrature_constraint);CHKERRQ(ierr);
1206674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint);CHKERRQ(ierr);
1207674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint_B);CHKERRQ(ierr);
1208984c4197SStefano Zampini   /* local to boundary numbering */
1209674ae819SStefano Zampini   ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&local_to_B);CHKERRQ(ierr);
1210674ae819SStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1211984c4197SStefano Zampini   for (i=0;i<pcis->n;i++) local_to_B[i]=-1;
1212984c4197SStefano Zampini   for (i=0;i<pcis->n_B;i++) local_to_B[is_indices[i]]=i;
1213674ae819SStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1214984c4197SStefano Zampini   /* get local part of global near null space vectors */
1215984c4197SStefano Zampini   ierr = PetscMalloc(nnsp_size*sizeof(Vec),&localnearnullsp);CHKERRQ(ierr);
1216984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1217984c4197SStefano Zampini     ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
1218984c4197SStefano Zampini     ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1219984c4197SStefano Zampini     ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1220984c4197SStefano Zampini   }
1221674ae819SStefano Zampini 
1222242a89d7SStefano Zampini   /* whether or not to skip lapack calls */
1223242a89d7SStefano Zampini   skip_lapack = PETSC_TRUE;
1224242a89d7SStefano Zampini   if (n_ISForFaces+n_ISForEdges) skip_lapack = PETSC_FALSE;
1225242a89d7SStefano Zampini 
1226984c4197SStefano Zampini   /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
1227242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1228674ae819SStefano Zampini     PetscScalar temp_work;
1229674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1230984c4197SStefano Zampini     /* Proper Orthogonal Decomposition (POD) using the snapshot method */
1231984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*max_constraints*sizeof(PetscScalar),&correlation_mat);CHKERRQ(ierr);
1232984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1233984c4197SStefano Zampini     ierr = PetscMalloc(max_size_of_constraint*max_constraints*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr);
1234674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1235984c4197SStefano Zampini     ierr = PetscMalloc(3*max_constraints*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1236674ae819SStefano Zampini #endif
1237674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1238c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
1239c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
1240674ae819SStefano Zampini     lwork = -1;
1241674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1242674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1243c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
1244674ae819SStefano Zampini #else
1245c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
1246674ae819SStefano Zampini #endif
1247674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1248984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
1249674ae819SStefano Zampini #else /* on missing GESVD */
1250674ae819SStefano Zampini     /* SVD */
1251674ae819SStefano Zampini     PetscInt max_n,min_n;
1252674ae819SStefano Zampini     max_n = max_size_of_constraint;
1253984c4197SStefano Zampini     min_n = max_constraints;
1254984c4197SStefano Zampini     if (max_size_of_constraint < max_constraints) {
1255674ae819SStefano Zampini       min_n = max_size_of_constraint;
1256984c4197SStefano Zampini       max_n = max_constraints;
1257674ae819SStefano Zampini     }
1258674ae819SStefano Zampini     ierr = PetscMalloc(min_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1259674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1260674ae819SStefano Zampini     ierr = PetscMalloc(5*min_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1261674ae819SStefano Zampini #endif
1262674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1263674ae819SStefano Zampini     lwork = -1;
1264e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
1265e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
1266b7d8b9f8SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
1267674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1268674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1269e310c8b4SStefano 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));
1270674ae819SStefano Zampini #else
1271e310c8b4SStefano 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));
1272674ae819SStefano Zampini #endif
1273674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1274984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
1275984c4197SStefano Zampini #endif /* on missing GESVD */
1276674ae819SStefano Zampini     /* Allocate optimal workspace */
1277674ae819SStefano Zampini     ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
1278984c4197SStefano Zampini     ierr = PetscMalloc((PetscInt)lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
1279674ae819SStefano Zampini   }
1280674ae819SStefano Zampini   /* Now we can loop on constraining sets */
1281674ae819SStefano Zampini   total_counts = 0;
1282674ae819SStefano Zampini   temp_indices[0] = 0;
1283674ae819SStefano Zampini   /* vertices */
1284674ae819SStefano Zampini   if (ISForVertices) {
1285674ae819SStefano Zampini     ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1286674ae819SStefano Zampini     if (nnsp_has_cnst) { /* consider all vertices */
1287674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1288674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1289674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
1290674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1291674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1292674ae819SStefano Zampini         total_counts++;
1293674ae819SStefano Zampini       }
1294674ae819SStefano Zampini     } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
1295984c4197SStefano Zampini       PetscBool used_vertex;
1296674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1297674ae819SStefano Zampini         used_vertex = PETSC_FALSE;
1298674ae819SStefano Zampini         k = 0;
1299674ae819SStefano Zampini         while (!used_vertex && k<nnsp_size) {
1300984c4197SStefano Zampini           ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1301984c4197SStefano Zampini           if (PetscAbsScalar(array[is_indices[i]])>0.0) {
1302674ae819SStefano Zampini             temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1303674ae819SStefano Zampini             temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
1304674ae819SStefano Zampini             temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1305674ae819SStefano Zampini             temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1306674ae819SStefano Zampini             total_counts++;
1307674ae819SStefano Zampini             used_vertex = PETSC_TRUE;
1308674ae819SStefano Zampini           }
1309984c4197SStefano Zampini           ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1310674ae819SStefano Zampini           k++;
1311674ae819SStefano Zampini         }
1312674ae819SStefano Zampini       }
1313674ae819SStefano Zampini     }
1314674ae819SStefano Zampini     ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1315674ae819SStefano Zampini     n_vertices = total_counts;
1316674ae819SStefano Zampini   }
1317984c4197SStefano Zampini 
1318674ae819SStefano Zampini   /* edges and faces */
1319674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1320674ae819SStefano Zampini     if (i<n_ISForEdges) {
1321674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1322984c4197SStefano Zampini       boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
1323674ae819SStefano Zampini     } else {
1324674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1325984c4197SStefano Zampini       boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
1326674ae819SStefano Zampini     }
1327674ae819SStefano Zampini     temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
1328674ae819SStefano Zampini     temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
1329674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
1330674ae819SStefano Zampini     ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1331984c4197SStefano Zampini     /* change of basis should not be performed on local periodic nodes */
1332984c4197SStefano Zampini     if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
1333674ae819SStefano Zampini     if (nnsp_has_cnst) {
13345b08dc53SStefano Zampini       PetscScalar quad_value;
1335674ae819SStefano Zampini       temp_constraints++;
1336674ae819SStefano Zampini       quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
1337674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1338674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
1339674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
1340674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
1341674ae819SStefano Zampini       }
1342674ae819SStefano Zampini       temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
13434641a718SStefano Zampini       if (boolforchange) {
13444641a718SStefano Zampini         ierr = PetscBTSet(change_basis,total_counts);CHKERRQ(ierr);
13454641a718SStefano Zampini       }
1346674ae819SStefano Zampini       total_counts++;
1347674ae819SStefano Zampini     }
1348674ae819SStefano Zampini     for (k=0;k<nnsp_size;k++) {
1349984c4197SStefano Zampini       PetscReal real_value;
1350984c4197SStefano Zampini       ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1351674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1352674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
1353674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
1354984c4197SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=array[is_indices[j]];
1355674ae819SStefano Zampini       }
1356984c4197SStefano Zampini       ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1357984c4197SStefano Zampini       /* check if array is null on the connected component */
1358e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1359e310c8b4SStefano Zampini       PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_one));
13605b08dc53SStefano Zampini       if (real_value > 0.0) { /* keep indices and values */
1361674ae819SStefano Zampini         temp_constraints++;
1362674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
13634641a718SStefano Zampini         if (boolforchange) {
13644641a718SStefano Zampini           ierr = PetscBTSet(change_basis,total_counts);CHKERRQ(ierr);
13654641a718SStefano Zampini         }
1366674ae819SStefano Zampini         total_counts++;
1367674ae819SStefano Zampini       }
1368674ae819SStefano Zampini     }
1369674ae819SStefano Zampini     ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1370984c4197SStefano Zampini     /* perform SVD on the constraints if use_nnsp_true has not be requested by the user */
1371984c4197SStefano Zampini     if (!pcbddc->use_nnsp_true) {
1372984c4197SStefano Zampini       PetscReal tol = 1.0e-8; /* tolerance for retaining eigenmodes */
1373674ae819SStefano Zampini 
1374674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1375984c4197SStefano Zampini       /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
1376984c4197SStefano Zampini          POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
1377984c4197SStefano Zampini          -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
1378984c4197SStefano Zampini             the constraints basis will differ (by a complex factor with absolute value equal to 1)
1379984c4197SStefano Zampini             from that computed using LAPACKgesvd
1380984c4197SStefano Zampini          -> This is due to a different computation of eigenvectors in LAPACKheev
1381984c4197SStefano Zampini          -> The quality of the POD-computed basis will be the same */
1382984c4197SStefano Zampini       ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
1383674ae819SStefano Zampini       /* Store upper triangular part of correlation matrix */
1384e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1385984c4197SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1386674ae819SStefano Zampini       for (j=0;j<temp_constraints;j++) {
1387674ae819SStefano Zampini         for (k=0;k<j+1;k++) {
1388e310c8b4SStefano 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));
1389674ae819SStefano Zampini         }
1390674ae819SStefano Zampini       }
1391e310c8b4SStefano Zampini       /* compute eigenvalues and eigenvectors of correlation matrix */
1392e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1393e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
1394674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1395c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
1396674ae819SStefano Zampini #else
1397c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
1398674ae819SStefano Zampini #endif
1399674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1400984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
1401984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
1402674ae819SStefano Zampini       j=0;
1403984c4197SStefano Zampini       while (j < temp_constraints && singular_vals[j] < tol) j++;
1404674ae819SStefano Zampini       total_counts=total_counts-j;
1405e310c8b4SStefano Zampini       /* scale and copy POD basis into used quadrature memory */
1406c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1407c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1408c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
1409c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1410c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
1411c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1412674ae819SStefano Zampini       if (j<temp_constraints) {
1413984c4197SStefano Zampini         PetscInt ii;
1414984c4197SStefano Zampini         for (k=j;k<temp_constraints;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]);
1415674ae819SStefano Zampini         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1416c4303822SStefano 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));
1417674ae819SStefano Zampini         ierr = PetscFPTrapPop();CHKERRQ(ierr);
1418984c4197SStefano Zampini         for (k=0;k<temp_constraints-j;k++) {
1419674ae819SStefano Zampini           for (ii=0;ii<size_of_constraint;ii++) {
1420984c4197SStefano 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];
1421674ae819SStefano Zampini           }
1422674ae819SStefano Zampini         }
1423674ae819SStefano Zampini       }
1424674ae819SStefano Zampini #else  /* on missing GESVD */
1425e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1426e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1427b7d8b9f8SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1428674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1429674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1430e310c8b4SStefano 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));
1431674ae819SStefano Zampini #else
1432e310c8b4SStefano 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));
1433674ae819SStefano Zampini #endif
1434984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
1435674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1436984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
1437e310c8b4SStefano Zampini       k = temp_constraints;
1438e310c8b4SStefano Zampini       if (k > size_of_constraint) k = size_of_constraint;
1439674ae819SStefano Zampini       j = 0;
1440e310c8b4SStefano Zampini       while (j < k && singular_vals[k-j-1] < tol) j++;
1441e310c8b4SStefano Zampini       total_counts = total_counts-temp_constraints+k-j;
1442984c4197SStefano Zampini #endif /* on missing GESVD */
1443674ae819SStefano Zampini     }
1444674ae819SStefano Zampini   }
1445674ae819SStefano Zampini   /* free index sets of faces, edges and vertices */
1446674ae819SStefano Zampini   for (i=0;i<n_ISForFaces;i++) {
1447674ae819SStefano Zampini     ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
1448674ae819SStefano Zampini   }
1449674ae819SStefano Zampini   ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
1450674ae819SStefano Zampini   for (i=0;i<n_ISForEdges;i++) {
1451674ae819SStefano Zampini     ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
1452674ae819SStefano Zampini   }
1453674ae819SStefano Zampini   ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
1454674ae819SStefano Zampini   ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
1455674ae819SStefano Zampini 
1456984c4197SStefano Zampini   /* free workspace */
1457242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1458984c4197SStefano Zampini     ierr = PetscFree(work);CHKERRQ(ierr);
1459984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1460984c4197SStefano Zampini     ierr = PetscFree(rwork);CHKERRQ(ierr);
1461984c4197SStefano Zampini #endif
1462984c4197SStefano Zampini     ierr = PetscFree(singular_vals);CHKERRQ(ierr);
1463984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1464984c4197SStefano Zampini     ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
1465984c4197SStefano Zampini     ierr = PetscFree(temp_basis);CHKERRQ(ierr);
1466984c4197SStefano Zampini #endif
1467984c4197SStefano Zampini   }
1468984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1469984c4197SStefano Zampini     ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
1470984c4197SStefano Zampini   }
1471984c4197SStefano Zampini   ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
1472984c4197SStefano Zampini 
1473674ae819SStefano Zampini   /* set quantities in pcbddc data structure */
1474984c4197SStefano Zampini   /* n_vertices defines the number of subdomain corners in the primal space */
1475674ae819SStefano Zampini   /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */
1476984c4197SStefano Zampini   pcbddc->local_primal_size = total_counts;
1477674ae819SStefano Zampini   pcbddc->n_vertices = n_vertices;
1478984c4197SStefano Zampini   pcbddc->n_constraints = pcbddc->local_primal_size-pcbddc->n_vertices;
1479674ae819SStefano Zampini 
1480674ae819SStefano Zampini   /* Create constraint matrix */
1481674ae819SStefano Zampini   /* The constraint matrix is used to compute the l2g map of primal dofs */
1482674ae819SStefano Zampini   /* so we need to set it up properly either with or without change of basis */
1483674ae819SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1484674ae819SStefano Zampini   ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr);
1485984c4197SStefano Zampini   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
1486984c4197SStefano Zampini   /* array to compute a local numbering of constraints : vertices first then constraints */
1487984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_numbering);CHKERRQ(ierr);
1488984c4197SStefano Zampini   /* array to select the proper local node (of minimum index with respect to global ordering) when changing the basis */
1489984c4197SStefano 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 */
1490984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_minloc);CHKERRQ(ierr);
1491984c4197SStefano Zampini   /* auxiliary stuff for basis change */
1492984c4197SStefano Zampini   ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&global_indices);CHKERRQ(ierr);
14934641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n_B,&touched);CHKERRQ(ierr);
1494984c4197SStefano Zampini 
1495984c4197SStefano Zampini   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
1496984c4197SStefano Zampini   total_primal_vertices=0;
1497984c4197SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
1498674ae819SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
1499984c4197SStefano Zampini     if (size_of_constraint == 1) {
15004641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]]);CHKERRQ(ierr);
1501984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]];
1502984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=0;
1503984c4197SStefano Zampini       total_primal_vertices++;
15044641a718SStefano Zampini     } else if (PetscBTLookup(change_basis,i)) { /* Same procedure used in PCBDDCGetPrimalConstraintsLocalIdx */
1505984c4197SStefano Zampini       PetscInt min_loc,min_index;
1506984c4197SStefano Zampini       ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],global_indices);CHKERRQ(ierr);
1507984c4197SStefano Zampini       /* find first untouched local node */
1508674ae819SStefano Zampini       k = 0;
15094641a718SStefano Zampini       while (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) k++;
1510984c4197SStefano Zampini       min_index = global_indices[k];
1511984c4197SStefano Zampini       min_loc = k;
1512984c4197SStefano Zampini       /* search the minimum among global nodes already untouched on the cc */
1513984c4197SStefano Zampini       for (k=1;k<size_of_constraint;k++) {
1514984c4197SStefano Zampini         /* there can be more than one constraint on a single connected component */
15154641a718SStefano Zampini         if (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k]) && min_index > global_indices[k]) {
1516984c4197SStefano Zampini           min_index = global_indices[k];
1517984c4197SStefano Zampini           min_loc = k;
1518674ae819SStefano Zampini         }
1519674ae819SStefano Zampini       }
15204641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]+min_loc]);CHKERRQ(ierr);
1521984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]+min_loc];
1522984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=min_loc;
1523984c4197SStefano Zampini       total_primal_vertices++;
1524984c4197SStefano Zampini     }
1525984c4197SStefano Zampini   }
1526984c4197SStefano Zampini   /* free workspace */
1527984c4197SStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
15284641a718SStefano Zampini   ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
1529674ae819SStefano Zampini   /* permute indices in order to have a sorted set of vertices */
1530984c4197SStefano Zampini   ierr = PetscSortInt(total_primal_vertices,aux_primal_numbering);
1531984c4197SStefano Zampini 
1532984c4197SStefano Zampini   /* nonzero structure of constraint matrix */
1533984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1534984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) nnz[i]=1;
1535984c4197SStefano Zampini   j=total_primal_vertices;
1536984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
15374641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1538674ae819SStefano Zampini       nnz[j]=temp_indices[i+1]-temp_indices[i];
1539674ae819SStefano Zampini       j++;
1540674ae819SStefano Zampini     }
1541674ae819SStefano Zampini   }
1542674ae819SStefano Zampini   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
1543674ae819SStefano Zampini   ierr = PetscFree(nnz);CHKERRQ(ierr);
1544674ae819SStefano Zampini   /* set values in constraint matrix */
1545984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) {
1546984c4197SStefano Zampini     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,aux_primal_numbering[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
1547674ae819SStefano Zampini   }
1548984c4197SStefano Zampini   total_counts = total_primal_vertices;
1549984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
15504641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1551674ae819SStefano Zampini       size_of_constraint=temp_indices[i+1]-temp_indices[i];
1552674ae819SStefano 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);
1553674ae819SStefano Zampini       total_counts++;
1554674ae819SStefano Zampini     }
1555674ae819SStefano Zampini   }
1556674ae819SStefano Zampini   /* assembling */
1557674ae819SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1558674ae819SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1559984c4197SStefano Zampini   /*
1560984c4197SStefano Zampini   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
1561984c4197SStefano Zampini   */
1562674ae819SStefano Zampini   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
1563674ae819SStefano Zampini   if (pcbddc->use_change_of_basis) {
1564984c4197SStefano Zampini     PetscBool qr_needed = PETSC_FALSE;
1565984c4197SStefano Zampini     /* change of basis acts on local interfaces -> dimension is n_B x n_B */
1566674ae819SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
1567674ae819SStefano Zampini     ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr);
1568674ae819SStefano Zampini     ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr);
1569674ae819SStefano Zampini     /* work arrays */
1570674ae819SStefano Zampini     ierr = PetscMalloc(pcis->n_B*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1571984c4197SStefano Zampini     for (i=0;i<pcis->n_B;i++) nnz[i]=1;
1572984c4197SStefano Zampini     /* nonzeros per row */
1573984c4197SStefano Zampini     for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
15744641a718SStefano Zampini       if (PetscBTLookup(change_basis,i)) {
1575984c4197SStefano Zampini         qr_needed = PETSC_TRUE;
1576674ae819SStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
1577984c4197SStefano Zampini         for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1578674ae819SStefano Zampini       }
1579674ae819SStefano Zampini     }
1580674ae819SStefano Zampini     ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
1581674ae819SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
1582674ae819SStefano Zampini     /* Set initial identity in the matrix */
1583674ae819SStefano Zampini     for (i=0;i<pcis->n_B;i++) {
1584674ae819SStefano Zampini       ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
1585674ae819SStefano Zampini     }
1586984c4197SStefano Zampini 
1587674ae819SStefano Zampini     /* Now we loop on the constraints which need a change of basis */
1588674ae819SStefano Zampini     /* Change of basis matrix is evaluated as the FIRST APPROACH in */
1589984c4197SStefano Zampini     /* Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1) */
1590984c4197SStefano Zampini     /* Change of basis matrix T computed via QR decomposition of constraints */
1591984c4197SStefano Zampini     if (qr_needed) {
1592026de310SStefano Zampini       /* dual and primal dofs on a single cc */
1593984c4197SStefano Zampini       PetscInt     dual_dofs,primal_dofs;
1594026de310SStefano Zampini       /* iterator on aux_primal_minloc (ordered as read from nearnullspace: vertices, edges and then constraints) */
1595026de310SStefano Zampini       PetscInt     primal_counter;
1596984c4197SStefano Zampini       /* working stuff for GEQRF */
1597984c4197SStefano Zampini       PetscScalar  *qr_basis,*qr_tau,*qr_work,lqr_work_t;
1598984c4197SStefano Zampini       PetscBLASInt lqr_work;
1599984c4197SStefano Zampini       /* working stuff for UNGQR */
1600984c4197SStefano Zampini       PetscScalar  *gqr_work,lgqr_work_t;
1601984c4197SStefano Zampini       PetscBLASInt lgqr_work;
1602984c4197SStefano Zampini       /* working stuff for TRTRS */
1603984c4197SStefano Zampini       PetscScalar  *trs_rhs;
16043f08241aSStefano Zampini       PetscBLASInt Blas_NRHS;
1605984c4197SStefano Zampini       /* pointers for values insertion into change of basis matrix */
1606984c4197SStefano Zampini       PetscInt     *start_rows,*start_cols;
1607984c4197SStefano Zampini       PetscScalar  *start_vals;
1608984c4197SStefano Zampini       /* working stuff for values insertion */
16094641a718SStefano Zampini       PetscBT      is_primal;
1610984c4197SStefano Zampini 
1611984c4197SStefano Zampini       /* space to store Q */
1612984c4197SStefano Zampini       ierr = PetscMalloc((max_size_of_constraint)*(max_size_of_constraint)*sizeof(PetscScalar),&qr_basis);CHKERRQ(ierr);
1613984c4197SStefano Zampini       /* first we issue queries for optimal work */
16143f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
16153f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
16163f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1617984c4197SStefano Zampini       lqr_work = -1;
16183f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
1619984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
1620984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
1621984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lqr_work_t)*sizeof(*qr_work),&qr_work);CHKERRQ(ierr);
1622984c4197SStefano Zampini       lgqr_work = -1;
16233f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
16243f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
16253f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
16263f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
16273f08241aSStefano Zampini       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
16283f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
1629984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
1630984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
1631984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lgqr_work_t)*sizeof(*gqr_work),&gqr_work);CHKERRQ(ierr);
1632984c4197SStefano Zampini       /* array to store scaling factors for reflectors */
1633984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*sizeof(*qr_tau),&qr_tau);CHKERRQ(ierr);
1634984c4197SStefano Zampini       /* array to store rhs and solution of triangular solver */
1635984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*max_constraints*sizeof(*trs_rhs),&trs_rhs);CHKERRQ(ierr);
1636984c4197SStefano Zampini       /* array to store whether a node is primal or not */
16374641a718SStefano Zampini       ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
16384641a718SStefano Zampini       for (i=0;i<total_primal_vertices;i++) {
16394641a718SStefano Zampini         ierr = PetscBTSet(is_primal,local_to_B[aux_primal_numbering[i]]);CHKERRQ(ierr);
16404641a718SStefano Zampini       }
1641984c4197SStefano Zampini 
1642984c4197SStefano Zampini       /* allocating workspace for check */
1643984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
1644984c4197SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1645984c4197SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
1646984c4197SStefano Zampini         ierr = PetscMalloc(max_size_of_constraint*(max_constraints+max_size_of_constraint)*sizeof(*work),&work);CHKERRQ(ierr);
1647674ae819SStefano Zampini       }
1648984c4197SStefano Zampini 
1649026de310SStefano Zampini       /* loop on constraints and see whether or not they need a change of basis */
1650026de310SStefano Zampini       /* -> using implicit ordering contained in temp_indices data */
1651026de310SStefano Zampini       total_counts = pcbddc->n_vertices;
1652026de310SStefano Zampini       primal_counter = total_counts;
1653026de310SStefano Zampini       while (total_counts<pcbddc->local_primal_size) {
1654026de310SStefano Zampini         primal_dofs = 1;
16554641a718SStefano Zampini         if (PetscBTLookup(change_basis,total_counts)) {
1656026de310SStefano Zampini           /* get all constraints with same support: if more then one constraint is present on the cc then surely indices are stored contiguosly */
1657026de310SStefano 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]]) {
1658026de310SStefano Zampini             primal_dofs++;
1659674ae819SStefano Zampini           }
1660984c4197SStefano Zampini           /* get constraint info */
1661026de310SStefano Zampini           size_of_constraint = temp_indices[total_counts+1]-temp_indices[total_counts];
1662984c4197SStefano Zampini           dual_dofs = size_of_constraint-primal_dofs;
1663984c4197SStefano Zampini 
1664984c4197SStefano Zampini           /* copy quadrature constraints for change of basis check */
1665984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
1666026de310SStefano Zampini             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d to %d need a change of basis (size %d)\n",total_counts,total_counts+primal_dofs,size_of_constraint);CHKERRQ(ierr);
1667026de310SStefano Zampini             ierr = PetscMemcpy(work,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1668674ae819SStefano Zampini           }
1669984c4197SStefano Zampini 
1670984c4197SStefano Zampini           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
1671026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1672984c4197SStefano Zampini 
1673984c4197SStefano Zampini           /* compute QR decomposition of constraints */
16743f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
16753f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
16763f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1677674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
16783f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
1679984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
1680674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1681984c4197SStefano Zampini 
1682984c4197SStefano Zampini           /* explictly compute R^-T */
1683984c4197SStefano Zampini           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
1684984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
16853f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
16863f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
16873f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
16883f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
1689984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
16903f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
1691984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
1692984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1693984c4197SStefano Zampini 
1694984c4197SStefano Zampini           /* explcitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
16953f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
16963f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
16973f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
16983f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1699984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
17003f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
1701984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
1702984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1703984c4197SStefano Zampini 
1704984c4197SStefano Zampini           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
1705984c4197SStefano Zampini              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
1706984c4197SStefano Zampini              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
17073f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
17083f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
17093f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
17103f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
17113f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
17123f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1713984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1714c4303822SStefano 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));
1715984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1716026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1717984c4197SStefano Zampini 
1718984c4197SStefano Zampini           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
1719026de310SStefano Zampini           start_rows = &temp_indices_to_constraint_B[temp_indices[total_counts]];
1720984c4197SStefano Zampini           /* insert cols for primal dofs */
1721984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) {
1722984c4197SStefano Zampini             start_vals = &qr_basis[j*size_of_constraint];
1723026de310SStefano Zampini             start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter+j]];
1724984c4197SStefano Zampini             ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1725984c4197SStefano Zampini           }
1726984c4197SStefano Zampini           /* insert cols for dual dofs */
1727984c4197SStefano Zampini           for (j=0,k=0;j<dual_dofs;k++) {
17284641a718SStefano Zampini             if (!PetscBTLookup(is_primal,temp_indices_to_constraint_B[temp_indices[total_counts]+k])) {
1729984c4197SStefano Zampini               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
1730026de310SStefano Zampini               start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+k];
1731984c4197SStefano Zampini               ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1732984c4197SStefano Zampini               j++;
1733674ae819SStefano Zampini             }
1734674ae819SStefano Zampini           }
1735984c4197SStefano Zampini 
1736984c4197SStefano Zampini           /* check change of basis */
1737984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
1738984c4197SStefano Zampini             PetscInt   ii,jj;
1739984c4197SStefano Zampini             PetscBool valid_qr=PETSC_TRUE;
1740c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
1741c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1742c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
1743c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1744c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
1745c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
1746984c4197SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1747c4303822SStefano 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));
1748984c4197SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
1749984c4197SStefano Zampini             for (jj=0;jj<size_of_constraint;jj++) {
1750984c4197SStefano Zampini               for (ii=0;ii<primal_dofs;ii++) {
1751984c4197SStefano Zampini                 if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
1752984c4197SStefano Zampini                 if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
1753674ae819SStefano Zampini               }
1754674ae819SStefano Zampini             }
1755984c4197SStefano Zampini             if (!valid_qr) {
1756984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
1757984c4197SStefano Zampini               for (jj=0;jj<size_of_constraint;jj++) {
1758984c4197SStefano Zampini                 for (ii=0;ii<primal_dofs;ii++) {
1759984c4197SStefano Zampini                   if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
1760984c4197SStefano 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]));
1761674ae819SStefano Zampini                   }
1762984c4197SStefano Zampini                   if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
1763984c4197SStefano 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]));
1764984c4197SStefano Zampini                   }
1765984c4197SStefano Zampini                 }
1766984c4197SStefano Zampini               }
1767674ae819SStefano Zampini             } else {
1768984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
1769674ae819SStefano Zampini             }
1770674ae819SStefano Zampini           }
1771026de310SStefano Zampini           /* increment primal counter */
1772026de310SStefano Zampini           primal_counter += primal_dofs;
1773984c4197SStefano Zampini         } else {
1774984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
1775026de310SStefano 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);
1776674ae819SStefano Zampini           }
1777674ae819SStefano Zampini         }
1778026de310SStefano Zampini         /* increment constraint counter total_counts */
1779026de310SStefano Zampini         total_counts += primal_dofs;
1780674ae819SStefano Zampini       }
1781984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
1782984c4197SStefano Zampini         ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1783984c4197SStefano Zampini         ierr = PetscFree(work);CHKERRQ(ierr);
1784984c4197SStefano Zampini       }
1785984c4197SStefano Zampini       /* free workspace */
1786984c4197SStefano Zampini       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
1787984c4197SStefano Zampini       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
1788984c4197SStefano Zampini       ierr = PetscFree(qr_work);CHKERRQ(ierr);
1789984c4197SStefano Zampini       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
17904641a718SStefano Zampini       ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
1791984c4197SStefano Zampini       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
1792674ae819SStefano Zampini     }
1793674ae819SStefano Zampini     /* assembling */
1794674ae819SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1795674ae819SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1796984c4197SStefano Zampini     /*
1797984c4197SStefano Zampini     ierr = MatView(pcbddc->ChangeOfBasisMatrix,(PetscViewer)0);CHKERRQ(ierr);
1798984c4197SStefano Zampini     */
1799674ae819SStefano Zampini   }
1800e310c8b4SStefano Zampini   /* free workspace */
1801984c4197SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
1802984c4197SStefano Zampini   ierr = PetscFree(aux_primal_minloc);CHKERRQ(ierr);
1803674ae819SStefano Zampini   ierr = PetscFree(temp_indices);CHKERRQ(ierr);
18044641a718SStefano Zampini   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
1805674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr);
1806674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
1807674ae819SStefano Zampini   ierr = PetscFree(local_to_B);CHKERRQ(ierr);
1808674ae819SStefano Zampini   ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr);
1809674ae819SStefano Zampini   PetscFunctionReturn(0);
1810674ae819SStefano Zampini }
1811674ae819SStefano Zampini 
1812674ae819SStefano Zampini #undef __FUNCT__
1813674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
1814674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
1815674ae819SStefano Zampini {
1816674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
1817674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
1818674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
1819674ae819SStefano Zampini   PetscInt    bs,ierr,i,vertex_size;
1820674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
1821674ae819SStefano Zampini 
1822674ae819SStefano Zampini   PetscFunctionBegin;
1823674ae819SStefano Zampini   /* Init local Graph struct */
1824674ae819SStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr);
1825674ae819SStefano Zampini 
1826575ad6abSStefano Zampini   /* Check validity of the csr graph passed in by the user */
1827575ad6abSStefano Zampini   if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) {
1828575ad6abSStefano Zampini     ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1829575ad6abSStefano Zampini   }
1830674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
1831674ae819SStefano Zampini   if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) {
1832674ae819SStefano Zampini     Mat mat_adj;
1833674ae819SStefano Zampini     const PetscInt *xadj,*adjncy;
1834674ae819SStefano Zampini     PetscBool flg_row=PETSC_TRUE;
1835674ae819SStefano Zampini 
1836674ae819SStefano Zampini     ierr = MatConvert(matis->A,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr);
1837674ae819SStefano Zampini     ierr = MatGetRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
1838674ae819SStefano Zampini     if (!flg_row) {
1839674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ called in %s\n",__FUNCT__);
1840674ae819SStefano Zampini     }
1841674ae819SStefano Zampini     ierr = PCBDDCSetLocalAdjacencyGraph(pc,i,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
1842674ae819SStefano Zampini     ierr = MatRestoreRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
1843674ae819SStefano Zampini     if (!flg_row) {
1844674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__);
1845674ae819SStefano Zampini     }
1846674ae819SStefano Zampini     ierr = MatDestroy(&mat_adj);CHKERRQ(ierr);
1847674ae819SStefano Zampini   }
1848674ae819SStefano Zampini 
1849674ae819SStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting */
1850674ae819SStefano Zampini   vertex_size = 1;
1851674ae819SStefano Zampini   if (!pcbddc->n_ISForDofs) {
1852674ae819SStefano Zampini     IS *custom_ISForDofs;
1853674ae819SStefano Zampini 
1854674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&bs);CHKERRQ(ierr);
1855674ae819SStefano Zampini     ierr = PetscMalloc(bs*sizeof(IS),&custom_ISForDofs);CHKERRQ(ierr);
1856674ae819SStefano Zampini     for (i=0;i<bs;i++) {
1857674ae819SStefano Zampini       ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n/bs,i,bs,&custom_ISForDofs[i]);CHKERRQ(ierr);
1858674ae819SStefano Zampini     }
1859674ae819SStefano Zampini     ierr = PCBDDCSetDofsSplitting(pc,bs,custom_ISForDofs);CHKERRQ(ierr);
1860674ae819SStefano Zampini     /* remove my references to IS objects */
1861674ae819SStefano Zampini     for (i=0;i<bs;i++) {
1862674ae819SStefano Zampini       ierr = ISDestroy(&custom_ISForDofs[i]);CHKERRQ(ierr);
1863674ae819SStefano Zampini     }
1864674ae819SStefano Zampini     ierr = PetscFree(custom_ISForDofs);CHKERRQ(ierr);
1865674ae819SStefano Zampini   } else { /* mat block size as vertex size (used for elasticity) */
1866674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
1867674ae819SStefano Zampini   }
1868674ae819SStefano Zampini 
1869674ae819SStefano Zampini   /* Setup of Graph */
1870674ae819SStefano Zampini   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundaries,pcbddc->DirichletBoundaries,pcbddc->n_ISForDofs,pcbddc->ISForDofs,pcbddc->user_primal_vertices);
1871674ae819SStefano Zampini 
1872674ae819SStefano Zampini   /* Graph's connected components analysis */
1873674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
1874674ae819SStefano Zampini 
1875674ae819SStefano Zampini   /* print some info to stdout */
1876674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
1877e49050b4SStefano Zampini     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer);
1878674ae819SStefano Zampini   }
1879674ae819SStefano Zampini   PetscFunctionReturn(0);
1880674ae819SStefano Zampini }
1881674ae819SStefano Zampini 
1882674ae819SStefano Zampini #undef __FUNCT__
1883674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx"
1884f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt **vertices_idx)
1885674ae819SStefano Zampini {
1886674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
1887674ae819SStefano Zampini   PetscInt       *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size;
1888674ae819SStefano Zampini   PetscErrorCode ierr;
1889674ae819SStefano Zampini 
1890674ae819SStefano Zampini   PetscFunctionBegin;
1891674ae819SStefano Zampini   n = 0;
1892674ae819SStefano Zampini   vertices = 0;
1893674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
1894674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr);
1895b120a5c6SStefano Zampini     for (i=0;i<local_primal_size;i++) {
1896b120a5c6SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
1897b120a5c6SStefano Zampini       if (size_of_constraint == 1) n++;
1898b120a5c6SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
1899b120a5c6SStefano Zampini     }
1900811e8ca2SStefano Zampini     if (vertices_idx) {
1901b120a5c6SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&vertices);CHKERRQ(ierr);
1902b120a5c6SStefano Zampini       n = 0;
1903674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
1904674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
1905674ae819SStefano Zampini         if (size_of_constraint == 1) {
1906674ae819SStefano Zampini           vertices[n++]=row_cmat_indices[0];
1907674ae819SStefano Zampini         }
1908674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
1909674ae819SStefano Zampini       }
1910674ae819SStefano Zampini     }
1911811e8ca2SStefano Zampini   }
1912674ae819SStefano Zampini   *n_vertices = n;
1913811e8ca2SStefano Zampini   if (vertices_idx) *vertices_idx = vertices;
1914674ae819SStefano Zampini   PetscFunctionReturn(0);
1915674ae819SStefano Zampini }
1916674ae819SStefano Zampini 
1917674ae819SStefano Zampini #undef __FUNCT__
1918674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx"
1919f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt **constraints_idx)
1920674ae819SStefano Zampini {
1921674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
1922674ae819SStefano Zampini   PetscInt       *constraints_index,*row_cmat_indices,*row_cmat_global_indices;
1923674ae819SStefano Zampini   PetscInt       n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc;
19244641a718SStefano Zampini   PetscBT        touched;
1925674ae819SStefano Zampini   PetscErrorCode ierr;
1926674ae819SStefano Zampini 
1927f34684f1SStefano Zampini     /* This function assumes that the number of local constraints per connected component
1928f34684f1SStefano Zampini        is not greater than the number of nodes defined for the connected component
1929f34684f1SStefano Zampini        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
1930674ae819SStefano Zampini   PetscFunctionBegin;
1931674ae819SStefano Zampini   n = 0;
1932674ae819SStefano Zampini   constraints_index = 0;
1933674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
1934674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr);
1935674ae819SStefano Zampini     max_size_of_constraint = 0;
1936674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
1937674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
1938674ae819SStefano Zampini       if (size_of_constraint > 1) {
1939674ae819SStefano Zampini         n++;
1940674ae819SStefano Zampini       }
1941674ae819SStefano Zampini       max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint);
1942674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
1943674ae819SStefano Zampini     }
1944811e8ca2SStefano Zampini     if (constraints_idx) {
1945674ae819SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&constraints_index);CHKERRQ(ierr);
1946674ae819SStefano Zampini       ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&row_cmat_global_indices);CHKERRQ(ierr);
19474641a718SStefano Zampini       ierr = PetscBTCreate(local_size,&touched);CHKERRQ(ierr);
1948674ae819SStefano Zampini       n = 0;
1949674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
1950674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
1951674ae819SStefano Zampini         if (size_of_constraint > 1) {
1952674ae819SStefano Zampini           ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr);
195382d3d8afSStefano Zampini           /* find first untouched local node */
195482d3d8afSStefano Zampini           j = 0;
19554641a718SStefano Zampini           while (PetscBTLookup(touched,row_cmat_indices[j])) j++;
195682d3d8afSStefano Zampini           min_index = row_cmat_global_indices[j];
195782d3d8afSStefano Zampini           min_loc = j;
195882d3d8afSStefano Zampini           /* search the minimum among nodes not yet touched on the connected component
195982d3d8afSStefano Zampini              since there can be more than one constraint on a single cc */
1960674ae819SStefano Zampini           for (j=1;j<size_of_constraint;j++) {
19614641a718SStefano Zampini             if (!PetscBTLookup(touched,row_cmat_indices[j]) && min_index > row_cmat_global_indices[j]) {
1962674ae819SStefano Zampini               min_index = row_cmat_global_indices[j];
1963674ae819SStefano Zampini               min_loc = j;
1964674ae819SStefano Zampini             }
1965674ae819SStefano Zampini           }
19664641a718SStefano Zampini           ierr = PetscBTSet(touched,row_cmat_indices[min_loc]);CHKERRQ(ierr);
1967674ae819SStefano Zampini           constraints_index[n++] = row_cmat_indices[min_loc];
1968674ae819SStefano Zampini         }
1969674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
1970674ae819SStefano Zampini       }
19714641a718SStefano Zampini       ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
1972674ae819SStefano Zampini       ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr);
1973811e8ca2SStefano Zampini     }
1974811e8ca2SStefano Zampini   }
1975674ae819SStefano Zampini   *n_constraints = n;
1976811e8ca2SStefano Zampini   if (constraints_idx) *constraints_idx = constraints_index;
1977674ae819SStefano Zampini   PetscFunctionReturn(0);
1978674ae819SStefano Zampini }
1979674ae819SStefano Zampini 
1980674ae819SStefano Zampini /* the next two functions has been adapted from pcis.c */
1981674ae819SStefano Zampini #undef __FUNCT__
1982674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchur"
1983674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchur(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
1984674ae819SStefano Zampini {
1985674ae819SStefano Zampini   PetscErrorCode ierr;
1986674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
1987674ae819SStefano Zampini 
1988674ae819SStefano Zampini   PetscFunctionBegin;
1989674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
1990674ae819SStefano Zampini   ierr = MatMult(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
1991674ae819SStefano Zampini   ierr = MatMult(pcis->A_IB,v,vec1_D);CHKERRQ(ierr);
1992674ae819SStefano Zampini   ierr = KSPSolve(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
1993674ae819SStefano Zampini   ierr = MatMult(pcis->A_BI,vec2_D,vec2_B);CHKERRQ(ierr);
1994674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
1995674ae819SStefano Zampini   PetscFunctionReturn(0);
1996674ae819SStefano Zampini }
1997674ae819SStefano Zampini 
1998674ae819SStefano Zampini #undef __FUNCT__
1999674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchurTranspose"
2000674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchurTranspose(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2001674ae819SStefano Zampini {
2002674ae819SStefano Zampini   PetscErrorCode ierr;
2003674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2004674ae819SStefano Zampini 
2005674ae819SStefano Zampini   PetscFunctionBegin;
2006674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2007674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2008674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BI,v,vec1_D);CHKERRQ(ierr);
2009674ae819SStefano Zampini   ierr = KSPSolveTranspose(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2010674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_IB,vec2_D,vec2_B);CHKERRQ(ierr);
2011674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2012674ae819SStefano Zampini   PetscFunctionReturn(0);
2013674ae819SStefano Zampini }
2014674ae819SStefano Zampini 
2015674ae819SStefano Zampini #undef __FUNCT__
2016674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
2017674ae819SStefano 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[])
2018674ae819SStefano Zampini {
2019674ae819SStefano Zampini   Vec            local_vec,global_vec;
2020674ae819SStefano Zampini   IS             seqis,paris;
2021674ae819SStefano Zampini   VecScatter     scatter_ctx;
2022674ae819SStefano Zampini   PetscScalar    *array;
2023674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
2024674ae819SStefano Zampini   PetscScalar    globalsum;
2025674ae819SStefano Zampini   PetscInt       i,j,s;
2026674ae819SStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local;
2027674ae819SStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm,max_global;
2028674ae819SStefano Zampini   PetscMPIInt    *dof_sizes,*dof_displs;
2029674ae819SStefano Zampini   PetscBool      first_found;
2030674ae819SStefano Zampini   PetscErrorCode ierr;
2031674ae819SStefano Zampini 
2032674ae819SStefano Zampini   PetscFunctionBegin;
2033674ae819SStefano Zampini   /* mpi buffers */
2034674ae819SStefano Zampini   MPI_Comm_size(comm,&size_prec_comm);
2035674ae819SStefano Zampini   MPI_Comm_rank(comm,&rank_prec_comm);
2036674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
2037674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_sizes),&dof_sizes);CHKERRQ(ierr);
2038674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_displs),&dof_displs);CHKERRQ(ierr);
2039674ae819SStefano Zampini   /* get maximum size of subset */
2040674ae819SStefano Zampini   ierr = PetscMalloc(n_local_dofs*sizeof(PetscInt),&temp_global_dofs);CHKERRQ(ierr);
2041674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
2042674ae819SStefano Zampini   max_local = 0;
2043674ae819SStefano Zampini   if (n_local_dofs) {
2044674ae819SStefano Zampini     max_local = temp_global_dofs[0];
2045674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2046674ae819SStefano Zampini       if (max_local < temp_global_dofs[i] ) {
2047674ae819SStefano Zampini         max_local = temp_global_dofs[i];
2048674ae819SStefano Zampini       }
2049674ae819SStefano Zampini     }
2050674ae819SStefano Zampini   }
2051674ae819SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);
2052674ae819SStefano Zampini   max_global++;
2053674ae819SStefano Zampini   max_local = 0;
2054674ae819SStefano Zampini   if (n_local_dofs) {
2055674ae819SStefano Zampini     max_local = local_dofs[0];
2056674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2057674ae819SStefano Zampini       if (max_local < local_dofs[i] ) {
2058674ae819SStefano Zampini         max_local = local_dofs[i];
2059674ae819SStefano Zampini       }
2060674ae819SStefano Zampini     }
2061674ae819SStefano Zampini   }
2062674ae819SStefano Zampini   max_local++;
2063674ae819SStefano Zampini   /* allocate workspace */
2064674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
2065674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
2066674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
2067674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
2068674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
2069674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
2070674ae819SStefano Zampini   /* create scatter */
2071674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
2072674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
2073674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
2074674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
2075674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
2076674ae819SStefano Zampini   /* init array */
2077674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
2078674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2079674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2080674ae819SStefano Zampini   if (local_dofs_mult) {
2081674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2082674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
2083674ae819SStefano Zampini     }
2084674ae819SStefano Zampini   } else {
2085674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2086674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
2087674ae819SStefano Zampini     }
2088674ae819SStefano Zampini   }
2089674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2090674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
2091674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2092674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2093674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
20945b08dc53SStefano Zampini   *n_global_subset = (PetscInt)PetscRealPart(globalsum);
2095674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
2096674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
2097674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
2098674ae819SStefano Zampini   nlocals = 0;
2099674ae819SStefano Zampini   first_index = -1;
2100674ae819SStefano Zampini   first_found = PETSC_FALSE;
2101674ae819SStefano Zampini   for (i=0;i<s;i++) {
21025b08dc53SStefano Zampini     if (!first_found && PetscRealPart(array[i]) > 0.0) {
2103674ae819SStefano Zampini       first_found = PETSC_TRUE;
2104674ae819SStefano Zampini       first_index = i;
2105674ae819SStefano Zampini     }
21065b08dc53SStefano Zampini     nlocals += (PetscInt)PetscRealPart(array[i]);
2107674ae819SStefano Zampini   }
2108674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2109674ae819SStefano Zampini   if (!rank_prec_comm) {
2110674ae819SStefano Zampini     dof_displs[0]=0;
2111674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
2112674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
2113674ae819SStefano Zampini     }
2114674ae819SStefano Zampini   }
2115674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2116674ae819SStefano Zampini   if (first_found) {
2117674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
2118674ae819SStefano Zampini     old_index = first_index;
2119674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
21205b08dc53SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) {
2121674ae819SStefano Zampini         array[i] += array[old_index];
2122674ae819SStefano Zampini         old_index = i;
2123674ae819SStefano Zampini       }
2124674ae819SStefano Zampini     }
2125674ae819SStefano Zampini   }
2126674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
2127674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2128674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2129674ae819SStefano Zampini   ierr = VecScatterEnd  (scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2130674ae819SStefano Zampini   /* get global ordering of local dofs */
2131674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2132674ae819SStefano Zampini   if (local_dofs_mult) {
2133674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
21345b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i];
2135674ae819SStefano Zampini     }
2136674ae819SStefano Zampini   } else {
2137674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
21385b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1;
2139674ae819SStefano Zampini     }
2140674ae819SStefano Zampini   }
2141674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2142674ae819SStefano Zampini   /* free workspace */
2143674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
2144674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
2145674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
2146674ae819SStefano Zampini   ierr = PetscFree(dof_sizes);CHKERRQ(ierr);
2147674ae819SStefano Zampini   ierr = PetscFree(dof_displs);CHKERRQ(ierr);
2148674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
2149674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
2150674ae819SStefano Zampini   PetscFunctionReturn(0);
2151674ae819SStefano Zampini }
21529a7d3425SStefano Zampini 
21539a7d3425SStefano Zampini #undef __FUNCT__
21549a7d3425SStefano Zampini #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
21559a7d3425SStefano Zampini PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
21569a7d3425SStefano Zampini {
21579a7d3425SStefano Zampini   PetscInt       i,j;
21589a7d3425SStefano Zampini   PetscScalar    *alphas;
21599a7d3425SStefano Zampini   PetscErrorCode ierr;
21609a7d3425SStefano Zampini 
21619a7d3425SStefano Zampini   PetscFunctionBegin;
21629a7d3425SStefano Zampini   /* this implements stabilized Gram-Schmidt */
21639a7d3425SStefano Zampini   ierr = PetscMalloc(n*sizeof(PetscScalar),&alphas);CHKERRQ(ierr);
21649a7d3425SStefano Zampini   for (i=0;i<n;i++) {
21659a7d3425SStefano Zampini     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
21669a7d3425SStefano Zampini     if (i<n) { ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],&alphas[i+1]);CHKERRQ(ierr); }
21679a7d3425SStefano Zampini     for (j=i+1;j<n;j++) { ierr = VecAXPY(vecs[j],PetscConj(-alphas[j]),vecs[i]);CHKERRQ(ierr); }
21689a7d3425SStefano Zampini   }
21699a7d3425SStefano Zampini   ierr = PetscFree(alphas);CHKERRQ(ierr);
21709a7d3425SStefano Zampini   PetscFunctionReturn(0);
21719a7d3425SStefano Zampini }
21729a7d3425SStefano Zampini 
2173a57a6d2fSStefano Zampini /* Currently support MAT_INITIAL_MATRIX only, with partial support to block matrices */
2174a57a6d2fSStefano Zampini #undef __FUNCT__
2175a57a6d2fSStefano Zampini #define __FUNCT__ "MatConvert_IS_AIJ"
2176a57a6d2fSStefano Zampini static PetscErrorCode MatConvert_IS_AIJ(Mat mat, MatType newtype,MatReuse reuse,Mat *M)
2177a57a6d2fSStefano Zampini {
2178a57a6d2fSStefano Zampini   Mat new_mat;
2179a57a6d2fSStefano Zampini   Mat_IS *matis = (Mat_IS*)(mat->data);
2180a57a6d2fSStefano Zampini   /* info on mat */
2181a57a6d2fSStefano Zampini   PetscInt bs,rows,cols;
2182a57a6d2fSStefano Zampini   PetscInt lrows,lcols;
2183a57a6d2fSStefano Zampini   PetscInt local_rows,local_cols;
2184e7931f94SStefano Zampini   PetscMPIInt nsubdomains;
2185a57a6d2fSStefano Zampini   /* preallocation */
2186a57a6d2fSStefano Zampini   Vec vec_dnz,vec_onz;
2187a57a6d2fSStefano Zampini   PetscScalar *my_dnz,*my_onz,*array;
2188a57a6d2fSStefano Zampini   PetscInt *dnz,*onz,*mat_ranges,*row_ownership;
2189a57a6d2fSStefano Zampini   PetscInt  index_row,index_col,owner;
2190a57a6d2fSStefano Zampini   PetscInt  *local_indices,*global_indices;
2191a57a6d2fSStefano Zampini   /* work */
2192a57a6d2fSStefano Zampini   PetscInt i,j;
2193a57a6d2fSStefano Zampini   PetscErrorCode ierr;
2194a57a6d2fSStefano Zampini 
2195a57a6d2fSStefano Zampini   PetscFunctionBegin;
2196a57a6d2fSStefano Zampini   /* CHECKS */
2197a57a6d2fSStefano Zampini   /* get info from mat */
2198a57a6d2fSStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
2199a57a6d2fSStefano Zampini   ierr = MatGetBlockSize(mat,&bs);CHKERRQ(ierr);
2200a57a6d2fSStefano Zampini   ierr = MatGetSize(matis->A,&local_rows,&local_cols);CHKERRQ(ierr);
2201a57a6d2fSStefano Zampini   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&nsubdomains);CHKERRQ(ierr);
2202a57a6d2fSStefano Zampini 
2203a57a6d2fSStefano Zampini   /* MAT_INITIAL_MATRIX */
2204a57a6d2fSStefano Zampini   ierr = MatCreate(PetscObjectComm((PetscObject)mat),&new_mat);CHKERRQ(ierr);
2205a57a6d2fSStefano Zampini   ierr = MatSetSizes(new_mat,PETSC_DECIDE,PETSC_DECIDE,rows,cols);CHKERRQ(ierr);
2206a57a6d2fSStefano Zampini   ierr = MatSetBlockSize(new_mat,bs);CHKERRQ(ierr);
2207a57a6d2fSStefano Zampini   ierr = MatSetType(new_mat,newtype);CHKERRQ(ierr);
2208a57a6d2fSStefano Zampini   ierr = MatSetUp(new_mat);CHKERRQ(ierr);
2209a57a6d2fSStefano Zampini   ierr = MatGetLocalSize(new_mat,&lrows,&lcols);CHKERRQ(ierr);
2210a57a6d2fSStefano Zampini 
2211a57a6d2fSStefano Zampini   /*
2212a57a6d2fSStefano Zampini     preallocation
2213a57a6d2fSStefano Zampini   */
2214a57a6d2fSStefano Zampini 
2215a57a6d2fSStefano Zampini   ierr = MatPreallocateInitialize(PetscObjectComm((PetscObject)new_mat),lrows,lcols,dnz,onz);CHKERRQ(ierr);
2216a57a6d2fSStefano Zampini   /*
2217a57a6d2fSStefano Zampini      Some vectors are needed to sum up properly on shared interface dofs.
2218a57a6d2fSStefano Zampini      Note that preallocation is not exact, since it overestimates nonzeros
2219a57a6d2fSStefano Zampini   */
2220a57a6d2fSStefano Zampini /*
2221a57a6d2fSStefano Zampini   ierr = VecCreate(PetscObjectComm((PetscObject)mat),&vec_dnz);CHKERRQ(ierr);
2222a57a6d2fSStefano Zampini   ierr = VecSetBlockSize(vec_dnz,bs);CHKERRQ(ierr);
2223a57a6d2fSStefano Zampini   ierr = VecSetSizes(vec_dnz,PETSC_DECIDE,rows);CHKERRQ(ierr);
2224a57a6d2fSStefano Zampini   ierr = VecSetType(vec_dnz,VECSTANDARD);CHKERRQ(ierr);
2225a57a6d2fSStefano Zampini */
2226a57a6d2fSStefano Zampini   ierr = MatGetVecs(new_mat,NULL,&vec_dnz);CHKERRQ(ierr);
2227a57a6d2fSStefano Zampini   ierr = VecDuplicate(vec_dnz,&vec_onz);CHKERRQ(ierr);
2228e7931f94SStefano Zampini   /* All processes need to compute entire row ownership */
2229a57a6d2fSStefano Zampini   ierr = PetscMalloc(rows*sizeof(*row_ownership),&row_ownership);CHKERRQ(ierr);
2230a57a6d2fSStefano Zampini   ierr = MatGetOwnershipRanges(new_mat,(const PetscInt**)&mat_ranges);CHKERRQ(ierr);
2231a57a6d2fSStefano Zampini   for (i=0;i<nsubdomains;i++) {
2232a57a6d2fSStefano Zampini     for (j=mat_ranges[i];j<mat_ranges[i+1];j++) {
2233a57a6d2fSStefano Zampini       row_ownership[j]=i;
2234a57a6d2fSStefano Zampini     }
2235a57a6d2fSStefano Zampini   }
2236a57a6d2fSStefano Zampini   /* map indices of local mat to global values */
2237a57a6d2fSStefano Zampini   ierr = PetscMalloc(PetscMax(local_cols,local_rows)*sizeof(*global_indices),&global_indices);CHKERRQ(ierr);
2238a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*local_indices),&local_indices);CHKERRQ(ierr);
2239a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) local_indices[i]=i;
2240a57a6d2fSStefano Zampini   ierr = ISLocalToGlobalMappingApply(matis->mapping,local_rows,local_indices,global_indices);CHKERRQ(ierr);
2241a57a6d2fSStefano Zampini   ierr = PetscFree(local_indices);CHKERRQ(ierr);
2242a57a6d2fSStefano Zampini 
2243e7931f94SStefano Zampini   /*
2244e7931f94SStefano Zampini      my_dnz and my_onz contains exact contribution to preallocation from each local mat
2245e7931f94SStefano Zampini      then, they will be summed up properly. This way, preallocation is always sufficient
2246e7931f94SStefano Zampini   */
2247a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*my_dnz),&my_dnz);CHKERRQ(ierr);
2248a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*my_onz),&my_onz);CHKERRQ(ierr);
2249a57a6d2fSStefano Zampini   ierr = PetscMemzero(my_dnz,local_rows*sizeof(*my_dnz));CHKERRQ(ierr);
2250a57a6d2fSStefano Zampini   ierr = PetscMemzero(my_onz,local_rows*sizeof(*my_onz));CHKERRQ(ierr);
2251a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) {
2252a57a6d2fSStefano Zampini     index_row = global_indices[i];
2253a57a6d2fSStefano Zampini     for (j=i;j<local_rows;j++) {
2254a57a6d2fSStefano Zampini       owner = row_ownership[index_row];
2255a57a6d2fSStefano Zampini       index_col = global_indices[j];
2256a57a6d2fSStefano Zampini       if (index_col > mat_ranges[owner]-1 && index_col < mat_ranges[owner+1] ) { /* diag block */
2257a57a6d2fSStefano Zampini         my_dnz[i] += 1.0;
2258a57a6d2fSStefano Zampini       } else { /* offdiag block */
2259a57a6d2fSStefano Zampini         my_onz[i] += 1.0;
2260a57a6d2fSStefano Zampini       }
2261a57a6d2fSStefano Zampini       /* same as before, interchanging rows and cols */
2262a57a6d2fSStefano Zampini       if (i != j) {
2263a57a6d2fSStefano Zampini         owner = row_ownership[index_col];
2264a57a6d2fSStefano Zampini         if (index_row > mat_ranges[owner]-1 && index_row < mat_ranges[owner+1] ) {
2265a57a6d2fSStefano Zampini           my_dnz[j] += 1.0;
2266a57a6d2fSStefano Zampini         } else {
2267a57a6d2fSStefano Zampini           my_onz[j] += 1.0;
2268a57a6d2fSStefano Zampini         }
2269a57a6d2fSStefano Zampini       }
2270a57a6d2fSStefano Zampini     }
2271a57a6d2fSStefano Zampini   }
2272a57a6d2fSStefano Zampini   ierr = VecSet(vec_dnz,0.0);CHKERRQ(ierr);
2273a57a6d2fSStefano Zampini   ierr = VecSet(vec_onz,0.0);CHKERRQ(ierr);
227420a2ab83SStefano Zampini   if (local_rows) { /* multilevel guard */
2275a57a6d2fSStefano Zampini     ierr = VecSetValues(vec_dnz,local_rows,global_indices,my_dnz,ADD_VALUES);CHKERRQ(ierr);
2276a57a6d2fSStefano Zampini     ierr = VecSetValues(vec_onz,local_rows,global_indices,my_onz,ADD_VALUES);CHKERRQ(ierr);
2277a57a6d2fSStefano Zampini   }
2278a57a6d2fSStefano Zampini   ierr = VecAssemblyBegin(vec_dnz);CHKERRQ(ierr);
2279a57a6d2fSStefano Zampini   ierr = VecAssemblyBegin(vec_onz);CHKERRQ(ierr);
2280a57a6d2fSStefano Zampini   ierr = VecAssemblyEnd(vec_dnz);CHKERRQ(ierr);
2281a57a6d2fSStefano Zampini   ierr = VecAssemblyEnd(vec_onz);CHKERRQ(ierr);
2282a57a6d2fSStefano Zampini   ierr = PetscFree(my_dnz);CHKERRQ(ierr);
2283a57a6d2fSStefano Zampini   ierr = PetscFree(my_onz);CHKERRQ(ierr);
2284a57a6d2fSStefano Zampini   ierr = PetscFree(row_ownership);CHKERRQ(ierr);
2285a57a6d2fSStefano Zampini 
2286a57a6d2fSStefano Zampini   /* set computed preallocation in dnz and onz */
2287a57a6d2fSStefano Zampini   ierr = VecGetArray(vec_dnz,&array);CHKERRQ(ierr);
2288a57a6d2fSStefano Zampini   for (i=0; i<lrows; i++) dnz[i] = (PetscInt)PetscRealPart(array[i]);
2289a57a6d2fSStefano Zampini   ierr = VecRestoreArray(vec_dnz,&array);CHKERRQ(ierr);
2290a57a6d2fSStefano Zampini   ierr = VecGetArray(vec_onz,&array);CHKERRQ(ierr);
2291a57a6d2fSStefano Zampini   for (i=0;i<lrows;i++) onz[i] = (PetscInt)PetscRealPart(array[i]);
2292a57a6d2fSStefano Zampini   ierr = VecRestoreArray(vec_onz,&array);CHKERRQ(ierr);
2293a57a6d2fSStefano Zampini   ierr = VecDestroy(&vec_dnz);CHKERRQ(ierr);
2294a57a6d2fSStefano Zampini   ierr = VecDestroy(&vec_onz);CHKERRQ(ierr);
2295a57a6d2fSStefano Zampini 
2296e7931f94SStefano Zampini   /* Resize preallocation if overestimated */
2297a57a6d2fSStefano Zampini   for (i=0;i<lrows;i++) {
2298a57a6d2fSStefano Zampini     dnz[i] = PetscMin(dnz[i],lcols);
2299a57a6d2fSStefano Zampini     onz[i] = PetscMin(onz[i],cols-lcols);
2300a57a6d2fSStefano Zampini   }
2301a57a6d2fSStefano Zampini   ierr = MatMPIAIJSetPreallocation(new_mat,0,dnz,0,onz);CHKERRQ(ierr);
2302a57a6d2fSStefano Zampini   ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
2303a57a6d2fSStefano Zampini 
2304a57a6d2fSStefano Zampini   /*
2305e7931f94SStefano Zampini     Set values. Very Basic.
2306a57a6d2fSStefano Zampini   */
2307a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) {
2308a57a6d2fSStefano Zampini     ierr = MatGetRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2309a57a6d2fSStefano Zampini     ierr = ISLocalToGlobalMappingApply(matis->mapping,j,local_indices,global_indices);CHKERRQ(ierr);
2310a57a6d2fSStefano Zampini     ierr = ISLocalToGlobalMappingApply(matis->mapping,1,&i,&index_row);CHKERRQ(ierr);
2311a57a6d2fSStefano Zampini     ierr = MatSetValues(new_mat,1,&index_row,j,global_indices,array,ADD_VALUES);CHKERRQ(ierr);
2312a57a6d2fSStefano Zampini     ierr = MatRestoreRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2313a57a6d2fSStefano Zampini   }
231420a2ab83SStefano Zampini   ierr = MatAssemblyBegin(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2315a57a6d2fSStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
231620a2ab83SStefano Zampini   ierr = MatAssemblyEnd(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2317a57a6d2fSStefano Zampini 
2318a57a6d2fSStefano Zampini   /* get back mat */
2319a57a6d2fSStefano Zampini   *M = new_mat;
2320a57a6d2fSStefano Zampini   PetscFunctionReturn(0);
2321a57a6d2fSStefano Zampini }
2322a57a6d2fSStefano Zampini 
2323e7931f94SStefano Zampini #undef __FUNCT__
2324e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble_Private"
2325e7931f94SStefano Zampini PetscErrorCode MatISSubassemble_Private(Mat mat, PetscInt coarsening_ratio, IS* is_sends)
2326e7931f94SStefano Zampini {
2327e7931f94SStefano Zampini   Mat             subdomain_adj;
2328e7931f94SStefano Zampini   IS              new_ranks,ranks_send_to;
2329e7931f94SStefano Zampini   MatPartitioning partitioner;
2330e7931f94SStefano Zampini   Mat_IS          *matis;
2331e7931f94SStefano Zampini   PetscInt        n_neighs,*neighs,*n_shared,**shared;
2332e7931f94SStefano Zampini   PetscInt        prank;
2333e7931f94SStefano Zampini   PetscMPIInt     size,rank,color;
2334e7931f94SStefano Zampini   PetscInt        *xadj,*adjncy,*oldranks;
2335e7931f94SStefano Zampini   PetscInt        *adjncy_wgt,*v_wgt,*is_indices,*ranks_send_to_idx;
2336e7931f94SStefano Zampini   PetscInt        i,j,n_subdomains,local_size,threshold=0;
2337e7931f94SStefano Zampini   PetscErrorCode  ierr;
23382b510759SStefano Zampini   PetscBool       use_vwgt=PETSC_FALSE,use_square=PETSC_FALSE;
2339e7931f94SStefano Zampini   PetscSubcomm    subcomm;
2340a57a6d2fSStefano Zampini 
2341e7931f94SStefano Zampini   PetscFunctionBegin;
23422b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_square",&use_square,NULL);CHKERRQ(ierr);
23432b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
23442b510759SStefano Zampini   ierr = PetscOptionsGetInt(NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
2345e7931f94SStefano Zampini 
2346e7931f94SStefano Zampini   /* Get info on mapping */
2347e7931f94SStefano Zampini   matis = (Mat_IS*)(mat->data);
2348e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&local_size);CHKERRQ(ierr);
2349e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2350e7931f94SStefano Zampini 
2351e7931f94SStefano Zampini   /* build local CSR graph of subdomains' connectivity */
2352e7931f94SStefano Zampini   ierr = PetscMalloc(2*sizeof(*xadj),&xadj);CHKERRQ(ierr);
2353e7931f94SStefano Zampini   xadj[0] = 0;
2354e7931f94SStefano Zampini   xadj[1] = PetscMax(n_neighs-1,0);
2355e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy),&adjncy);CHKERRQ(ierr);
2356e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy_wgt),&adjncy_wgt);CHKERRQ(ierr);
2357e7931f94SStefano Zampini 
23582b510759SStefano Zampini   if (threshold) {
23592b510759SStefano Zampini     PetscInt* count,min_threshold;
2360e7931f94SStefano Zampini     ierr = PetscMalloc(local_size*sizeof(PetscInt),&count);CHKERRQ(ierr);
2361e7931f94SStefano Zampini     ierr = PetscMemzero(count,local_size*sizeof(PetscInt));CHKERRQ(ierr);
2362e7931f94SStefano Zampini     for (i=1;i<n_neighs;i++) {/* i=1 so I don't count myself -> faces nodes counts to 1 */
2363e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2364e7931f94SStefano Zampini         count[shared[i][j]] += 1;
2365e7931f94SStefano Zampini       }
2366e7931f94SStefano Zampini     }
23672b510759SStefano Zampini     /* adapt threshold since we dont want to lose significant connections */
23682b510759SStefano Zampini     min_threshold = n_neighs;
23692b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
23702b510759SStefano Zampini       for (j=0;j<n_shared[i];j++) {
23712b510759SStefano Zampini         min_threshold = PetscMin(count[shared[i][j]],min_threshold);
23722b510759SStefano Zampini       }
23732b510759SStefano Zampini     }
23742b510759SStefano Zampini     PetscPrintf(PETSC_COMM_SELF,"PASSED THRESHOLD %d\n",threshold);
23752b510759SStefano Zampini     threshold = PetscMax(min_threshold+1,threshold);
23762b510759SStefano Zampini     PetscPrintf(PETSC_COMM_SELF,"USING THRESHOLD %d (min %d)\n",threshold,min_threshold);
2377e7931f94SStefano Zampini     xadj[1] = 0;
23782b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
2379e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2380e7931f94SStefano Zampini         if (count[shared[i][j]] < threshold) {
2381e7931f94SStefano Zampini           adjncy[xadj[1]] = neighs[i];
2382e7931f94SStefano Zampini           adjncy_wgt[xadj[1]] = n_shared[i];
2383e7931f94SStefano Zampini           xadj[1]++;
2384e7931f94SStefano Zampini           break;
2385e7931f94SStefano Zampini         }
2386e7931f94SStefano Zampini       }
2387e7931f94SStefano Zampini     }
2388e7931f94SStefano Zampini     ierr = PetscFree(count);CHKERRQ(ierr);
2389e7931f94SStefano Zampini   } else {
2390e7931f94SStefano Zampini     if (xadj[1]) {
2391e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy,&neighs[1],xadj[1]*sizeof(*adjncy));CHKERRQ(ierr);
2392e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy_wgt,&n_shared[1],xadj[1]*sizeof(*adjncy_wgt));CHKERRQ(ierr);
2393e7931f94SStefano Zampini     }
2394e7931f94SStefano Zampini   }
2395e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingRestoreInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2396e7931f94SStefano Zampini   if (use_square) {
2397e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2398e7931f94SStefano Zampini       adjncy_wgt[i] = adjncy_wgt[i]*adjncy_wgt[i];
2399e7931f94SStefano Zampini     }
2400e7931f94SStefano Zampini   }
2401e7931f94SStefano Zampini   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2402e7931f94SStefano Zampini 
2403e7931f94SStefano Zampini   ierr = PetscMalloc(sizeof(PetscInt),&ranks_send_to_idx);CHKERRQ(ierr);
2404e7931f94SStefano Zampini 
2405e7931f94SStefano Zampini   /*
2406e7931f94SStefano Zampini     Restrict work on active processes only.
2407e7931f94SStefano Zampini   */
2408e7931f94SStefano Zampini   ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&subcomm);CHKERRQ(ierr);
2409e7931f94SStefano Zampini   ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
2410e7931f94SStefano Zampini   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
24112b510759SStefano Zampini   ierr = PetscMPIIntCast(!local_size,&color);CHKERRQ(ierr);
2412e7931f94SStefano Zampini   ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank,rank);CHKERRQ(ierr);
2413e7931f94SStefano Zampini   if (color) {
2414e7931f94SStefano Zampini     ierr = PetscFree(xadj);CHKERRQ(ierr);
2415e7931f94SStefano Zampini     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2416e7931f94SStefano Zampini     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
2417e7931f94SStefano Zampini   } else {
2418e7931f94SStefano Zampini     ierr = MPI_Comm_size(subcomm->comm,&size);CHKERRQ(ierr);
2419e7931f94SStefano Zampini     ierr = PetscMalloc(size*sizeof(*oldranks),&oldranks);CHKERRQ(ierr);
2420e7931f94SStefano Zampini     prank = rank;
2421e7931f94SStefano Zampini     ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm->comm);CHKERRQ(ierr);
2422e7931f94SStefano Zampini     for (i=0;i<size;i++) {
2423e7931f94SStefano Zampini       PetscPrintf(subcomm->comm,"oldranks[%d] = %d\n",i,oldranks[i]);
2424e7931f94SStefano Zampini     }
2425e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2426e7931f94SStefano Zampini       ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
2427e7931f94SStefano Zampini     }
2428e7931f94SStefano Zampini     ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2429e7931f94SStefano Zampini     ierr = MatCreateMPIAdj(subcomm->comm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
2430e7931f94SStefano Zampini     n_subdomains = (PetscInt)size;
2431e7931f94SStefano Zampini     ierr = MatView(subdomain_adj,0);CHKERRQ(ierr);
2432e7931f94SStefano Zampini 
2433e7931f94SStefano Zampini     /* Partition */
2434e7931f94SStefano Zampini     ierr = MatPartitioningCreate(subcomm->comm,&partitioner);CHKERRQ(ierr);
2435e7931f94SStefano Zampini     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
2436e7931f94SStefano Zampini     if (use_vwgt) {
2437e7931f94SStefano Zampini       ierr = PetscMalloc(sizeof(*v_wgt),&v_wgt);CHKERRQ(ierr);
2438e7931f94SStefano Zampini       v_wgt[0] = local_size;
2439e7931f94SStefano Zampini       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
2440e7931f94SStefano Zampini     }
2441e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)partitioner),"NPARTS %d\n",n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2442e7931f94SStefano Zampini     ierr = MatPartitioningSetNParts(partitioner,n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2443e7931f94SStefano Zampini     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
2444e7931f94SStefano Zampini     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
2445e7931f94SStefano Zampini     ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr);
2446e7931f94SStefano Zampini 
2447e7931f94SStefano Zampini     ierr = ISGetIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2448e7931f94SStefano Zampini     ranks_send_to_idx[0] = oldranks[is_indices[0]];
2449e7931f94SStefano Zampini     ierr = ISRestoreIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2450e7931f94SStefano Zampini     /* clean up */
2451e7931f94SStefano Zampini     ierr = PetscFree(oldranks);CHKERRQ(ierr);
2452e7931f94SStefano Zampini     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
2453e7931f94SStefano Zampini     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
2454e7931f94SStefano Zampini     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
2455e7931f94SStefano Zampini   }
2456e7931f94SStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
2457e7931f94SStefano Zampini 
2458e7931f94SStefano Zampini   /* assemble parallel IS for sends */
2459e7931f94SStefano Zampini   i = 1;
2460e7931f94SStefano Zampini   if (color) i=0;
2461e7931f94SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,&ranks_send_to);CHKERRQ(ierr);
2462e7931f94SStefano Zampini   ierr = ISView(ranks_send_to,0);CHKERRQ(ierr);
2463e7931f94SStefano Zampini 
2464e7931f94SStefano Zampini   /* get back IS */
2465e7931f94SStefano Zampini   *is_sends = ranks_send_to;
2466e7931f94SStefano Zampini   PetscFunctionReturn(0);
2467e7931f94SStefano Zampini }
2468e7931f94SStefano Zampini 
2469e7931f94SStefano Zampini typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
2470e7931f94SStefano Zampini 
2471e7931f94SStefano Zampini #undef __FUNCT__
2472e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble"
2473e7931f94SStefano Zampini PetscErrorCode MatISSubassemble(Mat mat, IS is_sends, PetscInt coarsening_ratio, Mat *mat_n)
2474e7931f94SStefano Zampini {
2475e7931f94SStefano Zampini   Mat                    local_mat,new_mat;
2476e7931f94SStefano Zampini   Mat_IS                 *matis;
2477e7931f94SStefano Zampini   IS                     is_sends_internal;
2478e7931f94SStefano Zampini   PetscInt               rows,cols;
2479e7931f94SStefano Zampini   PetscInt               i,bs,buf_size_idxs,buf_size_vals;
2480e7931f94SStefano Zampini   PetscBool              ismatis,isdense;
2481e7931f94SStefano Zampini   ISLocalToGlobalMapping l2gmap;
2482e7931f94SStefano Zampini   PetscInt*              l2gmap_indices;
2483e7931f94SStefano Zampini   const PetscInt*        is_indices;
2484e7931f94SStefano Zampini   MatType                new_local_type;
2485e7931f94SStefano Zampini   MatTypePrivate         new_local_type_private;
2486e7931f94SStefano Zampini   /* buffers */
2487e7931f94SStefano Zampini   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
2488e7931f94SStefano Zampini   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
2489e7931f94SStefano Zampini   /* MPI */
2490e7931f94SStefano Zampini   MPI_Comm               comm;
2491e7931f94SStefano Zampini   PetscMPIInt            n_sends,n_recvs,commsize;
2492e7931f94SStefano Zampini   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals;
2493e7931f94SStefano Zampini   PetscMPIInt            *onodes,*olengths_idxs,*olengths_vals;
2494e7931f94SStefano Zampini   PetscMPIInt            len,tag_idxs,tag_vals,source_dest;
2495e7931f94SStefano Zampini   MPI_Request            *send_req_idxs,*send_req_vals,*recv_req_idxs,*recv_req_vals;
2496e7931f94SStefano Zampini   PetscErrorCode         ierr;
2497e7931f94SStefano Zampini 
2498e7931f94SStefano Zampini   PetscFunctionBegin;
2499e7931f94SStefano Zampini   /* checks */
2500e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
2501e7931f94SStefano Zampini   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on an matrix object which is not of type MATIS",__FUNCT__);
2502e7931f94SStefano Zampini   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2503e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
2504e7931f94SStefano Zampini   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
2505e7931f94SStefano Zampini   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
2506e7931f94SStefano Zampini   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
2507e7931f94SStefano Zampini   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
2508e7931f94SStefano Zampini   PetscValidLogicalCollectiveInt(mat,bs,0);
2509e7931f94SStefano Zampini   /* prepare IS for sending if not provided */
2510e7931f94SStefano Zampini   if (!is_sends) {
2511e7931f94SStefano Zampini     if (!coarsening_ratio) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a coarsening ratio");
2512e7931f94SStefano Zampini     ierr = MatISSubassemble_Private(mat,coarsening_ratio,&is_sends_internal);CHKERRQ(ierr);
2513e7931f94SStefano Zampini   } else {
2514e7931f94SStefano Zampini     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
2515e7931f94SStefano Zampini     is_sends_internal = is_sends;
2516e7931f94SStefano Zampini   }
2517e7931f94SStefano Zampini 
2518e7931f94SStefano Zampini   /* get pointer of MATIS data */
2519e7931f94SStefano Zampini   matis = (Mat_IS*)mat->data;
2520e7931f94SStefano Zampini 
2521e7931f94SStefano Zampini   /* get comm */
2522e7931f94SStefano Zampini   comm = PetscObjectComm((PetscObject)mat);
2523e7931f94SStefano Zampini 
2524e7931f94SStefano Zampini   /* compute number of sends */
2525e7931f94SStefano Zampini   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
2526e7931f94SStefano Zampini   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
2527e7931f94SStefano Zampini 
2528e7931f94SStefano Zampini   /* compute number of receives */
2529e7931f94SStefano Zampini   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
2530e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*iflags),&iflags);CHKERRQ(ierr);
2531e7931f94SStefano Zampini   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
2532e7931f94SStefano Zampini   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2533e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
2534e7931f94SStefano Zampini   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
2535e7931f94SStefano Zampini   ierr = PetscFree(iflags);CHKERRQ(ierr);
2536e7931f94SStefano Zampini 
2537e7931f94SStefano Zampini   /* prepare send/receive buffers */
2538e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_idxs),&ilengths_idxs);CHKERRQ(ierr);
2539e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
2540e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_vals),&ilengths_vals);CHKERRQ(ierr);
2541e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
2542e7931f94SStefano Zampini 
2543e7931f94SStefano Zampini   /* Get data from local mat */
2544e7931f94SStefano Zampini   if (!isdense) {
2545e7931f94SStefano Zampini     /* TODO: See below some guidelines on how to prepare the local buffers */
2546e7931f94SStefano Zampini     /*
2547e7931f94SStefano Zampini        send_buffer_vals should contain the raw values of the local matrix
2548e7931f94SStefano Zampini        send_buffer_idxs should contain:
2549e7931f94SStefano Zampini        - MatType_PRIVATE type
2550e7931f94SStefano Zampini        - PetscInt        size_of_l2gmap
2551e7931f94SStefano Zampini        - PetscInt        global_row_indices[size_of_l2gmap]
2552e7931f94SStefano Zampini        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
2553e7931f94SStefano Zampini     */
2554e7931f94SStefano Zampini   } else {
2555e7931f94SStefano Zampini     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
2556e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&i);CHKERRQ(ierr);
2557e7931f94SStefano Zampini     ierr = PetscMalloc((i+2)*sizeof(PetscInt),&send_buffer_idxs);CHKERRQ(ierr);
2558e7931f94SStefano Zampini     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
2559e7931f94SStefano Zampini     send_buffer_idxs[1] = i;
2560e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2561e7931f94SStefano Zampini     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
2562e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingRestoreIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2563e7931f94SStefano Zampini     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
2564e7931f94SStefano Zampini     for (i=0;i<n_sends;i++) {
2565e7931f94SStefano Zampini       ilengths_vals[is_indices[i]] = len*len;
2566e7931f94SStefano Zampini       ilengths_idxs[is_indices[i]] = len+2;
2567e7931f94SStefano Zampini     }
2568e7931f94SStefano Zampini   }
2569e7931f94SStefano Zampini   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
2570e7931f94SStefano Zampini   buf_size_idxs = 0;
2571e7931f94SStefano Zampini   buf_size_vals = 0;
2572e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2573e7931f94SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
2574e7931f94SStefano Zampini     buf_size_vals += (PetscInt)olengths_vals[i];
2575e7931f94SStefano Zampini   }
2576e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&recv_buffer_idxs);CHKERRQ(ierr);
2577e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_vals*sizeof(PetscScalar),&recv_buffer_vals);CHKERRQ(ierr);
2578e7931f94SStefano Zampini 
2579e7931f94SStefano Zampini   /* get new tags for clean communications */
2580e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
2581e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
2582e7931f94SStefano Zampini 
2583e7931f94SStefano Zampini   /* allocate for requests */
2584e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_idxs);CHKERRQ(ierr);
2585e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_vals);CHKERRQ(ierr);
2586e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_idxs);CHKERRQ(ierr);
2587e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_vals);CHKERRQ(ierr);
2588e7931f94SStefano Zampini 
2589e7931f94SStefano Zampini   /* communications */
2590e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2591e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
2592e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2593e7931f94SStefano Zampini     source_dest = onodes[i];
2594e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
2595e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
2596e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2597e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
2598e7931f94SStefano Zampini   }
2599e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) {
2600e7931f94SStefano Zampini     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
2601e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
2602e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
2603e7931f94SStefano Zampini   }
2604e7931f94SStefano Zampini   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2605e7931f94SStefano Zampini   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
2606e7931f94SStefano Zampini 
2607e7931f94SStefano Zampini   /* assemble new l2g map */
2608e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2609e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2610e7931f94SStefano Zampini   buf_size_idxs = 0;
2611e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2612e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
2613e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2614e7931f94SStefano Zampini   }
2615e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&l2gmap_indices);CHKERRQ(ierr);
2616e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2617e7931f94SStefano Zampini   buf_size_idxs = 0;
2618e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2619e7931f94SStefano Zampini     ierr = PetscMemcpy(&l2gmap_indices[buf_size_idxs],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
2620e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
2621e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2622e7931f94SStefano Zampini   }
2623e7931f94SStefano Zampini   ierr = PetscSortRemoveDupsInt(&buf_size_idxs,l2gmap_indices);CHKERRQ(ierr);
2624e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingCreate(comm,buf_size_idxs,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
2625e7931f94SStefano Zampini   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
2626e7931f94SStefano Zampini 
2627e7931f94SStefano Zampini   /* infer new local matrix type from received local matrices type */
2628e7931f94SStefano Zampini   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
2629e7931f94SStefano 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) */
2630e7931f94SStefano Zampini   new_local_type_private = MATAIJ_PRIVATE;
2631e7931f94SStefano Zampini   new_local_type = MATSEQAIJ;
2632e7931f94SStefano Zampini   if (n_recvs) {
2633e7931f94SStefano Zampini     new_local_type_private = send_buffer_idxs[0];
2634e7931f94SStefano Zampini     ptr_idxs = recv_buffer_idxs;
2635e7931f94SStefano Zampini     for (i=0;i<n_recvs;i++) {
2636e7931f94SStefano Zampini       if ((PetscInt)new_local_type_private != *ptr_idxs) {
2637e7931f94SStefano Zampini         new_local_type_private = MATAIJ_PRIVATE;
2638e7931f94SStefano Zampini         break;
2639e7931f94SStefano Zampini       }
2640e7931f94SStefano Zampini       ptr_idxs += olengths_idxs[i];
2641e7931f94SStefano Zampini     }
2642e7931f94SStefano Zampini     switch (new_local_type_private) {
2643e7931f94SStefano Zampini       case MATDENSE_PRIVATE: /* subassembling of dense matrices does not give a dense matrix! */
2644e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
2645e7931f94SStefano Zampini         bs = 1;
2646e7931f94SStefano Zampini         break;
2647e7931f94SStefano Zampini       case MATAIJ_PRIVATE:
2648e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
2649e7931f94SStefano Zampini         bs = 1;
2650e7931f94SStefano Zampini         break;
2651e7931f94SStefano Zampini       case MATBAIJ_PRIVATE:
2652e7931f94SStefano Zampini         new_local_type = MATSEQBAIJ;
2653e7931f94SStefano Zampini         break;
2654e7931f94SStefano Zampini       case MATSBAIJ_PRIVATE:
2655e7931f94SStefano Zampini         new_local_type = MATSEQSBAIJ;
2656e7931f94SStefano Zampini         break;
2657e7931f94SStefano Zampini       default:
2658e7931f94SStefano Zampini         SETERRQ2(comm,PETSC_ERR_LIB,"Unkwown private type %d in %s",new_local_type_private,__FUNCT__);
2659e7931f94SStefano Zampini         break;
2660e7931f94SStefano Zampini     }
2661e7931f94SStefano Zampini   }
2662e7931f94SStefano Zampini 
2663e7931f94SStefano Zampini   /* create MATIS object */
2664e7931f94SStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
2665e7931f94SStefano Zampini   ierr = MatCreateIS(comm,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,&new_mat);CHKERRQ(ierr);
2666e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
2667e7931f94SStefano Zampini   ierr = MatISGetLocalMat(new_mat,&local_mat);CHKERRQ(ierr);
2668e7931f94SStefano Zampini   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
2669e7931f94SStefano Zampini   ierr = MatSetUp(local_mat);CHKERRQ(ierr); /* WARNING -> no preallocation yet */
2670e7931f94SStefano Zampini 
2671e7931f94SStefano Zampini   /* set values */
2672e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2673e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
2674e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2675e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2676e7931f94SStefano Zampini     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
2677e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
2678e7931f94SStefano Zampini       ierr = MatSetValues(new_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
2679e7931f94SStefano Zampini       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
2680e7931f94SStefano Zampini       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
2681e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
2682e7931f94SStefano Zampini     }
2683e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2684e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
2685e7931f94SStefano Zampini   }
2686e7931f94SStefano Zampini   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2687e7931f94SStefano Zampini   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2688e7931f94SStefano Zampini   ierr = MatAssemblyBegin(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2689e7931f94SStefano Zampini   ierr = MatAssemblyEnd(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2690e7931f94SStefano Zampini 
2691e7931f94SStefano Zampini   { /* check */
2692e7931f94SStefano Zampini     Vec       lvec,rvec;
2693e7931f94SStefano Zampini     PetscReal infty_error;
2694e7931f94SStefano Zampini 
2695e7931f94SStefano Zampini     ierr = MatGetVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
2696e7931f94SStefano Zampini     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
2697e7931f94SStefano Zampini     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
2698e7931f94SStefano Zampini     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
2699e7931f94SStefano Zampini     ierr = MatMultAdd(new_mat,rvec,lvec,lvec);CHKERRQ(ierr);
2700e7931f94SStefano Zampini     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
2701e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
2702e7931f94SStefano Zampini     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
2703e7931f94SStefano Zampini     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
2704e7931f94SStefano Zampini   }
2705e7931f94SStefano Zampini 
2706e7931f94SStefano Zampini   /* free workspace */
2707e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
2708e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
2709e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2710e7931f94SStefano Zampini   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
2711e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2712e7931f94SStefano Zampini   if (isdense) {
2713e7931f94SStefano Zampini     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2714e7931f94SStefano Zampini     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
2715e7931f94SStefano Zampini   } else {
2716e7931f94SStefano Zampini     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
2717e7931f94SStefano Zampini   }
2718e7931f94SStefano Zampini   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
2719e7931f94SStefano Zampini   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
2720e7931f94SStefano Zampini   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
2721e7931f94SStefano Zampini   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
2722e7931f94SStefano Zampini   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
2723e7931f94SStefano Zampini   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
2724e7931f94SStefano Zampini   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
2725e7931f94SStefano Zampini   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
2726e7931f94SStefano Zampini   ierr = PetscFree(onodes);CHKERRQ(ierr);
2727e7931f94SStefano Zampini   /* get back new mat */
2728e7931f94SStefano Zampini   *mat_n = new_mat;
2729e7931f94SStefano Zampini   PetscFunctionReturn(0);
2730e7931f94SStefano Zampini }
2731a57a6d2fSStefano Zampini 
2732c8587f34SStefano Zampini #undef __FUNCT__
27338629588bSStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
27348629588bSStefano Zampini PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
2735c8587f34SStefano Zampini {
2736c8587f34SStefano Zampini   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
2737c8587f34SStefano Zampini   PC_IS                  *pcis = (PC_IS*)pc->data;
273820a2ab83SStefano Zampini   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
27399881197aSStefano Zampini   MatNullSpace           CoarseNullSpace=NULL;
274020a2ab83SStefano Zampini   ISLocalToGlobalMapping coarse_islg;
274120a2ab83SStefano Zampini   IS                     coarse_is;
2742*f9eb5b7dSStefano Zampini   PetscInt               max_it,coarse_size,*local_primal_indices=NULL;
2743*f9eb5b7dSStefano Zampini   PetscInt               im_active=-1,active_procs=-1;
2744*f9eb5b7dSStefano Zampini   PC                     pc_temp;
2745c8587f34SStefano Zampini   PCType                 coarse_pc_type;
2746c8587f34SStefano Zampini   KSPType                coarse_ksp_type;
2747*f9eb5b7dSStefano Zampini   PetscBool              multilevel_requested,multilevel_allowed;
2748*f9eb5b7dSStefano Zampini   PetscBool              setsym,issym,isbddc,isnn;
2749*f9eb5b7dSStefano Zampini   MatStructure           matstruct;
27509881197aSStefano Zampini   PetscErrorCode         ierr;
2751fdc09c96SStefano Zampini 
2752c8587f34SStefano Zampini   PetscFunctionBegin;
2753c8587f34SStefano Zampini   /* Assign global numbering to coarse dofs */
2754f34684f1SStefano Zampini   ierr = PCBDDCComputePrimalNumbering(pc,&coarse_size,&local_primal_indices);CHKERRQ(ierr);
2755c8587f34SStefano Zampini 
2756*f9eb5b7dSStefano Zampini   /* infer some info from user */
2757*f9eb5b7dSStefano Zampini   issym = PETSC_FALSE;
2758*f9eb5b7dSStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
2759*f9eb5b7dSStefano Zampini   multilevel_allowed = PETSC_FALSE;
2760*f9eb5b7dSStefano Zampini   multilevel_requested = PETSC_FALSE;
2761*f9eb5b7dSStefano Zampini   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
2762*f9eb5b7dSStefano Zampini   if (multilevel_requested) {
27632b510759SStefano Zampini     /* count "active processes" */
27642b510759SStefano Zampini     im_active = !!(pcis->n);
27652b510759SStefano Zampini     ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
27662b510759SStefano Zampini     if (active_procs/pcbddc->coarsening_ratio < 2) {
2767*f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_FALSE;
27682b510759SStefano Zampini     } else {
2769*f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_TRUE;
2770c8587f34SStefano Zampini     }
2771c8587f34SStefano Zampini   }
2772e7931f94SStefano Zampini 
2773*f9eb5b7dSStefano Zampini   /* set defaults for coarse KSP and PC */
2774*f9eb5b7dSStefano Zampini   if (multilevel_allowed) {
2775*f9eb5b7dSStefano Zampini     if (issym) {
2776*f9eb5b7dSStefano Zampini       coarse_ksp_type = KSPRICHARDSON;
2777*f9eb5b7dSStefano Zampini     } else {
2778*f9eb5b7dSStefano Zampini       coarse_ksp_type = KSPCHEBYSHEV;
2779*f9eb5b7dSStefano Zampini     }
2780*f9eb5b7dSStefano Zampini     coarse_pc_type = PCBDDC;
2781*f9eb5b7dSStefano Zampini   } else {
2782*f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPPREONLY;
2783*f9eb5b7dSStefano Zampini     coarse_pc_type = PCREDUNDANT;
2784*f9eb5b7dSStefano Zampini   }
2785*f9eb5b7dSStefano Zampini 
2786*f9eb5b7dSStefano Zampini   /* create the coarse KSP object only once with defaults */
2787*f9eb5b7dSStefano Zampini   if (!pcbddc->coarse_ksp) {
2788*f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_ksp);CHKERRQ(ierr);
2789*f9eb5b7dSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
2790*f9eb5b7dSStefano Zampini     ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
2791*f9eb5b7dSStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
2792*f9eb5b7dSStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
2793*f9eb5b7dSStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
2794*f9eb5b7dSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,"coarse_");CHKERRQ(ierr);
2795*f9eb5b7dSStefano Zampini   }
2796*f9eb5b7dSStefano Zampini   /* allow user customization */
2797*f9eb5b7dSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
2798*f9eb5b7dSStefano Zampini 
2799*f9eb5b7dSStefano Zampini   /* get some info after set from options */
2800*f9eb5b7dSStefano Zampini   ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
2801*f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
2802*f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
2803*f9eb5b7dSStefano Zampini   if (isbddc && !multilevel_allowed) { /* prevent from infinite loop if user as requested bddc pc for coarse solver */
2804*f9eb5b7dSStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
2805*f9eb5b7dSStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
2806*f9eb5b7dSStefano Zampini     isbddc = PETSC_FALSE;
2807*f9eb5b7dSStefano Zampini   }
2808*f9eb5b7dSStefano Zampini 
2809*f9eb5b7dSStefano Zampini   /* propagate BDDC info to the next level */
2810*f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
2811*f9eb5b7dSStefano Zampini   ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
2812*f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
2813*f9eb5b7dSStefano Zampini 
2814*f9eb5b7dSStefano Zampini   /* Compute coarse null space (special handling by BDDC only) */
2815*f9eb5b7dSStefano Zampini   if (pcbddc->NullSpace) {
2816*f9eb5b7dSStefano Zampini     ierr = PCBDDCNullSpaceAssembleCoarse(pc,coarse_mat,&CoarseNullSpace);CHKERRQ(ierr);
2817*f9eb5b7dSStefano Zampini     if (isbddc) {
2818*f9eb5b7dSStefano Zampini       ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
2819*f9eb5b7dSStefano Zampini     } else {
2820*f9eb5b7dSStefano Zampini       ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
2821*f9eb5b7dSStefano Zampini     }
2822*f9eb5b7dSStefano Zampini   }
2823*f9eb5b7dSStefano Zampini 
2824*f9eb5b7dSStefano Zampini   /* creates temporary MATIS object for coarse matrix */
2825a57a6d2fSStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,local_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
2826a57a6d2fSStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
2827a57a6d2fSStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
2828a57a6d2fSStefano Zampini   ierr = MatCreateIS(PetscObjectComm((PetscObject)pc),1,PETSC_DECIDE,PETSC_DECIDE,coarse_size,coarse_size,coarse_islg,&coarse_mat_is);CHKERRQ(ierr);
2829a57a6d2fSStefano Zampini   ierr = MatISSetLocalMat(coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
2830e7931f94SStefano Zampini   ierr = MatAssemblyBegin(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2831e7931f94SStefano Zampini   ierr = MatAssemblyEnd(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
283220a2ab83SStefano Zampini   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
283320a2ab83SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
283420a2ab83SStefano Zampini   ierr = PetscFree(local_primal_indices);CHKERRQ(ierr);
2835fdc09c96SStefano Zampini 
2836*f9eb5b7dSStefano Zampini   /* assemble coarse matrix */
2837*f9eb5b7dSStefano Zampini   if (isbddc || isnn) {
2838*f9eb5b7dSStefano Zampini     ierr = MatISSubassemble(coarse_mat_is,NULL,pcbddc->coarsening_ratio,&coarse_mat);CHKERRQ(ierr);
2839*f9eb5b7dSStefano Zampini   } else {
28402b510759SStefano Zampini     ierr = MatConvert_IS_AIJ(coarse_mat_is,MATAIJ,MAT_INITIAL_MATRIX,&coarse_mat);CHKERRQ(ierr);
2841c8587f34SStefano Zampini   }
28422b510759SStefano Zampini   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
28439881197aSStefano Zampini 
2844*f9eb5b7dSStefano Zampini   /* create local to global scatters for coarse problem */
2845*f9eb5b7dSStefano Zampini   ierr = MatGetVecs(coarse_mat,&pcbddc->coarse_vec,&pcbddc->coarse_rhs);CHKERRQ(ierr);
2846*f9eb5b7dSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
2847*f9eb5b7dSStefano Zampini   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
2848*f9eb5b7dSStefano Zampini 
2849*f9eb5b7dSStefano Zampini   /* propagate symmetry info to coarse matrix */
2850*f9eb5b7dSStefano Zampini   ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,issym);CHKERRQ(ierr);
2851*f9eb5b7dSStefano Zampini 
2852*f9eb5b7dSStefano Zampini   /* set operators */
2853*f9eb5b7dSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
2854*f9eb5b7dSStefano Zampini   ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat,matstruct);CHKERRQ(ierr);
2855*f9eb5b7dSStefano Zampini 
2856*f9eb5b7dSStefano Zampini   /* additional KSP customization */
2857*f9eb5b7dSStefano Zampini   ierr = KSPGetTolerances(pcbddc->coarse_ksp,NULL,NULL,NULL,&max_it);CHKERRQ(ierr);
2858*f9eb5b7dSStefano Zampini   if (max_it < 5) {
2859*f9eb5b7dSStefano Zampini     ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
2860*f9eb5b7dSStefano Zampini   }
2861*f9eb5b7dSStefano Zampini   //ierr = KSPChebyshevSetEstimateEigenvalues(pcbddc->coarse_ksp,1.0,0.0,0.0,1.1);CHKERRQ(ierr);
2862*f9eb5b7dSStefano Zampini 
2863*f9eb5b7dSStefano Zampini 
2864*f9eb5b7dSStefano Zampini   /* print some info if requested */
2865*f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
2866*f9eb5b7dSStefano Zampini     ierr = KSPGetType(pcbddc->coarse_ksp,&coarse_ksp_type);CHKERRQ(ierr);
2867*f9eb5b7dSStefano Zampini     ierr = PCGetType(pc_temp,&coarse_pc_type);CHKERRQ(ierr);
2868*f9eb5b7dSStefano Zampini     if (!multilevel_allowed) {
2869*f9eb5b7dSStefano Zampini       if (multilevel_requested) {
2870*f9eb5b7dSStefano 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);
2871*f9eb5b7dSStefano Zampini       } else if (pcbddc->max_levels) {
2872*f9eb5b7dSStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
2873*f9eb5b7dSStefano Zampini       }
2874*f9eb5b7dSStefano Zampini     }
2875*f9eb5b7dSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Calling %s/%s setup at level %d for coarse solver\n",coarse_ksp_type,coarse_pc_type,pcbddc->current_level);CHKERRQ(ierr);
2876*f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2877*f9eb5b7dSStefano Zampini   }
2878*f9eb5b7dSStefano Zampini 
2879*f9eb5b7dSStefano Zampini   /* setup coarse ksp */
2880*f9eb5b7dSStefano Zampini   ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
2881*f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
2882*f9eb5b7dSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
2883*f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2884*f9eb5b7dSStefano Zampini     ierr = KSPView(pcbddc->coarse_ksp,pcbddc->dbg_viewer);CHKERRQ(ierr);
2885*f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2886*f9eb5b7dSStefano Zampini   }
2887*f9eb5b7dSStefano Zampini 
2888*f9eb5b7dSStefano Zampini   /* HACK: TODO see if it could be avoided */
2889*f9eb5b7dSStefano Zampini   if (isbddc) {
2890*f9eb5b7dSStefano Zampini     ierr = PCBDDCSetUseExactDirichlet(pc_temp,PETSC_FALSE);CHKERRQ(ierr);
2891*f9eb5b7dSStefano Zampini   }
2892*f9eb5b7dSStefano Zampini 
2893c8587f34SStefano Zampini   /* Check coarse problem if requested */
289420a2ab83SStefano Zampini   if (pcbddc->dbg_flag) {
2895c8587f34SStefano Zampini     KSP       check_ksp;
28962b510759SStefano Zampini     KSPType   check_ksp_type;
2897c8587f34SStefano Zampini     PC        check_pc;
2898c8587f34SStefano Zampini     Vec       check_vec;
2899c8587f34SStefano Zampini     PetscReal abs_infty_error,infty_error,lambda_min,lambda_max;
29002b510759SStefano Zampini     PetscInt  its;
2901*f9eb5b7dSStefano Zampini     PetscBool ispreonly,compute;
2902c8587f34SStefano Zampini 
29032b510759SStefano Zampini     /* Create ksp object suitable for estimation of extreme eigenvalues */
2904*f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&check_ksp);CHKERRQ(ierr);
2905fdc635d7SStefano Zampini     ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
2906*f9eb5b7dSStefano Zampini     ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,coarse_size);CHKERRQ(ierr);
29072b510759SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
29082b510759SStefano Zampini     if (ispreonly) {
29092b510759SStefano Zampini       check_ksp_type = KSPPREONLY;
2910*f9eb5b7dSStefano Zampini       compute = PETSC_FALSE;
29112b510759SStefano Zampini     } else {
2912c8587f34SStefano Zampini       if (issym) check_ksp_type = KSPCG;
2913c8587f34SStefano Zampini       else check_ksp_type = KSPGMRES;
2914*f9eb5b7dSStefano Zampini       compute = PETSC_TRUE;
2915c8587f34SStefano Zampini     }
2916c8587f34SStefano Zampini     ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
2917*f9eb5b7dSStefano Zampini     ierr = KSPSetComputeSingularValues(check_ksp,compute);CHKERRQ(ierr);
2918c8587f34SStefano Zampini     ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
2919*f9eb5b7dSStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
2920*f9eb5b7dSStefano Zampini     ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
2921c8587f34SStefano Zampini     /* create random vec */
2922c8587f34SStefano Zampini     ierr = VecDuplicate(pcbddc->coarse_vec,&check_vec);CHKERRQ(ierr);
2923c8587f34SStefano Zampini     ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
2924c8587f34SStefano Zampini     if (CoarseNullSpace) {
2925c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec);CHKERRQ(ierr);
2926c8587f34SStefano Zampini     }
2927fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
2928c8587f34SStefano Zampini     /* solve coarse problem */
2929c8587f34SStefano Zampini     ierr = KSPSolve(check_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
2930c8587f34SStefano Zampini     if (CoarseNullSpace) {
2931c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,pcbddc->coarse_vec);CHKERRQ(ierr);
2932c8587f34SStefano Zampini     }
2933c8587f34SStefano Zampini     /* check coarse problem residual error */
2934c8587f34SStefano Zampini     ierr = VecAXPY(check_vec,-1.0,pcbddc->coarse_vec);CHKERRQ(ierr);
2935c8587f34SStefano Zampini     ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
2936fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
2937c8587f34SStefano Zampini     ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
2938c8587f34SStefano Zampini     ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
2939*f9eb5b7dSStefano Zampini     /* get eigenvalue estimation if preonly has not been requested */
29402b510759SStefano Zampini     if (!ispreonly) {
2941c8587f34SStefano Zampini       ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
294220a2ab83SStefano Zampini       ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
2943*f9eb5b7dSStefano 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);
2944c8587f34SStefano Zampini     }
2945*f9eb5b7dSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
2946*f9eb5b7dSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
29472b510759SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2948c8587f34SStefano Zampini     ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
2949c8587f34SStefano Zampini   }
29502b510759SStefano Zampini   /* free memory */
2951c8587f34SStefano Zampini   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
2952fdc635d7SStefano Zampini   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
2953c8587f34SStefano Zampini   PetscFunctionReturn(0);
2954c8587f34SStefano Zampini }
29559a7d3425SStefano Zampini 
2956f34684f1SStefano Zampini #undef __FUNCT__
2957f34684f1SStefano Zampini #define __FUNCT__ "PCBDDCComputePrimalNumbering"
2958f34684f1SStefano Zampini PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
2959f34684f1SStefano Zampini {
2960f34684f1SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2961f34684f1SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
2962f34684f1SStefano Zampini   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
2963f34684f1SStefano Zampini   PetscInt       i,j,coarse_size;
2964f34684f1SStefano Zampini   PetscInt       *local_primal_indices,*auxlocal_primal,*aux_idx;
2965f34684f1SStefano Zampini   PetscErrorCode ierr;
2966f34684f1SStefano Zampini 
2967f34684f1SStefano Zampini   PetscFunctionBegin;
2968f34684f1SStefano Zampini   /* get indices in local ordering for vertices and constraints */
2969f34684f1SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&auxlocal_primal);CHKERRQ(ierr);
2970f34684f1SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&i,&aux_idx);CHKERRQ(ierr);
2971f34684f1SStefano Zampini   ierr = PetscMemcpy(auxlocal_primal,aux_idx,i*sizeof(PetscInt));CHKERRQ(ierr);
2972f34684f1SStefano Zampini   ierr = PetscFree(aux_idx);CHKERRQ(ierr);
2973f34684f1SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&j,&aux_idx);CHKERRQ(ierr);
2974f34684f1SStefano Zampini   ierr = PetscMemcpy(&auxlocal_primal[i],aux_idx,j*sizeof(PetscInt));CHKERRQ(ierr);
2975f34684f1SStefano Zampini   ierr = PetscFree(aux_idx);CHKERRQ(ierr);
2976f34684f1SStefano Zampini 
2977f34684f1SStefano Zampini   /* Compute global number of coarse dofs */
2978f34684f1SStefano Zampini   ierr = PCBDDCSubsetNumbering(PetscObjectComm((PetscObject)(pc->pmat)),matis->mapping,pcbddc->local_primal_size,auxlocal_primal,NULL,&coarse_size,&local_primal_indices);CHKERRQ(ierr);
2979f34684f1SStefano Zampini 
2980f34684f1SStefano Zampini   /* check numbering */
2981f34684f1SStefano Zampini   if (pcbddc->dbg_flag) {
2982f34684f1SStefano Zampini     PetscScalar coarsesum,*array;
2983f34684f1SStefano Zampini 
2984f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2985f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
2986f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
2987f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
2988f34684f1SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
2989f34684f1SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,auxlocal_primal[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
2990f34684f1SStefano Zampini     }
2991f34684f1SStefano Zampini     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2992f34684f1SStefano Zampini     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2993f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
2994f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2995f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2996f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2997f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2998f34684f1SStefano Zampini     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
2999f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3000f34684f1SStefano Zampini       if (array[i] == 1.0) {
3001f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %d owned by a single process!\n",PetscGlobalRank,i);CHKERRQ(ierr);
3002f34684f1SStefano Zampini       }
3003f34684f1SStefano Zampini     }
3004f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3005f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3006f34684f1SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
3007f34684f1SStefano Zampini     }
3008f34684f1SStefano Zampini     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3009f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3010f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3011f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3012f34684f1SStefano Zampini     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
3013f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
3014f34684f1SStefano Zampini     if (pcbddc->dbg_flag > 1) {
3015f34684f1SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
3016f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3017f34684f1SStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
3018f34684f1SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
3019f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_primal_indices[%d]=%d \n",i,local_primal_indices[i]);
3020f34684f1SStefano Zampini       }
3021f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3022f34684f1SStefano Zampini     }
3023f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3024f34684f1SStefano Zampini   }
3025f34684f1SStefano Zampini   ierr = PetscFree(auxlocal_primal);CHKERRQ(ierr);
3026f34684f1SStefano Zampini   /* get back data */
3027f34684f1SStefano Zampini   *coarse_size_n = coarse_size;
3028f34684f1SStefano Zampini   *local_primal_indices_n = local_primal_indices;
3029f34684f1SStefano Zampini   PetscFunctionReturn(0);
3030f34684f1SStefano Zampini }
3031f34684f1SStefano Zampini 
3032