xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 3a50541e9233827658c04ec027dc69ca0cd440c1)
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   */
3547f4ddc3SStefano Zampini   ierr = PCBDDCSetUpCorrection(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);
639577ea80SStefano Zampini   pcbddc->n_ISForDofs = 0;
64674ae819SStefano Zampini   PetscFunctionReturn(0);
65674ae819SStefano Zampini }
66674ae819SStefano Zampini 
67674ae819SStefano Zampini #undef __FUNCT__
68674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetTopography"
69674ae819SStefano Zampini PetscErrorCode PCBDDCResetTopography(PC pc)
70674ae819SStefano Zampini {
71674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
72674ae819SStefano Zampini   PetscErrorCode ierr;
73674ae819SStefano Zampini 
74674ae819SStefano Zampini   PetscFunctionBegin;
75674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
76674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
77674ae819SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
78674ae819SStefano Zampini   PetscFunctionReturn(0);
79674ae819SStefano Zampini }
80674ae819SStefano Zampini 
81674ae819SStefano Zampini #undef __FUNCT__
82674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetSolvers"
83674ae819SStefano Zampini PetscErrorCode PCBDDCResetSolvers(PC pc)
84674ae819SStefano Zampini {
85674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
86674ae819SStefano Zampini   PetscErrorCode ierr;
87674ae819SStefano Zampini 
88674ae819SStefano Zampini   PetscFunctionBegin;
89674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
90674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_rhs);CHKERRQ(ierr);
91674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
92674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
9315aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
9415aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
95674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
96674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
97674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
98674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
99674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
100674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
101674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec4_D);CHKERRQ(ierr);
1028ce42a96SStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
103674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
104674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
105674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
106674ae819SStefano Zampini   PetscFunctionReturn(0);
107674ae819SStefano Zampini }
108674ae819SStefano Zampini 
109674ae819SStefano Zampini #undef __FUNCT__
1106bfb1811SStefano Zampini #define __FUNCT__ "PCBDDCCreateWorkVectors"
1116bfb1811SStefano Zampini PetscErrorCode PCBDDCCreateWorkVectors(PC pc)
1126bfb1811SStefano Zampini {
1136bfb1811SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1146bfb1811SStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
1156bfb1811SStefano Zampini   VecType        impVecType;
1166bfb1811SStefano Zampini   PetscInt       n_vertices,n_constraints,local_primal_size,n_R;
1176bfb1811SStefano Zampini   PetscErrorCode ierr;
1186bfb1811SStefano Zampini 
1196bfb1811SStefano Zampini   PetscFunctionBegin;
1206bfb1811SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,NULL);CHKERRQ(ierr);
1216bfb1811SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&n_constraints,NULL);CHKERRQ(ierr);
1226bfb1811SStefano Zampini   local_primal_size = n_constraints+n_vertices;
1236bfb1811SStefano Zampini   n_R = pcis->n-n_vertices;
1246bfb1811SStefano Zampini   /* local work vectors */
1256bfb1811SStefano Zampini   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
1266bfb1811SStefano Zampini   ierr = VecDuplicate(pcis->vec1_D,&pcbddc->vec4_D);CHKERRQ(ierr);
1276bfb1811SStefano Zampini   ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
1286bfb1811SStefano Zampini   ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
1296bfb1811SStefano Zampini   ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
1306bfb1811SStefano Zampini   ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
13183b7ccabSStefano Zampini   ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
1326bfb1811SStefano Zampini   ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,local_primal_size);CHKERRQ(ierr);
1336bfb1811SStefano Zampini   ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
13483b7ccabSStefano Zampini   if (n_constraints) {
13583b7ccabSStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
13683b7ccabSStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
13783b7ccabSStefano Zampini     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
13883b7ccabSStefano Zampini   }
1396bfb1811SStefano Zampini   PetscFunctionReturn(0);
1406bfb1811SStefano Zampini }
1416bfb1811SStefano Zampini 
1426bfb1811SStefano Zampini #undef __FUNCT__
14347f4ddc3SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCorrection"
14447f4ddc3SStefano Zampini PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
14588ebb749SStefano Zampini {
14625084f0cSStefano Zampini   PetscErrorCode         ierr;
14725084f0cSStefano Zampini   /* pointers to pcis and pcbddc */
14888ebb749SStefano Zampini   PC_IS*                 pcis = (PC_IS*)pc->data;
14988ebb749SStefano Zampini   PC_BDDC*               pcbddc = (PC_BDDC*)pc->data;
15025084f0cSStefano Zampini   /* submatrices of local problem */
15188ebb749SStefano Zampini   Mat                    A_RV,A_VR,A_VV;
15225084f0cSStefano Zampini   /* working matrices */
15325084f0cSStefano Zampini   Mat                    M1,M2,M3,C_CR;
15425084f0cSStefano Zampini   /* working vectors */
15525084f0cSStefano Zampini   Vec                    vec1_C,vec2_C,vec1_V,vec2_V;
15625084f0cSStefano Zampini   /* additional working stuff */
15725084f0cSStefano Zampini   IS                     is_aux;
15888ebb749SStefano Zampini   ISLocalToGlobalMapping BtoNmap;
15925084f0cSStefano Zampini   PetscScalar            *coarse_submat_vals; /* TODO: use a PETSc matrix */
16025084f0cSStefano Zampini   const PetscScalar      *array,*row_cmat_values;
16125084f0cSStefano Zampini   const PetscInt         *row_cmat_indices,*idx_R_local;
16225084f0cSStefano Zampini   PetscInt               *vertices,*idx_V_B,*auxindices;
16325084f0cSStefano Zampini   PetscInt               n_vertices,n_constraints,size_of_constraint;
16425084f0cSStefano Zampini   PetscInt               i,j,n_R,n_D,n_B;
16588ebb749SStefano Zampini   PetscBool              setsym=PETSC_FALSE,issym=PETSC_FALSE;
16625084f0cSStefano Zampini   /* Vector and matrix types */
16788ebb749SStefano Zampini   VecType                impVecType;
16888ebb749SStefano Zampini   MatType                impMatType;
16925084f0cSStefano Zampini   /* some shortcuts to scalars */
17025084f0cSStefano Zampini   PetscScalar            zero=0.0,one=1.0,m_one=-1.0;
17125084f0cSStefano Zampini   /* for debugging purposes */
17288ebb749SStefano Zampini   PetscReal              *coarsefunctions_errors,*constraints_errors;
17388ebb749SStefano Zampini 
17488ebb749SStefano Zampini   PetscFunctionBegin;
17525084f0cSStefano Zampini   /* get number of vertices and their local indices */
17625084f0cSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
17788ebb749SStefano Zampini   n_constraints = pcbddc->local_primal_size-n_vertices;
17888ebb749SStefano Zampini   /* Set Non-overlapping dimensions */
17988ebb749SStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
18088ebb749SStefano Zampini   n_R = pcis->n-n_vertices;
18188ebb749SStefano Zampini 
18288ebb749SStefano Zampini   /* Set types for local objects needed by BDDC precondtioner */
18388ebb749SStefano Zampini   impMatType = MATSEQDENSE;
18425084f0cSStefano Zampini   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
18588ebb749SStefano Zampini 
18688ebb749SStefano Zampini   /* Allocating some extra storage just to be safe */
18788ebb749SStefano Zampini   ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&auxindices);CHKERRQ(ierr);
18888ebb749SStefano Zampini   for (i=0;i<pcis->n;i++) auxindices[i]=i;
18988ebb749SStefano Zampini 
19088ebb749SStefano Zampini   /* vertices in boundary numbering */
19188ebb749SStefano Zampini   ierr = PetscMalloc(n_vertices*sizeof(PetscInt),&idx_V_B);CHKERRQ(ierr);
19288ebb749SStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(pcis->is_B_local,&BtoNmap);CHKERRQ(ierr);
19388ebb749SStefano Zampini   ierr = ISGlobalToLocalMappingApply(BtoNmap,IS_GTOLM_DROP,n_vertices,vertices,&i,idx_V_B);CHKERRQ(ierr);
19488ebb749SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&BtoNmap);CHKERRQ(ierr);
19588ebb749SStefano Zampini   if (i != n_vertices) {
19688ebb749SStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %d != %d\n",n_vertices,i);
19788ebb749SStefano Zampini   }
19888ebb749SStefano Zampini 
19988ebb749SStefano Zampini   /* some work vectors on vertices and/or constraints */
20088ebb749SStefano Zampini   if (n_vertices) {
20188ebb749SStefano Zampini     ierr = VecCreate(PETSC_COMM_SELF,&vec1_V);CHKERRQ(ierr);
20288ebb749SStefano Zampini     ierr = VecSetSizes(vec1_V,n_vertices,n_vertices);CHKERRQ(ierr);
20388ebb749SStefano Zampini     ierr = VecSetType(vec1_V,impVecType);CHKERRQ(ierr);
20488ebb749SStefano Zampini     ierr = VecDuplicate(vec1_V,&vec2_V);CHKERRQ(ierr);
20588ebb749SStefano Zampini   }
20688ebb749SStefano Zampini   if (n_constraints) {
20788ebb749SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec1_C);CHKERRQ(ierr);
20888ebb749SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec2_C);CHKERRQ(ierr);
20988ebb749SStefano Zampini   }
21025084f0cSStefano Zampini 
21188ebb749SStefano Zampini   /* Precompute stuffs needed for preprocessing and application of BDDC*/
21288ebb749SStefano Zampini   if (n_constraints) {
21388ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->local_auxmat2);CHKERRQ(ierr);
21425084f0cSStefano Zampini     ierr = MatSetSizes(pcbddc->local_auxmat2,n_R,n_constraints,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
21588ebb749SStefano Zampini     ierr = MatSetType(pcbddc->local_auxmat2,impMatType);CHKERRQ(ierr);
21625084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->local_auxmat2);CHKERRQ(ierr);
21788ebb749SStefano Zampini 
21825084f0cSStefano Zampini     /* Extract constraints on R nodes: C_{CR}  */
21925084f0cSStefano Zampini     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
2208ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
22125084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
22288ebb749SStefano Zampini 
22388ebb749SStefano Zampini     /* Assemble local_auxmat2 = - A_{RR}^{-1} C^T_{CR} needed by BDDC application */
22488ebb749SStefano Zampini     for (i=0;i<n_constraints;i++) {
22588ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
22688ebb749SStefano Zampini       /* Get row of constraint matrix in R numbering */
22725084f0cSStefano Zampini       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
22825084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_R,size_of_constraint,row_cmat_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
22925084f0cSStefano Zampini       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
23025084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_R);CHKERRQ(ierr);
23125084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_R);CHKERRQ(ierr);
23288ebb749SStefano Zampini       /* Solve for row of constraint matrix in R numbering */
23388ebb749SStefano Zampini       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
23425084f0cSStefano Zampini       /* Set values in local_auxmat2 */
23525084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
23688ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->local_auxmat2,n_R,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
23725084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
23888ebb749SStefano Zampini     }
23988ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
24088ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
24125084f0cSStefano Zampini     ierr = MatScale(pcbddc->local_auxmat2,m_one);CHKERRQ(ierr);
24288ebb749SStefano Zampini 
24388ebb749SStefano Zampini     /* Assemble explicitly M1 = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1} needed in preproc  */
24425084f0cSStefano Zampini     ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
24525084f0cSStefano Zampini     ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
24688ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&M1);CHKERRQ(ierr);
24788ebb749SStefano Zampini     ierr = MatSetSizes(M1,n_constraints,n_constraints,n_constraints,n_constraints);CHKERRQ(ierr);
24888ebb749SStefano Zampini     ierr = MatSetType(M1,impMatType);CHKERRQ(ierr);
24925084f0cSStefano Zampini     ierr = MatSetUp(M1);CHKERRQ(ierr);
25025084f0cSStefano Zampini     ierr = MatDuplicate(M1,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
25125084f0cSStefano Zampini     ierr = MatZeroEntries(M2);CHKERRQ(ierr);
25225084f0cSStefano Zampini     ierr = VecSet(vec1_C,m_one);CHKERRQ(ierr);
25325084f0cSStefano Zampini     ierr = MatDiagonalSet(M2,vec1_C,INSERT_VALUES);CHKERRQ(ierr);
25425084f0cSStefano Zampini     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
25525084f0cSStefano Zampini     ierr = MatDestroy(&M2);CHKERRQ(ierr);
25625084f0cSStefano Zampini     ierr = MatDestroy(&M3);CHKERRQ(ierr);
25788ebb749SStefano Zampini     /* Assemble local_auxmat1 = M1*C_{CR} needed by BDDC application in KSP and in preproc */
25888ebb749SStefano Zampini     ierr = MatMatMult(M1,C_CR,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
25988ebb749SStefano Zampini   }
26088ebb749SStefano Zampini 
26188ebb749SStefano Zampini   /* Get submatrices from subdomain matrix */
26288ebb749SStefano Zampini   if (n_vertices) {
263*3a50541eSStefano Zampini     PetscInt ibs,mbs;
264*3a50541eSStefano Zampini     PetscBool issbaij;
265af732b37SStefano Zampini     Mat newmat;
266*3a50541eSStefano Zampini 
267*3a50541eSStefano Zampini     ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
2689577ea80SStefano Zampini     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
2699577ea80SStefano Zampini     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
270*3a50541eSStefano Zampini     if (ibs != mbs) { /* need to convert to SEQAIJ */
2719577ea80SStefano Zampini       ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
2729577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
2739577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
2749577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
2759577ea80SStefano Zampini       ierr = MatDestroy(&newmat);CHKERRQ(ierr);
2769577ea80SStefano Zampini     } else {
277*3a50541eSStefano Zampini       /* this is safe */
2789577ea80SStefano Zampini       ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
279*3a50541eSStefano Zampini       ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
280*3a50541eSStefano Zampini       if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
281*3a50541eSStefano Zampini         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
282*3a50541eSStefano Zampini         /* ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
283*3a50541eSStefano Zampini         ierr = MatCreateTranspose(A_RV,&A_VR);CHKERRQ(ierr);*/
284*3a50541eSStefano Zampini         ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
285*3a50541eSStefano Zampini         ierr = MatCreateTranspose(A_VR,&A_RV);CHKERRQ(ierr);
286*3a50541eSStefano Zampini         ierr = MatDestroy(&newmat);CHKERRQ(ierr);
287*3a50541eSStefano Zampini       } else {
2889577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
2899577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
2909577ea80SStefano Zampini       }
291*3a50541eSStefano Zampini     }
29225084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
29388ebb749SStefano Zampini   }
29488ebb749SStefano Zampini 
29588ebb749SStefano Zampini   /* Matrix of coarse basis functions (local) */
29688ebb749SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
29788ebb749SStefano Zampini   ierr = MatSetSizes(pcbddc->coarse_phi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
29888ebb749SStefano Zampini   ierr = MatSetType(pcbddc->coarse_phi_B,impMatType);CHKERRQ(ierr);
29925084f0cSStefano Zampini   ierr = MatSetUp(pcbddc->coarse_phi_B);CHKERRQ(ierr);
3008eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
30188ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
30288ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_phi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
30388ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_phi_D,impMatType);CHKERRQ(ierr);
30425084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_phi_D);CHKERRQ(ierr);
30588ebb749SStefano Zampini   }
30688ebb749SStefano Zampini 
30725084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
3088ce42a96SStefano Zampini     ierr = ISGetIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
30988ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*coarsefunctions_errors),&coarsefunctions_errors);CHKERRQ(ierr);
31088ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*constraints_errors),&constraints_errors);CHKERRQ(ierr);
31188ebb749SStefano Zampini   }
31288ebb749SStefano Zampini   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
31388ebb749SStefano Zampini   ierr = PetscMalloc((pcbddc->local_primal_size)*(pcbddc->local_primal_size)*sizeof(PetscScalar),&coarse_submat_vals);CHKERRQ(ierr);
31488ebb749SStefano Zampini 
31588ebb749SStefano Zampini   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
31625084f0cSStefano Zampini 
31725084f0cSStefano Zampini   /* vertices */
31888ebb749SStefano Zampini   for (i=0;i<n_vertices;i++) {
31988ebb749SStefano Zampini     ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
32088ebb749SStefano Zampini     ierr = VecSetValue(vec1_V,i,one,INSERT_VALUES);CHKERRQ(ierr);
32188ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
32288ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
32325084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on constraints multipliers */
32488ebb749SStefano Zampini     ierr = MatMult(A_RV,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
32588ebb749SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
32688ebb749SStefano Zampini     ierr = VecScale(pcbddc->vec1_R,m_one);CHKERRQ(ierr);
32788ebb749SStefano Zampini     if (n_constraints) {
32888ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec1_R,vec1_C);CHKERRQ(ierr);
32988ebb749SStefano Zampini       ierr = MatMultAdd(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
33088ebb749SStefano Zampini       ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
33188ebb749SStefano Zampini     }
33288ebb749SStefano Zampini     ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
33388ebb749SStefano Zampini     ierr = MatMultAdd(A_VV,vec1_V,vec2_V,vec2_V);CHKERRQ(ierr);
33488ebb749SStefano Zampini 
33588ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
33688ebb749SStefano Zampini     /* coarse basis functions */
33788ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
33888ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
33988ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
34025084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
34188ebb749SStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
34225084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
34388ebb749SStefano Zampini     ierr = MatSetValue(pcbddc->coarse_phi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
3448eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
34588ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
34688ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
34725084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
34888ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
34925084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
35088ebb749SStefano Zampini     }
35125084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
35225084f0cSStefano Zampini     ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
35325084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
35425084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
35588ebb749SStefano Zampini     if (n_constraints) {
35625084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
35725084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
35825084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
35988ebb749SStefano Zampini     }
36088ebb749SStefano Zampini 
36125084f0cSStefano Zampini     /* check */
36225084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
36325084f0cSStefano Zampini       /* assemble subdomain vector on local nodes */
36488ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
36525084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
36625084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
36725084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
36825084f0cSStefano Zampini       ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
36925084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
37025084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
37188ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers (i.e. primal nodes) */
37288ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
37325084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
37425084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
37525084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
37688ebb749SStefano Zampini       if (n_constraints) {
37725084f0cSStefano Zampini         ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
37825084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
37925084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
38088ebb749SStefano Zampini       }
38125084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
38225084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
38388ebb749SStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
38488ebb749SStefano Zampini       /* check saddle point solution */
38588ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
38688ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
38788ebb749SStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i]);CHKERRQ(ierr);
38888ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
38925084f0cSStefano Zampini       /* shift by the identity matrix */
39025084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
39125084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
39225084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
39388ebb749SStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i]);CHKERRQ(ierr);
39488ebb749SStefano Zampini     }
39588ebb749SStefano Zampini   }
39688ebb749SStefano Zampini 
39725084f0cSStefano Zampini   /* constraints */
39888ebb749SStefano Zampini   for (i=0;i<n_constraints;i++) {
39988ebb749SStefano Zampini     ierr = VecSet(vec2_C,zero);CHKERRQ(ierr);
40088ebb749SStefano Zampini     ierr = VecSetValue(vec2_C,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
40188ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec2_C);CHKERRQ(ierr);
40288ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec2_C);CHKERRQ(ierr);
40325084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on vertices multipliers */
40488ebb749SStefano Zampini     ierr = MatMult(M1,vec2_C,vec1_C);CHKERRQ(ierr);
40588ebb749SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
40688ebb749SStefano Zampini     ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
40725084f0cSStefano Zampini     if (n_vertices) {
40825084f0cSStefano Zampini       ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
40925084f0cSStefano Zampini     }
41088ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
41188ebb749SStefano Zampini     /* coarse basis functions */
41225084f0cSStefano Zampini     j = i+n_vertices; /* don't touch this! */
41388ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
41488ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
41588ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
41625084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
41725084f0cSStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
41825084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
4198eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
42088ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
42188ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
42225084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
42325084f0cSStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
42425084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
42588ebb749SStefano Zampini     }
42625084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
42788ebb749SStefano Zampini     if (n_vertices) {
42825084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
42925084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
43025084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
43188ebb749SStefano Zampini     }
43225084f0cSStefano Zampini     ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
43325084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
43425084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
43588ebb749SStefano Zampini 
43625084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
43788ebb749SStefano Zampini       /* assemble subdomain vector on nodes */
43888ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
43925084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
44025084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
44125084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
44225084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
44325084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
44488ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers */
44588ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
44688ebb749SStefano Zampini       if (n_vertices) {
44725084f0cSStefano Zampini         ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
44825084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
44925084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
45088ebb749SStefano Zampini       }
45125084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
45225084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
45325084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
45425084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
45525084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
45625084f0cSStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
45788ebb749SStefano Zampini       /* check saddle point solution */
45888ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
45988ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
46025084f0cSStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[j]);CHKERRQ(ierr);
46188ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
46225084f0cSStefano Zampini       /* shift by the identity matrix */
46325084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,j,m_one,ADD_VALUES);CHKERRQ(ierr);
46425084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
46525084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
46625084f0cSStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[j]);CHKERRQ(ierr);
46788ebb749SStefano Zampini     }
46888ebb749SStefano Zampini   }
46925084f0cSStefano Zampini   /* call assembling routines for local coarse basis */
47088ebb749SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
47188ebb749SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4728eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
47388ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
47488ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
47588ebb749SStefano Zampini   }
47625084f0cSStefano Zampini 
47788ebb749SStefano Zampini   /* compute other basis functions for non-symmetric problems */
47888ebb749SStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
47988ebb749SStefano Zampini   if (!setsym || (setsym && !issym)) {
48088ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
48188ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_psi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
48288ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_psi_B,impMatType);CHKERRQ(ierr);
48325084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_psi_B);CHKERRQ(ierr);
4848eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
48588ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
48688ebb749SStefano Zampini       ierr = MatSetSizes(pcbddc->coarse_psi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
48788ebb749SStefano Zampini       ierr = MatSetType(pcbddc->coarse_psi_D,impMatType);CHKERRQ(ierr);
48825084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->coarse_psi_D);CHKERRQ(ierr);
48988ebb749SStefano Zampini     }
49088ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
49188ebb749SStefano Zampini       if (n_constraints) {
49288ebb749SStefano Zampini         ierr = VecSet(vec1_C,zero);CHKERRQ(ierr);
49388ebb749SStefano Zampini         for (j=0;j<n_constraints;j++) {
49425084f0cSStefano Zampini           ierr = VecSetValue(vec1_C,j,coarse_submat_vals[(j+n_vertices)*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
49588ebb749SStefano Zampini         }
49625084f0cSStefano Zampini         ierr = VecAssemblyBegin(vec1_C);CHKERRQ(ierr);
49725084f0cSStefano Zampini         ierr = VecAssemblyEnd(vec1_C);CHKERRQ(ierr);
49888ebb749SStefano Zampini       }
49988ebb749SStefano Zampini       if (i<n_vertices) {
50088ebb749SStefano Zampini         ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
50188ebb749SStefano Zampini         ierr = VecSetValue(vec1_V,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
50288ebb749SStefano Zampini         ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
50388ebb749SStefano Zampini         ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
50488ebb749SStefano Zampini         ierr = MatMultTranspose(A_VR,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
50588ebb749SStefano Zampini         if (n_constraints) {
50688ebb749SStefano Zampini           ierr = MatMultTransposeAdd(C_CR,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
50788ebb749SStefano Zampini         }
50888ebb749SStefano Zampini       } else {
50988ebb749SStefano Zampini         ierr = MatMultTranspose(C_CR,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
51088ebb749SStefano Zampini       }
51188ebb749SStefano Zampini       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
51288ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
51388ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
51488ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
51525084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
51688ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_psi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
51725084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
51888ebb749SStefano Zampini       if (i<n_vertices) {
51988ebb749SStefano Zampini         ierr = MatSetValue(pcbddc->coarse_psi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
52088ebb749SStefano Zampini       }
5218eeda7d8SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
52288ebb749SStefano Zampini         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
52388ebb749SStefano Zampini         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
52425084f0cSStefano Zampini         ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
52588ebb749SStefano Zampini         ierr = MatSetValues(pcbddc->coarse_psi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
52625084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
52788ebb749SStefano Zampini       }
52888ebb749SStefano Zampini 
52925084f0cSStefano Zampini       if (pcbddc->dbg_flag) {
53088ebb749SStefano Zampini         /* assemble subdomain vector on nodes */
53188ebb749SStefano Zampini         ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
53225084f0cSStefano Zampini         ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
53325084f0cSStefano Zampini         ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
53425084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
53525084f0cSStefano Zampini         if (i<n_vertices) {
53625084f0cSStefano Zampini           ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
53788ebb749SStefano Zampini         }
53825084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
53925084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
54025084f0cSStefano Zampini         /* assemble subdomain vector of lagrange multipliers */
54125084f0cSStefano Zampini         for (j=0;j<pcbddc->local_primal_size;j++) {
54225084f0cSStefano Zampini           ierr = VecSetValue(pcbddc->vec1_P,j,-coarse_submat_vals[j*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
54325084f0cSStefano Zampini         }
54425084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
54525084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
54688ebb749SStefano Zampini         /* check saddle point solution */
54788ebb749SStefano Zampini         ierr = MatMultTranspose(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
54888ebb749SStefano Zampini         ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
54988ebb749SStefano Zampini         ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
55088ebb749SStefano Zampini         ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
55125084f0cSStefano Zampini         /* shift by the identity matrix */
55225084f0cSStefano Zampini         ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
55325084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
55425084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
55588ebb749SStefano Zampini         ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
55688ebb749SStefano Zampini       }
55788ebb749SStefano Zampini     }
55888ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
55988ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5608eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
56188ebb749SStefano Zampini       ierr = MatAssemblyBegin(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
56288ebb749SStefano Zampini       ierr = MatAssemblyEnd(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
56388ebb749SStefano Zampini     }
56488ebb749SStefano Zampini   }
56588ebb749SStefano Zampini   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
56688ebb749SStefano Zampini   /* Checking coarse_sub_mat and coarse basis functios */
56788ebb749SStefano Zampini   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
56888ebb749SStefano Zampini   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
56925084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
57088ebb749SStefano Zampini     Mat         coarse_sub_mat;
57125084f0cSStefano Zampini     Mat         AUXMAT,TM1,TM2,TM3,TM4;
57288ebb749SStefano Zampini     Mat         coarse_phi_D,coarse_phi_B;
57388ebb749SStefano Zampini     Mat         coarse_psi_D,coarse_psi_B;
57488ebb749SStefano Zampini     Mat         A_II,A_BB,A_IB,A_BI;
57588ebb749SStefano Zampini     MatType     checkmattype=MATSEQAIJ;
57688ebb749SStefano Zampini     PetscReal   real_value;
57788ebb749SStefano Zampini 
57888ebb749SStefano Zampini     ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
57988ebb749SStefano Zampini     ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
58088ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
58188ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
58288ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
58388ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
58488ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
58588ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
58688ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
58788ebb749SStefano Zampini     }
58888ebb749SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
58988ebb749SStefano Zampini 
59025084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
59125084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat and local basis functions\n");CHKERRQ(ierr);
59225084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
59388ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
59488ebb749SStefano Zampini       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
59588ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
59688ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
59788ebb749SStefano Zampini       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
59888ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
59988ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
60088ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
60188ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
60288ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
60388ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
60488ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
60588ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
60688ebb749SStefano Zampini     } else {
60788ebb749SStefano Zampini       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
60888ebb749SStefano Zampini       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
60988ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
61088ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
61188ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
61288ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
61388ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
61488ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
61588ebb749SStefano Zampini     }
61688ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
61788ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
61888ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
61988ebb749SStefano Zampini     ierr = MatConvert(TM1,MATSEQDENSE,MAT_REUSE_MATRIX,&TM1);CHKERRQ(ierr);
62088ebb749SStefano Zampini     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
62188ebb749SStefano Zampini     ierr = MatNorm(TM1,NORM_INFINITY,&real_value);CHKERRQ(ierr);
62225084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"----------------------------------\n");CHKERRQ(ierr);
62325084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d \n",PetscGlobalRank);CHKERRQ(ierr);
62425084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"matrix error = % 1.14e\n",real_value);CHKERRQ(ierr);
62525084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (phi) errors\n");CHKERRQ(ierr);
62688ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
62725084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,coarsefunctions_errors[i]);CHKERRQ(ierr);
62888ebb749SStefano Zampini     }
62925084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (phi) errors\n");CHKERRQ(ierr);
63088ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
63125084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,constraints_errors[i]);CHKERRQ(ierr);
63288ebb749SStefano Zampini     }
63388ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
63425084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (psi) errors\n");CHKERRQ(ierr);
63588ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
63625084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,coarsefunctions_errors[i]);CHKERRQ(ierr);
63788ebb749SStefano Zampini       }
63825084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (psi) errors\n");CHKERRQ(ierr);
63988ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
64025084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,constraints_errors[i]);CHKERRQ(ierr);
64188ebb749SStefano Zampini       }
64288ebb749SStefano Zampini     }
64325084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
64488ebb749SStefano Zampini     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
64588ebb749SStefano Zampini     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
64688ebb749SStefano Zampini     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
64788ebb749SStefano Zampini     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
64888ebb749SStefano Zampini     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
64988ebb749SStefano Zampini     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
65088ebb749SStefano Zampini     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
65188ebb749SStefano Zampini     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
65288ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
65388ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
65488ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
65588ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
65688ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
65788ebb749SStefano Zampini     }
65888ebb749SStefano Zampini     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
6598ce42a96SStefano Zampini     ierr = ISRestoreIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
66088ebb749SStefano Zampini     ierr = PetscFree(coarsefunctions_errors);CHKERRQ(ierr);
66188ebb749SStefano Zampini     ierr = PetscFree(constraints_errors);CHKERRQ(ierr);
66288ebb749SStefano Zampini   }
66388ebb749SStefano Zampini   /* free memory */
66488ebb749SStefano Zampini   if (n_vertices) {
66588ebb749SStefano Zampini     ierr = PetscFree(vertices);CHKERRQ(ierr);
66688ebb749SStefano Zampini     ierr = VecDestroy(&vec1_V);CHKERRQ(ierr);
66788ebb749SStefano Zampini     ierr = VecDestroy(&vec2_V);CHKERRQ(ierr);
66888ebb749SStefano Zampini     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
66988ebb749SStefano Zampini     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
67088ebb749SStefano Zampini     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
67188ebb749SStefano Zampini   }
67288ebb749SStefano Zampini   if (n_constraints) {
67388ebb749SStefano Zampini     ierr = VecDestroy(&vec1_C);CHKERRQ(ierr);
67488ebb749SStefano Zampini     ierr = VecDestroy(&vec2_C);CHKERRQ(ierr);
67588ebb749SStefano Zampini     ierr = MatDestroy(&M1);CHKERRQ(ierr);
67688ebb749SStefano Zampini     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
67788ebb749SStefano Zampini   }
67888ebb749SStefano Zampini   ierr = PetscFree(auxindices);CHKERRQ(ierr);
6798629588bSStefano Zampini   /* get back data */
6808629588bSStefano Zampini   *coarse_submat_vals_n = coarse_submat_vals;
68188ebb749SStefano Zampini   PetscFunctionReturn(0);
68288ebb749SStefano Zampini }
68388ebb749SStefano Zampini 
68488ebb749SStefano Zampini #undef __FUNCT__
685aa0d41d4SStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalMatrices"
686aa0d41d4SStefano Zampini PetscErrorCode PCBDDCSetUpLocalMatrices(PC pc)
687aa0d41d4SStefano Zampini {
688aa0d41d4SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
689aa0d41d4SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
690aa0d41d4SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
6919577ea80SStefano Zampini   PetscBool         issbaij,isbaij;
692aa0d41d4SStefano Zampini   /* manage repeated solves */
693aa0d41d4SStefano Zampini   MatReuse          reuse;
694aa0d41d4SStefano Zampini   MatStructure      matstruct;
695aa0d41d4SStefano Zampini   PetscErrorCode    ierr;
696aa0d41d4SStefano Zampini 
697aa0d41d4SStefano Zampini   PetscFunctionBegin;
698aa0d41d4SStefano Zampini   /* get mat flags */
699aa0d41d4SStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
700aa0d41d4SStefano Zampini   reuse = MAT_INITIAL_MATRIX;
701aa0d41d4SStefano Zampini   if (pc->setupcalled) {
702aa0d41d4SStefano Zampini     /* when matstruct is SAME_PRECONDITIONER, we shouldn't be here */
703aa0d41d4SStefano Zampini     if (matstruct == SAME_PRECONDITIONER) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen");
704aa0d41d4SStefano Zampini     if (matstruct == SAME_NONZERO_PATTERN) {
705aa0d41d4SStefano Zampini       reuse = MAT_REUSE_MATRIX;
706aa0d41d4SStefano Zampini     } else {
707aa0d41d4SStefano Zampini       reuse = MAT_INITIAL_MATRIX;
708aa0d41d4SStefano Zampini     }
709aa0d41d4SStefano Zampini   }
710aa0d41d4SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
711aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
712aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
713aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
714aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BB);CHKERRQ(ierr);
715aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
716aa0d41d4SStefano Zampini   }
717aa0d41d4SStefano Zampini 
718aa0d41d4SStefano Zampini   /* transform local matrices if needed */
719aa0d41d4SStefano Zampini   if (pcbddc->use_change_of_basis) {
720aa0d41d4SStefano Zampini     Mat         change_mat_all;
721aa0d41d4SStefano Zampini     PetscScalar *row_cmat_values;
722aa0d41d4SStefano Zampini     PetscInt    *row_cmat_indices;
723aa0d41d4SStefano Zampini     PetscInt    *nnz,*is_indices,*temp_indices;
724aa0d41d4SStefano Zampini     PetscInt    i,j,k,n_D,n_B;
725aa0d41d4SStefano Zampini 
726aa0d41d4SStefano Zampini     /* Get Non-overlapping dimensions */
727aa0d41d4SStefano Zampini     n_B = pcis->n_B;
728aa0d41d4SStefano Zampini     n_D = pcis->n-n_B;
729aa0d41d4SStefano Zampini 
730aa0d41d4SStefano Zampini     /* compute nonzero structure of change of basis on all local nodes */
731aa0d41d4SStefano Zampini     ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
732aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
733aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) nnz[is_indices[i]] = 1;
734aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
735aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
736aa0d41d4SStefano Zampini     k=1;
737aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
738aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
739aa0d41d4SStefano Zampini       nnz[is_indices[i]]=j;
740aa0d41d4SStefano Zampini       if (k < j) k = j;
741aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
742aa0d41d4SStefano Zampini     }
743aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
744aa0d41d4SStefano Zampini     /* assemble change of basis matrix on the whole set of local dofs */
745aa0d41d4SStefano Zampini     ierr = PetscMalloc(k*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
746aa0d41d4SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&change_mat_all);CHKERRQ(ierr);
747aa0d41d4SStefano Zampini     ierr = MatSetSizes(change_mat_all,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
748aa0d41d4SStefano Zampini     ierr = MatSetType(change_mat_all,MATSEQAIJ);CHKERRQ(ierr);
749aa0d41d4SStefano Zampini     ierr = MatSeqAIJSetPreallocation(change_mat_all,0,nnz);CHKERRQ(ierr);
750aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
751aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) {
752aa0d41d4SStefano Zampini       ierr = MatSetValue(change_mat_all,is_indices[i],is_indices[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
753aa0d41d4SStefano Zampini     }
754aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
755aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
756aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
757aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
758aa0d41d4SStefano Zampini       for (k=0; k<j; k++) temp_indices[k]=is_indices[row_cmat_indices[k]];
759aa0d41d4SStefano Zampini       ierr = MatSetValues(change_mat_all,1,&is_indices[i],j,temp_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
760aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
761aa0d41d4SStefano Zampini     }
762aa0d41d4SStefano Zampini     ierr = MatAssemblyBegin(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
763aa0d41d4SStefano Zampini     ierr = MatAssemblyEnd(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7649577ea80SStefano Zampini     /* TODO: HOW TO WORK WITH BAIJ and SBAIJ? PtAP not provided */
7659577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
7669577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQBAIJ,&isbaij);CHKERRQ(ierr);
7679577ea80SStefano Zampini     if (!issbaij && !isbaij) {
768aa0d41d4SStefano Zampini       ierr = MatPtAP(matis->A,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
769aa0d41d4SStefano Zampini     } else {
770aa0d41d4SStefano Zampini       Mat work_mat;
771aa0d41d4SStefano Zampini       ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
772aa0d41d4SStefano Zampini       ierr = MatPtAP(work_mat,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
773aa0d41d4SStefano Zampini       ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
774aa0d41d4SStefano Zampini     }
775aa0d41d4SStefano Zampini     ierr = MatDestroy(&change_mat_all);CHKERRQ(ierr);
776aa0d41d4SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
777aa0d41d4SStefano Zampini     ierr = PetscFree(temp_indices);CHKERRQ(ierr);
778aa0d41d4SStefano Zampini   } else {
779aa0d41d4SStefano Zampini     /* without change of basis, the local matrix is unchanged */
780aa0d41d4SStefano Zampini     if (!pcbddc->local_mat) {
781aa0d41d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)matis->A);CHKERRQ(ierr);
782aa0d41d4SStefano Zampini       pcbddc->local_mat = matis->A;
783aa0d41d4SStefano Zampini     }
784aa0d41d4SStefano Zampini   }
785aa0d41d4SStefano Zampini 
786aa0d41d4SStefano Zampini   /* get submatrices */
787aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_I_local,reuse,&pcis->A_II);CHKERRQ(ierr);
7889577ea80SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_B_local,reuse,&pcis->A_BB);CHKERRQ(ierr);
7899577ea80SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
7909577ea80SStefano Zampini   if (!issbaij) {
791aa0d41d4SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
792aa0d41d4SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
7939577ea80SStefano Zampini   } else {
7949577ea80SStefano Zampini     Mat newmat;
7959577ea80SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
7969577ea80SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
7979577ea80SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
7989577ea80SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
7999577ea80SStefano Zampini   }
800aa0d41d4SStefano Zampini   PetscFunctionReturn(0);
801aa0d41d4SStefano Zampini }
802aa0d41d4SStefano Zampini 
803aa0d41d4SStefano Zampini #undef __FUNCT__
804a64d13efSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalScatters"
8058ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
806a64d13efSStefano Zampini {
807a64d13efSStefano Zampini   PC_IS*         pcis = (PC_IS*)(pc->data);
808a64d13efSStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8098ce42a96SStefano Zampini   IS             is_aux1,is_aux2;
810a64d13efSStefano Zampini   PetscInt       *vertices,*aux_array1,*aux_array2,*is_indices,*idx_R_local;
811*3a50541eSStefano Zampini   PetscInt       n_vertices,i,j,n_R,n_D,n_B;
812*3a50541eSStefano Zampini   PetscInt       vbs,bs;
8134641a718SStefano Zampini   PetscBT        bitmask;
814a64d13efSStefano Zampini   PetscErrorCode ierr;
815a64d13efSStefano Zampini 
816a64d13efSStefano Zampini   PetscFunctionBegin;
817a64d13efSStefano Zampini   /* Set Non-overlapping dimensions */
818a64d13efSStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
819a64d13efSStefano Zampini   /* get vertex indices from constraint matrix */
820a64d13efSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
821*3a50541eSStefano Zampini 
8224641a718SStefano Zampini   /* create auxiliary bitmask */
8234641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
8244641a718SStefano Zampini   for (i=0;i<n_vertices;i++) {
8254641a718SStefano Zampini     ierr = PetscBTSet(bitmask,vertices[i]);CHKERRQ(ierr);
8264641a718SStefano Zampini   }
827*3a50541eSStefano Zampini 
828a64d13efSStefano Zampini   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
829a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n-n_vertices)*sizeof(PetscInt),&idx_R_local);CHKERRQ(ierr);
830a64d13efSStefano Zampini   for (i=0, n_R=0; i<pcis->n; i++) {
8314641a718SStefano Zampini     if (!PetscBTLookup(bitmask,i)) {
832a64d13efSStefano Zampini       idx_R_local[n_R] = i;
833a64d13efSStefano Zampini       n_R++;
834a64d13efSStefano Zampini     }
835a64d13efSStefano Zampini   }
836*3a50541eSStefano Zampini 
837*3a50541eSStefano Zampini   /* Block code */
838*3a50541eSStefano Zampini   vbs = 1;
839*3a50541eSStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
840*3a50541eSStefano Zampini   if (bs>1 && !(n_vertices%bs)) {
841*3a50541eSStefano Zampini     PetscBool is_blocked = PETSC_TRUE;
842*3a50541eSStefano Zampini     PetscInt  *vary;
843*3a50541eSStefano Zampini     /* Verify if the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
844*3a50541eSStefano Zampini     ierr = PetscMalloc(pcis->n/bs*sizeof(PetscInt),&vary);CHKERRQ(ierr);
845*3a50541eSStefano Zampini     ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
846*3a50541eSStefano Zampini     for (i=0; i<n_vertices; i++) vary[vertices[i]/bs]++;
847*3a50541eSStefano Zampini     for (i=0; i<n_vertices; i++) {
848*3a50541eSStefano Zampini       if (vary[i]!=0 && vary[i]!=bs) {
849*3a50541eSStefano Zampini         is_blocked = PETSC_FALSE;
850*3a50541eSStefano Zampini         break;
851*3a50541eSStefano Zampini       }
852*3a50541eSStefano Zampini     }
853*3a50541eSStefano Zampini     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
854*3a50541eSStefano Zampini       vbs = bs;
855*3a50541eSStefano Zampini       for (i=0;i<n_R/vbs;i++) {
856*3a50541eSStefano Zampini         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
857*3a50541eSStefano Zampini       }
858*3a50541eSStefano Zampini     }
859*3a50541eSStefano Zampini     ierr = PetscFree(vary);CHKERRQ(ierr);
860*3a50541eSStefano Zampini   }
861a64d13efSStefano Zampini   ierr = PetscFree(vertices);CHKERRQ(ierr);
862*3a50541eSStefano Zampini   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
863*3a50541eSStefano Zampini   ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
864a64d13efSStefano Zampini 
865a64d13efSStefano Zampini   /* print some info if requested */
866a64d13efSStefano Zampini   if (pcbddc->dbg_flag) {
867a64d13efSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
868a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
869a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
870a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
871*3a50541eSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"r_size = %d, v_size = %d, constraints = %d, local_primal_size = %d\n",n_R,n_vertices,pcbddc->local_primal_size-n_vertices,pcbddc->local_primal_size);CHKERRQ(ierr);
872a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr);
873a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
874a64d13efSStefano Zampini   }
875a64d13efSStefano Zampini 
876a64d13efSStefano Zampini   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
877*3a50541eSStefano Zampini   ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
878a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
879a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array2);CHKERRQ(ierr);
880a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
8814641a718SStefano Zampini   for (i=0; i<n_D; i++) {
8824641a718SStefano Zampini     ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
8834641a718SStefano Zampini   }
884a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
885a64d13efSStefano Zampini   for (i=0, j=0; i<n_R; i++) {
8864641a718SStefano Zampini     if (!PetscBTLookup(bitmask,idx_R_local[i])) {
8874641a718SStefano Zampini       aux_array1[j++] = i;
888a64d13efSStefano Zampini     }
889a64d13efSStefano Zampini   }
890a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
891a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
892a64d13efSStefano Zampini   for (i=0, j=0; i<n_B; i++) {
8934641a718SStefano Zampini     if (!PetscBTLookup(bitmask,is_indices[i])) {
8944641a718SStefano Zampini       aux_array2[j++] = i;
895a64d13efSStefano Zampini     }
896a64d13efSStefano Zampini   }
897a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
898a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
899a64d13efSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
900a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
901a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
902a64d13efSStefano Zampini 
9038eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
904a64d13efSStefano Zampini     ierr = PetscMalloc(n_D*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
905a64d13efSStefano Zampini     for (i=0, j=0; i<n_R; i++) {
9064641a718SStefano Zampini       if (PetscBTLookup(bitmask,idx_R_local[i])) {
9074641a718SStefano Zampini         aux_array1[j++] = i;
908a64d13efSStefano Zampini       }
909a64d13efSStefano Zampini     }
910a64d13efSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
911a64d13efSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
912a64d13efSStefano Zampini     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
913a64d13efSStefano Zampini   }
9144641a718SStefano Zampini   ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
915*3a50541eSStefano Zampini   ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
916a64d13efSStefano Zampini   PetscFunctionReturn(0);
917a64d13efSStefano Zampini }
918a64d13efSStefano Zampini 
919304d26faSStefano Zampini 
920304d26faSStefano Zampini #undef __FUNCT__
921304d26faSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
9228ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc)
923304d26faSStefano Zampini {
924304d26faSStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
925304d26faSStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
926304d26faSStefano Zampini   PC             pc_temp;
927304d26faSStefano Zampini   Mat            A_RR;
928304d26faSStefano Zampini   Vec            vec1,vec2,vec3;
929304d26faSStefano Zampini   MatStructure   matstruct;
930304d26faSStefano Zampini   PetscScalar    m_one = -1.0;
931304d26faSStefano Zampini   PetscReal      value;
932af732b37SStefano Zampini   PetscInt       n_D,n_R,ibs,mbs;
9339577ea80SStefano Zampini   PetscBool      use_exact,use_exact_reduced,issbaij;
934304d26faSStefano Zampini   PetscErrorCode ierr;
935e604994aSStefano Zampini   /* prefixes stuff */
936e604994aSStefano Zampini   char           dir_prefix[256],neu_prefix[256],str_level[3];
937e604994aSStefano Zampini   size_t         len;
938304d26faSStefano Zampini 
939304d26faSStefano Zampini   PetscFunctionBegin;
940304d26faSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
941304d26faSStefano Zampini 
942e604994aSStefano Zampini   /* compute prefixes */
943e604994aSStefano Zampini   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
944e604994aSStefano Zampini   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
945e604994aSStefano Zampini   if (!pcbddc->current_level) {
946e604994aSStefano Zampini     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
947e604994aSStefano Zampini     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
948e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
949e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
950e604994aSStefano Zampini   } else {
951e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
952e604994aSStefano Zampini     sprintf(str_level,"%d_",(int)(pcbddc->current_level));
953e604994aSStefano Zampini     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
954e604994aSStefano Zampini     len -= 15; /* remove "pc_bddc_coarse_" */
955e604994aSStefano Zampini     if (pcbddc->current_level>1) len -= 2; /* remove "X_" with X level number (works with 9 levels max) */
956e604994aSStefano Zampini     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
957e604994aSStefano Zampini     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
958e604994aSStefano Zampini     *(dir_prefix+len)='\0';
959e604994aSStefano Zampini     *(neu_prefix+len)='\0';
960e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
961e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
962e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
963e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
964e604994aSStefano Zampini   }
965e604994aSStefano Zampini 
966304d26faSStefano Zampini   /* DIRICHLET PROBLEM */
967ac78edfcSStefano Zampini   /* Matrix for Dirichlet problem is pcis->A_II */
9688ce42a96SStefano Zampini   ierr = ISGetSize(pcis->is_I_local,&n_D);CHKERRQ(ierr);
969304d26faSStefano Zampini   if (!pcbddc->ksp_D) { /* create object if not yet build */
970304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
971304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
972304d26faSStefano Zampini     /* default */
973304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
974e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
9759577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
976304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
9779577ea80SStefano Zampini     if (issbaij) {
9789577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
9799577ea80SStefano Zampini     } else {
980304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
9819577ea80SStefano Zampini     }
982304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
983304d26faSStefano Zampini   }
984304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II,matstruct);CHKERRQ(ierr);
985304d26faSStefano Zampini   /* Allow user's customization */
986304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
987304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
988304d26faSStefano Zampini   if (!n_D) {
989304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
990304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
991304d26faSStefano Zampini   }
992304d26faSStefano Zampini   /* Set Up KSP for Dirichlet problem of BDDC */
993304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
994304d26faSStefano Zampini   /* set ksp_D into pcis data */
995304d26faSStefano Zampini   ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
996304d26faSStefano Zampini   ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
997304d26faSStefano Zampini   pcis->ksp_D = pcbddc->ksp_D;
998304d26faSStefano Zampini 
999304d26faSStefano Zampini   /* NEUMANN PROBLEM */
1000304d26faSStefano Zampini   /* Matrix for Neumann problem is A_RR -> we need to create it */
10018ce42a96SStefano Zampini   ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
1002af732b37SStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
1003af732b37SStefano Zampini   ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
1004*3a50541eSStefano Zampini   if (ibs != mbs) {
1005af732b37SStefano Zampini     Mat newmat;
1006af732b37SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
1007af732b37SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
1008af732b37SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
1009af732b37SStefano Zampini   } else {
10108ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
1011af732b37SStefano Zampini   }
1012304d26faSStefano Zampini   if (!pcbddc->ksp_R) { /* create object if not yet build */
1013304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
1014304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
1015304d26faSStefano Zampini     /* default */
1016304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
1017e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
1018304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
10199577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
10209577ea80SStefano Zampini     if (issbaij) {
10219577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
10229577ea80SStefano Zampini     } else {
1023304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
10249577ea80SStefano Zampini     }
1025304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1026304d26faSStefano Zampini   }
1027304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR,matstruct);CHKERRQ(ierr);
1028304d26faSStefano Zampini   /* Allow user's customization */
1029304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
1030304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1031304d26faSStefano Zampini   if (!n_R) {
1032304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
1033304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1034304d26faSStefano Zampini   }
1035304d26faSStefano Zampini   /* Set Up KSP for Neumann problem of BDDC */
1036304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
1037304d26faSStefano Zampini 
1038304d26faSStefano Zampini   /* check Dirichlet and Neumann solvers and adapt them if a nullspace correction is needed */
1039304d26faSStefano Zampini 
1040304d26faSStefano Zampini   /* Dirichlet */
1041304d26faSStefano Zampini   ierr = MatGetVecs(pcis->A_II,&vec1,&vec2);CHKERRQ(ierr);
1042304d26faSStefano Zampini   ierr = VecDuplicate(vec1,&vec3);CHKERRQ(ierr);
1043304d26faSStefano Zampini   ierr = VecSetRandom(vec1,NULL);CHKERRQ(ierr);
1044304d26faSStefano Zampini   ierr = MatMult(pcis->A_II,vec1,vec2);CHKERRQ(ierr);
1045304d26faSStefano Zampini   ierr = KSPSolve(pcbddc->ksp_D,vec2,vec3);CHKERRQ(ierr);
1046304d26faSStefano Zampini   ierr = VecAXPY(vec3,m_one,vec1);CHKERRQ(ierr);
1047304d26faSStefano Zampini   ierr = VecNorm(vec3,NORM_INFINITY,&value);CHKERRQ(ierr);
1048304d26faSStefano Zampini   ierr = VecDestroy(&vec1);CHKERRQ(ierr);
1049304d26faSStefano Zampini   ierr = VecDestroy(&vec2);CHKERRQ(ierr);
1050304d26faSStefano Zampini   ierr = VecDestroy(&vec3);CHKERRQ(ierr);
1051304d26faSStefano Zampini   /* need to be adapted? */
1052b8ffe317SStefano Zampini   use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1053b8ffe317SStefano Zampini   ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1054b8ffe317SStefano Zampini   ierr = PCBDDCSetUseExactDirichlet(pc,use_exact_reduced);CHKERRQ(ierr);
1055304d26faSStefano Zampini   /* print info */
1056304d26faSStefano Zampini   if (pcbddc->dbg_flag) {
1057304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1058304d26faSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
1059304d26faSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Checking solution of Dirichlet and Neumann problems\n");CHKERRQ(ierr);
1060e604994aSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Dirichlet solve (%s) = % 1.14e \n",PetscGlobalRank,((PetscObject)(pcbddc->ksp_D))->prefix,value);CHKERRQ(ierr);
1061304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1062304d26faSStefano Zampini   }
1063b8ffe317SStefano Zampini   if (pcbddc->NullSpace && !use_exact_reduced && !pcbddc->switch_static) {
10648ce42a96SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcis->is_I_local);CHKERRQ(ierr);
1065304d26faSStefano Zampini   }
1066304d26faSStefano Zampini 
1067304d26faSStefano Zampini   /* Neumann */
1068304d26faSStefano Zampini   ierr = MatGetVecs(A_RR,&vec1,&vec2);CHKERRQ(ierr);
1069304d26faSStefano Zampini   ierr = VecDuplicate(vec1,&vec3);CHKERRQ(ierr);
1070304d26faSStefano Zampini   ierr = VecSetRandom(vec1,NULL);CHKERRQ(ierr);
1071304d26faSStefano Zampini   ierr = MatMult(A_RR,vec1,vec2);CHKERRQ(ierr);
1072304d26faSStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,vec2,vec3);CHKERRQ(ierr);
1073304d26faSStefano Zampini   ierr = VecAXPY(vec3,m_one,vec1);CHKERRQ(ierr);
1074304d26faSStefano Zampini   ierr = VecNorm(vec3,NORM_INFINITY,&value);CHKERRQ(ierr);
1075304d26faSStefano Zampini   ierr = VecDestroy(&vec1);CHKERRQ(ierr);
1076304d26faSStefano Zampini   ierr = VecDestroy(&vec2);CHKERRQ(ierr);
1077304d26faSStefano Zampini   ierr = VecDestroy(&vec3);CHKERRQ(ierr);
1078304d26faSStefano Zampini   /* need to be adapted? */
1079b8ffe317SStefano Zampini   use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1080b8ffe317SStefano Zampini   ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1081304d26faSStefano Zampini   /* print info */
1082304d26faSStefano Zampini   if (pcbddc->dbg_flag) {
1083e604994aSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Neumann solve (%s) = % 1.14e \n",PetscGlobalRank,((PetscObject)(pcbddc->ksp_R))->prefix,value);CHKERRQ(ierr);
1084304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1085304d26faSStefano Zampini   }
1086b8ffe317SStefano Zampini   if (pcbddc->NullSpace && !use_exact_reduced) { /* is it the right logic? */
10878ce42a96SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcbddc->is_R_local);CHKERRQ(ierr);
1088304d26faSStefano Zampini   }
1089304d26faSStefano Zampini   /* free Neumann problem's matrix */
1090304d26faSStefano Zampini   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1091304d26faSStefano Zampini   PetscFunctionReturn(0);
1092304d26faSStefano Zampini }
1093304d26faSStefano Zampini 
1094304d26faSStefano Zampini #undef __FUNCT__
1095674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSolveSaddlePoint"
1096674ae819SStefano Zampini static PetscErrorCode  PCBDDCSolveSaddlePoint(PC pc)
1097674ae819SStefano Zampini {
1098674ae819SStefano Zampini   PetscErrorCode ierr;
1099674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1100674ae819SStefano Zampini 
1101674ae819SStefano Zampini   PetscFunctionBegin;
1102674ae819SStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
1103674ae819SStefano Zampini   if (pcbddc->local_auxmat1) {
1104674ae819SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec2_R,pcbddc->vec1_C);CHKERRQ(ierr);
1105674ae819SStefano Zampini     ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
1106674ae819SStefano Zampini   }
1107674ae819SStefano Zampini   PetscFunctionReturn(0);
1108674ae819SStefano Zampini }
1109674ae819SStefano Zampini 
1110674ae819SStefano Zampini #undef __FUNCT__
1111674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
1112674ae819SStefano Zampini PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc)
1113674ae819SStefano Zampini {
1114674ae819SStefano Zampini   PetscErrorCode ierr;
1115674ae819SStefano Zampini   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
1116674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)  (pc->data);
1117674ae819SStefano Zampini   const PetscScalar zero = 0.0;
1118674ae819SStefano Zampini 
1119674ae819SStefano Zampini   PetscFunctionBegin;
112015aaf578SStefano Zampini   /* Application of PHI^T (or PSI^T)  */
112115aaf578SStefano Zampini   if (pcbddc->coarse_psi_B) {
112215aaf578SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
11238eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
112415aaf578SStefano Zampini   } else {
1125674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
11268eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
112715aaf578SStefano Zampini   }
1128674ae819SStefano Zampini   /* Scatter data of coarse_rhs */
1129674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { ierr = VecSet(pcbddc->coarse_rhs,zero);CHKERRQ(ierr); }
1130674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1131674ae819SStefano Zampini 
1132674ae819SStefano Zampini   /* Local solution on R nodes */
1133674ae819SStefano Zampini   ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
1134674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1135674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
11368eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1137674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1138674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1139674ae819SStefano Zampini   }
1140674ae819SStefano Zampini   ierr = PCBDDCSolveSaddlePoint(pc);CHKERRQ(ierr);
1141674ae819SStefano Zampini   ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1142674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1143674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
11448eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1145674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1146674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1147674ae819SStefano Zampini   }
1148674ae819SStefano Zampini 
1149674ae819SStefano Zampini   /* Coarse solution */
1150674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1151674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { /* TODO remove null space when doing multilevel */
1152674ae819SStefano Zampini     ierr = KSPSolve(pcbddc->coarse_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
1153674ae819SStefano Zampini   }
1154674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1155674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd  (pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1156674ae819SStefano Zampini 
1157674ae819SStefano Zampini   /* Sum contributions from two levels */
1158674ae819SStefano Zampini   ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
11598eeda7d8SStefano Zampini   if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1160674ae819SStefano Zampini   PetscFunctionReturn(0);
1161674ae819SStefano Zampini }
1162674ae819SStefano Zampini 
1163674ae819SStefano Zampini #undef __FUNCT__
1164674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
1165674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1166674ae819SStefano Zampini {
1167674ae819SStefano Zampini   PetscErrorCode ierr;
1168674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1169674ae819SStefano Zampini 
1170674ae819SStefano Zampini   PetscFunctionBegin;
1171674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1172674ae819SStefano Zampini   PetscFunctionReturn(0);
1173674ae819SStefano Zampini }
1174674ae819SStefano Zampini 
1175674ae819SStefano Zampini #undef __FUNCT__
1176674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
1177674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1178674ae819SStefano Zampini {
1179674ae819SStefano Zampini   PetscErrorCode ierr;
1180674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1181674ae819SStefano Zampini 
1182674ae819SStefano Zampini   PetscFunctionBegin;
1183674ae819SStefano Zampini   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1184674ae819SStefano Zampini   PetscFunctionReturn(0);
1185674ae819SStefano Zampini }
1186674ae819SStefano Zampini 
1187984c4197SStefano Zampini /* uncomment for testing purposes */
1188984c4197SStefano Zampini /* #define PETSC_MISSING_LAPACK_GESVD 1 */
1189674ae819SStefano Zampini #undef __FUNCT__
1190674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp"
1191674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
1192674ae819SStefano Zampini {
1193674ae819SStefano Zampini   PetscErrorCode    ierr;
1194674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
1195674ae819SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
1196674ae819SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
1197984c4197SStefano Zampini   /* constraint and (optionally) change of basis matrix implemented as SeqAIJ */
1198674ae819SStefano Zampini   MatType           impMatType=MATSEQAIJ;
1199984c4197SStefano Zampini   /* one and zero */
1200984c4197SStefano Zampini   PetscScalar       one=1.0,zero=0.0;
1201984c4197SStefano Zampini   /* space to store constraints and their local indices */
1202984c4197SStefano Zampini   PetscScalar       *temp_quadrature_constraint;
1203984c4197SStefano Zampini   PetscInt          *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B;
1204984c4197SStefano Zampini   /* iterators */
1205984c4197SStefano Zampini   PetscInt          i,j,k,total_counts,temp_start_ptr;
1206984c4197SStefano Zampini   /* stuff to store connected components stored in pcbddc->mat_graph */
1207984c4197SStefano Zampini   IS                ISForVertices,*ISForFaces,*ISForEdges,*used_IS;
1208984c4197SStefano Zampini   PetscInt          n_ISForFaces,n_ISForEdges;
1209984c4197SStefano Zampini   /* near null space stuff */
1210674ae819SStefano Zampini   MatNullSpace      nearnullsp;
1211674ae819SStefano Zampini   const Vec         *nearnullvecs;
1212674ae819SStefano Zampini   Vec               *localnearnullsp;
1213984c4197SStefano Zampini   PetscBool         nnsp_has_cnst;
1214984c4197SStefano Zampini   PetscInt          nnsp_size;
1215984c4197SStefano Zampini   PetscScalar       *array;
1216984c4197SStefano Zampini   /* BLAS integers */
1217e310c8b4SStefano Zampini   PetscBLASInt      lwork,lierr;
1218e310c8b4SStefano Zampini   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
1219c4303822SStefano Zampini   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
1220984c4197SStefano Zampini   /* LAPACK working arrays for SVD or POD */
1221242a89d7SStefano Zampini   PetscBool         skip_lapack;
1222984c4197SStefano Zampini   PetscScalar       *work;
1223984c4197SStefano Zampini   PetscReal         *singular_vals;
1224984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1225984c4197SStefano Zampini   PetscReal         *rwork;
1226674ae819SStefano Zampini #endif
1227984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1228e310c8b4SStefano Zampini   PetscBLASInt      Blas_one_2=1;
1229984c4197SStefano Zampini   PetscScalar       *temp_basis,*correlation_mat;
1230b7d8b9f8SStefano Zampini #else
1231b7d8b9f8SStefano Zampini   PetscBLASInt      dummy_int_1=1,dummy_int_2=1;
1232b7d8b9f8SStefano Zampini   PetscScalar       dummy_scalar_1=0.0,dummy_scalar_2=0.0;
1233984c4197SStefano Zampini #endif
1234984c4197SStefano Zampini   /* change of basis */
1235984c4197SStefano Zampini   PetscInt          *aux_primal_numbering,*aux_primal_minloc,*global_indices;
1236a717540cSStefano Zampini   PetscBool         boolforchange,qr_needed;
1237a717540cSStefano Zampini   PetscBT           touched,change_basis,qr_needed_idx;
1238984c4197SStefano Zampini   /* auxiliary stuff */
1239984c4197SStefano Zampini   PetscInt          *nnz,*is_indices,*local_to_B;
1240984c4197SStefano Zampini   /* some quantities */
1241984c4197SStefano Zampini   PetscInt          n_vertices,total_primal_vertices;
1242984c4197SStefano Zampini   PetscInt          size_of_constraint,max_size_of_constraint,max_constraints,temp_constraints;
1243984c4197SStefano Zampini 
1244674ae819SStefano Zampini 
1245674ae819SStefano Zampini   PetscFunctionBegin;
1246674ae819SStefano Zampini   /* Get index sets for faces, edges and vertices from graph */
12478eeda7d8SStefano Zampini   if (!pcbddc->use_faces && !pcbddc->use_edges && !pcbddc->use_vertices) {
12488eeda7d8SStefano Zampini     pcbddc->use_vertices = PETSC_TRUE;
1249674ae819SStefano Zampini   }
12508eeda7d8SStefano Zampini   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,pcbddc->use_faces,pcbddc->use_edges,pcbddc->use_vertices,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);
1251b8ffe317SStefano Zampini   /* HACK: provide functions to set change of basis */
1252b8ffe317SStefano Zampini   if (!ISForVertices && pcbddc->NullSpace) {
1253b8ffe317SStefano Zampini     pcbddc->use_change_of_basis = PETSC_TRUE;
1254b8ffe317SStefano Zampini     pcbddc->use_change_on_faces = PETSC_FALSE;
1255b8ffe317SStefano Zampini   }
1256984c4197SStefano Zampini   /* print some info */
1257674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
1258674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1259674ae819SStefano Zampini     i = 0;
1260674ae819SStefano Zampini     if (ISForVertices) {
1261674ae819SStefano Zampini       ierr = ISGetSize(ISForVertices,&i);CHKERRQ(ierr);
1262674ae819SStefano Zampini     }
1263674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices\n",PetscGlobalRank,i);CHKERRQ(ierr);
1264674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges\n",PetscGlobalRank,n_ISForEdges);CHKERRQ(ierr);
126515aaf578SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces\n",PetscGlobalRank,n_ISForFaces);CHKERRQ(ierr);
1266674ae819SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1267674ae819SStefano Zampini   }
1268674ae819SStefano Zampini   /* check if near null space is attached to global mat */
1269674ae819SStefano Zampini   ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
1270674ae819SStefano Zampini   if (nearnullsp) {
1271674ae819SStefano Zampini     ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
1272984c4197SStefano Zampini   } else { /* if near null space is not provided BDDC uses constants by default */
1273984c4197SStefano Zampini     nnsp_size = 0;
1274674ae819SStefano Zampini     nnsp_has_cnst = PETSC_TRUE;
1275674ae819SStefano Zampini   }
1276984c4197SStefano Zampini   /* get max number of constraints on a single cc */
1277984c4197SStefano Zampini   max_constraints = nnsp_size;
1278984c4197SStefano Zampini   if (nnsp_has_cnst) max_constraints++;
1279984c4197SStefano Zampini 
1280674ae819SStefano Zampini   /*
1281674ae819SStefano Zampini        Evaluate maximum storage size needed by the procedure
1282674ae819SStefano Zampini        - temp_indices will contain start index of each constraint stored as follows
1283674ae819SStefano 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
1284674ae819SStefano 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
1285674ae819SStefano Zampini        - temp_quadrature_constraint  [temp_indices[i],...,temp[indices[i+1]-1] will contain the scalars representing the constraint itself
1286674ae819SStefano Zampini                                                                                                                                                          */
1287674ae819SStefano Zampini   total_counts = n_ISForFaces+n_ISForEdges;
1288984c4197SStefano Zampini   total_counts *= max_constraints;
1289674ae819SStefano Zampini   n_vertices = 0;
1290674ae819SStefano Zampini   if (ISForVertices) {
1291674ae819SStefano Zampini     ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
1292674ae819SStefano Zampini   }
1293674ae819SStefano Zampini   total_counts += n_vertices;
1294674ae819SStefano Zampini   ierr = PetscMalloc((total_counts+1)*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
12954641a718SStefano Zampini   ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
1296674ae819SStefano Zampini   total_counts = 0;
1297674ae819SStefano Zampini   max_size_of_constraint = 0;
1298674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1299674ae819SStefano Zampini     if (i<n_ISForEdges) {
1300674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1301674ae819SStefano Zampini     } else {
1302674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1303674ae819SStefano Zampini     }
1304674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
1305674ae819SStefano Zampini     total_counts += j;
1306674ae819SStefano Zampini     max_size_of_constraint = PetscMax(j,max_size_of_constraint);
1307674ae819SStefano Zampini   }
1308984c4197SStefano Zampini   total_counts *= max_constraints;
1309674ae819SStefano Zampini   total_counts += n_vertices;
1310674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&temp_quadrature_constraint);CHKERRQ(ierr);
1311674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint);CHKERRQ(ierr);
1312674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint_B);CHKERRQ(ierr);
1313984c4197SStefano Zampini   /* local to boundary numbering */
1314674ae819SStefano Zampini   ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&local_to_B);CHKERRQ(ierr);
1315674ae819SStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1316984c4197SStefano Zampini   for (i=0;i<pcis->n;i++) local_to_B[i]=-1;
1317984c4197SStefano Zampini   for (i=0;i<pcis->n_B;i++) local_to_B[is_indices[i]]=i;
1318674ae819SStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1319984c4197SStefano Zampini   /* get local part of global near null space vectors */
1320984c4197SStefano Zampini   ierr = PetscMalloc(nnsp_size*sizeof(Vec),&localnearnullsp);CHKERRQ(ierr);
1321984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1322984c4197SStefano Zampini     ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
1323984c4197SStefano Zampini     ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1324984c4197SStefano Zampini     ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1325984c4197SStefano Zampini   }
1326674ae819SStefano Zampini 
1327242a89d7SStefano Zampini   /* whether or not to skip lapack calls */
1328242a89d7SStefano Zampini   skip_lapack = PETSC_TRUE;
1329242a89d7SStefano Zampini   if (n_ISForFaces+n_ISForEdges) skip_lapack = PETSC_FALSE;
1330242a89d7SStefano Zampini 
1331984c4197SStefano Zampini   /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
1332242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1333674ae819SStefano Zampini     PetscScalar temp_work;
1334674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1335984c4197SStefano Zampini     /* Proper Orthogonal Decomposition (POD) using the snapshot method */
1336984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*max_constraints*sizeof(PetscScalar),&correlation_mat);CHKERRQ(ierr);
1337984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1338984c4197SStefano Zampini     ierr = PetscMalloc(max_size_of_constraint*max_constraints*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr);
1339674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1340984c4197SStefano Zampini     ierr = PetscMalloc(3*max_constraints*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1341674ae819SStefano Zampini #endif
1342674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1343c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
1344c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
1345674ae819SStefano Zampini     lwork = -1;
1346674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1347674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1348c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
1349674ae819SStefano Zampini #else
1350c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
1351674ae819SStefano Zampini #endif
1352674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1353984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
1354674ae819SStefano Zampini #else /* on missing GESVD */
1355674ae819SStefano Zampini     /* SVD */
1356674ae819SStefano Zampini     PetscInt max_n,min_n;
1357674ae819SStefano Zampini     max_n = max_size_of_constraint;
1358984c4197SStefano Zampini     min_n = max_constraints;
1359984c4197SStefano Zampini     if (max_size_of_constraint < max_constraints) {
1360674ae819SStefano Zampini       min_n = max_size_of_constraint;
1361984c4197SStefano Zampini       max_n = max_constraints;
1362674ae819SStefano Zampini     }
1363674ae819SStefano Zampini     ierr = PetscMalloc(min_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1364674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1365674ae819SStefano Zampini     ierr = PetscMalloc(5*min_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1366674ae819SStefano Zampini #endif
1367674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1368674ae819SStefano Zampini     lwork = -1;
1369e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
1370e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
1371b7d8b9f8SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
1372674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1373674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1374e310c8b4SStefano 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));
1375674ae819SStefano Zampini #else
1376e310c8b4SStefano 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));
1377674ae819SStefano Zampini #endif
1378674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1379984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
1380984c4197SStefano Zampini #endif /* on missing GESVD */
1381674ae819SStefano Zampini     /* Allocate optimal workspace */
1382674ae819SStefano Zampini     ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
1383984c4197SStefano Zampini     ierr = PetscMalloc((PetscInt)lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
1384674ae819SStefano Zampini   }
1385674ae819SStefano Zampini   /* Now we can loop on constraining sets */
1386674ae819SStefano Zampini   total_counts = 0;
1387674ae819SStefano Zampini   temp_indices[0] = 0;
1388674ae819SStefano Zampini   /* vertices */
1389674ae819SStefano Zampini   if (ISForVertices) {
1390674ae819SStefano Zampini     ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1391674ae819SStefano Zampini     if (nnsp_has_cnst) { /* consider all vertices */
1392674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1393674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1394674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
1395674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1396674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1397674ae819SStefano Zampini         total_counts++;
1398674ae819SStefano Zampini       }
1399674ae819SStefano Zampini     } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
1400984c4197SStefano Zampini       PetscBool used_vertex;
1401674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1402674ae819SStefano Zampini         used_vertex = PETSC_FALSE;
1403674ae819SStefano Zampini         k = 0;
1404674ae819SStefano Zampini         while (!used_vertex && k<nnsp_size) {
1405984c4197SStefano Zampini           ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1406984c4197SStefano Zampini           if (PetscAbsScalar(array[is_indices[i]])>0.0) {
1407674ae819SStefano Zampini             temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1408674ae819SStefano Zampini             temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
1409674ae819SStefano Zampini             temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1410674ae819SStefano Zampini             temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1411674ae819SStefano Zampini             total_counts++;
1412674ae819SStefano Zampini             used_vertex = PETSC_TRUE;
1413674ae819SStefano Zampini           }
1414984c4197SStefano Zampini           ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1415674ae819SStefano Zampini           k++;
1416674ae819SStefano Zampini         }
1417674ae819SStefano Zampini       }
1418674ae819SStefano Zampini     }
1419674ae819SStefano Zampini     ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1420674ae819SStefano Zampini     n_vertices = total_counts;
1421674ae819SStefano Zampini   }
1422984c4197SStefano Zampini 
1423674ae819SStefano Zampini   /* edges and faces */
1424674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1425674ae819SStefano Zampini     if (i<n_ISForEdges) {
1426674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1427984c4197SStefano Zampini       boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
1428674ae819SStefano Zampini     } else {
1429674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1430984c4197SStefano Zampini       boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
1431674ae819SStefano Zampini     }
1432674ae819SStefano Zampini     temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
1433674ae819SStefano Zampini     temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
1434674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
1435674ae819SStefano Zampini     ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1436984c4197SStefano Zampini     /* change of basis should not be performed on local periodic nodes */
1437984c4197SStefano Zampini     if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
1438674ae819SStefano Zampini     if (nnsp_has_cnst) {
14395b08dc53SStefano Zampini       PetscScalar quad_value;
1440674ae819SStefano Zampini       temp_constraints++;
1441674ae819SStefano Zampini       quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
1442674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1443674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
1444674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
1445674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
1446674ae819SStefano Zampini       }
1447674ae819SStefano Zampini       temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
14484641a718SStefano Zampini       if (boolforchange) {
14494641a718SStefano Zampini         ierr = PetscBTSet(change_basis,total_counts);CHKERRQ(ierr);
14504641a718SStefano Zampini       }
1451674ae819SStefano Zampini       total_counts++;
1452674ae819SStefano Zampini     }
1453674ae819SStefano Zampini     for (k=0;k<nnsp_size;k++) {
1454984c4197SStefano Zampini       PetscReal real_value;
1455984c4197SStefano Zampini       ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1456674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1457674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
1458674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
1459984c4197SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=array[is_indices[j]];
1460674ae819SStefano Zampini       }
1461984c4197SStefano Zampini       ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1462984c4197SStefano Zampini       /* check if array is null on the connected component */
1463e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1464e310c8b4SStefano Zampini       PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_one));
14655b08dc53SStefano Zampini       if (real_value > 0.0) { /* keep indices and values */
1466674ae819SStefano Zampini         temp_constraints++;
1467674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
14684641a718SStefano Zampini         if (boolforchange) {
14694641a718SStefano Zampini           ierr = PetscBTSet(change_basis,total_counts);CHKERRQ(ierr);
14704641a718SStefano Zampini         }
1471674ae819SStefano Zampini         total_counts++;
1472674ae819SStefano Zampini       }
1473674ae819SStefano Zampini     }
1474674ae819SStefano Zampini     ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1475eb97c9d2SStefano Zampini     /* perform SVD on the constraints if use_nnsp_true has not be requested by the user and there are non-null constraints on the cc */
1476eb97c9d2SStefano Zampini     if (!pcbddc->use_nnsp_true && temp_constraints) {
1477984c4197SStefano Zampini       PetscReal tol = 1.0e-8; /* tolerance for retaining eigenmodes */
1478674ae819SStefano Zampini 
1479674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1480984c4197SStefano Zampini       /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
1481984c4197SStefano Zampini          POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
1482984c4197SStefano Zampini          -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
1483984c4197SStefano Zampini             the constraints basis will differ (by a complex factor with absolute value equal to 1)
1484984c4197SStefano Zampini             from that computed using LAPACKgesvd
1485984c4197SStefano Zampini          -> This is due to a different computation of eigenvectors in LAPACKheev
1486984c4197SStefano Zampini          -> The quality of the POD-computed basis will be the same */
1487984c4197SStefano Zampini       ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
1488674ae819SStefano Zampini       /* Store upper triangular part of correlation matrix */
1489e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1490984c4197SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1491674ae819SStefano Zampini       for (j=0;j<temp_constraints;j++) {
1492674ae819SStefano Zampini         for (k=0;k<j+1;k++) {
1493e310c8b4SStefano 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));
1494674ae819SStefano Zampini         }
1495674ae819SStefano Zampini       }
1496e310c8b4SStefano Zampini       /* compute eigenvalues and eigenvectors of correlation matrix */
1497e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1498e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
1499674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1500c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
1501674ae819SStefano Zampini #else
1502c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
1503674ae819SStefano Zampini #endif
1504674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1505984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
1506984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
1507674ae819SStefano Zampini       j=0;
1508984c4197SStefano Zampini       while (j < temp_constraints && singular_vals[j] < tol) j++;
1509674ae819SStefano Zampini       total_counts=total_counts-j;
1510e310c8b4SStefano Zampini       /* scale and copy POD basis into used quadrature memory */
1511c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1512c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1513c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
1514c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1515c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
1516c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1517674ae819SStefano Zampini       if (j<temp_constraints) {
1518984c4197SStefano Zampini         PetscInt ii;
1519984c4197SStefano Zampini         for (k=j;k<temp_constraints;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]);
1520674ae819SStefano Zampini         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1521c4303822SStefano 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));
1522674ae819SStefano Zampini         ierr = PetscFPTrapPop();CHKERRQ(ierr);
1523984c4197SStefano Zampini         for (k=0;k<temp_constraints-j;k++) {
1524674ae819SStefano Zampini           for (ii=0;ii<size_of_constraint;ii++) {
1525984c4197SStefano 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];
1526674ae819SStefano Zampini           }
1527674ae819SStefano Zampini         }
1528674ae819SStefano Zampini       }
1529674ae819SStefano Zampini #else  /* on missing GESVD */
1530e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1531e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1532b7d8b9f8SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1533674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1534674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1535e310c8b4SStefano 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));
1536674ae819SStefano Zampini #else
1537e310c8b4SStefano 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));
1538674ae819SStefano Zampini #endif
1539984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
1540674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1541984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
1542e310c8b4SStefano Zampini       k = temp_constraints;
1543e310c8b4SStefano Zampini       if (k > size_of_constraint) k = size_of_constraint;
1544674ae819SStefano Zampini       j = 0;
1545e310c8b4SStefano Zampini       while (j < k && singular_vals[k-j-1] < tol) j++;
1546e310c8b4SStefano Zampini       total_counts = total_counts-temp_constraints+k-j;
1547984c4197SStefano Zampini #endif /* on missing GESVD */
1548674ae819SStefano Zampini     }
1549674ae819SStefano Zampini   }
1550674ae819SStefano Zampini   /* free index sets of faces, edges and vertices */
1551674ae819SStefano Zampini   for (i=0;i<n_ISForFaces;i++) {
1552674ae819SStefano Zampini     ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
1553674ae819SStefano Zampini   }
1554674ae819SStefano Zampini   ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
1555674ae819SStefano Zampini   for (i=0;i<n_ISForEdges;i++) {
1556674ae819SStefano Zampini     ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
1557674ae819SStefano Zampini   }
1558674ae819SStefano Zampini   ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
1559674ae819SStefano Zampini   ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
1560674ae819SStefano Zampini 
1561984c4197SStefano Zampini   /* free workspace */
1562242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1563984c4197SStefano Zampini     ierr = PetscFree(work);CHKERRQ(ierr);
1564984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1565984c4197SStefano Zampini     ierr = PetscFree(rwork);CHKERRQ(ierr);
1566984c4197SStefano Zampini #endif
1567984c4197SStefano Zampini     ierr = PetscFree(singular_vals);CHKERRQ(ierr);
1568984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1569984c4197SStefano Zampini     ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
1570984c4197SStefano Zampini     ierr = PetscFree(temp_basis);CHKERRQ(ierr);
1571984c4197SStefano Zampini #endif
1572984c4197SStefano Zampini   }
1573984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1574984c4197SStefano Zampini     ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
1575984c4197SStefano Zampini   }
1576984c4197SStefano Zampini   ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
1577984c4197SStefano Zampini 
1578674ae819SStefano Zampini   /* set quantities in pcbddc data structure */
1579984c4197SStefano Zampini   /* n_vertices defines the number of subdomain corners in the primal space */
1580674ae819SStefano Zampini   /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */
1581984c4197SStefano Zampini   pcbddc->local_primal_size = total_counts;
1582674ae819SStefano Zampini   pcbddc->n_vertices = n_vertices;
1583984c4197SStefano Zampini   pcbddc->n_constraints = pcbddc->local_primal_size-pcbddc->n_vertices;
1584674ae819SStefano Zampini 
1585674ae819SStefano Zampini   /* Create constraint matrix */
1586674ae819SStefano Zampini   /* The constraint matrix is used to compute the l2g map of primal dofs */
1587674ae819SStefano Zampini   /* so we need to set it up properly either with or without change of basis */
1588674ae819SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1589674ae819SStefano Zampini   ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr);
1590984c4197SStefano Zampini   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
1591984c4197SStefano Zampini   /* array to compute a local numbering of constraints : vertices first then constraints */
1592984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_numbering);CHKERRQ(ierr);
1593984c4197SStefano Zampini   /* array to select the proper local node (of minimum index with respect to global ordering) when changing the basis */
1594984c4197SStefano 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 */
1595984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_minloc);CHKERRQ(ierr);
1596984c4197SStefano Zampini   /* auxiliary stuff for basis change */
1597984c4197SStefano Zampini   ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&global_indices);CHKERRQ(ierr);
15984641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n_B,&touched);CHKERRQ(ierr);
1599984c4197SStefano Zampini 
1600984c4197SStefano Zampini   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
1601984c4197SStefano Zampini   total_primal_vertices=0;
1602984c4197SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
1603674ae819SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
1604984c4197SStefano Zampini     if (size_of_constraint == 1) {
16054641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]]);CHKERRQ(ierr);
1606984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]];
1607984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=0;
1608984c4197SStefano Zampini       total_primal_vertices++;
16094641a718SStefano Zampini     } else if (PetscBTLookup(change_basis,i)) { /* Same procedure used in PCBDDCGetPrimalConstraintsLocalIdx */
1610984c4197SStefano Zampini       PetscInt min_loc,min_index;
1611984c4197SStefano Zampini       ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],global_indices);CHKERRQ(ierr);
1612984c4197SStefano Zampini       /* find first untouched local node */
1613674ae819SStefano Zampini       k = 0;
16144641a718SStefano Zampini       while (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) k++;
1615984c4197SStefano Zampini       min_index = global_indices[k];
1616984c4197SStefano Zampini       min_loc = k;
1617984c4197SStefano Zampini       /* search the minimum among global nodes already untouched on the cc */
1618984c4197SStefano Zampini       for (k=1;k<size_of_constraint;k++) {
1619984c4197SStefano Zampini         /* there can be more than one constraint on a single connected component */
16204641a718SStefano Zampini         if (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k]) && min_index > global_indices[k]) {
1621984c4197SStefano Zampini           min_index = global_indices[k];
1622984c4197SStefano Zampini           min_loc = k;
1623674ae819SStefano Zampini         }
1624674ae819SStefano Zampini       }
16254641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]+min_loc]);CHKERRQ(ierr);
1626984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]+min_loc];
1627984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=min_loc;
1628984c4197SStefano Zampini       total_primal_vertices++;
1629984c4197SStefano Zampini     }
1630984c4197SStefano Zampini   }
1631a717540cSStefano Zampini   /* determine if a QR strategy is needed for change of basis */
1632a717540cSStefano Zampini   qr_needed = PETSC_FALSE;
1633a717540cSStefano Zampini   ierr = PetscBTCreate(pcbddc->local_primal_size,&qr_needed_idx);CHKERRQ(ierr);
1634a717540cSStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1635a717540cSStefano Zampini     if (PetscBTLookup(change_basis,i)) {
1636a717540cSStefano Zampini       size_of_constraint = temp_indices[i+1]-temp_indices[i];
1637a717540cSStefano Zampini       j = 0;
1638a717540cSStefano Zampini       for (k=0;k<size_of_constraint;k++) {
1639a717540cSStefano Zampini         if (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) {
1640a717540cSStefano Zampini           j++;
1641a717540cSStefano Zampini         }
1642a717540cSStefano Zampini       }
1643a717540cSStefano Zampini       /* found more than one primal dof on the cc */
1644a717540cSStefano Zampini       if (j > 1) {
1645a717540cSStefano Zampini         PetscBTSet(qr_needed_idx,i);
1646a717540cSStefano Zampini         qr_needed = PETSC_TRUE;
1647a717540cSStefano Zampini       }
1648a717540cSStefano Zampini     }
1649a717540cSStefano Zampini   }
1650984c4197SStefano Zampini   /* free workspace */
1651984c4197SStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
1652674ae819SStefano Zampini   /* permute indices in order to have a sorted set of vertices */
1653a717540cSStefano Zampini   ierr = PetscSortInt(total_primal_vertices,aux_primal_numbering);CHKERRQ(ierr);
1654984c4197SStefano Zampini 
1655984c4197SStefano Zampini   /* nonzero structure of constraint matrix */
1656984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1657984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) nnz[i]=1;
1658984c4197SStefano Zampini   j=total_primal_vertices;
1659984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
16604641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1661674ae819SStefano Zampini       nnz[j]=temp_indices[i+1]-temp_indices[i];
1662674ae819SStefano Zampini       j++;
1663674ae819SStefano Zampini     }
1664674ae819SStefano Zampini   }
1665674ae819SStefano Zampini   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
1666674ae819SStefano Zampini   ierr = PetscFree(nnz);CHKERRQ(ierr);
1667674ae819SStefano Zampini   /* set values in constraint matrix */
1668984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) {
1669984c4197SStefano Zampini     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,aux_primal_numbering[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
1670674ae819SStefano Zampini   }
1671984c4197SStefano Zampini   total_counts = total_primal_vertices;
1672984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
16734641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1674674ae819SStefano Zampini       size_of_constraint=temp_indices[i+1]-temp_indices[i];
1675674ae819SStefano 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);
1676674ae819SStefano Zampini       total_counts++;
1677674ae819SStefano Zampini     }
1678674ae819SStefano Zampini   }
1679674ae819SStefano Zampini   /* assembling */
1680674ae819SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1681674ae819SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1682984c4197SStefano Zampini   /*
1683984c4197SStefano Zampini   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
1684984c4197SStefano Zampini   */
1685674ae819SStefano Zampini   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
1686674ae819SStefano Zampini   if (pcbddc->use_change_of_basis) {
1687026de310SStefano Zampini     /* dual and primal dofs on a single cc */
1688984c4197SStefano Zampini     PetscInt     dual_dofs,primal_dofs;
1689026de310SStefano Zampini     /* iterator on aux_primal_minloc (ordered as read from nearnullspace: vertices, edges and then constraints) */
1690026de310SStefano Zampini     PetscInt     primal_counter;
1691984c4197SStefano Zampini     /* working stuff for GEQRF */
1692984c4197SStefano Zampini     PetscScalar  *qr_basis,*qr_tau,*qr_work,lqr_work_t;
1693984c4197SStefano Zampini     PetscBLASInt lqr_work;
1694984c4197SStefano Zampini     /* working stuff for UNGQR */
1695984c4197SStefano Zampini     PetscScalar  *gqr_work,lgqr_work_t;
1696984c4197SStefano Zampini     PetscBLASInt lgqr_work;
1697984c4197SStefano Zampini     /* working stuff for TRTRS */
1698984c4197SStefano Zampini     PetscScalar  *trs_rhs;
16993f08241aSStefano Zampini     PetscBLASInt Blas_NRHS;
1700984c4197SStefano Zampini     /* pointers for values insertion into change of basis matrix */
1701984c4197SStefano Zampini     PetscInt     *start_rows,*start_cols;
1702984c4197SStefano Zampini     PetscScalar  *start_vals;
1703984c4197SStefano Zampini     /* working stuff for values insertion */
17044641a718SStefano Zampini     PetscBT      is_primal;
1705984c4197SStefano Zampini 
1706a717540cSStefano Zampini     /* change of basis acts on local interfaces -> dimension is n_B x n_B */
1707a717540cSStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
1708a717540cSStefano Zampini     ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr);
1709a717540cSStefano Zampini     ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr);
1710a717540cSStefano Zampini     /* work arrays */
1711a717540cSStefano Zampini     ierr = PetscMalloc(pcis->n_B*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1712a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) nnz[i]=1;
1713a717540cSStefano Zampini     /* nonzeros per row */
1714a717540cSStefano Zampini     for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1715a717540cSStefano Zampini       if (PetscBTLookup(change_basis,i)) {
1716a717540cSStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
1717a717540cSStefano Zampini         if (PetscBTLookup(qr_needed_idx,i)) {
1718a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1719a717540cSStefano Zampini         } else {
1720a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = 2;
1721a717540cSStefano Zampini           /* get local primal index on the cc */
1722a717540cSStefano Zampini           j = 0;
1723a717540cSStefano Zampini           while (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+j])) j++;
1724a717540cSStefano Zampini           nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1725a717540cSStefano Zampini         }
1726a717540cSStefano Zampini       }
1727a717540cSStefano Zampini     }
1728a717540cSStefano Zampini     ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
1729a717540cSStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
1730a717540cSStefano Zampini     /* Set initial identity in the matrix */
1731a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) {
1732a717540cSStefano Zampini       ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
1733a717540cSStefano Zampini     }
1734a717540cSStefano Zampini 
1735a717540cSStefano Zampini     if (pcbddc->dbg_flag) {
1736a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1737a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
1738a717540cSStefano Zampini     }
1739a717540cSStefano Zampini 
1740a717540cSStefano Zampini 
1741a717540cSStefano Zampini     /* Now we loop on the constraints which need a change of basis */
1742a717540cSStefano Zampini     /*
1743a717540cSStefano Zampini        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
1744a717540cSStefano Zampini        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
1745a717540cSStefano Zampini 
1746a717540cSStefano Zampini        Basic blocks of change of basis matrix T computed
1747a717540cSStefano Zampini 
1748a717540cSStefano Zampini           - Using the following block transformation if there is only a primal dof on the cc
1749a717540cSStefano Zampini             (in the example, primal dof is the last one of the edge in LOCAL ordering
1750a717540cSStefano Zampini              in this code, primal dof is the first one of the edge in GLOBAL ordering)
1751a717540cSStefano Zampini             | 1        0   ...        0     1 |
1752a717540cSStefano Zampini             | 0        1   ...        0     1 |
1753a717540cSStefano Zampini             |              ...                |
1754a717540cSStefano Zampini             | 0        ...            1     1 |
1755a717540cSStefano Zampini             | -s_1/s_n ...    -s_{n-1}/-s_n 1 |
1756a717540cSStefano Zampini 
1757a717540cSStefano Zampini           - via QR decomposition of constraints otherwise
1758a717540cSStefano Zampini     */
1759a717540cSStefano Zampini     if (qr_needed) {
1760984c4197SStefano Zampini       /* space to store Q */
1761984c4197SStefano Zampini       ierr = PetscMalloc((max_size_of_constraint)*(max_size_of_constraint)*sizeof(PetscScalar),&qr_basis);CHKERRQ(ierr);
1762984c4197SStefano Zampini       /* first we issue queries for optimal work */
17633f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
17643f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
17653f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1766984c4197SStefano Zampini       lqr_work = -1;
17673f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
1768984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
1769984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
1770984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lqr_work_t)*sizeof(*qr_work),&qr_work);CHKERRQ(ierr);
1771984c4197SStefano Zampini       lgqr_work = -1;
17723f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
17733f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
17743f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
17753f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
17763f08241aSStefano Zampini       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
17773f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
1778984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
1779984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
1780984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lgqr_work_t)*sizeof(*gqr_work),&gqr_work);CHKERRQ(ierr);
1781984c4197SStefano Zampini       /* array to store scaling factors for reflectors */
1782984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*sizeof(*qr_tau),&qr_tau);CHKERRQ(ierr);
1783984c4197SStefano Zampini       /* array to store rhs and solution of triangular solver */
1784984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*max_constraints*sizeof(*trs_rhs),&trs_rhs);CHKERRQ(ierr);
1785a717540cSStefano Zampini       /* allocating workspace for check */
1786a717540cSStefano Zampini       if (pcbddc->dbg_flag) {
1787a717540cSStefano Zampini         ierr = PetscMalloc(max_size_of_constraint*(max_constraints+max_size_of_constraint)*sizeof(*work),&work);CHKERRQ(ierr);
1788a717540cSStefano Zampini       }
1789a717540cSStefano Zampini     }
1790984c4197SStefano Zampini     /* array to store whether a node is primal or not */
17914641a718SStefano Zampini     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
17924641a718SStefano Zampini     for (i=0;i<total_primal_vertices;i++) {
17934641a718SStefano Zampini       ierr = PetscBTSet(is_primal,local_to_B[aux_primal_numbering[i]]);CHKERRQ(ierr);
17944641a718SStefano Zampini     }
1795984c4197SStefano Zampini 
1796a717540cSStefano Zampini     /* loop on constraints and see whether or not they need a change of basis and compute it */
1797026de310SStefano Zampini     /* -> using implicit ordering contained in temp_indices data */
1798026de310SStefano Zampini     total_counts = pcbddc->n_vertices;
1799026de310SStefano Zampini     primal_counter = total_counts;
1800026de310SStefano Zampini     while (total_counts<pcbddc->local_primal_size) {
1801026de310SStefano Zampini       primal_dofs = 1;
18024641a718SStefano Zampini       if (PetscBTLookup(change_basis,total_counts)) {
1803026de310SStefano Zampini         /* get all constraints with same support: if more then one constraint is present on the cc then surely indices are stored contiguosly */
1804026de310SStefano 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]]) {
1805026de310SStefano Zampini           primal_dofs++;
1806674ae819SStefano Zampini         }
1807984c4197SStefano Zampini         /* get constraint info */
1808026de310SStefano Zampini         size_of_constraint = temp_indices[total_counts+1]-temp_indices[total_counts];
1809984c4197SStefano Zampini         dual_dofs = size_of_constraint-primal_dofs;
1810984c4197SStefano Zampini 
1811984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
1812a717540cSStefano Zampini           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraints %d to %d (incl) need a change of basis (size %d)\n",total_counts,total_counts+primal_dofs-1,size_of_constraint);CHKERRQ(ierr);
1813674ae819SStefano Zampini         }
1814984c4197SStefano Zampini 
1815a717540cSStefano Zampini         if (primal_dofs > 1) { /* QR */
1816a717540cSStefano Zampini 
1817a717540cSStefano Zampini           /* copy quadrature constraints for change of basis check */
1818a717540cSStefano Zampini           if (pcbddc->dbg_flag) {
1819a717540cSStefano Zampini             ierr = PetscMemcpy(work,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1820a717540cSStefano Zampini           }
1821984c4197SStefano Zampini           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
1822026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1823984c4197SStefano Zampini 
1824984c4197SStefano Zampini           /* compute QR decomposition of constraints */
18253f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
18263f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
18273f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1828674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
18293f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
1830984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
1831674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1832984c4197SStefano Zampini 
1833984c4197SStefano Zampini           /* explictly compute R^-T */
1834984c4197SStefano Zampini           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
1835984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
18363f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
18373f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
18383f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
18393f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
1840984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
18413f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
1842984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
1843984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1844984c4197SStefano Zampini 
1845a717540cSStefano Zampini           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
18463f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
18473f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
18483f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
18493f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1850984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
18513f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
1852984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
1853984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1854984c4197SStefano Zampini 
1855984c4197SStefano Zampini           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
1856984c4197SStefano Zampini              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
1857984c4197SStefano Zampini              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
18583f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
18593f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
18603f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
18613f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
18623f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
18633f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1864984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1865c4303822SStefano 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));
1866984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1867026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1868984c4197SStefano Zampini 
1869984c4197SStefano Zampini           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
1870026de310SStefano Zampini           start_rows = &temp_indices_to_constraint_B[temp_indices[total_counts]];
1871984c4197SStefano Zampini           /* insert cols for primal dofs */
1872984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) {
1873984c4197SStefano Zampini             start_vals = &qr_basis[j*size_of_constraint];
1874026de310SStefano Zampini             start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter+j]];
1875984c4197SStefano Zampini             ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1876984c4197SStefano Zampini           }
1877984c4197SStefano Zampini           /* insert cols for dual dofs */
1878984c4197SStefano Zampini           for (j=0,k=0;j<dual_dofs;k++) {
18794641a718SStefano Zampini             if (!PetscBTLookup(is_primal,temp_indices_to_constraint_B[temp_indices[total_counts]+k])) {
1880984c4197SStefano Zampini               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
1881026de310SStefano Zampini               start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+k];
1882984c4197SStefano Zampini               ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1883984c4197SStefano Zampini               j++;
1884674ae819SStefano Zampini             }
1885674ae819SStefano Zampini           }
1886984c4197SStefano Zampini 
1887984c4197SStefano Zampini           /* check change of basis */
1888984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
1889984c4197SStefano Zampini             PetscInt   ii,jj;
1890984c4197SStefano Zampini             PetscBool valid_qr=PETSC_TRUE;
1891c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
1892c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1893c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
1894c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1895c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
1896c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
1897984c4197SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1898c4303822SStefano 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));
1899984c4197SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
1900984c4197SStefano Zampini             for (jj=0;jj<size_of_constraint;jj++) {
1901984c4197SStefano Zampini               for (ii=0;ii<primal_dofs;ii++) {
1902984c4197SStefano Zampini                 if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
1903984c4197SStefano Zampini                 if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
1904674ae819SStefano Zampini               }
1905674ae819SStefano Zampini             }
1906984c4197SStefano Zampini             if (!valid_qr) {
1907984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
1908984c4197SStefano Zampini               for (jj=0;jj<size_of_constraint;jj++) {
1909984c4197SStefano Zampini                 for (ii=0;ii<primal_dofs;ii++) {
1910984c4197SStefano Zampini                   if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
1911984c4197SStefano 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]));
1912674ae819SStefano Zampini                   }
1913984c4197SStefano Zampini                   if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
1914984c4197SStefano 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]));
1915984c4197SStefano Zampini                   }
1916984c4197SStefano Zampini                 }
1917984c4197SStefano Zampini               }
1918674ae819SStefano Zampini             } else {
1919984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
1920674ae819SStefano Zampini             }
1921674ae819SStefano Zampini           }
1922a717540cSStefano Zampini         } else { /* simple transformation block */
1923a717540cSStefano Zampini           PetscInt row,col;
1924a717540cSStefano Zampini           PetscScalar val;
1925a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) {
1926a717540cSStefano Zampini             row = temp_indices_to_constraint_B[temp_indices[total_counts]+j];
1927a717540cSStefano Zampini             if (!PetscBTLookup(is_primal,row)) {
1928a717540cSStefano Zampini               col = temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
1929a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
1930a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,1.0,INSERT_VALUES);CHKERRQ(ierr);
1931a717540cSStefano Zampini             } else {
1932a717540cSStefano Zampini               for (k=0;k<size_of_constraint;k++) {
1933a717540cSStefano Zampini                 col = temp_indices_to_constraint_B[temp_indices[total_counts]+k];
1934a717540cSStefano Zampini                 if (row != col) {
1935a717540cSStefano Zampini                   val = -temp_quadrature_constraint[temp_indices[total_counts]+k]/temp_quadrature_constraint[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
1936a717540cSStefano Zampini                 } else {
1937a717540cSStefano Zampini                   val = 1.0;
1938a717540cSStefano Zampini                 }
1939a717540cSStefano Zampini                 ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
1940a717540cSStefano Zampini               }
1941a717540cSStefano Zampini             }
1942a717540cSStefano Zampini           }
1943a717540cSStefano Zampini         }
1944026de310SStefano Zampini         /* increment primal counter */
1945026de310SStefano Zampini         primal_counter += primal_dofs;
1946984c4197SStefano Zampini       } else {
1947984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
1948026de310SStefano 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);
1949674ae819SStefano Zampini         }
1950674ae819SStefano Zampini       }
1951026de310SStefano Zampini       /* increment constraint counter total_counts */
1952026de310SStefano Zampini       total_counts += primal_dofs;
1953674ae819SStefano Zampini     }
1954a717540cSStefano Zampini 
1955a717540cSStefano Zampini     /* free workspace */
1956a717540cSStefano Zampini     if (qr_needed) {
1957984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
1958984c4197SStefano Zampini         ierr = PetscFree(work);CHKERRQ(ierr);
1959984c4197SStefano Zampini       }
1960984c4197SStefano Zampini       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
1961984c4197SStefano Zampini       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
1962984c4197SStefano Zampini       ierr = PetscFree(qr_work);CHKERRQ(ierr);
1963984c4197SStefano Zampini       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
1964984c4197SStefano Zampini       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
1965674ae819SStefano Zampini     }
1966a717540cSStefano Zampini     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
1967674ae819SStefano Zampini     /* assembling */
1968674ae819SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1969674ae819SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1970984c4197SStefano Zampini     /*
1971984c4197SStefano Zampini     ierr = MatView(pcbddc->ChangeOfBasisMatrix,(PetscViewer)0);CHKERRQ(ierr);
1972984c4197SStefano Zampini     */
1973674ae819SStefano Zampini   }
1974a717540cSStefano Zampini 
1975a717540cSStefano Zampini   /* flush dbg viewer */
1976b8ffe317SStefano Zampini   if (pcbddc->dbg_flag) {
1977b8ffe317SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1978b8ffe317SStefano Zampini   }
1979a717540cSStefano Zampini 
1980e310c8b4SStefano Zampini   /* free workspace */
1981a717540cSStefano Zampini   ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
1982a717540cSStefano Zampini   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
1983984c4197SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
1984984c4197SStefano Zampini   ierr = PetscFree(aux_primal_minloc);CHKERRQ(ierr);
1985674ae819SStefano Zampini   ierr = PetscFree(temp_indices);CHKERRQ(ierr);
19864641a718SStefano Zampini   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
1987674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr);
1988674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
1989674ae819SStefano Zampini   ierr = PetscFree(local_to_B);CHKERRQ(ierr);
1990674ae819SStefano Zampini   ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr);
1991674ae819SStefano Zampini   PetscFunctionReturn(0);
1992674ae819SStefano Zampini }
1993674ae819SStefano Zampini 
1994674ae819SStefano Zampini #undef __FUNCT__
1995674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
1996674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
1997674ae819SStefano Zampini {
1998674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
1999674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
2000674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
2001674ae819SStefano Zampini   PetscInt    bs,ierr,i,vertex_size;
2002674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
2003674ae819SStefano Zampini 
2004674ae819SStefano Zampini   PetscFunctionBegin;
2005674ae819SStefano Zampini   /* Init local Graph struct */
2006674ae819SStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr);
2007674ae819SStefano Zampini 
2008575ad6abSStefano Zampini   /* Check validity of the csr graph passed in by the user */
2009575ad6abSStefano Zampini   if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) {
2010575ad6abSStefano Zampini     ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
2011575ad6abSStefano Zampini   }
20129577ea80SStefano Zampini 
2013674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
2014674ae819SStefano Zampini   if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) {
2015674ae819SStefano Zampini     Mat mat_adj;
2016674ae819SStefano Zampini     const PetscInt *xadj,*adjncy;
2017674ae819SStefano Zampini     PetscBool flg_row=PETSC_TRUE;
2018674ae819SStefano Zampini 
2019674ae819SStefano Zampini     ierr = MatConvert(matis->A,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr);
2020674ae819SStefano Zampini     ierr = MatGetRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2021674ae819SStefano Zampini     if (!flg_row) {
2022674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ called in %s\n",__FUNCT__);
2023674ae819SStefano Zampini     }
2024674ae819SStefano Zampini     ierr = PCBDDCSetLocalAdjacencyGraph(pc,i,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
2025674ae819SStefano Zampini     ierr = MatRestoreRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2026674ae819SStefano Zampini     if (!flg_row) {
2027674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__);
2028674ae819SStefano Zampini     }
2029674ae819SStefano Zampini     ierr = MatDestroy(&mat_adj);CHKERRQ(ierr);
2030674ae819SStefano Zampini   }
2031674ae819SStefano Zampini 
2032674ae819SStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting */
2033674ae819SStefano Zampini   vertex_size = 1;
20349577ea80SStefano Zampini   if (!pcbddc->user_provided_isfordofs) {
2035674ae819SStefano Zampini     if (!pcbddc->n_ISForDofs) {
2036674ae819SStefano Zampini       IS *custom_ISForDofs;
2037674ae819SStefano Zampini 
2038674ae819SStefano Zampini       ierr = MatGetBlockSize(matis->A,&bs);CHKERRQ(ierr);
2039674ae819SStefano Zampini       ierr = PetscMalloc(bs*sizeof(IS),&custom_ISForDofs);CHKERRQ(ierr);
2040674ae819SStefano Zampini       for (i=0;i<bs;i++) {
2041674ae819SStefano Zampini         ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n/bs,i,bs,&custom_ISForDofs[i]);CHKERRQ(ierr);
2042674ae819SStefano Zampini       }
2043674ae819SStefano Zampini       ierr = PCBDDCSetDofsSplitting(pc,bs,custom_ISForDofs);CHKERRQ(ierr);
20449577ea80SStefano Zampini       pcbddc->user_provided_isfordofs = PETSC_FALSE;
2045674ae819SStefano Zampini       /* remove my references to IS objects */
2046674ae819SStefano Zampini       for (i=0;i<bs;i++) {
2047674ae819SStefano Zampini         ierr = ISDestroy(&custom_ISForDofs[i]);CHKERRQ(ierr);
2048674ae819SStefano Zampini       }
2049674ae819SStefano Zampini       ierr = PetscFree(custom_ISForDofs);CHKERRQ(ierr);
20509577ea80SStefano Zampini     }
20519577ea80SStefano Zampini   } else { /* mat block size as vertex size (used for elasticity with rigid body modes as nearnullspace) */
2052674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
2053674ae819SStefano Zampini   }
2054674ae819SStefano Zampini 
2055674ae819SStefano Zampini   /* Setup of Graph */
2056674ae819SStefano Zampini   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundaries,pcbddc->DirichletBoundaries,pcbddc->n_ISForDofs,pcbddc->ISForDofs,pcbddc->user_primal_vertices);
2057674ae819SStefano Zampini 
2058674ae819SStefano Zampini   /* Graph's connected components analysis */
2059674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
2060674ae819SStefano Zampini 
2061674ae819SStefano Zampini   /* print some info to stdout */
2062674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
2063e49050b4SStefano Zampini     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer);
2064674ae819SStefano Zampini   }
2065674ae819SStefano Zampini   PetscFunctionReturn(0);
2066674ae819SStefano Zampini }
2067674ae819SStefano Zampini 
2068674ae819SStefano Zampini #undef __FUNCT__
2069674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx"
2070f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt **vertices_idx)
2071674ae819SStefano Zampini {
2072674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2073674ae819SStefano Zampini   PetscInt       *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size;
2074674ae819SStefano Zampini   PetscErrorCode ierr;
2075674ae819SStefano Zampini 
2076674ae819SStefano Zampini   PetscFunctionBegin;
2077674ae819SStefano Zampini   n = 0;
2078674ae819SStefano Zampini   vertices = 0;
2079674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2080674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr);
2081b120a5c6SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2082b120a5c6SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2083b120a5c6SStefano Zampini       if (size_of_constraint == 1) n++;
2084b120a5c6SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2085b120a5c6SStefano Zampini     }
2086811e8ca2SStefano Zampini     if (vertices_idx) {
2087b120a5c6SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&vertices);CHKERRQ(ierr);
2088b120a5c6SStefano Zampini       n = 0;
2089674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2090674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2091674ae819SStefano Zampini         if (size_of_constraint == 1) {
2092674ae819SStefano Zampini           vertices[n++]=row_cmat_indices[0];
2093674ae819SStefano Zampini         }
2094674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2095674ae819SStefano Zampini       }
2096674ae819SStefano Zampini     }
2097811e8ca2SStefano Zampini   }
2098674ae819SStefano Zampini   *n_vertices = n;
2099811e8ca2SStefano Zampini   if (vertices_idx) *vertices_idx = vertices;
2100674ae819SStefano Zampini   PetscFunctionReturn(0);
2101674ae819SStefano Zampini }
2102674ae819SStefano Zampini 
2103674ae819SStefano Zampini #undef __FUNCT__
2104674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx"
2105f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt **constraints_idx)
2106674ae819SStefano Zampini {
2107674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2108674ae819SStefano Zampini   PetscInt       *constraints_index,*row_cmat_indices,*row_cmat_global_indices;
2109674ae819SStefano Zampini   PetscInt       n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc;
21104641a718SStefano Zampini   PetscBT        touched;
2111674ae819SStefano Zampini   PetscErrorCode ierr;
2112674ae819SStefano Zampini 
2113f34684f1SStefano Zampini     /* This function assumes that the number of local constraints per connected component
2114f34684f1SStefano Zampini        is not greater than the number of nodes defined for the connected component
2115f34684f1SStefano Zampini        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
2116674ae819SStefano Zampini   PetscFunctionBegin;
2117674ae819SStefano Zampini   n = 0;
2118674ae819SStefano Zampini   constraints_index = 0;
2119674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2120674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr);
2121674ae819SStefano Zampini     max_size_of_constraint = 0;
2122674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2123674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2124674ae819SStefano Zampini       if (size_of_constraint > 1) {
2125674ae819SStefano Zampini         n++;
2126674ae819SStefano Zampini       }
2127674ae819SStefano Zampini       max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint);
2128674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2129674ae819SStefano Zampini     }
2130811e8ca2SStefano Zampini     if (constraints_idx) {
2131674ae819SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&constraints_index);CHKERRQ(ierr);
2132674ae819SStefano Zampini       ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&row_cmat_global_indices);CHKERRQ(ierr);
21334641a718SStefano Zampini       ierr = PetscBTCreate(local_size,&touched);CHKERRQ(ierr);
2134674ae819SStefano Zampini       n = 0;
2135674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2136674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2137674ae819SStefano Zampini         if (size_of_constraint > 1) {
2138674ae819SStefano Zampini           ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr);
213982d3d8afSStefano Zampini           /* find first untouched local node */
214082d3d8afSStefano Zampini           j = 0;
21414641a718SStefano Zampini           while (PetscBTLookup(touched,row_cmat_indices[j])) j++;
214282d3d8afSStefano Zampini           min_index = row_cmat_global_indices[j];
214382d3d8afSStefano Zampini           min_loc = j;
214482d3d8afSStefano Zampini           /* search the minimum among nodes not yet touched on the connected component
214582d3d8afSStefano Zampini              since there can be more than one constraint on a single cc */
2146674ae819SStefano Zampini           for (j=1;j<size_of_constraint;j++) {
21474641a718SStefano Zampini             if (!PetscBTLookup(touched,row_cmat_indices[j]) && min_index > row_cmat_global_indices[j]) {
2148674ae819SStefano Zampini               min_index = row_cmat_global_indices[j];
2149674ae819SStefano Zampini               min_loc = j;
2150674ae819SStefano Zampini             }
2151674ae819SStefano Zampini           }
21524641a718SStefano Zampini           ierr = PetscBTSet(touched,row_cmat_indices[min_loc]);CHKERRQ(ierr);
2153674ae819SStefano Zampini           constraints_index[n++] = row_cmat_indices[min_loc];
2154674ae819SStefano Zampini         }
2155674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2156674ae819SStefano Zampini       }
21574641a718SStefano Zampini       ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2158674ae819SStefano Zampini       ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr);
2159811e8ca2SStefano Zampini     }
2160811e8ca2SStefano Zampini   }
2161674ae819SStefano Zampini   *n_constraints = n;
2162811e8ca2SStefano Zampini   if (constraints_idx) *constraints_idx = constraints_index;
2163674ae819SStefano Zampini   PetscFunctionReturn(0);
2164674ae819SStefano Zampini }
2165674ae819SStefano Zampini 
2166674ae819SStefano Zampini /* the next two functions has been adapted from pcis.c */
2167674ae819SStefano Zampini #undef __FUNCT__
2168674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchur"
2169674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchur(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2170674ae819SStefano Zampini {
2171674ae819SStefano Zampini   PetscErrorCode ierr;
2172674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2173674ae819SStefano Zampini 
2174674ae819SStefano Zampini   PetscFunctionBegin;
2175674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2176674ae819SStefano Zampini   ierr = MatMult(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2177674ae819SStefano Zampini   ierr = MatMult(pcis->A_IB,v,vec1_D);CHKERRQ(ierr);
2178674ae819SStefano Zampini   ierr = KSPSolve(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2179674ae819SStefano Zampini   ierr = MatMult(pcis->A_BI,vec2_D,vec2_B);CHKERRQ(ierr);
2180674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2181674ae819SStefano Zampini   PetscFunctionReturn(0);
2182674ae819SStefano Zampini }
2183674ae819SStefano Zampini 
2184674ae819SStefano Zampini #undef __FUNCT__
2185674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchurTranspose"
2186674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchurTranspose(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2187674ae819SStefano Zampini {
2188674ae819SStefano Zampini   PetscErrorCode ierr;
2189674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2190674ae819SStefano Zampini 
2191674ae819SStefano Zampini   PetscFunctionBegin;
2192674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2193674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2194674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BI,v,vec1_D);CHKERRQ(ierr);
2195674ae819SStefano Zampini   ierr = KSPSolveTranspose(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2196674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_IB,vec2_D,vec2_B);CHKERRQ(ierr);
2197674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2198674ae819SStefano Zampini   PetscFunctionReturn(0);
2199674ae819SStefano Zampini }
2200674ae819SStefano Zampini 
2201674ae819SStefano Zampini #undef __FUNCT__
2202674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
2203674ae819SStefano 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[])
2204674ae819SStefano Zampini {
2205674ae819SStefano Zampini   Vec            local_vec,global_vec;
2206674ae819SStefano Zampini   IS             seqis,paris;
2207674ae819SStefano Zampini   VecScatter     scatter_ctx;
2208674ae819SStefano Zampini   PetscScalar    *array;
2209674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
2210674ae819SStefano Zampini   PetscScalar    globalsum;
2211674ae819SStefano Zampini   PetscInt       i,j,s;
2212674ae819SStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local;
2213674ae819SStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm,max_global;
2214674ae819SStefano Zampini   PetscMPIInt    *dof_sizes,*dof_displs;
2215674ae819SStefano Zampini   PetscBool      first_found;
2216674ae819SStefano Zampini   PetscErrorCode ierr;
2217674ae819SStefano Zampini 
2218674ae819SStefano Zampini   PetscFunctionBegin;
2219674ae819SStefano Zampini   /* mpi buffers */
2220674ae819SStefano Zampini   MPI_Comm_size(comm,&size_prec_comm);
2221674ae819SStefano Zampini   MPI_Comm_rank(comm,&rank_prec_comm);
2222674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
2223674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_sizes),&dof_sizes);CHKERRQ(ierr);
2224674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_displs),&dof_displs);CHKERRQ(ierr);
2225674ae819SStefano Zampini   /* get maximum size of subset */
2226674ae819SStefano Zampini   ierr = PetscMalloc(n_local_dofs*sizeof(PetscInt),&temp_global_dofs);CHKERRQ(ierr);
2227674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
2228674ae819SStefano Zampini   max_local = 0;
2229674ae819SStefano Zampini   if (n_local_dofs) {
2230674ae819SStefano Zampini     max_local = temp_global_dofs[0];
2231674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2232674ae819SStefano Zampini       if (max_local < temp_global_dofs[i] ) {
2233674ae819SStefano Zampini         max_local = temp_global_dofs[i];
2234674ae819SStefano Zampini       }
2235674ae819SStefano Zampini     }
2236674ae819SStefano Zampini   }
2237674ae819SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);
2238674ae819SStefano Zampini   max_global++;
2239674ae819SStefano Zampini   max_local = 0;
2240674ae819SStefano Zampini   if (n_local_dofs) {
2241674ae819SStefano Zampini     max_local = local_dofs[0];
2242674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2243674ae819SStefano Zampini       if (max_local < local_dofs[i] ) {
2244674ae819SStefano Zampini         max_local = local_dofs[i];
2245674ae819SStefano Zampini       }
2246674ae819SStefano Zampini     }
2247674ae819SStefano Zampini   }
2248674ae819SStefano Zampini   max_local++;
2249674ae819SStefano Zampini   /* allocate workspace */
2250674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
2251674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
2252674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
2253674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
2254674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
2255674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
2256674ae819SStefano Zampini   /* create scatter */
2257674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
2258674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
2259674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
2260674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
2261674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
2262674ae819SStefano Zampini   /* init array */
2263674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
2264674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2265674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2266674ae819SStefano Zampini   if (local_dofs_mult) {
2267674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2268674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
2269674ae819SStefano Zampini     }
2270674ae819SStefano Zampini   } else {
2271674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2272674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
2273674ae819SStefano Zampini     }
2274674ae819SStefano Zampini   }
2275674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2276674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
2277674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2278674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2279674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
22805b08dc53SStefano Zampini   *n_global_subset = (PetscInt)PetscRealPart(globalsum);
2281674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
2282674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
2283674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
2284674ae819SStefano Zampini   nlocals = 0;
2285674ae819SStefano Zampini   first_index = -1;
2286674ae819SStefano Zampini   first_found = PETSC_FALSE;
2287674ae819SStefano Zampini   for (i=0;i<s;i++) {
22885b08dc53SStefano Zampini     if (!first_found && PetscRealPart(array[i]) > 0.0) {
2289674ae819SStefano Zampini       first_found = PETSC_TRUE;
2290674ae819SStefano Zampini       first_index = i;
2291674ae819SStefano Zampini     }
22925b08dc53SStefano Zampini     nlocals += (PetscInt)PetscRealPart(array[i]);
2293674ae819SStefano Zampini   }
2294674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2295674ae819SStefano Zampini   if (!rank_prec_comm) {
2296674ae819SStefano Zampini     dof_displs[0]=0;
2297674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
2298674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
2299674ae819SStefano Zampini     }
2300674ae819SStefano Zampini   }
2301674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2302674ae819SStefano Zampini   if (first_found) {
2303674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
2304674ae819SStefano Zampini     old_index = first_index;
2305674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
23065b08dc53SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) {
2307674ae819SStefano Zampini         array[i] += array[old_index];
2308674ae819SStefano Zampini         old_index = i;
2309674ae819SStefano Zampini       }
2310674ae819SStefano Zampini     }
2311674ae819SStefano Zampini   }
2312674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
2313674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2314674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2315674ae819SStefano Zampini   ierr = VecScatterEnd  (scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2316674ae819SStefano Zampini   /* get global ordering of local dofs */
2317674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2318674ae819SStefano Zampini   if (local_dofs_mult) {
2319674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
23205b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i];
2321674ae819SStefano Zampini     }
2322674ae819SStefano Zampini   } else {
2323674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
23245b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1;
2325674ae819SStefano Zampini     }
2326674ae819SStefano Zampini   }
2327674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2328674ae819SStefano Zampini   /* free workspace */
2329674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
2330674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
2331674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
2332674ae819SStefano Zampini   ierr = PetscFree(dof_sizes);CHKERRQ(ierr);
2333674ae819SStefano Zampini   ierr = PetscFree(dof_displs);CHKERRQ(ierr);
2334674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
2335674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
2336674ae819SStefano Zampini   PetscFunctionReturn(0);
2337674ae819SStefano Zampini }
23389a7d3425SStefano Zampini 
23399a7d3425SStefano Zampini #undef __FUNCT__
23409a7d3425SStefano Zampini #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
23419a7d3425SStefano Zampini PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
23429a7d3425SStefano Zampini {
23439a7d3425SStefano Zampini   PetscInt       i,j;
23449a7d3425SStefano Zampini   PetscScalar    *alphas;
23459a7d3425SStefano Zampini   PetscErrorCode ierr;
23469a7d3425SStefano Zampini 
23479a7d3425SStefano Zampini   PetscFunctionBegin;
23489a7d3425SStefano Zampini   /* this implements stabilized Gram-Schmidt */
23499a7d3425SStefano Zampini   ierr = PetscMalloc(n*sizeof(PetscScalar),&alphas);CHKERRQ(ierr);
23509a7d3425SStefano Zampini   for (i=0;i<n;i++) {
23519a7d3425SStefano Zampini     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
23529a7d3425SStefano Zampini     if (i<n) { ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],&alphas[i+1]);CHKERRQ(ierr); }
23539a7d3425SStefano Zampini     for (j=i+1;j<n;j++) { ierr = VecAXPY(vecs[j],PetscConj(-alphas[j]),vecs[i]);CHKERRQ(ierr); }
23549a7d3425SStefano Zampini   }
23559a7d3425SStefano Zampini   ierr = PetscFree(alphas);CHKERRQ(ierr);
23569a7d3425SStefano Zampini   PetscFunctionReturn(0);
23579a7d3425SStefano Zampini }
23589a7d3425SStefano Zampini 
2359a57a6d2fSStefano Zampini /* Currently support MAT_INITIAL_MATRIX only, with partial support to block matrices */
2360c8587f34SStefano Zampini #undef __FUNCT__
2361a57a6d2fSStefano Zampini #define __FUNCT__ "MatConvert_IS_AIJ"
2362a57a6d2fSStefano Zampini static PetscErrorCode MatConvert_IS_AIJ(Mat mat, MatType newtype,MatReuse reuse,Mat *M)
2363c8587f34SStefano Zampini {
2364a57a6d2fSStefano Zampini   Mat new_mat;
2365a57a6d2fSStefano Zampini   Mat_IS *matis = (Mat_IS*)(mat->data);
2366a57a6d2fSStefano Zampini   /* info on mat */
2367a57a6d2fSStefano Zampini   PetscInt bs,rows,cols;
2368a57a6d2fSStefano Zampini   PetscInt lrows,lcols;
2369a57a6d2fSStefano Zampini   PetscInt local_rows,local_cols;
2370e7931f94SStefano Zampini   PetscMPIInt nsubdomains;
2371c8587f34SStefano Zampini   /* preallocation */
2372c8587f34SStefano Zampini   Vec vec_dnz,vec_onz;
2373c8587f34SStefano Zampini   PetscScalar *my_dnz,*my_onz,*array;
2374a57a6d2fSStefano Zampini   PetscInt *dnz,*onz,*mat_ranges,*row_ownership;
2375a57a6d2fSStefano Zampini   PetscInt  index_row,index_col,owner;
2376a57a6d2fSStefano Zampini   PetscInt  *local_indices,*global_indices;
2377a57a6d2fSStefano Zampini   /* work */
2378a57a6d2fSStefano Zampini   PetscInt i,j;
2379a57a6d2fSStefano Zampini   PetscErrorCode ierr;
2380c8587f34SStefano Zampini 
2381a57a6d2fSStefano Zampini   PetscFunctionBegin;
2382a57a6d2fSStefano Zampini   /* CHECKS */
2383a57a6d2fSStefano Zampini   /* get info from mat */
2384a57a6d2fSStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
2385a57a6d2fSStefano Zampini   ierr = MatGetBlockSize(mat,&bs);CHKERRQ(ierr);
2386a57a6d2fSStefano Zampini   ierr = MatGetSize(matis->A,&local_rows,&local_cols);CHKERRQ(ierr);
2387a57a6d2fSStefano Zampini   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&nsubdomains);CHKERRQ(ierr);
2388a57a6d2fSStefano Zampini 
2389a57a6d2fSStefano Zampini   /* MAT_INITIAL_MATRIX */
2390a57a6d2fSStefano Zampini   ierr = MatCreate(PetscObjectComm((PetscObject)mat),&new_mat);CHKERRQ(ierr);
2391a57a6d2fSStefano Zampini   ierr = MatSetSizes(new_mat,PETSC_DECIDE,PETSC_DECIDE,rows,cols);CHKERRQ(ierr);
2392a57a6d2fSStefano Zampini   ierr = MatSetBlockSize(new_mat,bs);CHKERRQ(ierr);
2393a57a6d2fSStefano Zampini   ierr = MatSetType(new_mat,newtype);CHKERRQ(ierr);
2394a57a6d2fSStefano Zampini   ierr = MatSetUp(new_mat);CHKERRQ(ierr);
2395a57a6d2fSStefano Zampini   ierr = MatGetLocalSize(new_mat,&lrows,&lcols);CHKERRQ(ierr);
2396a57a6d2fSStefano Zampini 
2397a57a6d2fSStefano Zampini   /*
2398a57a6d2fSStefano Zampini     preallocation
2399a57a6d2fSStefano Zampini   */
2400a57a6d2fSStefano Zampini 
2401a57a6d2fSStefano Zampini   ierr = MatPreallocateInitialize(PetscObjectComm((PetscObject)new_mat),lrows,lcols,dnz,onz);CHKERRQ(ierr);
2402a57a6d2fSStefano Zampini   /*
2403a57a6d2fSStefano Zampini      Some vectors are needed to sum up properly on shared interface dofs.
2404a57a6d2fSStefano Zampini      Note that preallocation is not exact, since it overestimates nonzeros
2405a57a6d2fSStefano Zampini   */
2406a57a6d2fSStefano Zampini /*
2407a57a6d2fSStefano Zampini   ierr = VecCreate(PetscObjectComm((PetscObject)mat),&vec_dnz);CHKERRQ(ierr);
2408c8587f34SStefano Zampini   ierr = VecSetBlockSize(vec_dnz,bs);CHKERRQ(ierr);
2409a57a6d2fSStefano Zampini   ierr = VecSetSizes(vec_dnz,PETSC_DECIDE,rows);CHKERRQ(ierr);
2410a57a6d2fSStefano Zampini   ierr = VecSetType(vec_dnz,VECSTANDARD);CHKERRQ(ierr);
2411a57a6d2fSStefano Zampini */
2412a57a6d2fSStefano Zampini   ierr = MatGetVecs(new_mat,NULL,&vec_dnz);CHKERRQ(ierr);
2413c8587f34SStefano Zampini   ierr = VecDuplicate(vec_dnz,&vec_onz);CHKERRQ(ierr);
2414e7931f94SStefano Zampini   /* All processes need to compute entire row ownership */
2415a57a6d2fSStefano Zampini   ierr = PetscMalloc(rows*sizeof(*row_ownership),&row_ownership);CHKERRQ(ierr);
2416a57a6d2fSStefano Zampini   ierr = MatGetOwnershipRanges(new_mat,(const PetscInt**)&mat_ranges);CHKERRQ(ierr);
2417a57a6d2fSStefano Zampini   for (i=0;i<nsubdomains;i++) {
2418c8587f34SStefano Zampini     for (j=mat_ranges[i];j<mat_ranges[i+1];j++) {
2419c8587f34SStefano Zampini       row_ownership[j]=i;
2420c8587f34SStefano Zampini     }
2421c8587f34SStefano Zampini   }
2422a57a6d2fSStefano Zampini   /* map indices of local mat to global values */
2423a57a6d2fSStefano Zampini   ierr = PetscMalloc(PetscMax(local_cols,local_rows)*sizeof(*global_indices),&global_indices);CHKERRQ(ierr);
2424a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*local_indices),&local_indices);CHKERRQ(ierr);
2425a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) local_indices[i]=i;
2426a57a6d2fSStefano Zampini   ierr = ISLocalToGlobalMappingApply(matis->mapping,local_rows,local_indices,global_indices);CHKERRQ(ierr);
2427a57a6d2fSStefano Zampini   ierr = PetscFree(local_indices);CHKERRQ(ierr);
2428c8587f34SStefano Zampini 
2429e7931f94SStefano Zampini   /*
2430e7931f94SStefano Zampini      my_dnz and my_onz contains exact contribution to preallocation from each local mat
2431e7931f94SStefano Zampini      then, they will be summed up properly. This way, preallocation is always sufficient
2432e7931f94SStefano Zampini   */
2433a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*my_dnz),&my_dnz);CHKERRQ(ierr);
2434a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*my_onz),&my_onz);CHKERRQ(ierr);
2435a57a6d2fSStefano Zampini   ierr = PetscMemzero(my_dnz,local_rows*sizeof(*my_dnz));CHKERRQ(ierr);
2436a57a6d2fSStefano Zampini   ierr = PetscMemzero(my_onz,local_rows*sizeof(*my_onz));CHKERRQ(ierr);
2437a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) {
2438a57a6d2fSStefano Zampini     index_row = global_indices[i];
2439a57a6d2fSStefano Zampini     for (j=i;j<local_rows;j++) {
2440a57a6d2fSStefano Zampini       owner = row_ownership[index_row];
2441a57a6d2fSStefano Zampini       index_col = global_indices[j];
2442a57a6d2fSStefano Zampini       if (index_col > mat_ranges[owner]-1 && index_col < mat_ranges[owner+1] ) { /* diag block */
2443c8587f34SStefano Zampini         my_dnz[i] += 1.0;
2444a57a6d2fSStefano Zampini       } else { /* offdiag block */
2445c8587f34SStefano Zampini         my_onz[i] += 1.0;
2446c8587f34SStefano Zampini       }
2447a57a6d2fSStefano Zampini       /* same as before, interchanging rows and cols */
2448c8587f34SStefano Zampini       if (i != j) {
2449a57a6d2fSStefano Zampini         owner = row_ownership[index_col];
2450a57a6d2fSStefano Zampini         if (index_row > mat_ranges[owner]-1 && index_row < mat_ranges[owner+1] ) {
2451c8587f34SStefano Zampini           my_dnz[j] += 1.0;
2452c8587f34SStefano Zampini         } else {
2453c8587f34SStefano Zampini           my_onz[j] += 1.0;
2454c8587f34SStefano Zampini         }
2455c8587f34SStefano Zampini       }
2456c8587f34SStefano Zampini     }
2457c8587f34SStefano Zampini   }
2458c8587f34SStefano Zampini   ierr = VecSet(vec_dnz,0.0);CHKERRQ(ierr);
2459c8587f34SStefano Zampini   ierr = VecSet(vec_onz,0.0);CHKERRQ(ierr);
246020a2ab83SStefano Zampini   if (local_rows) { /* multilevel guard */
2461a57a6d2fSStefano Zampini     ierr = VecSetValues(vec_dnz,local_rows,global_indices,my_dnz,ADD_VALUES);CHKERRQ(ierr);
2462a57a6d2fSStefano Zampini     ierr = VecSetValues(vec_onz,local_rows,global_indices,my_onz,ADD_VALUES);CHKERRQ(ierr);
2463c8587f34SStefano Zampini   }
2464c8587f34SStefano Zampini   ierr = VecAssemblyBegin(vec_dnz);CHKERRQ(ierr);
2465c8587f34SStefano Zampini   ierr = VecAssemblyBegin(vec_onz);CHKERRQ(ierr);
2466c8587f34SStefano Zampini   ierr = VecAssemblyEnd(vec_dnz);CHKERRQ(ierr);
2467c8587f34SStefano Zampini   ierr = VecAssemblyEnd(vec_onz);CHKERRQ(ierr);
2468c8587f34SStefano Zampini   ierr = PetscFree(my_dnz);CHKERRQ(ierr);
2469c8587f34SStefano Zampini   ierr = PetscFree(my_onz);CHKERRQ(ierr);
2470c8587f34SStefano Zampini   ierr = PetscFree(row_ownership);CHKERRQ(ierr);
2471a57a6d2fSStefano Zampini 
2472a57a6d2fSStefano Zampini   /* set computed preallocation in dnz and onz */
2473a57a6d2fSStefano Zampini   ierr = VecGetArray(vec_dnz,&array);CHKERRQ(ierr);
2474a57a6d2fSStefano Zampini   for (i=0; i<lrows; i++) dnz[i] = (PetscInt)PetscRealPart(array[i]);
2475a57a6d2fSStefano Zampini   ierr = VecRestoreArray(vec_dnz,&array);CHKERRQ(ierr);
2476a57a6d2fSStefano Zampini   ierr = VecGetArray(vec_onz,&array);CHKERRQ(ierr);
2477a57a6d2fSStefano Zampini   for (i=0;i<lrows;i++) onz[i] = (PetscInt)PetscRealPart(array[i]);
2478a57a6d2fSStefano Zampini   ierr = VecRestoreArray(vec_onz,&array);CHKERRQ(ierr);
2479c8587f34SStefano Zampini   ierr = VecDestroy(&vec_dnz);CHKERRQ(ierr);
2480c8587f34SStefano Zampini   ierr = VecDestroy(&vec_onz);CHKERRQ(ierr);
2481c8587f34SStefano Zampini 
2482e7931f94SStefano Zampini   /* Resize preallocation if overestimated */
2483c8587f34SStefano Zampini   for (i=0;i<lrows;i++) {
2484a57a6d2fSStefano Zampini     dnz[i] = PetscMin(dnz[i],lcols);
2485a57a6d2fSStefano Zampini     onz[i] = PetscMin(onz[i],cols-lcols);
2486c8587f34SStefano Zampini   }
2487a57a6d2fSStefano Zampini   ierr = MatMPIAIJSetPreallocation(new_mat,0,dnz,0,onz);CHKERRQ(ierr);
2488c8587f34SStefano Zampini   ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
2489a57a6d2fSStefano Zampini 
2490a57a6d2fSStefano Zampini   /*
2491e7931f94SStefano Zampini     Set values. Very Basic.
2492a57a6d2fSStefano Zampini   */
2493a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) {
2494a57a6d2fSStefano Zampini     ierr = MatGetRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2495a57a6d2fSStefano Zampini     ierr = ISLocalToGlobalMappingApply(matis->mapping,j,local_indices,global_indices);CHKERRQ(ierr);
2496a57a6d2fSStefano Zampini     ierr = ISLocalToGlobalMappingApply(matis->mapping,1,&i,&index_row);CHKERRQ(ierr);
2497a57a6d2fSStefano Zampini     ierr = MatSetValues(new_mat,1,&index_row,j,global_indices,array,ADD_VALUES);CHKERRQ(ierr);
2498a57a6d2fSStefano Zampini     ierr = MatRestoreRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2499a57a6d2fSStefano Zampini   }
250020a2ab83SStefano Zampini   ierr = MatAssemblyBegin(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2501a57a6d2fSStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
250220a2ab83SStefano Zampini   ierr = MatAssemblyEnd(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2503a57a6d2fSStefano Zampini 
2504a57a6d2fSStefano Zampini   /* get back mat */
2505a57a6d2fSStefano Zampini   *M = new_mat;
2506a57a6d2fSStefano Zampini   PetscFunctionReturn(0);
2507a57a6d2fSStefano Zampini }
2508a57a6d2fSStefano Zampini 
2509e7931f94SStefano Zampini #undef __FUNCT__
2510e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble_Private"
2511e7931f94SStefano Zampini PetscErrorCode MatISSubassemble_Private(Mat mat, PetscInt coarsening_ratio, IS* is_sends)
2512e7931f94SStefano Zampini {
2513e7931f94SStefano Zampini   Mat             subdomain_adj;
2514e7931f94SStefano Zampini   IS              new_ranks,ranks_send_to;
2515e7931f94SStefano Zampini   MatPartitioning partitioner;
2516e7931f94SStefano Zampini   Mat_IS          *matis;
2517e7931f94SStefano Zampini   PetscInt        n_neighs,*neighs,*n_shared,**shared;
2518e7931f94SStefano Zampini   PetscInt        prank;
2519e7931f94SStefano Zampini   PetscMPIInt     size,rank,color;
2520e7931f94SStefano Zampini   PetscInt        *xadj,*adjncy,*oldranks;
2521e7931f94SStefano Zampini   PetscInt        *adjncy_wgt,*v_wgt,*is_indices,*ranks_send_to_idx;
2522e7931f94SStefano Zampini   PetscInt        i,j,n_subdomains,local_size,threshold=0;
2523e7931f94SStefano Zampini   PetscErrorCode  ierr;
25242b510759SStefano Zampini   PetscBool       use_vwgt=PETSC_FALSE,use_square=PETSC_FALSE;
2525e7931f94SStefano Zampini   PetscSubcomm    subcomm;
2526a57a6d2fSStefano Zampini 
2527e7931f94SStefano Zampini   PetscFunctionBegin;
25282b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_square",&use_square,NULL);CHKERRQ(ierr);
25292b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
25302b510759SStefano Zampini   ierr = PetscOptionsGetInt(NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
2531e7931f94SStefano Zampini 
2532e7931f94SStefano Zampini   /* Get info on mapping */
2533e7931f94SStefano Zampini   matis = (Mat_IS*)(mat->data);
2534e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&local_size);CHKERRQ(ierr);
2535e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2536e7931f94SStefano Zampini 
2537e7931f94SStefano Zampini   /* build local CSR graph of subdomains' connectivity */
2538e7931f94SStefano Zampini   ierr = PetscMalloc(2*sizeof(*xadj),&xadj);CHKERRQ(ierr);
2539e7931f94SStefano Zampini   xadj[0] = 0;
2540e7931f94SStefano Zampini   xadj[1] = PetscMax(n_neighs-1,0);
2541e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy),&adjncy);CHKERRQ(ierr);
2542e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy_wgt),&adjncy_wgt);CHKERRQ(ierr);
2543e7931f94SStefano Zampini 
25442b510759SStefano Zampini   if (threshold) {
25452b510759SStefano Zampini     PetscInt* count,min_threshold;
2546e7931f94SStefano Zampini     ierr = PetscMalloc(local_size*sizeof(PetscInt),&count);CHKERRQ(ierr);
2547e7931f94SStefano Zampini     ierr = PetscMemzero(count,local_size*sizeof(PetscInt));CHKERRQ(ierr);
2548e7931f94SStefano Zampini     for (i=1;i<n_neighs;i++) {/* i=1 so I don't count myself -> faces nodes counts to 1 */
2549e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2550e7931f94SStefano Zampini         count[shared[i][j]] += 1;
2551e7931f94SStefano Zampini       }
2552e7931f94SStefano Zampini     }
25532b510759SStefano Zampini     /* adapt threshold since we dont want to lose significant connections */
25542b510759SStefano Zampini     min_threshold = n_neighs;
25552b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
25562b510759SStefano Zampini       for (j=0;j<n_shared[i];j++) {
25572b510759SStefano Zampini         min_threshold = PetscMin(count[shared[i][j]],min_threshold);
25582b510759SStefano Zampini       }
25592b510759SStefano Zampini     }
25602b510759SStefano Zampini     PetscPrintf(PETSC_COMM_SELF,"PASSED THRESHOLD %d\n",threshold);
25612b510759SStefano Zampini     threshold = PetscMax(min_threshold+1,threshold);
25622b510759SStefano Zampini     PetscPrintf(PETSC_COMM_SELF,"USING THRESHOLD %d (min %d)\n",threshold,min_threshold);
2563e7931f94SStefano Zampini     xadj[1] = 0;
25642b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
2565e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2566e7931f94SStefano Zampini         if (count[shared[i][j]] < threshold) {
2567e7931f94SStefano Zampini           adjncy[xadj[1]] = neighs[i];
2568e7931f94SStefano Zampini           adjncy_wgt[xadj[1]] = n_shared[i];
2569e7931f94SStefano Zampini           xadj[1]++;
2570e7931f94SStefano Zampini           break;
2571e7931f94SStefano Zampini         }
2572e7931f94SStefano Zampini       }
2573e7931f94SStefano Zampini     }
2574e7931f94SStefano Zampini     ierr = PetscFree(count);CHKERRQ(ierr);
2575c8587f34SStefano Zampini   } else {
2576e7931f94SStefano Zampini     if (xadj[1]) {
2577e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy,&neighs[1],xadj[1]*sizeof(*adjncy));CHKERRQ(ierr);
2578e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy_wgt,&n_shared[1],xadj[1]*sizeof(*adjncy_wgt));CHKERRQ(ierr);
2579c8587f34SStefano Zampini     }
2580e7931f94SStefano Zampini   }
2581e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingRestoreInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2582e7931f94SStefano Zampini   if (use_square) {
2583e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2584e7931f94SStefano Zampini       adjncy_wgt[i] = adjncy_wgt[i]*adjncy_wgt[i];
2585e7931f94SStefano Zampini     }
2586e7931f94SStefano Zampini   }
2587e7931f94SStefano Zampini   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2588e7931f94SStefano Zampini 
2589e7931f94SStefano Zampini   ierr = PetscMalloc(sizeof(PetscInt),&ranks_send_to_idx);CHKERRQ(ierr);
2590e7931f94SStefano Zampini 
2591e7931f94SStefano Zampini   /*
2592e7931f94SStefano Zampini     Restrict work on active processes only.
2593e7931f94SStefano Zampini   */
2594e7931f94SStefano Zampini   ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&subcomm);CHKERRQ(ierr);
2595e7931f94SStefano Zampini   ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
2596e7931f94SStefano Zampini   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
25972b510759SStefano Zampini   ierr = PetscMPIIntCast(!local_size,&color);CHKERRQ(ierr);
2598d3531aaaSJed Brown   ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
2599e7931f94SStefano Zampini   if (color) {
2600e7931f94SStefano Zampini     ierr = PetscFree(xadj);CHKERRQ(ierr);
2601e7931f94SStefano Zampini     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2602e7931f94SStefano Zampini     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
2603c8587f34SStefano Zampini   } else {
2604e7931f94SStefano Zampini     ierr = MPI_Comm_size(subcomm->comm,&size);CHKERRQ(ierr);
2605e7931f94SStefano Zampini     ierr = PetscMalloc(size*sizeof(*oldranks),&oldranks);CHKERRQ(ierr);
2606e7931f94SStefano Zampini     prank = rank;
2607e7931f94SStefano Zampini     ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm->comm);CHKERRQ(ierr);
2608e7931f94SStefano Zampini     for (i=0;i<size;i++) {
2609e7931f94SStefano Zampini       PetscPrintf(subcomm->comm,"oldranks[%d] = %d\n",i,oldranks[i]);
2610c8587f34SStefano Zampini     }
2611e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2612e7931f94SStefano Zampini       ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
2613c8587f34SStefano Zampini     }
2614e7931f94SStefano Zampini     ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2615e7931f94SStefano Zampini     ierr = MatCreateMPIAdj(subcomm->comm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
2616e7931f94SStefano Zampini     n_subdomains = (PetscInt)size;
2617e7931f94SStefano Zampini     ierr = MatView(subdomain_adj,0);CHKERRQ(ierr);
2618e7931f94SStefano Zampini 
2619e7931f94SStefano Zampini     /* Partition */
2620e7931f94SStefano Zampini     ierr = MatPartitioningCreate(subcomm->comm,&partitioner);CHKERRQ(ierr);
2621e7931f94SStefano Zampini     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
2622e7931f94SStefano Zampini     if (use_vwgt) {
2623e7931f94SStefano Zampini       ierr = PetscMalloc(sizeof(*v_wgt),&v_wgt);CHKERRQ(ierr);
2624e7931f94SStefano Zampini       v_wgt[0] = local_size;
2625e7931f94SStefano Zampini       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
2626c8587f34SStefano Zampini     }
2627e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)partitioner),"NPARTS %d\n",n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2628e7931f94SStefano Zampini     ierr = MatPartitioningSetNParts(partitioner,n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2629e7931f94SStefano Zampini     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
2630e7931f94SStefano Zampini     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
2631e7931f94SStefano Zampini     ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr);
2632e7931f94SStefano Zampini 
2633e7931f94SStefano Zampini     ierr = ISGetIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2634e7931f94SStefano Zampini     ranks_send_to_idx[0] = oldranks[is_indices[0]];
2635e7931f94SStefano Zampini     ierr = ISRestoreIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2636e7931f94SStefano Zampini     /* clean up */
2637e7931f94SStefano Zampini     ierr = PetscFree(oldranks);CHKERRQ(ierr);
2638e7931f94SStefano Zampini     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
2639e7931f94SStefano Zampini     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
2640e7931f94SStefano Zampini     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
2641e7931f94SStefano Zampini   }
2642e7931f94SStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
2643e7931f94SStefano Zampini 
2644e7931f94SStefano Zampini   /* assemble parallel IS for sends */
2645e7931f94SStefano Zampini   i = 1;
2646e7931f94SStefano Zampini   if (color) i=0;
2647e7931f94SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,&ranks_send_to);CHKERRQ(ierr);
2648e7931f94SStefano Zampini   ierr = ISView(ranks_send_to,0);CHKERRQ(ierr);
2649e7931f94SStefano Zampini 
2650e7931f94SStefano Zampini   /* get back IS */
2651e7931f94SStefano Zampini   *is_sends = ranks_send_to;
2652e7931f94SStefano Zampini   PetscFunctionReturn(0);
2653e7931f94SStefano Zampini }
2654e7931f94SStefano Zampini 
2655e7931f94SStefano Zampini typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
2656e7931f94SStefano Zampini 
2657e7931f94SStefano Zampini #undef __FUNCT__
2658e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble"
2659e7931f94SStefano Zampini PetscErrorCode MatISSubassemble(Mat mat, IS is_sends, PetscInt coarsening_ratio, Mat *mat_n)
2660e7931f94SStefano Zampini {
2661e7931f94SStefano Zampini   Mat                    local_mat,new_mat;
2662e7931f94SStefano Zampini   Mat_IS                 *matis;
2663e7931f94SStefano Zampini   IS                     is_sends_internal;
2664e7931f94SStefano Zampini   PetscInt               rows,cols;
2665e7931f94SStefano Zampini   PetscInt               i,bs,buf_size_idxs,buf_size_vals;
2666e7931f94SStefano Zampini   PetscBool              ismatis,isdense;
2667e7931f94SStefano Zampini   ISLocalToGlobalMapping l2gmap;
2668e7931f94SStefano Zampini   PetscInt*              l2gmap_indices;
2669e7931f94SStefano Zampini   const PetscInt*        is_indices;
2670e7931f94SStefano Zampini   MatType                new_local_type;
2671e7931f94SStefano Zampini   MatTypePrivate         new_local_type_private;
2672e7931f94SStefano Zampini   /* buffers */
2673e7931f94SStefano Zampini   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
2674e7931f94SStefano Zampini   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
2675e7931f94SStefano Zampini   /* MPI */
2676e7931f94SStefano Zampini   MPI_Comm               comm;
2677e7931f94SStefano Zampini   PetscMPIInt            n_sends,n_recvs,commsize;
2678e7931f94SStefano Zampini   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals;
2679e7931f94SStefano Zampini   PetscMPIInt            *onodes,*olengths_idxs,*olengths_vals;
2680e7931f94SStefano Zampini   PetscMPIInt            len,tag_idxs,tag_vals,source_dest;
2681e7931f94SStefano Zampini   MPI_Request            *send_req_idxs,*send_req_vals,*recv_req_idxs,*recv_req_vals;
2682e7931f94SStefano Zampini   PetscErrorCode         ierr;
2683e7931f94SStefano Zampini 
2684e7931f94SStefano Zampini   PetscFunctionBegin;
2685e7931f94SStefano Zampini   /* checks */
2686e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
2687e7931f94SStefano Zampini   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on an matrix object which is not of type MATIS",__FUNCT__);
2688e7931f94SStefano Zampini   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2689e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
2690e7931f94SStefano Zampini   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
2691e7931f94SStefano Zampini   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
2692e7931f94SStefano Zampini   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
2693e7931f94SStefano Zampini   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
2694e7931f94SStefano Zampini   PetscValidLogicalCollectiveInt(mat,bs,0);
2695e7931f94SStefano Zampini   /* prepare IS for sending if not provided */
2696e7931f94SStefano Zampini   if (!is_sends) {
2697e7931f94SStefano Zampini     if (!coarsening_ratio) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a coarsening ratio");
2698e7931f94SStefano Zampini     ierr = MatISSubassemble_Private(mat,coarsening_ratio,&is_sends_internal);CHKERRQ(ierr);
2699c8587f34SStefano Zampini   } else {
2700e7931f94SStefano Zampini     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
2701e7931f94SStefano Zampini     is_sends_internal = is_sends;
2702c8587f34SStefano Zampini   }
2703e7931f94SStefano Zampini 
2704e7931f94SStefano Zampini   /* get pointer of MATIS data */
2705e7931f94SStefano Zampini   matis = (Mat_IS*)mat->data;
2706e7931f94SStefano Zampini 
2707e7931f94SStefano Zampini   /* get comm */
2708e7931f94SStefano Zampini   comm = PetscObjectComm((PetscObject)mat);
2709e7931f94SStefano Zampini 
2710e7931f94SStefano Zampini   /* compute number of sends */
2711e7931f94SStefano Zampini   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
2712e7931f94SStefano Zampini   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
2713e7931f94SStefano Zampini 
2714e7931f94SStefano Zampini   /* compute number of receives */
2715e7931f94SStefano Zampini   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
2716e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*iflags),&iflags);CHKERRQ(ierr);
2717e7931f94SStefano Zampini   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
2718e7931f94SStefano Zampini   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2719e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
2720e7931f94SStefano Zampini   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
2721e7931f94SStefano Zampini   ierr = PetscFree(iflags);CHKERRQ(ierr);
2722e7931f94SStefano Zampini 
2723e7931f94SStefano Zampini   /* prepare send/receive buffers */
2724e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_idxs),&ilengths_idxs);CHKERRQ(ierr);
2725e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
2726e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_vals),&ilengths_vals);CHKERRQ(ierr);
2727e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
2728e7931f94SStefano Zampini 
2729e7931f94SStefano Zampini   /* Get data from local mat */
2730e7931f94SStefano Zampini   if (!isdense) {
2731e7931f94SStefano Zampini     /* TODO: See below some guidelines on how to prepare the local buffers */
2732e7931f94SStefano Zampini     /*
2733e7931f94SStefano Zampini        send_buffer_vals should contain the raw values of the local matrix
2734e7931f94SStefano Zampini        send_buffer_idxs should contain:
2735e7931f94SStefano Zampini        - MatType_PRIVATE type
2736e7931f94SStefano Zampini        - PetscInt        size_of_l2gmap
2737e7931f94SStefano Zampini        - PetscInt        global_row_indices[size_of_l2gmap]
2738e7931f94SStefano Zampini        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
2739e7931f94SStefano Zampini     */
2740e7931f94SStefano Zampini   } else {
2741e7931f94SStefano Zampini     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
2742e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&i);CHKERRQ(ierr);
2743e7931f94SStefano Zampini     ierr = PetscMalloc((i+2)*sizeof(PetscInt),&send_buffer_idxs);CHKERRQ(ierr);
2744e7931f94SStefano Zampini     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
2745e7931f94SStefano Zampini     send_buffer_idxs[1] = i;
2746e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2747e7931f94SStefano Zampini     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
2748e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingRestoreIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2749e7931f94SStefano Zampini     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
2750e7931f94SStefano Zampini     for (i=0;i<n_sends;i++) {
2751e7931f94SStefano Zampini       ilengths_vals[is_indices[i]] = len*len;
2752e7931f94SStefano Zampini       ilengths_idxs[is_indices[i]] = len+2;
2753c8587f34SStefano Zampini     }
2754c8587f34SStefano Zampini   }
2755e7931f94SStefano Zampini   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
2756e7931f94SStefano Zampini   buf_size_idxs = 0;
2757e7931f94SStefano Zampini   buf_size_vals = 0;
2758e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2759e7931f94SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
2760e7931f94SStefano Zampini     buf_size_vals += (PetscInt)olengths_vals[i];
2761e7931f94SStefano Zampini   }
2762e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&recv_buffer_idxs);CHKERRQ(ierr);
2763e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_vals*sizeof(PetscScalar),&recv_buffer_vals);CHKERRQ(ierr);
2764e7931f94SStefano Zampini 
2765e7931f94SStefano Zampini   /* get new tags for clean communications */
2766e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
2767e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
2768e7931f94SStefano Zampini 
2769e7931f94SStefano Zampini   /* allocate for requests */
2770e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_idxs);CHKERRQ(ierr);
2771e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_vals);CHKERRQ(ierr);
2772e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_idxs);CHKERRQ(ierr);
2773e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_vals);CHKERRQ(ierr);
2774e7931f94SStefano Zampini 
2775e7931f94SStefano Zampini   /* communications */
2776e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2777e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
2778e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2779e7931f94SStefano Zampini     source_dest = onodes[i];
2780e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
2781e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
2782e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2783e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
2784e7931f94SStefano Zampini   }
2785e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) {
2786e7931f94SStefano Zampini     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
2787e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
2788e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
2789e7931f94SStefano Zampini   }
2790e7931f94SStefano Zampini   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2791e7931f94SStefano Zampini   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
2792e7931f94SStefano Zampini 
2793e7931f94SStefano Zampini   /* assemble new l2g map */
2794e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2795e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2796e7931f94SStefano Zampini   buf_size_idxs = 0;
2797e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2798e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
2799e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2800e7931f94SStefano Zampini   }
2801e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&l2gmap_indices);CHKERRQ(ierr);
2802e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2803e7931f94SStefano Zampini   buf_size_idxs = 0;
2804e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2805e7931f94SStefano Zampini     ierr = PetscMemcpy(&l2gmap_indices[buf_size_idxs],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
2806e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
2807e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2808e7931f94SStefano Zampini   }
2809e7931f94SStefano Zampini   ierr = PetscSortRemoveDupsInt(&buf_size_idxs,l2gmap_indices);CHKERRQ(ierr);
2810e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingCreate(comm,buf_size_idxs,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
2811e7931f94SStefano Zampini   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
2812e7931f94SStefano Zampini 
2813e7931f94SStefano Zampini   /* infer new local matrix type from received local matrices type */
2814e7931f94SStefano Zampini   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
2815e7931f94SStefano 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) */
2816e7931f94SStefano Zampini   new_local_type_private = MATAIJ_PRIVATE;
2817e7931f94SStefano Zampini   new_local_type = MATSEQAIJ;
2818e7931f94SStefano Zampini   if (n_recvs) {
2819be4bc593SStefano Zampini     new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
2820e7931f94SStefano Zampini     ptr_idxs = recv_buffer_idxs;
2821e7931f94SStefano Zampini     for (i=0;i<n_recvs;i++) {
2822e7931f94SStefano Zampini       if ((PetscInt)new_local_type_private != *ptr_idxs) {
2823e7931f94SStefano Zampini         new_local_type_private = MATAIJ_PRIVATE;
2824e7931f94SStefano Zampini         break;
2825e7931f94SStefano Zampini       }
2826e7931f94SStefano Zampini       ptr_idxs += olengths_idxs[i];
2827e7931f94SStefano Zampini     }
2828e7931f94SStefano Zampini     switch (new_local_type_private) {
2829e7931f94SStefano Zampini       case MATDENSE_PRIVATE: /* subassembling of dense matrices does not give a dense matrix! */
2830e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
2831e7931f94SStefano Zampini         bs = 1;
2832e7931f94SStefano Zampini         break;
2833e7931f94SStefano Zampini       case MATAIJ_PRIVATE:
2834e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
2835e7931f94SStefano Zampini         bs = 1;
2836e7931f94SStefano Zampini         break;
2837e7931f94SStefano Zampini       case MATBAIJ_PRIVATE:
2838e7931f94SStefano Zampini         new_local_type = MATSEQBAIJ;
2839e7931f94SStefano Zampini         break;
2840e7931f94SStefano Zampini       case MATSBAIJ_PRIVATE:
2841e7931f94SStefano Zampini         new_local_type = MATSEQSBAIJ;
2842e7931f94SStefano Zampini         break;
2843e7931f94SStefano Zampini       default:
2844e7931f94SStefano Zampini         SETERRQ2(comm,PETSC_ERR_LIB,"Unkwown private type %d in %s",new_local_type_private,__FUNCT__);
2845e7931f94SStefano Zampini         break;
2846e7931f94SStefano Zampini     }
2847e7931f94SStefano Zampini   }
2848e7931f94SStefano Zampini 
2849e7931f94SStefano Zampini   /* create MATIS object */
2850e7931f94SStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
2851e7931f94SStefano Zampini   ierr = MatCreateIS(comm,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,&new_mat);CHKERRQ(ierr);
2852e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
2853e7931f94SStefano Zampini   ierr = MatISGetLocalMat(new_mat,&local_mat);CHKERRQ(ierr);
2854e7931f94SStefano Zampini   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
2855e7931f94SStefano Zampini   ierr = MatSetUp(local_mat);CHKERRQ(ierr); /* WARNING -> no preallocation yet */
2856e7931f94SStefano Zampini 
2857e7931f94SStefano Zampini   /* set values */
2858e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2859e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
2860e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2861e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2862e7931f94SStefano Zampini     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
2863e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
2864e7931f94SStefano Zampini       ierr = MatSetValues(new_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
2865e7931f94SStefano Zampini       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
2866e7931f94SStefano Zampini       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
2867e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
2868e7931f94SStefano Zampini     }
2869e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2870e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
2871e7931f94SStefano Zampini   }
2872e7931f94SStefano Zampini   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2873e7931f94SStefano Zampini   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2874e7931f94SStefano Zampini   ierr = MatAssemblyBegin(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2875e7931f94SStefano Zampini   ierr = MatAssemblyEnd(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2876e7931f94SStefano Zampini 
2877e7931f94SStefano Zampini   { /* check */
2878e7931f94SStefano Zampini     Vec       lvec,rvec;
2879e7931f94SStefano Zampini     PetscReal infty_error;
2880e7931f94SStefano Zampini 
2881e7931f94SStefano Zampini     ierr = MatGetVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
2882e7931f94SStefano Zampini     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
2883e7931f94SStefano Zampini     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
2884e7931f94SStefano Zampini     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
2885e7931f94SStefano Zampini     ierr = MatMultAdd(new_mat,rvec,lvec,lvec);CHKERRQ(ierr);
2886e7931f94SStefano Zampini     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
2887e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
2888e7931f94SStefano Zampini     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
2889e7931f94SStefano Zampini     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
2890e7931f94SStefano Zampini   }
2891e7931f94SStefano Zampini 
2892e7931f94SStefano Zampini   /* free workspace */
2893e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
2894e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
2895e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2896e7931f94SStefano Zampini   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
2897e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2898e7931f94SStefano Zampini   if (isdense) {
2899e7931f94SStefano Zampini     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2900e7931f94SStefano Zampini     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
2901e7931f94SStefano Zampini   } else {
2902e7931f94SStefano Zampini     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
2903e7931f94SStefano Zampini   }
2904e7931f94SStefano Zampini   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
2905e7931f94SStefano Zampini   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
2906e7931f94SStefano Zampini   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
2907e7931f94SStefano Zampini   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
2908e7931f94SStefano Zampini   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
2909e7931f94SStefano Zampini   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
2910e7931f94SStefano Zampini   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
2911e7931f94SStefano Zampini   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
2912e7931f94SStefano Zampini   ierr = PetscFree(onodes);CHKERRQ(ierr);
2913e7931f94SStefano Zampini   /* get back new mat */
2914e7931f94SStefano Zampini   *mat_n = new_mat;
2915e7931f94SStefano Zampini   PetscFunctionReturn(0);
2916e7931f94SStefano Zampini }
2917a57a6d2fSStefano Zampini 
2918c8587f34SStefano Zampini #undef __FUNCT__
2919c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
2920c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
2921c8587f34SStefano Zampini {
2922c8587f34SStefano Zampini   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
2923c8587f34SStefano Zampini   PC_IS                  *pcis = (PC_IS*)pc->data;
292420a2ab83SStefano Zampini   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
29259881197aSStefano Zampini   MatNullSpace           CoarseNullSpace=NULL;
292620a2ab83SStefano Zampini   ISLocalToGlobalMapping coarse_islg;
292720a2ab83SStefano Zampini   IS                     coarse_is;
2928f9eb5b7dSStefano Zampini   PetscInt               max_it,coarse_size,*local_primal_indices=NULL;
2929f9eb5b7dSStefano Zampini   PetscInt               im_active=-1,active_procs=-1;
2930f9eb5b7dSStefano Zampini   PC                     pc_temp;
2931c8587f34SStefano Zampini   PCType                 coarse_pc_type;
2932c8587f34SStefano Zampini   KSPType                coarse_ksp_type;
2933f9eb5b7dSStefano Zampini   PetscBool              multilevel_requested,multilevel_allowed;
2934f9eb5b7dSStefano Zampini   PetscBool              setsym,issym,isbddc,isnn;
2935f9eb5b7dSStefano Zampini   MatStructure           matstruct;
29369881197aSStefano Zampini   PetscErrorCode         ierr;
2937fdc09c96SStefano Zampini 
2938c8587f34SStefano Zampini   PetscFunctionBegin;
2939c8587f34SStefano Zampini   /* Assign global numbering to coarse dofs */
2940f34684f1SStefano Zampini   ierr = PCBDDCComputePrimalNumbering(pc,&coarse_size,&local_primal_indices);CHKERRQ(ierr);
2941c8587f34SStefano Zampini 
2942f9eb5b7dSStefano Zampini   /* infer some info from user */
2943f9eb5b7dSStefano Zampini   issym = PETSC_FALSE;
2944f9eb5b7dSStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
2945f9eb5b7dSStefano Zampini   multilevel_allowed = PETSC_FALSE;
2946f9eb5b7dSStefano Zampini   multilevel_requested = PETSC_FALSE;
2947f9eb5b7dSStefano Zampini   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
2948f9eb5b7dSStefano Zampini   if (multilevel_requested) {
29492b510759SStefano Zampini     /* count "active processes" */
29502b510759SStefano Zampini     im_active = !!(pcis->n);
29512b510759SStefano Zampini     ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
29522b510759SStefano Zampini     if (active_procs/pcbddc->coarsening_ratio < 2) {
2953f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_FALSE;
29542b510759SStefano Zampini     } else {
2955f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_TRUE;
2956c8587f34SStefano Zampini     }
2957c8587f34SStefano Zampini   }
2958e7931f94SStefano Zampini 
2959f9eb5b7dSStefano Zampini   /* set defaults for coarse KSP and PC */
2960f9eb5b7dSStefano Zampini   if (multilevel_allowed) {
2961c8587f34SStefano Zampini     if (issym) {
2962f9eb5b7dSStefano Zampini       coarse_ksp_type = KSPRICHARDSON;
2963f9eb5b7dSStefano Zampini     } else {
2964f9eb5b7dSStefano Zampini       coarse_ksp_type = KSPCHEBYSHEV;
2965c8587f34SStefano Zampini     }
2966f9eb5b7dSStefano Zampini     coarse_pc_type = PCBDDC;
2967f9eb5b7dSStefano Zampini   } else {
2968f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPPREONLY;
2969f9eb5b7dSStefano Zampini     coarse_pc_type = PCREDUNDANT;
2970c8587f34SStefano Zampini   }
2971c8587f34SStefano Zampini 
2972f9eb5b7dSStefano Zampini   /* create the coarse KSP object only once with defaults */
2973f9eb5b7dSStefano Zampini   if (!pcbddc->coarse_ksp) {
2974e604994aSStefano Zampini     char prefix[256],str_level[3];
2975e604994aSStefano Zampini     size_t len;
2976f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_ksp);CHKERRQ(ierr);
2977c8587f34SStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
2978f9eb5b7dSStefano Zampini     ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
2979c8587f34SStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
2980c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
2981c8587f34SStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
2982e604994aSStefano Zampini     /* prefix */
2983e604994aSStefano Zampini     ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
2984e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
2985e604994aSStefano Zampini     if (!pcbddc->current_level) {
2986e604994aSStefano Zampini       ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
2987e604994aSStefano Zampini       ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
2988c8587f34SStefano Zampini     } else {
2989e604994aSStefano Zampini       ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
2990e604994aSStefano Zampini       if (pcbddc->current_level>1) len -= 2;
2991e604994aSStefano Zampini       ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
2992e604994aSStefano Zampini       *(prefix+len)='\0';
2993e604994aSStefano Zampini       sprintf(str_level,"%d_",(int)(pcbddc->current_level));
2994e604994aSStefano Zampini       ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
2995e604994aSStefano Zampini     }
2996e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
2997f9eb5b7dSStefano Zampini   }
2998f9eb5b7dSStefano Zampini   /* allow user customization */
299985c4d303SStefano Zampini   /* ierr = PetscPrintf(PETSC_COMM_WORLD,"Type of %s before setting from options %s\n",((PetscObject)pcbddc->coarse_ksp)->prefix,((PetscObject)pcbddc->coarse_ksp)->type_name);CHKERRQ(ierr); */
3000f9eb5b7dSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
300185c4d303SStefano Zampini   /* ierr = PetscPrintf(PETSC_COMM_WORLD,"Type of %s after setting from options %s\n",((PetscObject)pcbddc->coarse_ksp)->prefix,((PetscObject)pcbddc->coarse_ksp)->type_name);CHKERRQ(ierr); */
3002f9eb5b7dSStefano Zampini 
3003f9eb5b7dSStefano Zampini   /* get some info after set from options */
3004f9eb5b7dSStefano Zampini   ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3005f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
3006f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
3007f9eb5b7dSStefano Zampini   if (isbddc && !multilevel_allowed) { /* prevent from infinite loop if user as requested bddc pc for coarse solver */
3008f9eb5b7dSStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
3009f9eb5b7dSStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
3010f9eb5b7dSStefano Zampini     isbddc = PETSC_FALSE;
3011f9eb5b7dSStefano Zampini   }
3012f9eb5b7dSStefano Zampini 
3013f9eb5b7dSStefano Zampini   /* propagate BDDC info to the next level */
3014f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
3015f9eb5b7dSStefano Zampini   ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
3016f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
3017f9eb5b7dSStefano Zampini 
3018f9eb5b7dSStefano Zampini   /* creates temporary MATIS object for coarse matrix */
3019a57a6d2fSStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,local_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
3020a57a6d2fSStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
3021a57a6d2fSStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
3022a57a6d2fSStefano Zampini   ierr = MatCreateIS(PetscObjectComm((PetscObject)pc),1,PETSC_DECIDE,PETSC_DECIDE,coarse_size,coarse_size,coarse_islg,&coarse_mat_is);CHKERRQ(ierr);
3023a57a6d2fSStefano Zampini   ierr = MatISSetLocalMat(coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
3024e7931f94SStefano Zampini   ierr = MatAssemblyBegin(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3025e7931f94SStefano Zampini   ierr = MatAssemblyEnd(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
302620a2ab83SStefano Zampini   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
302720a2ab83SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
302820a2ab83SStefano Zampini   ierr = PetscFree(local_primal_indices);CHKERRQ(ierr);
3029fdc09c96SStefano Zampini 
3030f9eb5b7dSStefano Zampini   /* assemble coarse matrix */
3031f9eb5b7dSStefano Zampini   if (isbddc || isnn) {
3032f9eb5b7dSStefano Zampini     ierr = MatISSubassemble(coarse_mat_is,NULL,pcbddc->coarsening_ratio,&coarse_mat);CHKERRQ(ierr);
3033f9eb5b7dSStefano Zampini   } else {
30342b510759SStefano Zampini     ierr = MatConvert_IS_AIJ(coarse_mat_is,MATAIJ,MAT_INITIAL_MATRIX,&coarse_mat);CHKERRQ(ierr);
3035c8587f34SStefano Zampini   }
30362b510759SStefano Zampini   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
30379881197aSStefano Zampini 
3038f9eb5b7dSStefano Zampini   /* create local to global scatters for coarse problem */
3039f9eb5b7dSStefano Zampini   ierr = MatGetVecs(coarse_mat,&pcbddc->coarse_vec,&pcbddc->coarse_rhs);CHKERRQ(ierr);
3040f9eb5b7dSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3041f9eb5b7dSStefano Zampini   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
3042f9eb5b7dSStefano Zampini 
3043f9eb5b7dSStefano Zampini   /* propagate symmetry info to coarse matrix */
3044f9eb5b7dSStefano Zampini   ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,issym);CHKERRQ(ierr);
3045f9eb5b7dSStefano Zampini 
3046b8ffe317SStefano Zampini   /* Compute coarse null space (special handling by BDDC only) */
3047b8ffe317SStefano Zampini   if (pcbddc->NullSpace) {
3048b8ffe317SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCoarse(pc,coarse_mat,&CoarseNullSpace);CHKERRQ(ierr);
3049b8ffe317SStefano Zampini     if (isbddc) {
3050b8ffe317SStefano Zampini       ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
3051b8ffe317SStefano Zampini     } else {
3052c8587f34SStefano Zampini       ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
3053c8587f34SStefano Zampini     }
3054c8587f34SStefano Zampini   }
3055c8587f34SStefano Zampini 
3056f9eb5b7dSStefano Zampini   /* set operators */
3057f9eb5b7dSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
3058f9eb5b7dSStefano Zampini   ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat,matstruct);CHKERRQ(ierr);
3059f9eb5b7dSStefano Zampini 
3060f9eb5b7dSStefano Zampini   /* additional KSP customization */
3061f9eb5b7dSStefano Zampini   ierr = KSPGetTolerances(pcbddc->coarse_ksp,NULL,NULL,NULL,&max_it);CHKERRQ(ierr);
3062f9eb5b7dSStefano Zampini   if (max_it < 5) {
3063c8587f34SStefano Zampini     ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
3064f9eb5b7dSStefano Zampini   }
3065b8ffe317SStefano Zampini   /* ierr = KSPChebyshevSetEstimateEigenvalues(pcbddc->coarse_ksp,1.0,0.0,0.0,1.1);CHKERRQ(ierr); */
3066f9eb5b7dSStefano Zampini 
3067f9eb5b7dSStefano Zampini 
3068f9eb5b7dSStefano Zampini   /* print some info if requested */
3069f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
3070f9eb5b7dSStefano Zampini     ierr = KSPGetType(pcbddc->coarse_ksp,&coarse_ksp_type);CHKERRQ(ierr);
3071f9eb5b7dSStefano Zampini     ierr = PCGetType(pc_temp,&coarse_pc_type);CHKERRQ(ierr);
3072f9eb5b7dSStefano Zampini     if (!multilevel_allowed) {
3073f9eb5b7dSStefano Zampini       if (multilevel_requested) {
3074f9eb5b7dSStefano 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);
3075f9eb5b7dSStefano Zampini       } else if (pcbddc->max_levels) {
3076f9eb5b7dSStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
3077c8587f34SStefano Zampini       }
3078c8587f34SStefano Zampini     }
3079e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Calling %s/%s setup at level %d for coarse solver (%s)\n",coarse_ksp_type,coarse_pc_type,pcbddc->current_level,((PetscObject)pcbddc->coarse_ksp)->prefix);CHKERRQ(ierr);
3080f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3081c8587f34SStefano Zampini   }
3082f9eb5b7dSStefano Zampini 
3083f9eb5b7dSStefano Zampini   /* setup coarse ksp */
3084f9eb5b7dSStefano Zampini   ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
3085f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
3086f9eb5b7dSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
3087f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3088f9eb5b7dSStefano Zampini     ierr = KSPView(pcbddc->coarse_ksp,pcbddc->dbg_viewer);CHKERRQ(ierr);
3089f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3090f9eb5b7dSStefano Zampini   }
3091f9eb5b7dSStefano Zampini 
3092c8587f34SStefano Zampini   /* Check coarse problem if requested */
309320a2ab83SStefano Zampini   if (pcbddc->dbg_flag) {
3094c8587f34SStefano Zampini     KSP       check_ksp;
30952b510759SStefano Zampini     KSPType   check_ksp_type;
3096c8587f34SStefano Zampini     PC        check_pc;
3097c8587f34SStefano Zampini     Vec       check_vec;
3098c8587f34SStefano Zampini     PetscReal abs_infty_error,infty_error,lambda_min,lambda_max;
30992b510759SStefano Zampini     PetscInt  its;
3100f9eb5b7dSStefano Zampini     PetscBool ispreonly,compute;
3101c8587f34SStefano Zampini 
31022b510759SStefano Zampini     /* Create ksp object suitable for estimation of extreme eigenvalues */
3103f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&check_ksp);CHKERRQ(ierr);
3104fdc635d7SStefano Zampini     ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
3105983f5fd7SStefano Zampini     ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,coarse_size);CHKERRQ(ierr);
31062b510759SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
31072b510759SStefano Zampini     if (ispreonly) {
31082b510759SStefano Zampini       check_ksp_type = KSPPREONLY;
3109f9eb5b7dSStefano Zampini       compute = PETSC_FALSE;
31102b510759SStefano Zampini     } else {
3111c8587f34SStefano Zampini       if (issym) check_ksp_type = KSPCG;
3112c8587f34SStefano Zampini       else check_ksp_type = KSPGMRES;
3113f9eb5b7dSStefano Zampini       compute = PETSC_TRUE;
3114c8587f34SStefano Zampini     }
3115c8587f34SStefano Zampini     ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
3116f9eb5b7dSStefano Zampini     ierr = KSPSetComputeSingularValues(check_ksp,compute);CHKERRQ(ierr);
3117c8587f34SStefano Zampini     ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
3118c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
3119c8587f34SStefano Zampini     ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
3120c8587f34SStefano Zampini     /* create random vec */
3121c8587f34SStefano Zampini     ierr = VecDuplicate(pcbddc->coarse_vec,&check_vec);CHKERRQ(ierr);
3122c8587f34SStefano Zampini     ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
3123c8587f34SStefano Zampini     if (CoarseNullSpace) {
3124c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec);CHKERRQ(ierr);
3125c8587f34SStefano Zampini     }
3126fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3127c8587f34SStefano Zampini     /* solve coarse problem */
3128c8587f34SStefano Zampini     ierr = KSPSolve(check_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
3129c8587f34SStefano Zampini     if (CoarseNullSpace) {
3130c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,pcbddc->coarse_vec);CHKERRQ(ierr);
3131c8587f34SStefano Zampini     }
3132c8587f34SStefano Zampini     /* check coarse problem residual error */
3133c8587f34SStefano Zampini     ierr = VecAXPY(check_vec,-1.0,pcbddc->coarse_vec);CHKERRQ(ierr);
3134c8587f34SStefano Zampini     ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3135fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3136c8587f34SStefano Zampini     ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
3137c8587f34SStefano Zampini     ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
3138e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem (%s) details\n",((PetscObject)(pcbddc->coarse_ksp))->prefix);CHKERRQ(ierr);
3139e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
3140e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
3141f9eb5b7dSStefano Zampini     /* get eigenvalue estimation if preonly has not been requested */
31422b510759SStefano Zampini     if (!ispreonly) {
3143c8587f34SStefano Zampini       ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
314420a2ab83SStefano Zampini       ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
3145f9eb5b7dSStefano 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);
3146c8587f34SStefano Zampini     }
31472b510759SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3148c8587f34SStefano Zampini     ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
3149c8587f34SStefano Zampini   }
31502b510759SStefano Zampini   /* free memory */
3151c8587f34SStefano Zampini   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
3152fdc635d7SStefano Zampini   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
3153c8587f34SStefano Zampini   PetscFunctionReturn(0);
3154c8587f34SStefano Zampini }
3155674ae819SStefano Zampini 
3156f34684f1SStefano Zampini #undef __FUNCT__
3157f34684f1SStefano Zampini #define __FUNCT__ "PCBDDCComputePrimalNumbering"
3158f34684f1SStefano Zampini PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
3159f34684f1SStefano Zampini {
3160f34684f1SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3161f34684f1SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
3162f34684f1SStefano Zampini   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
3163f34684f1SStefano Zampini   PetscInt       i,j,coarse_size;
3164f34684f1SStefano Zampini   PetscInt       *local_primal_indices,*auxlocal_primal,*aux_idx;
3165f34684f1SStefano Zampini   PetscErrorCode ierr;
3166f34684f1SStefano Zampini 
3167f34684f1SStefano Zampini   PetscFunctionBegin;
3168f34684f1SStefano Zampini   /* get indices in local ordering for vertices and constraints */
3169f34684f1SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&auxlocal_primal);CHKERRQ(ierr);
3170f34684f1SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&i,&aux_idx);CHKERRQ(ierr);
3171f34684f1SStefano Zampini   ierr = PetscMemcpy(auxlocal_primal,aux_idx,i*sizeof(PetscInt));CHKERRQ(ierr);
3172f34684f1SStefano Zampini   ierr = PetscFree(aux_idx);CHKERRQ(ierr);
3173f34684f1SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&j,&aux_idx);CHKERRQ(ierr);
3174f34684f1SStefano Zampini   ierr = PetscMemcpy(&auxlocal_primal[i],aux_idx,j*sizeof(PetscInt));CHKERRQ(ierr);
3175f34684f1SStefano Zampini   ierr = PetscFree(aux_idx);CHKERRQ(ierr);
3176f34684f1SStefano Zampini 
3177f34684f1SStefano Zampini   /* Compute global number of coarse dofs */
3178f34684f1SStefano Zampini   ierr = PCBDDCSubsetNumbering(PetscObjectComm((PetscObject)(pc->pmat)),matis->mapping,pcbddc->local_primal_size,auxlocal_primal,NULL,&coarse_size,&local_primal_indices);CHKERRQ(ierr);
3179f34684f1SStefano Zampini 
3180f34684f1SStefano Zampini   /* check numbering */
3181f34684f1SStefano Zampini   if (pcbddc->dbg_flag) {
3182f34684f1SStefano Zampini     PetscScalar coarsesum,*array;
3183f34684f1SStefano Zampini 
3184f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3185f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3186f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
3187f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
3188f34684f1SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
3189f34684f1SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,auxlocal_primal[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
3190f34684f1SStefano Zampini     }
3191f34684f1SStefano Zampini     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
3192f34684f1SStefano Zampini     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
3193f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3194f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3195f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3196f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3197f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3198f34684f1SStefano Zampini     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3199f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3200f34684f1SStefano Zampini       if (array[i] == 1.0) {
3201f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %d owned by a single process!\n",PetscGlobalRank,i);CHKERRQ(ierr);
3202f34684f1SStefano Zampini       }
3203f34684f1SStefano Zampini     }
3204f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3205f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3206f34684f1SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
3207f34684f1SStefano Zampini     }
3208f34684f1SStefano Zampini     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3209f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3210f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3211f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3212f34684f1SStefano Zampini     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
3213f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
3214f34684f1SStefano Zampini     if (pcbddc->dbg_flag > 1) {
3215f34684f1SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
3216f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3217f34684f1SStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
3218f34684f1SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
3219f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_primal_indices[%d]=%d \n",i,local_primal_indices[i]);
3220f34684f1SStefano Zampini       }
3221f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3222f34684f1SStefano Zampini     }
3223f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3224f34684f1SStefano Zampini   }
3225f34684f1SStefano Zampini   ierr = PetscFree(auxlocal_primal);CHKERRQ(ierr);
3226f34684f1SStefano Zampini   /* get back data */
3227f34684f1SStefano Zampini   *coarse_size_n = coarse_size;
3228f34684f1SStefano Zampini   *local_primal_indices_n = local_primal_indices;
3229674ae819SStefano Zampini   PetscFunctionReturn(0);
3230674ae819SStefano Zampini }
3231674ae819SStefano Zampini 
3232