xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision eb97c9d281e1e6b405ea8e13f1ece24889ffc2d3)
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) {
2639577ea80SStefano Zampini     /* PetscInt ibs,iibs,mbs; */
2649577ea80SStefano Zampini     PetscBool issbaij,isbaij;
2659577ea80SStefano Zampini 
26625084f0cSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,n_vertices,vertices,PETSC_COPY_VALUES,&is_aux);CHKERRQ(ierr);
2679577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
2689577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQBAIJ,&isbaij);CHKERRQ(ierr);
2699577ea80SStefano Zampini     if (issbaij || isbaij) {
270af732b37SStefano Zampini       Mat newmat;
271af732b37SStefano Zampini       ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
272af732b37SStefano Zampini       ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
273af732b37SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
274af732b37SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
275af732b37SStefano Zampini       ierr = MatDestroy(&newmat);CHKERRQ(ierr);
276af732b37SStefano Zampini     } else {
2779577ea80SStefano Zampini       ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
2788ce42a96SStefano Zampini       ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
2798ce42a96SStefano Zampini       ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
280af732b37SStefano Zampini     }
2819577ea80SStefano Zampini /*
2829577ea80SStefano Zampini     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
2839577ea80SStefano Zampini     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
2849577ea80SStefano Zampini     ierr = ISGetBlockSize(is_aux,&iibs);CHKERRQ(ierr);
2859577ea80SStefano Zampini     if (ibs != mbs || iibs != mbs) {
2869577ea80SStefano Zampini       Mat newmat;
2879577ea80SStefano Zampini       ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
2889577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
2899577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
2909577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
2919577ea80SStefano Zampini       ierr = MatDestroy(&newmat);CHKERRQ(ierr);
2929577ea80SStefano Zampini     } else {
2939577ea80SStefano Zampini       ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
2949577ea80SStefano Zampini       ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
2959577ea80SStefano Zampini       ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
2969577ea80SStefano Zampini     }
2979577ea80SStefano Zampini */
29825084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
29988ebb749SStefano Zampini   }
30088ebb749SStefano Zampini 
30188ebb749SStefano Zampini   /* Matrix of coarse basis functions (local) */
30288ebb749SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
30388ebb749SStefano Zampini   ierr = MatSetSizes(pcbddc->coarse_phi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
30488ebb749SStefano Zampini   ierr = MatSetType(pcbddc->coarse_phi_B,impMatType);CHKERRQ(ierr);
30525084f0cSStefano Zampini   ierr = MatSetUp(pcbddc->coarse_phi_B);CHKERRQ(ierr);
3068eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
30788ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
30888ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_phi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
30988ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_phi_D,impMatType);CHKERRQ(ierr);
31025084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_phi_D);CHKERRQ(ierr);
31188ebb749SStefano Zampini   }
31288ebb749SStefano Zampini 
31325084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
3148ce42a96SStefano Zampini     ierr = ISGetIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
31588ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*coarsefunctions_errors),&coarsefunctions_errors);CHKERRQ(ierr);
31688ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*constraints_errors),&constraints_errors);CHKERRQ(ierr);
31788ebb749SStefano Zampini   }
31888ebb749SStefano Zampini   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
31988ebb749SStefano Zampini   ierr = PetscMalloc((pcbddc->local_primal_size)*(pcbddc->local_primal_size)*sizeof(PetscScalar),&coarse_submat_vals);CHKERRQ(ierr);
32088ebb749SStefano Zampini 
32188ebb749SStefano Zampini   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
32225084f0cSStefano Zampini 
32325084f0cSStefano Zampini   /* vertices */
32488ebb749SStefano Zampini   for (i=0;i<n_vertices;i++) {
32588ebb749SStefano Zampini     ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
32688ebb749SStefano Zampini     ierr = VecSetValue(vec1_V,i,one,INSERT_VALUES);CHKERRQ(ierr);
32788ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
32888ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
32925084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on constraints multipliers */
33088ebb749SStefano Zampini     ierr = MatMult(A_RV,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
33188ebb749SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
33288ebb749SStefano Zampini     ierr = VecScale(pcbddc->vec1_R,m_one);CHKERRQ(ierr);
33388ebb749SStefano Zampini     if (n_constraints) {
33488ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec1_R,vec1_C);CHKERRQ(ierr);
33588ebb749SStefano Zampini       ierr = MatMultAdd(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
33688ebb749SStefano Zampini       ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
33788ebb749SStefano Zampini     }
33888ebb749SStefano Zampini     ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
33988ebb749SStefano Zampini     ierr = MatMultAdd(A_VV,vec1_V,vec2_V,vec2_V);CHKERRQ(ierr);
34088ebb749SStefano Zampini 
34188ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
34288ebb749SStefano Zampini     /* coarse basis functions */
34388ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
34488ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
34588ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
34625084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
34788ebb749SStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
34825084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
34988ebb749SStefano Zampini     ierr = MatSetValue(pcbddc->coarse_phi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
3508eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
35188ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
35288ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
35325084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
35488ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
35525084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
35688ebb749SStefano Zampini     }
35725084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
35825084f0cSStefano Zampini     ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
35925084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
36025084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
36188ebb749SStefano Zampini     if (n_constraints) {
36225084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
36325084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
36425084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
36588ebb749SStefano Zampini     }
36688ebb749SStefano Zampini 
36725084f0cSStefano Zampini     /* check */
36825084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
36925084f0cSStefano Zampini       /* assemble subdomain vector on local nodes */
37088ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
37125084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
37225084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
37325084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
37425084f0cSStefano Zampini       ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
37525084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
37625084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
37788ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers (i.e. primal nodes) */
37888ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
37925084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
38025084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
38125084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
38288ebb749SStefano Zampini       if (n_constraints) {
38325084f0cSStefano Zampini         ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
38425084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
38525084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
38688ebb749SStefano Zampini       }
38725084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
38825084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
38988ebb749SStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
39088ebb749SStefano Zampini       /* check saddle point solution */
39188ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
39288ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
39388ebb749SStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i]);CHKERRQ(ierr);
39488ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
39525084f0cSStefano Zampini       /* shift by the identity matrix */
39625084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
39725084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
39825084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
39988ebb749SStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i]);CHKERRQ(ierr);
40088ebb749SStefano Zampini     }
40188ebb749SStefano Zampini   }
40288ebb749SStefano Zampini 
40325084f0cSStefano Zampini   /* constraints */
40488ebb749SStefano Zampini   for (i=0;i<n_constraints;i++) {
40588ebb749SStefano Zampini     ierr = VecSet(vec2_C,zero);CHKERRQ(ierr);
40688ebb749SStefano Zampini     ierr = VecSetValue(vec2_C,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
40788ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec2_C);CHKERRQ(ierr);
40888ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec2_C);CHKERRQ(ierr);
40925084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on vertices multipliers */
41088ebb749SStefano Zampini     ierr = MatMult(M1,vec2_C,vec1_C);CHKERRQ(ierr);
41188ebb749SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
41288ebb749SStefano Zampini     ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
41325084f0cSStefano Zampini     if (n_vertices) {
41425084f0cSStefano Zampini       ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
41525084f0cSStefano Zampini     }
41688ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
41788ebb749SStefano Zampini     /* coarse basis functions */
41825084f0cSStefano Zampini     j = i+n_vertices; /* don't touch this! */
41988ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
42088ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
42188ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
42225084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
42325084f0cSStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
42425084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
4258eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
42688ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
42788ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
42825084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
42925084f0cSStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
43025084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
43188ebb749SStefano Zampini     }
43225084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
43388ebb749SStefano Zampini     if (n_vertices) {
43425084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
43525084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
43625084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
43788ebb749SStefano Zampini     }
43825084f0cSStefano Zampini     ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
43925084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
44025084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
44188ebb749SStefano Zampini 
44225084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
44388ebb749SStefano Zampini       /* assemble subdomain vector on nodes */
44488ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
44525084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
44625084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
44725084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
44825084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
44925084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
45088ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers */
45188ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
45288ebb749SStefano Zampini       if (n_vertices) {
45325084f0cSStefano Zampini         ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
45425084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
45525084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
45688ebb749SStefano Zampini       }
45725084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
45825084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
45925084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
46025084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
46125084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
46225084f0cSStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
46388ebb749SStefano Zampini       /* check saddle point solution */
46488ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
46588ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
46625084f0cSStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[j]);CHKERRQ(ierr);
46788ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
46825084f0cSStefano Zampini       /* shift by the identity matrix */
46925084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,j,m_one,ADD_VALUES);CHKERRQ(ierr);
47025084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
47125084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
47225084f0cSStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[j]);CHKERRQ(ierr);
47388ebb749SStefano Zampini     }
47488ebb749SStefano Zampini   }
47525084f0cSStefano Zampini   /* call assembling routines for local coarse basis */
47688ebb749SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
47788ebb749SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4788eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
47988ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
48088ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
48188ebb749SStefano Zampini   }
48225084f0cSStefano Zampini 
48388ebb749SStefano Zampini   /* compute other basis functions for non-symmetric problems */
48488ebb749SStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
48588ebb749SStefano Zampini   if (!setsym || (setsym && !issym)) {
48688ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
48788ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_psi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
48888ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_psi_B,impMatType);CHKERRQ(ierr);
48925084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_psi_B);CHKERRQ(ierr);
4908eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
49188ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
49288ebb749SStefano Zampini       ierr = MatSetSizes(pcbddc->coarse_psi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
49388ebb749SStefano Zampini       ierr = MatSetType(pcbddc->coarse_psi_D,impMatType);CHKERRQ(ierr);
49425084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->coarse_psi_D);CHKERRQ(ierr);
49588ebb749SStefano Zampini     }
49688ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
49788ebb749SStefano Zampini       if (n_constraints) {
49888ebb749SStefano Zampini         ierr = VecSet(vec1_C,zero);CHKERRQ(ierr);
49988ebb749SStefano Zampini         for (j=0;j<n_constraints;j++) {
50025084f0cSStefano Zampini           ierr = VecSetValue(vec1_C,j,coarse_submat_vals[(j+n_vertices)*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
50188ebb749SStefano Zampini         }
50225084f0cSStefano Zampini         ierr = VecAssemblyBegin(vec1_C);CHKERRQ(ierr);
50325084f0cSStefano Zampini         ierr = VecAssemblyEnd(vec1_C);CHKERRQ(ierr);
50488ebb749SStefano Zampini       }
50588ebb749SStefano Zampini       if (i<n_vertices) {
50688ebb749SStefano Zampini         ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
50788ebb749SStefano Zampini         ierr = VecSetValue(vec1_V,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
50888ebb749SStefano Zampini         ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
50988ebb749SStefano Zampini         ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
51088ebb749SStefano Zampini         ierr = MatMultTranspose(A_VR,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
51188ebb749SStefano Zampini         if (n_constraints) {
51288ebb749SStefano Zampini           ierr = MatMultTransposeAdd(C_CR,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
51388ebb749SStefano Zampini         }
51488ebb749SStefano Zampini       } else {
51588ebb749SStefano Zampini         ierr = MatMultTranspose(C_CR,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
51688ebb749SStefano Zampini       }
51788ebb749SStefano Zampini       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
51888ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
51988ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
52088ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
52125084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
52288ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_psi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
52325084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
52488ebb749SStefano Zampini       if (i<n_vertices) {
52588ebb749SStefano Zampini         ierr = MatSetValue(pcbddc->coarse_psi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
52688ebb749SStefano Zampini       }
5278eeda7d8SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
52888ebb749SStefano Zampini         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
52988ebb749SStefano Zampini         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
53025084f0cSStefano Zampini         ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
53188ebb749SStefano Zampini         ierr = MatSetValues(pcbddc->coarse_psi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
53225084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
53388ebb749SStefano Zampini       }
53488ebb749SStefano Zampini 
53525084f0cSStefano Zampini       if (pcbddc->dbg_flag) {
53688ebb749SStefano Zampini         /* assemble subdomain vector on nodes */
53788ebb749SStefano Zampini         ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
53825084f0cSStefano Zampini         ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
53925084f0cSStefano Zampini         ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
54025084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
54125084f0cSStefano Zampini         if (i<n_vertices) {
54225084f0cSStefano Zampini           ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
54388ebb749SStefano Zampini         }
54425084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
54525084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
54625084f0cSStefano Zampini         /* assemble subdomain vector of lagrange multipliers */
54725084f0cSStefano Zampini         for (j=0;j<pcbddc->local_primal_size;j++) {
54825084f0cSStefano Zampini           ierr = VecSetValue(pcbddc->vec1_P,j,-coarse_submat_vals[j*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
54925084f0cSStefano Zampini         }
55025084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
55125084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
55288ebb749SStefano Zampini         /* check saddle point solution */
55388ebb749SStefano Zampini         ierr = MatMultTranspose(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
55488ebb749SStefano Zampini         ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
55588ebb749SStefano Zampini         ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
55688ebb749SStefano Zampini         ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
55725084f0cSStefano Zampini         /* shift by the identity matrix */
55825084f0cSStefano Zampini         ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
55925084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
56025084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
56188ebb749SStefano Zampini         ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
56288ebb749SStefano Zampini       }
56388ebb749SStefano Zampini     }
56488ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
56588ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5668eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
56788ebb749SStefano Zampini       ierr = MatAssemblyBegin(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
56888ebb749SStefano Zampini       ierr = MatAssemblyEnd(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
56988ebb749SStefano Zampini     }
57088ebb749SStefano Zampini   }
57188ebb749SStefano Zampini   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
57288ebb749SStefano Zampini   /* Checking coarse_sub_mat and coarse basis functios */
57388ebb749SStefano Zampini   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
57488ebb749SStefano Zampini   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
57525084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
57688ebb749SStefano Zampini     Mat         coarse_sub_mat;
57725084f0cSStefano Zampini     Mat         AUXMAT,TM1,TM2,TM3,TM4;
57888ebb749SStefano Zampini     Mat         coarse_phi_D,coarse_phi_B;
57988ebb749SStefano Zampini     Mat         coarse_psi_D,coarse_psi_B;
58088ebb749SStefano Zampini     Mat         A_II,A_BB,A_IB,A_BI;
58188ebb749SStefano Zampini     MatType     checkmattype=MATSEQAIJ;
58288ebb749SStefano Zampini     PetscReal   real_value;
58388ebb749SStefano Zampini 
58488ebb749SStefano Zampini     ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
58588ebb749SStefano Zampini     ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
58688ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
58788ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
58888ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
58988ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
59088ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
59188ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
59288ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
59388ebb749SStefano Zampini     }
59488ebb749SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
59588ebb749SStefano Zampini 
59625084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
59725084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat and local basis functions\n");CHKERRQ(ierr);
59825084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
59988ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
60088ebb749SStefano Zampini       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
60188ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
60288ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
60388ebb749SStefano Zampini       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
60488ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
60588ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
60688ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
60788ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
60888ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
60988ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
61088ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
61188ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
61288ebb749SStefano Zampini     } else {
61388ebb749SStefano Zampini       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
61488ebb749SStefano Zampini       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
61588ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
61688ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
61788ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
61888ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
61988ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
62088ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
62188ebb749SStefano Zampini     }
62288ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
62388ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
62488ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
62588ebb749SStefano Zampini     ierr = MatConvert(TM1,MATSEQDENSE,MAT_REUSE_MATRIX,&TM1);CHKERRQ(ierr);
62688ebb749SStefano Zampini     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
62788ebb749SStefano Zampini     ierr = MatNorm(TM1,NORM_INFINITY,&real_value);CHKERRQ(ierr);
62825084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"----------------------------------\n");CHKERRQ(ierr);
62925084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d \n",PetscGlobalRank);CHKERRQ(ierr);
63025084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"matrix error = % 1.14e\n",real_value);CHKERRQ(ierr);
63125084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (phi) errors\n");CHKERRQ(ierr);
63288ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
63325084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,coarsefunctions_errors[i]);CHKERRQ(ierr);
63488ebb749SStefano Zampini     }
63525084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (phi) errors\n");CHKERRQ(ierr);
63688ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
63725084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,constraints_errors[i]);CHKERRQ(ierr);
63888ebb749SStefano Zampini     }
63988ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
64025084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (psi) errors\n");CHKERRQ(ierr);
64188ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
64225084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,coarsefunctions_errors[i]);CHKERRQ(ierr);
64388ebb749SStefano Zampini       }
64425084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (psi) errors\n");CHKERRQ(ierr);
64588ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
64625084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,constraints_errors[i]);CHKERRQ(ierr);
64788ebb749SStefano Zampini       }
64888ebb749SStefano Zampini     }
64925084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
65088ebb749SStefano Zampini     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
65188ebb749SStefano Zampini     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
65288ebb749SStefano Zampini     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
65388ebb749SStefano Zampini     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
65488ebb749SStefano Zampini     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
65588ebb749SStefano Zampini     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
65688ebb749SStefano Zampini     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
65788ebb749SStefano Zampini     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
65888ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
65988ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
66088ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
66188ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
66288ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
66388ebb749SStefano Zampini     }
66488ebb749SStefano Zampini     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
6658ce42a96SStefano Zampini     ierr = ISRestoreIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
66688ebb749SStefano Zampini     ierr = PetscFree(coarsefunctions_errors);CHKERRQ(ierr);
66788ebb749SStefano Zampini     ierr = PetscFree(constraints_errors);CHKERRQ(ierr);
66888ebb749SStefano Zampini   }
66988ebb749SStefano Zampini   /* free memory */
67088ebb749SStefano Zampini   if (n_vertices) {
67188ebb749SStefano Zampini     ierr = PetscFree(vertices);CHKERRQ(ierr);
67288ebb749SStefano Zampini     ierr = VecDestroy(&vec1_V);CHKERRQ(ierr);
67388ebb749SStefano Zampini     ierr = VecDestroy(&vec2_V);CHKERRQ(ierr);
67488ebb749SStefano Zampini     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
67588ebb749SStefano Zampini     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
67688ebb749SStefano Zampini     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
67788ebb749SStefano Zampini   }
67888ebb749SStefano Zampini   if (n_constraints) {
67988ebb749SStefano Zampini     ierr = VecDestroy(&vec1_C);CHKERRQ(ierr);
68088ebb749SStefano Zampini     ierr = VecDestroy(&vec2_C);CHKERRQ(ierr);
68188ebb749SStefano Zampini     ierr = MatDestroy(&M1);CHKERRQ(ierr);
68288ebb749SStefano Zampini     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
68388ebb749SStefano Zampini   }
68488ebb749SStefano Zampini   ierr = PetscFree(auxindices);CHKERRQ(ierr);
6858629588bSStefano Zampini   /* get back data */
6868629588bSStefano Zampini   *coarse_submat_vals_n = coarse_submat_vals;
68788ebb749SStefano Zampini   PetscFunctionReturn(0);
68888ebb749SStefano Zampini }
68988ebb749SStefano Zampini 
69088ebb749SStefano Zampini #undef __FUNCT__
691aa0d41d4SStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalMatrices"
692aa0d41d4SStefano Zampini PetscErrorCode PCBDDCSetUpLocalMatrices(PC pc)
693aa0d41d4SStefano Zampini {
694aa0d41d4SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
695aa0d41d4SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
696aa0d41d4SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
6979577ea80SStefano Zampini   PetscBool         issbaij,isbaij;
698aa0d41d4SStefano Zampini   /* manage repeated solves */
699aa0d41d4SStefano Zampini   MatReuse          reuse;
700aa0d41d4SStefano Zampini   MatStructure      matstruct;
701aa0d41d4SStefano Zampini   PetscErrorCode    ierr;
702aa0d41d4SStefano Zampini 
703aa0d41d4SStefano Zampini   PetscFunctionBegin;
704aa0d41d4SStefano Zampini   /* get mat flags */
705aa0d41d4SStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
706aa0d41d4SStefano Zampini   reuse = MAT_INITIAL_MATRIX;
707aa0d41d4SStefano Zampini   if (pc->setupcalled) {
708aa0d41d4SStefano Zampini     /* when matstruct is SAME_PRECONDITIONER, we shouldn't be here */
709aa0d41d4SStefano Zampini     if (matstruct == SAME_PRECONDITIONER) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen");
710aa0d41d4SStefano Zampini     if (matstruct == SAME_NONZERO_PATTERN) {
711aa0d41d4SStefano Zampini       reuse = MAT_REUSE_MATRIX;
712aa0d41d4SStefano Zampini     } else {
713aa0d41d4SStefano Zampini       reuse = MAT_INITIAL_MATRIX;
714aa0d41d4SStefano Zampini     }
715aa0d41d4SStefano Zampini   }
716aa0d41d4SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
717aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
718aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
719aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
720aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BB);CHKERRQ(ierr);
721aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
722aa0d41d4SStefano Zampini   }
723aa0d41d4SStefano Zampini 
724aa0d41d4SStefano Zampini   /* transform local matrices if needed */
725aa0d41d4SStefano Zampini   if (pcbddc->use_change_of_basis) {
726aa0d41d4SStefano Zampini     Mat         change_mat_all;
727aa0d41d4SStefano Zampini     PetscScalar *row_cmat_values;
728aa0d41d4SStefano Zampini     PetscInt    *row_cmat_indices;
729aa0d41d4SStefano Zampini     PetscInt    *nnz,*is_indices,*temp_indices;
730aa0d41d4SStefano Zampini     PetscInt    i,j,k,n_D,n_B;
731aa0d41d4SStefano Zampini 
732aa0d41d4SStefano Zampini     /* Get Non-overlapping dimensions */
733aa0d41d4SStefano Zampini     n_B = pcis->n_B;
734aa0d41d4SStefano Zampini     n_D = pcis->n-n_B;
735aa0d41d4SStefano Zampini 
736aa0d41d4SStefano Zampini     /* compute nonzero structure of change of basis on all local nodes */
737aa0d41d4SStefano Zampini     ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
738aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
739aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) nnz[is_indices[i]] = 1;
740aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
741aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
742aa0d41d4SStefano Zampini     k=1;
743aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
744aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
745aa0d41d4SStefano Zampini       nnz[is_indices[i]]=j;
746aa0d41d4SStefano Zampini       if (k < j) k = j;
747aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
748aa0d41d4SStefano Zampini     }
749aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
750aa0d41d4SStefano Zampini     /* assemble change of basis matrix on the whole set of local dofs */
751aa0d41d4SStefano Zampini     ierr = PetscMalloc(k*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
752aa0d41d4SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&change_mat_all);CHKERRQ(ierr);
753aa0d41d4SStefano Zampini     ierr = MatSetSizes(change_mat_all,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
754aa0d41d4SStefano Zampini     ierr = MatSetType(change_mat_all,MATSEQAIJ);CHKERRQ(ierr);
755aa0d41d4SStefano Zampini     ierr = MatSeqAIJSetPreallocation(change_mat_all,0,nnz);CHKERRQ(ierr);
756aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
757aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) {
758aa0d41d4SStefano Zampini       ierr = MatSetValue(change_mat_all,is_indices[i],is_indices[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
759aa0d41d4SStefano Zampini     }
760aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
761aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
762aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
763aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
764aa0d41d4SStefano Zampini       for (k=0; k<j; k++) temp_indices[k]=is_indices[row_cmat_indices[k]];
765aa0d41d4SStefano Zampini       ierr = MatSetValues(change_mat_all,1,&is_indices[i],j,temp_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
766aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
767aa0d41d4SStefano Zampini     }
768aa0d41d4SStefano Zampini     ierr = MatAssemblyBegin(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
769aa0d41d4SStefano Zampini     ierr = MatAssemblyEnd(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7709577ea80SStefano Zampini     /* TODO: HOW TO WORK WITH BAIJ and SBAIJ? PtAP not provided */
7719577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
7729577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQBAIJ,&isbaij);CHKERRQ(ierr);
7739577ea80SStefano Zampini     if (!issbaij && !isbaij) {
774aa0d41d4SStefano Zampini       ierr = MatPtAP(matis->A,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
775aa0d41d4SStefano Zampini     } else {
776aa0d41d4SStefano Zampini       Mat work_mat;
777aa0d41d4SStefano Zampini       ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
778aa0d41d4SStefano Zampini       ierr = MatPtAP(work_mat,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
779aa0d41d4SStefano Zampini       ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
780aa0d41d4SStefano Zampini     }
781aa0d41d4SStefano Zampini     ierr = MatDestroy(&change_mat_all);CHKERRQ(ierr);
782aa0d41d4SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
783aa0d41d4SStefano Zampini     ierr = PetscFree(temp_indices);CHKERRQ(ierr);
784aa0d41d4SStefano Zampini   } else {
785aa0d41d4SStefano Zampini     /* without change of basis, the local matrix is unchanged */
786aa0d41d4SStefano Zampini     if (!pcbddc->local_mat) {
787aa0d41d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)matis->A);CHKERRQ(ierr);
788aa0d41d4SStefano Zampini       pcbddc->local_mat = matis->A;
789aa0d41d4SStefano Zampini     }
790aa0d41d4SStefano Zampini   }
791aa0d41d4SStefano Zampini 
792aa0d41d4SStefano Zampini   /* get submatrices */
793aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_I_local,reuse,&pcis->A_II);CHKERRQ(ierr);
7949577ea80SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_B_local,reuse,&pcis->A_BB);CHKERRQ(ierr);
7959577ea80SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
7969577ea80SStefano Zampini   if (!issbaij) {
797aa0d41d4SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
798aa0d41d4SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
7999577ea80SStefano Zampini   } else {
8009577ea80SStefano Zampini     Mat newmat;
8019577ea80SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
8029577ea80SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
8039577ea80SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
8049577ea80SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
8059577ea80SStefano Zampini   }
806aa0d41d4SStefano Zampini   PetscFunctionReturn(0);
807aa0d41d4SStefano Zampini }
808aa0d41d4SStefano Zampini 
809aa0d41d4SStefano Zampini #undef __FUNCT__
810a64d13efSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalScatters"
8118ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
812a64d13efSStefano Zampini {
813a64d13efSStefano Zampini   PC_IS*         pcis = (PC_IS*)(pc->data);
814a64d13efSStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8158ce42a96SStefano Zampini   IS             is_aux1,is_aux2;
816a64d13efSStefano Zampini   PetscInt       *vertices,*aux_array1,*aux_array2,*is_indices,*idx_R_local;
817a64d13efSStefano Zampini   PetscInt       n_vertices,n_constraints,i,j,n_R,n_D,n_B;
8184641a718SStefano Zampini   PetscBT        bitmask;
819a64d13efSStefano Zampini   PetscErrorCode ierr;
820a64d13efSStefano Zampini 
821a64d13efSStefano Zampini   PetscFunctionBegin;
822a64d13efSStefano Zampini   /* Set Non-overlapping dimensions */
823a64d13efSStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
824a64d13efSStefano Zampini   /* get vertex indices from constraint matrix */
825a64d13efSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
826a64d13efSStefano Zampini   /* Set number of constraints */
827a64d13efSStefano Zampini   n_constraints = pcbddc->local_primal_size-n_vertices;
8284641a718SStefano Zampini   /* create auxiliary bitmask */
8294641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
8304641a718SStefano Zampini   for (i=0;i<n_vertices;i++) {
8314641a718SStefano Zampini     ierr = PetscBTSet(bitmask,vertices[i]);CHKERRQ(ierr);
8324641a718SStefano Zampini   }
833a64d13efSStefano Zampini   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
834a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n-n_vertices)*sizeof(PetscInt),&idx_R_local);CHKERRQ(ierr);
835a64d13efSStefano Zampini   for (i=0, n_R=0; i<pcis->n; i++) {
8364641a718SStefano Zampini     if (!PetscBTLookup(bitmask,i)) {
837a64d13efSStefano Zampini       idx_R_local[n_R] = i;
838a64d13efSStefano Zampini       n_R++;
839a64d13efSStefano Zampini     }
840a64d13efSStefano Zampini   }
841a64d13efSStefano Zampini   ierr = PetscFree(vertices);CHKERRQ(ierr);
8428ce42a96SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_R,idx_R_local,PETSC_OWN_POINTER,&pcbddc->is_R_local);CHKERRQ(ierr);
843a64d13efSStefano Zampini 
844a64d13efSStefano Zampini   /* print some info if requested */
845a64d13efSStefano Zampini   if (pcbddc->dbg_flag) {
846a64d13efSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
847a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
848a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
849a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
850a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"r_size = %d, v_size = %d, constraints = %d, local_primal_size = %d\n",n_R,n_vertices,n_constraints,pcbddc->local_primal_size);CHKERRQ(ierr);
851a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr);
852a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
853a64d13efSStefano Zampini   }
854a64d13efSStefano Zampini 
855a64d13efSStefano Zampini   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
856a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
857a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array2);CHKERRQ(ierr);
858a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
8594641a718SStefano Zampini   for (i=0; i<n_D; i++) {
8604641a718SStefano Zampini     ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
8614641a718SStefano Zampini   }
862a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
863a64d13efSStefano Zampini   for (i=0, j=0; i<n_R; i++) {
8644641a718SStefano Zampini     if (!PetscBTLookup(bitmask,idx_R_local[i])) {
8654641a718SStefano Zampini       aux_array1[j++] = i;
866a64d13efSStefano Zampini     }
867a64d13efSStefano Zampini   }
868a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
869a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
870a64d13efSStefano Zampini   for (i=0, j=0; i<n_B; i++) {
8714641a718SStefano Zampini     if (!PetscBTLookup(bitmask,is_indices[i])) {
8724641a718SStefano Zampini       aux_array2[j++] = i;
873a64d13efSStefano Zampini     }
874a64d13efSStefano Zampini   }
875a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
876a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
877a64d13efSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
878a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
879a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
880a64d13efSStefano Zampini 
8818eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
882a64d13efSStefano Zampini     ierr = PetscMalloc(n_D*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
883a64d13efSStefano Zampini     for (i=0, j=0; i<n_R; i++) {
8844641a718SStefano Zampini       if (PetscBTLookup(bitmask,idx_R_local[i])) {
8854641a718SStefano Zampini         aux_array1[j++] = i;
886a64d13efSStefano Zampini       }
887a64d13efSStefano Zampini     }
888a64d13efSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
889a64d13efSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
890a64d13efSStefano Zampini     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
891a64d13efSStefano Zampini   }
8924641a718SStefano Zampini   ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
893a64d13efSStefano Zampini   PetscFunctionReturn(0);
894a64d13efSStefano Zampini }
895a64d13efSStefano Zampini 
896304d26faSStefano Zampini 
897304d26faSStefano Zampini #undef __FUNCT__
898304d26faSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
8998ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc)
900304d26faSStefano Zampini {
901304d26faSStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
902304d26faSStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
903304d26faSStefano Zampini   PC             pc_temp;
904304d26faSStefano Zampini   Mat            A_RR;
905304d26faSStefano Zampini   Vec            vec1,vec2,vec3;
906304d26faSStefano Zampini   MatStructure   matstruct;
907304d26faSStefano Zampini   PetscScalar    m_one = -1.0;
908304d26faSStefano Zampini   PetscReal      value;
909af732b37SStefano Zampini   PetscInt       n_D,n_R,ibs,mbs;
9109577ea80SStefano Zampini   PetscBool      use_exact,use_exact_reduced,issbaij;
911304d26faSStefano Zampini   PetscErrorCode ierr;
912e604994aSStefano Zampini   /* prefixes stuff */
913e604994aSStefano Zampini   char           dir_prefix[256],neu_prefix[256],str_level[3];
914e604994aSStefano Zampini   size_t         len;
915304d26faSStefano Zampini 
916304d26faSStefano Zampini   PetscFunctionBegin;
917304d26faSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
918304d26faSStefano Zampini 
919e604994aSStefano Zampini   /* compute prefixes */
920e604994aSStefano Zampini   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
921e604994aSStefano Zampini   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
922e604994aSStefano Zampini   if (!pcbddc->current_level) {
923e604994aSStefano Zampini     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
924e604994aSStefano Zampini     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
925e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
926e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
927e604994aSStefano Zampini   } else {
928e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
929e604994aSStefano Zampini     sprintf(str_level,"%d_",(int)(pcbddc->current_level));
930e604994aSStefano Zampini     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
931e604994aSStefano Zampini     len -= 15; /* remove "pc_bddc_coarse_" */
932e604994aSStefano Zampini     if (pcbddc->current_level>1) len -= 2; /* remove "X_" with X level number (works with 9 levels max) */
933e604994aSStefano Zampini     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
934e604994aSStefano Zampini     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
935e604994aSStefano Zampini     *(dir_prefix+len)='\0';
936e604994aSStefano Zampini     *(neu_prefix+len)='\0';
937e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
938e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
939e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
940e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
941e604994aSStefano Zampini   }
942e604994aSStefano Zampini 
943304d26faSStefano Zampini   /* DIRICHLET PROBLEM */
944ac78edfcSStefano Zampini   /* Matrix for Dirichlet problem is pcis->A_II */
9458ce42a96SStefano Zampini   ierr = ISGetSize(pcis->is_I_local,&n_D);CHKERRQ(ierr);
946304d26faSStefano Zampini   if (!pcbddc->ksp_D) { /* create object if not yet build */
947304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
948304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
949304d26faSStefano Zampini     /* default */
950304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
951e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
9529577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
953304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
9549577ea80SStefano Zampini     if (issbaij) {
9559577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
9569577ea80SStefano Zampini     } else {
957304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
9589577ea80SStefano Zampini     }
959304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
960304d26faSStefano Zampini   }
961304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II,matstruct);CHKERRQ(ierr);
962304d26faSStefano Zampini   /* Allow user's customization */
963304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
964304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
965304d26faSStefano Zampini   if (!n_D) {
966304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
967304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
968304d26faSStefano Zampini   }
969304d26faSStefano Zampini   /* Set Up KSP for Dirichlet problem of BDDC */
970304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
971304d26faSStefano Zampini   /* set ksp_D into pcis data */
972304d26faSStefano Zampini   ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
973304d26faSStefano Zampini   ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
974304d26faSStefano Zampini   pcis->ksp_D = pcbddc->ksp_D;
975304d26faSStefano Zampini 
976304d26faSStefano Zampini   /* NEUMANN PROBLEM */
977304d26faSStefano Zampini   /* Matrix for Neumann problem is A_RR -> we need to create it */
9788ce42a96SStefano Zampini   ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
979af732b37SStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
980af732b37SStefano Zampini   ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
981af732b37SStefano Zampini   if (ibs != mbs) { /* TODO BAIJ: see if this can be avoided */
982af732b37SStefano Zampini     Mat newmat;
983af732b37SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
984af732b37SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
985af732b37SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
986af732b37SStefano Zampini   } else {
9878ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
988af732b37SStefano Zampini   }
989304d26faSStefano Zampini   if (!pcbddc->ksp_R) { /* create object if not yet build */
990304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
991304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
992304d26faSStefano Zampini     /* default */
993304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
994e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
995304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
9969577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
9979577ea80SStefano Zampini     if (issbaij) {
9989577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
9999577ea80SStefano Zampini     } else {
1000304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
10019577ea80SStefano Zampini     }
1002304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1003304d26faSStefano Zampini   }
1004304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR,matstruct);CHKERRQ(ierr);
1005304d26faSStefano Zampini   /* Allow user's customization */
1006304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
1007304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1008304d26faSStefano Zampini   if (!n_R) {
1009304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
1010304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1011304d26faSStefano Zampini   }
1012304d26faSStefano Zampini   /* Set Up KSP for Neumann problem of BDDC */
1013304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
1014304d26faSStefano Zampini 
1015304d26faSStefano Zampini   /* check Dirichlet and Neumann solvers and adapt them if a nullspace correction is needed */
1016304d26faSStefano Zampini 
1017304d26faSStefano Zampini   /* Dirichlet */
1018304d26faSStefano Zampini   ierr = MatGetVecs(pcis->A_II,&vec1,&vec2);CHKERRQ(ierr);
1019304d26faSStefano Zampini   ierr = VecDuplicate(vec1,&vec3);CHKERRQ(ierr);
1020304d26faSStefano Zampini   ierr = VecSetRandom(vec1,NULL);CHKERRQ(ierr);
1021304d26faSStefano Zampini   ierr = MatMult(pcis->A_II,vec1,vec2);CHKERRQ(ierr);
1022304d26faSStefano Zampini   ierr = KSPSolve(pcbddc->ksp_D,vec2,vec3);CHKERRQ(ierr);
1023304d26faSStefano Zampini   ierr = VecAXPY(vec3,m_one,vec1);CHKERRQ(ierr);
1024304d26faSStefano Zampini   ierr = VecNorm(vec3,NORM_INFINITY,&value);CHKERRQ(ierr);
1025304d26faSStefano Zampini   ierr = VecDestroy(&vec1);CHKERRQ(ierr);
1026304d26faSStefano Zampini   ierr = VecDestroy(&vec2);CHKERRQ(ierr);
1027304d26faSStefano Zampini   ierr = VecDestroy(&vec3);CHKERRQ(ierr);
1028304d26faSStefano Zampini   /* need to be adapted? */
1029b8ffe317SStefano Zampini   use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1030b8ffe317SStefano Zampini   ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1031b8ffe317SStefano Zampini   ierr = PCBDDCSetUseExactDirichlet(pc,use_exact_reduced);CHKERRQ(ierr);
1032304d26faSStefano Zampini   /* print info */
1033304d26faSStefano Zampini   if (pcbddc->dbg_flag) {
1034304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1035304d26faSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
1036304d26faSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Checking solution of Dirichlet and Neumann problems\n");CHKERRQ(ierr);
1037e604994aSStefano 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);
1038304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1039304d26faSStefano Zampini   }
1040b8ffe317SStefano Zampini   if (pcbddc->NullSpace && !use_exact_reduced && !pcbddc->switch_static) {
10418ce42a96SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcis->is_I_local);CHKERRQ(ierr);
1042304d26faSStefano Zampini   }
1043304d26faSStefano Zampini 
1044304d26faSStefano Zampini   /* Neumann */
1045304d26faSStefano Zampini   ierr = MatGetVecs(A_RR,&vec1,&vec2);CHKERRQ(ierr);
1046304d26faSStefano Zampini   ierr = VecDuplicate(vec1,&vec3);CHKERRQ(ierr);
1047304d26faSStefano Zampini   ierr = VecSetRandom(vec1,NULL);CHKERRQ(ierr);
1048304d26faSStefano Zampini   ierr = MatMult(A_RR,vec1,vec2);CHKERRQ(ierr);
1049304d26faSStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,vec2,vec3);CHKERRQ(ierr);
1050304d26faSStefano Zampini   ierr = VecAXPY(vec3,m_one,vec1);CHKERRQ(ierr);
1051304d26faSStefano Zampini   ierr = VecNorm(vec3,NORM_INFINITY,&value);CHKERRQ(ierr);
1052304d26faSStefano Zampini   ierr = VecDestroy(&vec1);CHKERRQ(ierr);
1053304d26faSStefano Zampini   ierr = VecDestroy(&vec2);CHKERRQ(ierr);
1054304d26faSStefano Zampini   ierr = VecDestroy(&vec3);CHKERRQ(ierr);
1055304d26faSStefano Zampini   /* need to be adapted? */
1056b8ffe317SStefano Zampini   use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1057b8ffe317SStefano Zampini   ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1058304d26faSStefano Zampini   /* print info */
1059304d26faSStefano Zampini   if (pcbddc->dbg_flag) {
1060e604994aSStefano 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);
1061304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1062304d26faSStefano Zampini   }
1063b8ffe317SStefano Zampini   if (pcbddc->NullSpace && !use_exact_reduced) { /* is it the right logic? */
10648ce42a96SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcbddc->is_R_local);CHKERRQ(ierr);
1065304d26faSStefano Zampini   }
1066304d26faSStefano Zampini   /* free Neumann problem's matrix */
1067304d26faSStefano Zampini   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1068304d26faSStefano Zampini   PetscFunctionReturn(0);
1069304d26faSStefano Zampini }
1070304d26faSStefano Zampini 
1071304d26faSStefano Zampini #undef __FUNCT__
1072674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSolveSaddlePoint"
1073674ae819SStefano Zampini static PetscErrorCode  PCBDDCSolveSaddlePoint(PC pc)
1074674ae819SStefano Zampini {
1075674ae819SStefano Zampini   PetscErrorCode ierr;
1076674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1077674ae819SStefano Zampini 
1078674ae819SStefano Zampini   PetscFunctionBegin;
1079674ae819SStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
1080674ae819SStefano Zampini   if (pcbddc->local_auxmat1) {
1081674ae819SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec2_R,pcbddc->vec1_C);CHKERRQ(ierr);
1082674ae819SStefano Zampini     ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
1083674ae819SStefano Zampini   }
1084674ae819SStefano Zampini   PetscFunctionReturn(0);
1085674ae819SStefano Zampini }
1086674ae819SStefano Zampini 
1087674ae819SStefano Zampini #undef __FUNCT__
1088674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
1089674ae819SStefano Zampini PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc)
1090674ae819SStefano Zampini {
1091674ae819SStefano Zampini   PetscErrorCode ierr;
1092674ae819SStefano Zampini   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
1093674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)  (pc->data);
1094674ae819SStefano Zampini   const PetscScalar zero = 0.0;
1095674ae819SStefano Zampini 
1096674ae819SStefano Zampini   PetscFunctionBegin;
109715aaf578SStefano Zampini   /* Application of PHI^T (or PSI^T)  */
109815aaf578SStefano Zampini   if (pcbddc->coarse_psi_B) {
109915aaf578SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
11008eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
110115aaf578SStefano Zampini   } else {
1102674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
11038eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
110415aaf578SStefano Zampini   }
1105674ae819SStefano Zampini   /* Scatter data of coarse_rhs */
1106674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { ierr = VecSet(pcbddc->coarse_rhs,zero);CHKERRQ(ierr); }
1107674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1108674ae819SStefano Zampini 
1109674ae819SStefano Zampini   /* Local solution on R nodes */
1110674ae819SStefano Zampini   ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
1111674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1112674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
11138eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1114674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1115674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1116674ae819SStefano Zampini   }
1117674ae819SStefano Zampini   ierr = PCBDDCSolveSaddlePoint(pc);CHKERRQ(ierr);
1118674ae819SStefano Zampini   ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1119674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1120674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
11218eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1122674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1123674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1124674ae819SStefano Zampini   }
1125674ae819SStefano Zampini 
1126674ae819SStefano Zampini   /* Coarse solution */
1127674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1128674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { /* TODO remove null space when doing multilevel */
1129674ae819SStefano Zampini     ierr = KSPSolve(pcbddc->coarse_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
1130674ae819SStefano Zampini   }
1131674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1132674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd  (pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1133674ae819SStefano Zampini 
1134674ae819SStefano Zampini   /* Sum contributions from two levels */
1135674ae819SStefano Zampini   ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
11368eeda7d8SStefano Zampini   if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1137674ae819SStefano Zampini   PetscFunctionReturn(0);
1138674ae819SStefano Zampini }
1139674ae819SStefano Zampini 
1140674ae819SStefano Zampini #undef __FUNCT__
1141674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
1142674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1143674ae819SStefano Zampini {
1144674ae819SStefano Zampini   PetscErrorCode ierr;
1145674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1146674ae819SStefano Zampini 
1147674ae819SStefano Zampini   PetscFunctionBegin;
1148674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1149674ae819SStefano Zampini   PetscFunctionReturn(0);
1150674ae819SStefano Zampini }
1151674ae819SStefano Zampini 
1152674ae819SStefano Zampini #undef __FUNCT__
1153674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
1154674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1155674ae819SStefano Zampini {
1156674ae819SStefano Zampini   PetscErrorCode ierr;
1157674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1158674ae819SStefano Zampini 
1159674ae819SStefano Zampini   PetscFunctionBegin;
1160674ae819SStefano Zampini   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1161674ae819SStefano Zampini   PetscFunctionReturn(0);
1162674ae819SStefano Zampini }
1163674ae819SStefano Zampini 
1164984c4197SStefano Zampini /* uncomment for testing purposes */
1165984c4197SStefano Zampini /* #define PETSC_MISSING_LAPACK_GESVD 1 */
1166674ae819SStefano Zampini #undef __FUNCT__
1167674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp"
1168674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
1169674ae819SStefano Zampini {
1170674ae819SStefano Zampini   PetscErrorCode    ierr;
1171674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
1172674ae819SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
1173674ae819SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
1174984c4197SStefano Zampini   /* constraint and (optionally) change of basis matrix implemented as SeqAIJ */
1175674ae819SStefano Zampini   MatType           impMatType=MATSEQAIJ;
1176984c4197SStefano Zampini   /* one and zero */
1177984c4197SStefano Zampini   PetscScalar       one=1.0,zero=0.0;
1178984c4197SStefano Zampini   /* space to store constraints and their local indices */
1179984c4197SStefano Zampini   PetscScalar       *temp_quadrature_constraint;
1180984c4197SStefano Zampini   PetscInt          *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B;
1181984c4197SStefano Zampini   /* iterators */
1182984c4197SStefano Zampini   PetscInt          i,j,k,total_counts,temp_start_ptr;
1183984c4197SStefano Zampini   /* stuff to store connected components stored in pcbddc->mat_graph */
1184984c4197SStefano Zampini   IS                ISForVertices,*ISForFaces,*ISForEdges,*used_IS;
1185984c4197SStefano Zampini   PetscInt          n_ISForFaces,n_ISForEdges;
1186984c4197SStefano Zampini   /* near null space stuff */
1187674ae819SStefano Zampini   MatNullSpace      nearnullsp;
1188674ae819SStefano Zampini   const Vec         *nearnullvecs;
1189674ae819SStefano Zampini   Vec               *localnearnullsp;
1190984c4197SStefano Zampini   PetscBool         nnsp_has_cnst;
1191984c4197SStefano Zampini   PetscInt          nnsp_size;
1192984c4197SStefano Zampini   PetscScalar       *array;
1193984c4197SStefano Zampini   /* BLAS integers */
1194e310c8b4SStefano Zampini   PetscBLASInt      lwork,lierr;
1195e310c8b4SStefano Zampini   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
1196c4303822SStefano Zampini   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
1197984c4197SStefano Zampini   /* LAPACK working arrays for SVD or POD */
1198242a89d7SStefano Zampini   PetscBool         skip_lapack;
1199984c4197SStefano Zampini   PetscScalar       *work;
1200984c4197SStefano Zampini   PetscReal         *singular_vals;
1201984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1202984c4197SStefano Zampini   PetscReal         *rwork;
1203674ae819SStefano Zampini #endif
1204984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1205e310c8b4SStefano Zampini   PetscBLASInt      Blas_one_2=1;
1206984c4197SStefano Zampini   PetscScalar       *temp_basis,*correlation_mat;
1207b7d8b9f8SStefano Zampini #else
1208b7d8b9f8SStefano Zampini   PetscBLASInt      dummy_int_1=1,dummy_int_2=1;
1209b7d8b9f8SStefano Zampini   PetscScalar       dummy_scalar_1=0.0,dummy_scalar_2=0.0;
1210984c4197SStefano Zampini #endif
1211984c4197SStefano Zampini   /* change of basis */
1212984c4197SStefano Zampini   PetscInt          *aux_primal_numbering,*aux_primal_minloc,*global_indices;
1213a717540cSStefano Zampini   PetscBool         boolforchange,qr_needed;
1214a717540cSStefano Zampini   PetscBT           touched,change_basis,qr_needed_idx;
1215984c4197SStefano Zampini   /* auxiliary stuff */
1216984c4197SStefano Zampini   PetscInt          *nnz,*is_indices,*local_to_B;
1217984c4197SStefano Zampini   /* some quantities */
1218984c4197SStefano Zampini   PetscInt          n_vertices,total_primal_vertices;
1219984c4197SStefano Zampini   PetscInt          size_of_constraint,max_size_of_constraint,max_constraints,temp_constraints;
1220984c4197SStefano Zampini 
1221674ae819SStefano Zampini 
1222674ae819SStefano Zampini   PetscFunctionBegin;
1223674ae819SStefano Zampini   /* Get index sets for faces, edges and vertices from graph */
12248eeda7d8SStefano Zampini   if (!pcbddc->use_faces && !pcbddc->use_edges && !pcbddc->use_vertices) {
12258eeda7d8SStefano Zampini     pcbddc->use_vertices = PETSC_TRUE;
1226674ae819SStefano Zampini   }
12278eeda7d8SStefano Zampini   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,pcbddc->use_faces,pcbddc->use_edges,pcbddc->use_vertices,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);
1228b8ffe317SStefano Zampini   /* HACK: provide functions to set change of basis */
1229b8ffe317SStefano Zampini   if (!ISForVertices && pcbddc->NullSpace) {
1230b8ffe317SStefano Zampini     pcbddc->use_change_of_basis = PETSC_TRUE;
1231b8ffe317SStefano Zampini     pcbddc->use_change_on_faces = PETSC_FALSE;
1232b8ffe317SStefano Zampini   }
1233984c4197SStefano Zampini   /* print some info */
1234674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
1235674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1236674ae819SStefano Zampini     i = 0;
1237674ae819SStefano Zampini     if (ISForVertices) {
1238674ae819SStefano Zampini       ierr = ISGetSize(ISForVertices,&i);CHKERRQ(ierr);
1239674ae819SStefano Zampini     }
1240674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices\n",PetscGlobalRank,i);CHKERRQ(ierr);
1241674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges\n",PetscGlobalRank,n_ISForEdges);CHKERRQ(ierr);
124215aaf578SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces\n",PetscGlobalRank,n_ISForFaces);CHKERRQ(ierr);
1243674ae819SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1244674ae819SStefano Zampini   }
1245674ae819SStefano Zampini   /* check if near null space is attached to global mat */
1246674ae819SStefano Zampini   ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
1247674ae819SStefano Zampini   if (nearnullsp) {
1248674ae819SStefano Zampini     ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
1249984c4197SStefano Zampini   } else { /* if near null space is not provided BDDC uses constants by default */
1250984c4197SStefano Zampini     nnsp_size = 0;
1251674ae819SStefano Zampini     nnsp_has_cnst = PETSC_TRUE;
1252674ae819SStefano Zampini   }
1253984c4197SStefano Zampini   /* get max number of constraints on a single cc */
1254984c4197SStefano Zampini   max_constraints = nnsp_size;
1255984c4197SStefano Zampini   if (nnsp_has_cnst) max_constraints++;
1256984c4197SStefano Zampini 
1257674ae819SStefano Zampini   /*
1258674ae819SStefano Zampini        Evaluate maximum storage size needed by the procedure
1259674ae819SStefano Zampini        - temp_indices will contain start index of each constraint stored as follows
1260674ae819SStefano 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
1261674ae819SStefano 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
1262674ae819SStefano Zampini        - temp_quadrature_constraint  [temp_indices[i],...,temp[indices[i+1]-1] will contain the scalars representing the constraint itself
1263674ae819SStefano Zampini                                                                                                                                                          */
1264674ae819SStefano Zampini   total_counts = n_ISForFaces+n_ISForEdges;
1265984c4197SStefano Zampini   total_counts *= max_constraints;
1266674ae819SStefano Zampini   n_vertices = 0;
1267674ae819SStefano Zampini   if (ISForVertices) {
1268674ae819SStefano Zampini     ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
1269674ae819SStefano Zampini   }
1270674ae819SStefano Zampini   total_counts += n_vertices;
1271674ae819SStefano Zampini   ierr = PetscMalloc((total_counts+1)*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
12724641a718SStefano Zampini   ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
1273674ae819SStefano Zampini   total_counts = 0;
1274674ae819SStefano Zampini   max_size_of_constraint = 0;
1275674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1276674ae819SStefano Zampini     if (i<n_ISForEdges) {
1277674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1278674ae819SStefano Zampini     } else {
1279674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1280674ae819SStefano Zampini     }
1281674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
1282674ae819SStefano Zampini     total_counts += j;
1283674ae819SStefano Zampini     max_size_of_constraint = PetscMax(j,max_size_of_constraint);
1284674ae819SStefano Zampini   }
1285984c4197SStefano Zampini   total_counts *= max_constraints;
1286674ae819SStefano Zampini   total_counts += n_vertices;
1287674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&temp_quadrature_constraint);CHKERRQ(ierr);
1288674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint);CHKERRQ(ierr);
1289674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint_B);CHKERRQ(ierr);
1290984c4197SStefano Zampini   /* local to boundary numbering */
1291674ae819SStefano Zampini   ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&local_to_B);CHKERRQ(ierr);
1292674ae819SStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1293984c4197SStefano Zampini   for (i=0;i<pcis->n;i++) local_to_B[i]=-1;
1294984c4197SStefano Zampini   for (i=0;i<pcis->n_B;i++) local_to_B[is_indices[i]]=i;
1295674ae819SStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1296984c4197SStefano Zampini   /* get local part of global near null space vectors */
1297984c4197SStefano Zampini   ierr = PetscMalloc(nnsp_size*sizeof(Vec),&localnearnullsp);CHKERRQ(ierr);
1298984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1299984c4197SStefano Zampini     ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
1300984c4197SStefano Zampini     ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1301984c4197SStefano Zampini     ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1302984c4197SStefano Zampini   }
1303674ae819SStefano Zampini 
1304242a89d7SStefano Zampini   /* whether or not to skip lapack calls */
1305242a89d7SStefano Zampini   skip_lapack = PETSC_TRUE;
1306242a89d7SStefano Zampini   if (n_ISForFaces+n_ISForEdges) skip_lapack = PETSC_FALSE;
1307242a89d7SStefano Zampini 
1308984c4197SStefano Zampini   /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
1309242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1310674ae819SStefano Zampini     PetscScalar temp_work;
1311674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1312984c4197SStefano Zampini     /* Proper Orthogonal Decomposition (POD) using the snapshot method */
1313984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*max_constraints*sizeof(PetscScalar),&correlation_mat);CHKERRQ(ierr);
1314984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1315984c4197SStefano Zampini     ierr = PetscMalloc(max_size_of_constraint*max_constraints*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr);
1316674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1317984c4197SStefano Zampini     ierr = PetscMalloc(3*max_constraints*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1318674ae819SStefano Zampini #endif
1319674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1320c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
1321c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
1322674ae819SStefano Zampini     lwork = -1;
1323674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1324674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1325c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
1326674ae819SStefano Zampini #else
1327c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
1328674ae819SStefano Zampini #endif
1329674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1330984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
1331674ae819SStefano Zampini #else /* on missing GESVD */
1332674ae819SStefano Zampini     /* SVD */
1333674ae819SStefano Zampini     PetscInt max_n,min_n;
1334674ae819SStefano Zampini     max_n = max_size_of_constraint;
1335984c4197SStefano Zampini     min_n = max_constraints;
1336984c4197SStefano Zampini     if (max_size_of_constraint < max_constraints) {
1337674ae819SStefano Zampini       min_n = max_size_of_constraint;
1338984c4197SStefano Zampini       max_n = max_constraints;
1339674ae819SStefano Zampini     }
1340674ae819SStefano Zampini     ierr = PetscMalloc(min_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1341674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1342674ae819SStefano Zampini     ierr = PetscMalloc(5*min_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1343674ae819SStefano Zampini #endif
1344674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1345674ae819SStefano Zampini     lwork = -1;
1346e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
1347e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
1348b7d8b9f8SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
1349674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1350674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1351e310c8b4SStefano 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));
1352674ae819SStefano Zampini #else
1353e310c8b4SStefano 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));
1354674ae819SStefano Zampini #endif
1355674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1356984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
1357984c4197SStefano Zampini #endif /* on missing GESVD */
1358674ae819SStefano Zampini     /* Allocate optimal workspace */
1359674ae819SStefano Zampini     ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
1360984c4197SStefano Zampini     ierr = PetscMalloc((PetscInt)lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
1361674ae819SStefano Zampini   }
1362674ae819SStefano Zampini   /* Now we can loop on constraining sets */
1363674ae819SStefano Zampini   total_counts = 0;
1364674ae819SStefano Zampini   temp_indices[0] = 0;
1365674ae819SStefano Zampini   /* vertices */
1366674ae819SStefano Zampini   if (ISForVertices) {
1367674ae819SStefano Zampini     ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1368674ae819SStefano Zampini     if (nnsp_has_cnst) { /* consider all vertices */
1369674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1370674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1371674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
1372674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1373674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1374674ae819SStefano Zampini         total_counts++;
1375674ae819SStefano Zampini       }
1376674ae819SStefano Zampini     } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
1377984c4197SStefano Zampini       PetscBool used_vertex;
1378674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1379674ae819SStefano Zampini         used_vertex = PETSC_FALSE;
1380674ae819SStefano Zampini         k = 0;
1381674ae819SStefano Zampini         while (!used_vertex && k<nnsp_size) {
1382984c4197SStefano Zampini           ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1383984c4197SStefano Zampini           if (PetscAbsScalar(array[is_indices[i]])>0.0) {
1384674ae819SStefano Zampini             temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1385674ae819SStefano Zampini             temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
1386674ae819SStefano Zampini             temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1387674ae819SStefano Zampini             temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1388674ae819SStefano Zampini             total_counts++;
1389674ae819SStefano Zampini             used_vertex = PETSC_TRUE;
1390674ae819SStefano Zampini           }
1391984c4197SStefano Zampini           ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1392674ae819SStefano Zampini           k++;
1393674ae819SStefano Zampini         }
1394674ae819SStefano Zampini       }
1395674ae819SStefano Zampini     }
1396674ae819SStefano Zampini     ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1397674ae819SStefano Zampini     n_vertices = total_counts;
1398674ae819SStefano Zampini   }
1399984c4197SStefano Zampini 
1400674ae819SStefano Zampini   /* edges and faces */
1401674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1402674ae819SStefano Zampini     if (i<n_ISForEdges) {
1403674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1404984c4197SStefano Zampini       boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
1405674ae819SStefano Zampini     } else {
1406674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1407984c4197SStefano Zampini       boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
1408674ae819SStefano Zampini     }
1409674ae819SStefano Zampini     temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
1410674ae819SStefano Zampini     temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
1411674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
1412674ae819SStefano Zampini     ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1413984c4197SStefano Zampini     /* change of basis should not be performed on local periodic nodes */
1414984c4197SStefano Zampini     if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
1415674ae819SStefano Zampini     if (nnsp_has_cnst) {
14165b08dc53SStefano Zampini       PetscScalar quad_value;
1417674ae819SStefano Zampini       temp_constraints++;
1418674ae819SStefano Zampini       quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
1419674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1420674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
1421674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
1422674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
1423674ae819SStefano Zampini       }
1424674ae819SStefano Zampini       temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
14254641a718SStefano Zampini       if (boolforchange) {
14264641a718SStefano Zampini         ierr = PetscBTSet(change_basis,total_counts);CHKERRQ(ierr);
14274641a718SStefano Zampini       }
1428674ae819SStefano Zampini       total_counts++;
1429674ae819SStefano Zampini     }
1430674ae819SStefano Zampini     for (k=0;k<nnsp_size;k++) {
1431984c4197SStefano Zampini       PetscReal real_value;
1432984c4197SStefano Zampini       ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1433674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1434674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
1435674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
1436984c4197SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=array[is_indices[j]];
1437674ae819SStefano Zampini       }
1438984c4197SStefano Zampini       ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1439984c4197SStefano Zampini       /* check if array is null on the connected component */
1440e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1441e310c8b4SStefano Zampini       PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_one));
14425b08dc53SStefano Zampini       if (real_value > 0.0) { /* keep indices and values */
1443674ae819SStefano Zampini         temp_constraints++;
1444674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
14454641a718SStefano Zampini         if (boolforchange) {
14464641a718SStefano Zampini           ierr = PetscBTSet(change_basis,total_counts);CHKERRQ(ierr);
14474641a718SStefano Zampini         }
1448674ae819SStefano Zampini         total_counts++;
1449674ae819SStefano Zampini       }
1450674ae819SStefano Zampini     }
1451674ae819SStefano Zampini     ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1452*eb97c9d2SStefano 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 */
1453*eb97c9d2SStefano Zampini     if (!pcbddc->use_nnsp_true && temp_constraints) {
1454984c4197SStefano Zampini       PetscReal tol = 1.0e-8; /* tolerance for retaining eigenmodes */
1455674ae819SStefano Zampini 
1456674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1457984c4197SStefano Zampini       /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
1458984c4197SStefano Zampini          POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
1459984c4197SStefano Zampini          -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
1460984c4197SStefano Zampini             the constraints basis will differ (by a complex factor with absolute value equal to 1)
1461984c4197SStefano Zampini             from that computed using LAPACKgesvd
1462984c4197SStefano Zampini          -> This is due to a different computation of eigenvectors in LAPACKheev
1463984c4197SStefano Zampini          -> The quality of the POD-computed basis will be the same */
1464984c4197SStefano Zampini       ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
1465674ae819SStefano Zampini       /* Store upper triangular part of correlation matrix */
1466e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1467984c4197SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1468674ae819SStefano Zampini       for (j=0;j<temp_constraints;j++) {
1469674ae819SStefano Zampini         for (k=0;k<j+1;k++) {
1470e310c8b4SStefano 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));
1471674ae819SStefano Zampini         }
1472674ae819SStefano Zampini       }
1473e310c8b4SStefano Zampini       /* compute eigenvalues and eigenvectors of correlation matrix */
1474e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1475e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
1476674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1477c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
1478674ae819SStefano Zampini #else
1479c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
1480674ae819SStefano Zampini #endif
1481674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1482984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
1483984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
1484674ae819SStefano Zampini       j=0;
1485984c4197SStefano Zampini       while (j < temp_constraints && singular_vals[j] < tol) j++;
1486674ae819SStefano Zampini       total_counts=total_counts-j;
1487e310c8b4SStefano Zampini       /* scale and copy POD basis into used quadrature memory */
1488c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1489c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1490c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
1491c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1492c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
1493c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1494674ae819SStefano Zampini       if (j<temp_constraints) {
1495984c4197SStefano Zampini         PetscInt ii;
1496984c4197SStefano Zampini         for (k=j;k<temp_constraints;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]);
1497674ae819SStefano Zampini         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1498c4303822SStefano 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));
1499674ae819SStefano Zampini         ierr = PetscFPTrapPop();CHKERRQ(ierr);
1500984c4197SStefano Zampini         for (k=0;k<temp_constraints-j;k++) {
1501674ae819SStefano Zampini           for (ii=0;ii<size_of_constraint;ii++) {
1502984c4197SStefano 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];
1503674ae819SStefano Zampini           }
1504674ae819SStefano Zampini         }
1505674ae819SStefano Zampini       }
1506674ae819SStefano Zampini #else  /* on missing GESVD */
1507e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1508e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1509b7d8b9f8SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1510674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1511674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1512e310c8b4SStefano 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));
1513674ae819SStefano Zampini #else
1514e310c8b4SStefano 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));
1515674ae819SStefano Zampini #endif
1516984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
1517674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1518984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
1519e310c8b4SStefano Zampini       k = temp_constraints;
1520e310c8b4SStefano Zampini       if (k > size_of_constraint) k = size_of_constraint;
1521674ae819SStefano Zampini       j = 0;
1522e310c8b4SStefano Zampini       while (j < k && singular_vals[k-j-1] < tol) j++;
1523e310c8b4SStefano Zampini       total_counts = total_counts-temp_constraints+k-j;
1524984c4197SStefano Zampini #endif /* on missing GESVD */
1525674ae819SStefano Zampini     }
1526674ae819SStefano Zampini   }
1527674ae819SStefano Zampini   /* free index sets of faces, edges and vertices */
1528674ae819SStefano Zampini   for (i=0;i<n_ISForFaces;i++) {
1529674ae819SStefano Zampini     ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
1530674ae819SStefano Zampini   }
1531674ae819SStefano Zampini   ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
1532674ae819SStefano Zampini   for (i=0;i<n_ISForEdges;i++) {
1533674ae819SStefano Zampini     ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
1534674ae819SStefano Zampini   }
1535674ae819SStefano Zampini   ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
1536674ae819SStefano Zampini   ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
1537674ae819SStefano Zampini 
1538984c4197SStefano Zampini   /* free workspace */
1539242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1540984c4197SStefano Zampini     ierr = PetscFree(work);CHKERRQ(ierr);
1541984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1542984c4197SStefano Zampini     ierr = PetscFree(rwork);CHKERRQ(ierr);
1543984c4197SStefano Zampini #endif
1544984c4197SStefano Zampini     ierr = PetscFree(singular_vals);CHKERRQ(ierr);
1545984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1546984c4197SStefano Zampini     ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
1547984c4197SStefano Zampini     ierr = PetscFree(temp_basis);CHKERRQ(ierr);
1548984c4197SStefano Zampini #endif
1549984c4197SStefano Zampini   }
1550984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1551984c4197SStefano Zampini     ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
1552984c4197SStefano Zampini   }
1553984c4197SStefano Zampini   ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
1554984c4197SStefano Zampini 
1555674ae819SStefano Zampini   /* set quantities in pcbddc data structure */
1556984c4197SStefano Zampini   /* n_vertices defines the number of subdomain corners in the primal space */
1557674ae819SStefano Zampini   /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */
1558984c4197SStefano Zampini   pcbddc->local_primal_size = total_counts;
1559674ae819SStefano Zampini   pcbddc->n_vertices = n_vertices;
1560984c4197SStefano Zampini   pcbddc->n_constraints = pcbddc->local_primal_size-pcbddc->n_vertices;
1561674ae819SStefano Zampini 
1562674ae819SStefano Zampini   /* Create constraint matrix */
1563674ae819SStefano Zampini   /* The constraint matrix is used to compute the l2g map of primal dofs */
1564674ae819SStefano Zampini   /* so we need to set it up properly either with or without change of basis */
1565674ae819SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1566674ae819SStefano Zampini   ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr);
1567984c4197SStefano Zampini   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
1568984c4197SStefano Zampini   /* array to compute a local numbering of constraints : vertices first then constraints */
1569984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_numbering);CHKERRQ(ierr);
1570984c4197SStefano Zampini   /* array to select the proper local node (of minimum index with respect to global ordering) when changing the basis */
1571984c4197SStefano 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 */
1572984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_minloc);CHKERRQ(ierr);
1573984c4197SStefano Zampini   /* auxiliary stuff for basis change */
1574984c4197SStefano Zampini   ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&global_indices);CHKERRQ(ierr);
15754641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n_B,&touched);CHKERRQ(ierr);
1576984c4197SStefano Zampini 
1577984c4197SStefano Zampini   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
1578984c4197SStefano Zampini   total_primal_vertices=0;
1579984c4197SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
1580674ae819SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
1581984c4197SStefano Zampini     if (size_of_constraint == 1) {
15824641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]]);CHKERRQ(ierr);
1583984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]];
1584984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=0;
1585984c4197SStefano Zampini       total_primal_vertices++;
15864641a718SStefano Zampini     } else if (PetscBTLookup(change_basis,i)) { /* Same procedure used in PCBDDCGetPrimalConstraintsLocalIdx */
1587984c4197SStefano Zampini       PetscInt min_loc,min_index;
1588984c4197SStefano Zampini       ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],global_indices);CHKERRQ(ierr);
1589984c4197SStefano Zampini       /* find first untouched local node */
1590674ae819SStefano Zampini       k = 0;
15914641a718SStefano Zampini       while (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) k++;
1592984c4197SStefano Zampini       min_index = global_indices[k];
1593984c4197SStefano Zampini       min_loc = k;
1594984c4197SStefano Zampini       /* search the minimum among global nodes already untouched on the cc */
1595984c4197SStefano Zampini       for (k=1;k<size_of_constraint;k++) {
1596984c4197SStefano Zampini         /* there can be more than one constraint on a single connected component */
15974641a718SStefano Zampini         if (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k]) && min_index > global_indices[k]) {
1598984c4197SStefano Zampini           min_index = global_indices[k];
1599984c4197SStefano Zampini           min_loc = k;
1600674ae819SStefano Zampini         }
1601674ae819SStefano Zampini       }
16024641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]+min_loc]);CHKERRQ(ierr);
1603984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]+min_loc];
1604984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=min_loc;
1605984c4197SStefano Zampini       total_primal_vertices++;
1606984c4197SStefano Zampini     }
1607984c4197SStefano Zampini   }
1608a717540cSStefano Zampini   /* determine if a QR strategy is needed for change of basis */
1609a717540cSStefano Zampini   qr_needed = PETSC_FALSE;
1610a717540cSStefano Zampini   ierr = PetscBTCreate(pcbddc->local_primal_size,&qr_needed_idx);CHKERRQ(ierr);
1611a717540cSStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1612a717540cSStefano Zampini     if (PetscBTLookup(change_basis,i)) {
1613a717540cSStefano Zampini       size_of_constraint = temp_indices[i+1]-temp_indices[i];
1614a717540cSStefano Zampini       j = 0;
1615a717540cSStefano Zampini       for (k=0;k<size_of_constraint;k++) {
1616a717540cSStefano Zampini         if (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) {
1617a717540cSStefano Zampini           j++;
1618a717540cSStefano Zampini         }
1619a717540cSStefano Zampini       }
1620a717540cSStefano Zampini       /* found more than one primal dof on the cc */
1621a717540cSStefano Zampini       if (j > 1) {
1622a717540cSStefano Zampini         PetscBTSet(qr_needed_idx,i);
1623a717540cSStefano Zampini         qr_needed = PETSC_TRUE;
1624a717540cSStefano Zampini       }
1625a717540cSStefano Zampini     }
1626a717540cSStefano Zampini   }
1627984c4197SStefano Zampini   /* free workspace */
1628984c4197SStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
1629674ae819SStefano Zampini   /* permute indices in order to have a sorted set of vertices */
1630a717540cSStefano Zampini   ierr = PetscSortInt(total_primal_vertices,aux_primal_numbering);CHKERRQ(ierr);
1631984c4197SStefano Zampini 
1632984c4197SStefano Zampini   /* nonzero structure of constraint matrix */
1633984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1634984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) nnz[i]=1;
1635984c4197SStefano Zampini   j=total_primal_vertices;
1636984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
16374641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1638674ae819SStefano Zampini       nnz[j]=temp_indices[i+1]-temp_indices[i];
1639674ae819SStefano Zampini       j++;
1640674ae819SStefano Zampini     }
1641674ae819SStefano Zampini   }
1642674ae819SStefano Zampini   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
1643674ae819SStefano Zampini   ierr = PetscFree(nnz);CHKERRQ(ierr);
1644674ae819SStefano Zampini   /* set values in constraint matrix */
1645984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) {
1646984c4197SStefano Zampini     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,aux_primal_numbering[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
1647674ae819SStefano Zampini   }
1648984c4197SStefano Zampini   total_counts = total_primal_vertices;
1649984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
16504641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1651674ae819SStefano Zampini       size_of_constraint=temp_indices[i+1]-temp_indices[i];
1652674ae819SStefano 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);
1653674ae819SStefano Zampini       total_counts++;
1654674ae819SStefano Zampini     }
1655674ae819SStefano Zampini   }
1656674ae819SStefano Zampini   /* assembling */
1657674ae819SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1658674ae819SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1659984c4197SStefano Zampini   /*
1660984c4197SStefano Zampini   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
1661984c4197SStefano Zampini   */
1662674ae819SStefano Zampini   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
1663674ae819SStefano Zampini   if (pcbddc->use_change_of_basis) {
1664026de310SStefano Zampini     /* dual and primal dofs on a single cc */
1665984c4197SStefano Zampini     PetscInt     dual_dofs,primal_dofs;
1666026de310SStefano Zampini     /* iterator on aux_primal_minloc (ordered as read from nearnullspace: vertices, edges and then constraints) */
1667026de310SStefano Zampini     PetscInt     primal_counter;
1668984c4197SStefano Zampini     /* working stuff for GEQRF */
1669984c4197SStefano Zampini     PetscScalar  *qr_basis,*qr_tau,*qr_work,lqr_work_t;
1670984c4197SStefano Zampini     PetscBLASInt lqr_work;
1671984c4197SStefano Zampini     /* working stuff for UNGQR */
1672984c4197SStefano Zampini     PetscScalar  *gqr_work,lgqr_work_t;
1673984c4197SStefano Zampini     PetscBLASInt lgqr_work;
1674984c4197SStefano Zampini     /* working stuff for TRTRS */
1675984c4197SStefano Zampini     PetscScalar  *trs_rhs;
16763f08241aSStefano Zampini     PetscBLASInt Blas_NRHS;
1677984c4197SStefano Zampini     /* pointers for values insertion into change of basis matrix */
1678984c4197SStefano Zampini     PetscInt     *start_rows,*start_cols;
1679984c4197SStefano Zampini     PetscScalar  *start_vals;
1680984c4197SStefano Zampini     /* working stuff for values insertion */
16814641a718SStefano Zampini     PetscBT      is_primal;
1682984c4197SStefano Zampini 
1683a717540cSStefano Zampini     /* change of basis acts on local interfaces -> dimension is n_B x n_B */
1684a717540cSStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
1685a717540cSStefano Zampini     ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr);
1686a717540cSStefano Zampini     ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr);
1687a717540cSStefano Zampini     /* work arrays */
1688a717540cSStefano Zampini     ierr = PetscMalloc(pcis->n_B*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1689a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) nnz[i]=1;
1690a717540cSStefano Zampini     /* nonzeros per row */
1691a717540cSStefano Zampini     for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1692a717540cSStefano Zampini       if (PetscBTLookup(change_basis,i)) {
1693a717540cSStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
1694a717540cSStefano Zampini         if (PetscBTLookup(qr_needed_idx,i)) {
1695a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1696a717540cSStefano Zampini         } else {
1697a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = 2;
1698a717540cSStefano Zampini           /* get local primal index on the cc */
1699a717540cSStefano Zampini           j = 0;
1700a717540cSStefano Zampini           while (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+j])) j++;
1701a717540cSStefano Zampini           nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1702a717540cSStefano Zampini         }
1703a717540cSStefano Zampini       }
1704a717540cSStefano Zampini     }
1705a717540cSStefano Zampini     ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
1706a717540cSStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
1707a717540cSStefano Zampini     /* Set initial identity in the matrix */
1708a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) {
1709a717540cSStefano Zampini       ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
1710a717540cSStefano Zampini     }
1711a717540cSStefano Zampini 
1712a717540cSStefano Zampini     if (pcbddc->dbg_flag) {
1713a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1714a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
1715a717540cSStefano Zampini     }
1716a717540cSStefano Zampini 
1717a717540cSStefano Zampini 
1718a717540cSStefano Zampini     /* Now we loop on the constraints which need a change of basis */
1719a717540cSStefano Zampini     /*
1720a717540cSStefano Zampini        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
1721a717540cSStefano Zampini        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
1722a717540cSStefano Zampini 
1723a717540cSStefano Zampini        Basic blocks of change of basis matrix T computed
1724a717540cSStefano Zampini 
1725a717540cSStefano Zampini           - Using the following block transformation if there is only a primal dof on the cc
1726a717540cSStefano Zampini             (in the example, primal dof is the last one of the edge in LOCAL ordering
1727a717540cSStefano Zampini              in this code, primal dof is the first one of the edge in GLOBAL ordering)
1728a717540cSStefano Zampini             | 1        0   ...        0     1 |
1729a717540cSStefano Zampini             | 0        1   ...        0     1 |
1730a717540cSStefano Zampini             |              ...                |
1731a717540cSStefano Zampini             | 0        ...            1     1 |
1732a717540cSStefano Zampini             | -s_1/s_n ...    -s_{n-1}/-s_n 1 |
1733a717540cSStefano Zampini 
1734a717540cSStefano Zampini           - via QR decomposition of constraints otherwise
1735a717540cSStefano Zampini     */
1736a717540cSStefano Zampini     if (qr_needed) {
1737984c4197SStefano Zampini       /* space to store Q */
1738984c4197SStefano Zampini       ierr = PetscMalloc((max_size_of_constraint)*(max_size_of_constraint)*sizeof(PetscScalar),&qr_basis);CHKERRQ(ierr);
1739984c4197SStefano Zampini       /* first we issue queries for optimal work */
17403f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
17413f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
17423f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1743984c4197SStefano Zampini       lqr_work = -1;
17443f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
1745984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
1746984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
1747984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lqr_work_t)*sizeof(*qr_work),&qr_work);CHKERRQ(ierr);
1748984c4197SStefano Zampini       lgqr_work = -1;
17493f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
17503f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
17513f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
17523f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
17533f08241aSStefano Zampini       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
17543f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
1755984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
1756984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
1757984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lgqr_work_t)*sizeof(*gqr_work),&gqr_work);CHKERRQ(ierr);
1758984c4197SStefano Zampini       /* array to store scaling factors for reflectors */
1759984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*sizeof(*qr_tau),&qr_tau);CHKERRQ(ierr);
1760984c4197SStefano Zampini       /* array to store rhs and solution of triangular solver */
1761984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*max_constraints*sizeof(*trs_rhs),&trs_rhs);CHKERRQ(ierr);
1762a717540cSStefano Zampini       /* allocating workspace for check */
1763a717540cSStefano Zampini       if (pcbddc->dbg_flag) {
1764a717540cSStefano Zampini         ierr = PetscMalloc(max_size_of_constraint*(max_constraints+max_size_of_constraint)*sizeof(*work),&work);CHKERRQ(ierr);
1765a717540cSStefano Zampini       }
1766a717540cSStefano Zampini     }
1767984c4197SStefano Zampini     /* array to store whether a node is primal or not */
17684641a718SStefano Zampini     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
17694641a718SStefano Zampini     for (i=0;i<total_primal_vertices;i++) {
17704641a718SStefano Zampini       ierr = PetscBTSet(is_primal,local_to_B[aux_primal_numbering[i]]);CHKERRQ(ierr);
17714641a718SStefano Zampini     }
1772984c4197SStefano Zampini 
1773a717540cSStefano Zampini     /* loop on constraints and see whether or not they need a change of basis and compute it */
1774026de310SStefano Zampini     /* -> using implicit ordering contained in temp_indices data */
1775026de310SStefano Zampini     total_counts = pcbddc->n_vertices;
1776026de310SStefano Zampini     primal_counter = total_counts;
1777026de310SStefano Zampini     while (total_counts<pcbddc->local_primal_size) {
1778026de310SStefano Zampini       primal_dofs = 1;
17794641a718SStefano Zampini       if (PetscBTLookup(change_basis,total_counts)) {
1780026de310SStefano Zampini         /* get all constraints with same support: if more then one constraint is present on the cc then surely indices are stored contiguosly */
1781026de310SStefano 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]]) {
1782026de310SStefano Zampini           primal_dofs++;
1783674ae819SStefano Zampini         }
1784984c4197SStefano Zampini         /* get constraint info */
1785026de310SStefano Zampini         size_of_constraint = temp_indices[total_counts+1]-temp_indices[total_counts];
1786984c4197SStefano Zampini         dual_dofs = size_of_constraint-primal_dofs;
1787984c4197SStefano Zampini 
1788984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
1789a717540cSStefano 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);
1790674ae819SStefano Zampini         }
1791984c4197SStefano Zampini 
1792a717540cSStefano Zampini         if (primal_dofs > 1) { /* QR */
1793a717540cSStefano Zampini 
1794a717540cSStefano Zampini           /* copy quadrature constraints for change of basis check */
1795a717540cSStefano Zampini           if (pcbddc->dbg_flag) {
1796a717540cSStefano Zampini             ierr = PetscMemcpy(work,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1797a717540cSStefano Zampini           }
1798984c4197SStefano Zampini           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
1799026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1800984c4197SStefano Zampini 
1801984c4197SStefano Zampini           /* compute QR decomposition of constraints */
18023f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
18033f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
18043f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1805674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
18063f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
1807984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
1808674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1809984c4197SStefano Zampini 
1810984c4197SStefano Zampini           /* explictly compute R^-T */
1811984c4197SStefano Zampini           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
1812984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
18133f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
18143f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
18153f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
18163f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
1817984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
18183f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
1819984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
1820984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1821984c4197SStefano Zampini 
1822a717540cSStefano Zampini           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
18233f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
18243f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
18253f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
18263f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1827984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
18283f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
1829984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
1830984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1831984c4197SStefano Zampini 
1832984c4197SStefano Zampini           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
1833984c4197SStefano Zampini              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
1834984c4197SStefano Zampini              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
18353f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
18363f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
18373f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
18383f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
18393f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
18403f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1841984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1842c4303822SStefano 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));
1843984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1844026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1845984c4197SStefano Zampini 
1846984c4197SStefano Zampini           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
1847026de310SStefano Zampini           start_rows = &temp_indices_to_constraint_B[temp_indices[total_counts]];
1848984c4197SStefano Zampini           /* insert cols for primal dofs */
1849984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) {
1850984c4197SStefano Zampini             start_vals = &qr_basis[j*size_of_constraint];
1851026de310SStefano Zampini             start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter+j]];
1852984c4197SStefano Zampini             ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1853984c4197SStefano Zampini           }
1854984c4197SStefano Zampini           /* insert cols for dual dofs */
1855984c4197SStefano Zampini           for (j=0,k=0;j<dual_dofs;k++) {
18564641a718SStefano Zampini             if (!PetscBTLookup(is_primal,temp_indices_to_constraint_B[temp_indices[total_counts]+k])) {
1857984c4197SStefano Zampini               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
1858026de310SStefano Zampini               start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+k];
1859984c4197SStefano Zampini               ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1860984c4197SStefano Zampini               j++;
1861674ae819SStefano Zampini             }
1862674ae819SStefano Zampini           }
1863984c4197SStefano Zampini 
1864984c4197SStefano Zampini           /* check change of basis */
1865984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
1866984c4197SStefano Zampini             PetscInt   ii,jj;
1867984c4197SStefano Zampini             PetscBool valid_qr=PETSC_TRUE;
1868c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
1869c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1870c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
1871c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1872c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
1873c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
1874984c4197SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1875c4303822SStefano 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));
1876984c4197SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
1877984c4197SStefano Zampini             for (jj=0;jj<size_of_constraint;jj++) {
1878984c4197SStefano Zampini               for (ii=0;ii<primal_dofs;ii++) {
1879984c4197SStefano Zampini                 if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
1880984c4197SStefano Zampini                 if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
1881674ae819SStefano Zampini               }
1882674ae819SStefano Zampini             }
1883984c4197SStefano Zampini             if (!valid_qr) {
1884984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
1885984c4197SStefano Zampini               for (jj=0;jj<size_of_constraint;jj++) {
1886984c4197SStefano Zampini                 for (ii=0;ii<primal_dofs;ii++) {
1887984c4197SStefano Zampini                   if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
1888984c4197SStefano 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]));
1889674ae819SStefano Zampini                   }
1890984c4197SStefano Zampini                   if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
1891984c4197SStefano 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]));
1892984c4197SStefano Zampini                   }
1893984c4197SStefano Zampini                 }
1894984c4197SStefano Zampini               }
1895674ae819SStefano Zampini             } else {
1896984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
1897674ae819SStefano Zampini             }
1898674ae819SStefano Zampini           }
1899a717540cSStefano Zampini         } else { /* simple transformation block */
1900a717540cSStefano Zampini           PetscInt row,col;
1901a717540cSStefano Zampini           PetscScalar val;
1902a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) {
1903a717540cSStefano Zampini             row = temp_indices_to_constraint_B[temp_indices[total_counts]+j];
1904a717540cSStefano Zampini             if (!PetscBTLookup(is_primal,row)) {
1905a717540cSStefano Zampini               col = temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
1906a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
1907a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,1.0,INSERT_VALUES);CHKERRQ(ierr);
1908a717540cSStefano Zampini             } else {
1909a717540cSStefano Zampini               for (k=0;k<size_of_constraint;k++) {
1910a717540cSStefano Zampini                 col = temp_indices_to_constraint_B[temp_indices[total_counts]+k];
1911a717540cSStefano Zampini                 if (row != col) {
1912a717540cSStefano Zampini                   val = -temp_quadrature_constraint[temp_indices[total_counts]+k]/temp_quadrature_constraint[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
1913a717540cSStefano Zampini                 } else {
1914a717540cSStefano Zampini                   val = 1.0;
1915a717540cSStefano Zampini                 }
1916a717540cSStefano Zampini                 ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
1917a717540cSStefano Zampini               }
1918a717540cSStefano Zampini             }
1919a717540cSStefano Zampini           }
1920a717540cSStefano Zampini         }
1921026de310SStefano Zampini         /* increment primal counter */
1922026de310SStefano Zampini         primal_counter += primal_dofs;
1923984c4197SStefano Zampini       } else {
1924984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
1925026de310SStefano 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);
1926674ae819SStefano Zampini         }
1927674ae819SStefano Zampini       }
1928026de310SStefano Zampini       /* increment constraint counter total_counts */
1929026de310SStefano Zampini       total_counts += primal_dofs;
1930674ae819SStefano Zampini     }
1931a717540cSStefano Zampini 
1932a717540cSStefano Zampini     /* free workspace */
1933a717540cSStefano Zampini     if (qr_needed) {
1934984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
1935984c4197SStefano Zampini         ierr = PetscFree(work);CHKERRQ(ierr);
1936984c4197SStefano Zampini       }
1937984c4197SStefano Zampini       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
1938984c4197SStefano Zampini       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
1939984c4197SStefano Zampini       ierr = PetscFree(qr_work);CHKERRQ(ierr);
1940984c4197SStefano Zampini       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
1941984c4197SStefano Zampini       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
1942674ae819SStefano Zampini     }
1943a717540cSStefano Zampini     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
1944674ae819SStefano Zampini     /* assembling */
1945674ae819SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1946674ae819SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1947984c4197SStefano Zampini     /*
1948984c4197SStefano Zampini     ierr = MatView(pcbddc->ChangeOfBasisMatrix,(PetscViewer)0);CHKERRQ(ierr);
1949984c4197SStefano Zampini     */
1950674ae819SStefano Zampini   }
1951a717540cSStefano Zampini 
1952a717540cSStefano Zampini   /* flush dbg viewer */
1953b8ffe317SStefano Zampini   if (pcbddc->dbg_flag) {
1954b8ffe317SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1955b8ffe317SStefano Zampini   }
1956a717540cSStefano Zampini 
1957e310c8b4SStefano Zampini   /* free workspace */
1958a717540cSStefano Zampini   ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
1959a717540cSStefano Zampini   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
1960984c4197SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
1961984c4197SStefano Zampini   ierr = PetscFree(aux_primal_minloc);CHKERRQ(ierr);
1962674ae819SStefano Zampini   ierr = PetscFree(temp_indices);CHKERRQ(ierr);
19634641a718SStefano Zampini   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
1964674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr);
1965674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
1966674ae819SStefano Zampini   ierr = PetscFree(local_to_B);CHKERRQ(ierr);
1967674ae819SStefano Zampini   ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr);
1968674ae819SStefano Zampini   PetscFunctionReturn(0);
1969674ae819SStefano Zampini }
1970674ae819SStefano Zampini 
1971674ae819SStefano Zampini #undef __FUNCT__
1972674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
1973674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
1974674ae819SStefano Zampini {
1975674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
1976674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
1977674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
1978674ae819SStefano Zampini   PetscInt    bs,ierr,i,vertex_size;
1979674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
1980674ae819SStefano Zampini 
1981674ae819SStefano Zampini   PetscFunctionBegin;
1982674ae819SStefano Zampini   /* Init local Graph struct */
1983674ae819SStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr);
1984674ae819SStefano Zampini 
1985575ad6abSStefano Zampini   /* Check validity of the csr graph passed in by the user */
1986575ad6abSStefano Zampini   if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) {
1987575ad6abSStefano Zampini     ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1988575ad6abSStefano Zampini   }
19899577ea80SStefano Zampini 
1990674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
1991674ae819SStefano Zampini   if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) {
1992674ae819SStefano Zampini     Mat mat_adj;
1993674ae819SStefano Zampini     const PetscInt *xadj,*adjncy;
1994674ae819SStefano Zampini     PetscBool flg_row=PETSC_TRUE;
1995674ae819SStefano Zampini 
1996674ae819SStefano Zampini     ierr = MatConvert(matis->A,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr);
1997674ae819SStefano Zampini     ierr = MatGetRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
1998674ae819SStefano Zampini     if (!flg_row) {
1999674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ called in %s\n",__FUNCT__);
2000674ae819SStefano Zampini     }
2001674ae819SStefano Zampini     ierr = PCBDDCSetLocalAdjacencyGraph(pc,i,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
2002674ae819SStefano Zampini     ierr = MatRestoreRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2003674ae819SStefano Zampini     if (!flg_row) {
2004674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__);
2005674ae819SStefano Zampini     }
2006674ae819SStefano Zampini     ierr = MatDestroy(&mat_adj);CHKERRQ(ierr);
2007674ae819SStefano Zampini   }
2008674ae819SStefano Zampini 
2009674ae819SStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting */
2010674ae819SStefano Zampini   vertex_size = 1;
20119577ea80SStefano Zampini   if (!pcbddc->user_provided_isfordofs) {
2012674ae819SStefano Zampini     if (!pcbddc->n_ISForDofs) {
2013674ae819SStefano Zampini       IS *custom_ISForDofs;
2014674ae819SStefano Zampini 
2015674ae819SStefano Zampini       ierr = MatGetBlockSize(matis->A,&bs);CHKERRQ(ierr);
2016674ae819SStefano Zampini       ierr = PetscMalloc(bs*sizeof(IS),&custom_ISForDofs);CHKERRQ(ierr);
2017674ae819SStefano Zampini       for (i=0;i<bs;i++) {
2018674ae819SStefano Zampini         ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n/bs,i,bs,&custom_ISForDofs[i]);CHKERRQ(ierr);
2019674ae819SStefano Zampini       }
2020674ae819SStefano Zampini       ierr = PCBDDCSetDofsSplitting(pc,bs,custom_ISForDofs);CHKERRQ(ierr);
20219577ea80SStefano Zampini       pcbddc->user_provided_isfordofs = PETSC_FALSE;
2022674ae819SStefano Zampini       /* remove my references to IS objects */
2023674ae819SStefano Zampini       for (i=0;i<bs;i++) {
2024674ae819SStefano Zampini         ierr = ISDestroy(&custom_ISForDofs[i]);CHKERRQ(ierr);
2025674ae819SStefano Zampini       }
2026674ae819SStefano Zampini       ierr = PetscFree(custom_ISForDofs);CHKERRQ(ierr);
20279577ea80SStefano Zampini     }
20289577ea80SStefano Zampini   } else { /* mat block size as vertex size (used for elasticity with rigid body modes as nearnullspace) */
2029674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
2030674ae819SStefano Zampini   }
2031674ae819SStefano Zampini 
2032674ae819SStefano Zampini   /* Setup of Graph */
2033674ae819SStefano Zampini   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundaries,pcbddc->DirichletBoundaries,pcbddc->n_ISForDofs,pcbddc->ISForDofs,pcbddc->user_primal_vertices);
2034674ae819SStefano Zampini 
2035674ae819SStefano Zampini   /* Graph's connected components analysis */
2036674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
2037674ae819SStefano Zampini 
2038674ae819SStefano Zampini   /* print some info to stdout */
2039674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
2040e49050b4SStefano Zampini     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer);
2041674ae819SStefano Zampini   }
2042674ae819SStefano Zampini   PetscFunctionReturn(0);
2043674ae819SStefano Zampini }
2044674ae819SStefano Zampini 
2045674ae819SStefano Zampini #undef __FUNCT__
2046674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx"
2047f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt **vertices_idx)
2048674ae819SStefano Zampini {
2049674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2050674ae819SStefano Zampini   PetscInt       *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size;
2051674ae819SStefano Zampini   PetscErrorCode ierr;
2052674ae819SStefano Zampini 
2053674ae819SStefano Zampini   PetscFunctionBegin;
2054674ae819SStefano Zampini   n = 0;
2055674ae819SStefano Zampini   vertices = 0;
2056674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2057674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr);
2058b120a5c6SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2059b120a5c6SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2060b120a5c6SStefano Zampini       if (size_of_constraint == 1) n++;
2061b120a5c6SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2062b120a5c6SStefano Zampini     }
2063811e8ca2SStefano Zampini     if (vertices_idx) {
2064b120a5c6SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&vertices);CHKERRQ(ierr);
2065b120a5c6SStefano Zampini       n = 0;
2066674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2067674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2068674ae819SStefano Zampini         if (size_of_constraint == 1) {
2069674ae819SStefano Zampini           vertices[n++]=row_cmat_indices[0];
2070674ae819SStefano Zampini         }
2071674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2072674ae819SStefano Zampini       }
2073674ae819SStefano Zampini     }
2074811e8ca2SStefano Zampini   }
2075674ae819SStefano Zampini   *n_vertices = n;
2076811e8ca2SStefano Zampini   if (vertices_idx) *vertices_idx = vertices;
2077674ae819SStefano Zampini   PetscFunctionReturn(0);
2078674ae819SStefano Zampini }
2079674ae819SStefano Zampini 
2080674ae819SStefano Zampini #undef __FUNCT__
2081674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx"
2082f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt **constraints_idx)
2083674ae819SStefano Zampini {
2084674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2085674ae819SStefano Zampini   PetscInt       *constraints_index,*row_cmat_indices,*row_cmat_global_indices;
2086674ae819SStefano Zampini   PetscInt       n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc;
20874641a718SStefano Zampini   PetscBT        touched;
2088674ae819SStefano Zampini   PetscErrorCode ierr;
2089674ae819SStefano Zampini 
2090f34684f1SStefano Zampini     /* This function assumes that the number of local constraints per connected component
2091f34684f1SStefano Zampini        is not greater than the number of nodes defined for the connected component
2092f34684f1SStefano Zampini        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
2093674ae819SStefano Zampini   PetscFunctionBegin;
2094674ae819SStefano Zampini   n = 0;
2095674ae819SStefano Zampini   constraints_index = 0;
2096674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2097674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr);
2098674ae819SStefano Zampini     max_size_of_constraint = 0;
2099674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2100674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2101674ae819SStefano Zampini       if (size_of_constraint > 1) {
2102674ae819SStefano Zampini         n++;
2103674ae819SStefano Zampini       }
2104674ae819SStefano Zampini       max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint);
2105674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2106674ae819SStefano Zampini     }
2107811e8ca2SStefano Zampini     if (constraints_idx) {
2108674ae819SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&constraints_index);CHKERRQ(ierr);
2109674ae819SStefano Zampini       ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&row_cmat_global_indices);CHKERRQ(ierr);
21104641a718SStefano Zampini       ierr = PetscBTCreate(local_size,&touched);CHKERRQ(ierr);
2111674ae819SStefano Zampini       n = 0;
2112674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2113674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2114674ae819SStefano Zampini         if (size_of_constraint > 1) {
2115674ae819SStefano Zampini           ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr);
211682d3d8afSStefano Zampini           /* find first untouched local node */
211782d3d8afSStefano Zampini           j = 0;
21184641a718SStefano Zampini           while (PetscBTLookup(touched,row_cmat_indices[j])) j++;
211982d3d8afSStefano Zampini           min_index = row_cmat_global_indices[j];
212082d3d8afSStefano Zampini           min_loc = j;
212182d3d8afSStefano Zampini           /* search the minimum among nodes not yet touched on the connected component
212282d3d8afSStefano Zampini              since there can be more than one constraint on a single cc */
2123674ae819SStefano Zampini           for (j=1;j<size_of_constraint;j++) {
21244641a718SStefano Zampini             if (!PetscBTLookup(touched,row_cmat_indices[j]) && min_index > row_cmat_global_indices[j]) {
2125674ae819SStefano Zampini               min_index = row_cmat_global_indices[j];
2126674ae819SStefano Zampini               min_loc = j;
2127674ae819SStefano Zampini             }
2128674ae819SStefano Zampini           }
21294641a718SStefano Zampini           ierr = PetscBTSet(touched,row_cmat_indices[min_loc]);CHKERRQ(ierr);
2130674ae819SStefano Zampini           constraints_index[n++] = row_cmat_indices[min_loc];
2131674ae819SStefano Zampini         }
2132674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2133674ae819SStefano Zampini       }
21344641a718SStefano Zampini       ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2135674ae819SStefano Zampini       ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr);
2136811e8ca2SStefano Zampini     }
2137811e8ca2SStefano Zampini   }
2138674ae819SStefano Zampini   *n_constraints = n;
2139811e8ca2SStefano Zampini   if (constraints_idx) *constraints_idx = constraints_index;
2140674ae819SStefano Zampini   PetscFunctionReturn(0);
2141674ae819SStefano Zampini }
2142674ae819SStefano Zampini 
2143674ae819SStefano Zampini /* the next two functions has been adapted from pcis.c */
2144674ae819SStefano Zampini #undef __FUNCT__
2145674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchur"
2146674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchur(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2147674ae819SStefano Zampini {
2148674ae819SStefano Zampini   PetscErrorCode ierr;
2149674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2150674ae819SStefano Zampini 
2151674ae819SStefano Zampini   PetscFunctionBegin;
2152674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2153674ae819SStefano Zampini   ierr = MatMult(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2154674ae819SStefano Zampini   ierr = MatMult(pcis->A_IB,v,vec1_D);CHKERRQ(ierr);
2155674ae819SStefano Zampini   ierr = KSPSolve(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2156674ae819SStefano Zampini   ierr = MatMult(pcis->A_BI,vec2_D,vec2_B);CHKERRQ(ierr);
2157674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2158674ae819SStefano Zampini   PetscFunctionReturn(0);
2159674ae819SStefano Zampini }
2160674ae819SStefano Zampini 
2161674ae819SStefano Zampini #undef __FUNCT__
2162674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchurTranspose"
2163674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchurTranspose(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2164674ae819SStefano Zampini {
2165674ae819SStefano Zampini   PetscErrorCode ierr;
2166674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2167674ae819SStefano Zampini 
2168674ae819SStefano Zampini   PetscFunctionBegin;
2169674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2170674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2171674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BI,v,vec1_D);CHKERRQ(ierr);
2172674ae819SStefano Zampini   ierr = KSPSolveTranspose(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2173674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_IB,vec2_D,vec2_B);CHKERRQ(ierr);
2174674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2175674ae819SStefano Zampini   PetscFunctionReturn(0);
2176674ae819SStefano Zampini }
2177674ae819SStefano Zampini 
2178674ae819SStefano Zampini #undef __FUNCT__
2179674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
2180674ae819SStefano 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[])
2181674ae819SStefano Zampini {
2182674ae819SStefano Zampini   Vec            local_vec,global_vec;
2183674ae819SStefano Zampini   IS             seqis,paris;
2184674ae819SStefano Zampini   VecScatter     scatter_ctx;
2185674ae819SStefano Zampini   PetscScalar    *array;
2186674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
2187674ae819SStefano Zampini   PetscScalar    globalsum;
2188674ae819SStefano Zampini   PetscInt       i,j,s;
2189674ae819SStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local;
2190674ae819SStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm,max_global;
2191674ae819SStefano Zampini   PetscMPIInt    *dof_sizes,*dof_displs;
2192674ae819SStefano Zampini   PetscBool      first_found;
2193674ae819SStefano Zampini   PetscErrorCode ierr;
2194674ae819SStefano Zampini 
2195674ae819SStefano Zampini   PetscFunctionBegin;
2196674ae819SStefano Zampini   /* mpi buffers */
2197674ae819SStefano Zampini   MPI_Comm_size(comm,&size_prec_comm);
2198674ae819SStefano Zampini   MPI_Comm_rank(comm,&rank_prec_comm);
2199674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
2200674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_sizes),&dof_sizes);CHKERRQ(ierr);
2201674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_displs),&dof_displs);CHKERRQ(ierr);
2202674ae819SStefano Zampini   /* get maximum size of subset */
2203674ae819SStefano Zampini   ierr = PetscMalloc(n_local_dofs*sizeof(PetscInt),&temp_global_dofs);CHKERRQ(ierr);
2204674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
2205674ae819SStefano Zampini   max_local = 0;
2206674ae819SStefano Zampini   if (n_local_dofs) {
2207674ae819SStefano Zampini     max_local = temp_global_dofs[0];
2208674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2209674ae819SStefano Zampini       if (max_local < temp_global_dofs[i] ) {
2210674ae819SStefano Zampini         max_local = temp_global_dofs[i];
2211674ae819SStefano Zampini       }
2212674ae819SStefano Zampini     }
2213674ae819SStefano Zampini   }
2214674ae819SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);
2215674ae819SStefano Zampini   max_global++;
2216674ae819SStefano Zampini   max_local = 0;
2217674ae819SStefano Zampini   if (n_local_dofs) {
2218674ae819SStefano Zampini     max_local = local_dofs[0];
2219674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2220674ae819SStefano Zampini       if (max_local < local_dofs[i] ) {
2221674ae819SStefano Zampini         max_local = local_dofs[i];
2222674ae819SStefano Zampini       }
2223674ae819SStefano Zampini     }
2224674ae819SStefano Zampini   }
2225674ae819SStefano Zampini   max_local++;
2226674ae819SStefano Zampini   /* allocate workspace */
2227674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
2228674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
2229674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
2230674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
2231674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
2232674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
2233674ae819SStefano Zampini   /* create scatter */
2234674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
2235674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
2236674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
2237674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
2238674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
2239674ae819SStefano Zampini   /* init array */
2240674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
2241674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2242674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2243674ae819SStefano Zampini   if (local_dofs_mult) {
2244674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2245674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
2246674ae819SStefano Zampini     }
2247674ae819SStefano Zampini   } else {
2248674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2249674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
2250674ae819SStefano Zampini     }
2251674ae819SStefano Zampini   }
2252674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2253674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
2254674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2255674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2256674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
22575b08dc53SStefano Zampini   *n_global_subset = (PetscInt)PetscRealPart(globalsum);
2258674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
2259674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
2260674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
2261674ae819SStefano Zampini   nlocals = 0;
2262674ae819SStefano Zampini   first_index = -1;
2263674ae819SStefano Zampini   first_found = PETSC_FALSE;
2264674ae819SStefano Zampini   for (i=0;i<s;i++) {
22655b08dc53SStefano Zampini     if (!first_found && PetscRealPart(array[i]) > 0.0) {
2266674ae819SStefano Zampini       first_found = PETSC_TRUE;
2267674ae819SStefano Zampini       first_index = i;
2268674ae819SStefano Zampini     }
22695b08dc53SStefano Zampini     nlocals += (PetscInt)PetscRealPart(array[i]);
2270674ae819SStefano Zampini   }
2271674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2272674ae819SStefano Zampini   if (!rank_prec_comm) {
2273674ae819SStefano Zampini     dof_displs[0]=0;
2274674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
2275674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
2276674ae819SStefano Zampini     }
2277674ae819SStefano Zampini   }
2278674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2279674ae819SStefano Zampini   if (first_found) {
2280674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
2281674ae819SStefano Zampini     old_index = first_index;
2282674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
22835b08dc53SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) {
2284674ae819SStefano Zampini         array[i] += array[old_index];
2285674ae819SStefano Zampini         old_index = i;
2286674ae819SStefano Zampini       }
2287674ae819SStefano Zampini     }
2288674ae819SStefano Zampini   }
2289674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
2290674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2291674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2292674ae819SStefano Zampini   ierr = VecScatterEnd  (scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2293674ae819SStefano Zampini   /* get global ordering of local dofs */
2294674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2295674ae819SStefano Zampini   if (local_dofs_mult) {
2296674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
22975b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i];
2298674ae819SStefano Zampini     }
2299674ae819SStefano Zampini   } else {
2300674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
23015b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1;
2302674ae819SStefano Zampini     }
2303674ae819SStefano Zampini   }
2304674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2305674ae819SStefano Zampini   /* free workspace */
2306674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
2307674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
2308674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
2309674ae819SStefano Zampini   ierr = PetscFree(dof_sizes);CHKERRQ(ierr);
2310674ae819SStefano Zampini   ierr = PetscFree(dof_displs);CHKERRQ(ierr);
2311674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
2312674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
2313674ae819SStefano Zampini   PetscFunctionReturn(0);
2314674ae819SStefano Zampini }
23159a7d3425SStefano Zampini 
23169a7d3425SStefano Zampini #undef __FUNCT__
23179a7d3425SStefano Zampini #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
23189a7d3425SStefano Zampini PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
23199a7d3425SStefano Zampini {
23209a7d3425SStefano Zampini   PetscInt       i,j;
23219a7d3425SStefano Zampini   PetscScalar    *alphas;
23229a7d3425SStefano Zampini   PetscErrorCode ierr;
23239a7d3425SStefano Zampini 
23249a7d3425SStefano Zampini   PetscFunctionBegin;
23259a7d3425SStefano Zampini   /* this implements stabilized Gram-Schmidt */
23269a7d3425SStefano Zampini   ierr = PetscMalloc(n*sizeof(PetscScalar),&alphas);CHKERRQ(ierr);
23279a7d3425SStefano Zampini   for (i=0;i<n;i++) {
23289a7d3425SStefano Zampini     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
23299a7d3425SStefano Zampini     if (i<n) { ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],&alphas[i+1]);CHKERRQ(ierr); }
23309a7d3425SStefano Zampini     for (j=i+1;j<n;j++) { ierr = VecAXPY(vecs[j],PetscConj(-alphas[j]),vecs[i]);CHKERRQ(ierr); }
23319a7d3425SStefano Zampini   }
23329a7d3425SStefano Zampini   ierr = PetscFree(alphas);CHKERRQ(ierr);
23339a7d3425SStefano Zampini   PetscFunctionReturn(0);
23349a7d3425SStefano Zampini }
23359a7d3425SStefano Zampini 
2336a57a6d2fSStefano Zampini /* Currently support MAT_INITIAL_MATRIX only, with partial support to block matrices */
2337c8587f34SStefano Zampini #undef __FUNCT__
2338a57a6d2fSStefano Zampini #define __FUNCT__ "MatConvert_IS_AIJ"
2339a57a6d2fSStefano Zampini static PetscErrorCode MatConvert_IS_AIJ(Mat mat, MatType newtype,MatReuse reuse,Mat *M)
2340c8587f34SStefano Zampini {
2341a57a6d2fSStefano Zampini   Mat new_mat;
2342a57a6d2fSStefano Zampini   Mat_IS *matis = (Mat_IS*)(mat->data);
2343a57a6d2fSStefano Zampini   /* info on mat */
2344a57a6d2fSStefano Zampini   PetscInt bs,rows,cols;
2345a57a6d2fSStefano Zampini   PetscInt lrows,lcols;
2346a57a6d2fSStefano Zampini   PetscInt local_rows,local_cols;
2347e7931f94SStefano Zampini   PetscMPIInt nsubdomains;
2348c8587f34SStefano Zampini   /* preallocation */
2349c8587f34SStefano Zampini   Vec vec_dnz,vec_onz;
2350c8587f34SStefano Zampini   PetscScalar *my_dnz,*my_onz,*array;
2351a57a6d2fSStefano Zampini   PetscInt *dnz,*onz,*mat_ranges,*row_ownership;
2352a57a6d2fSStefano Zampini   PetscInt  index_row,index_col,owner;
2353a57a6d2fSStefano Zampini   PetscInt  *local_indices,*global_indices;
2354a57a6d2fSStefano Zampini   /* work */
2355a57a6d2fSStefano Zampini   PetscInt i,j;
2356a57a6d2fSStefano Zampini   PetscErrorCode ierr;
2357c8587f34SStefano Zampini 
2358a57a6d2fSStefano Zampini   PetscFunctionBegin;
2359a57a6d2fSStefano Zampini   /* CHECKS */
2360a57a6d2fSStefano Zampini   /* get info from mat */
2361a57a6d2fSStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
2362a57a6d2fSStefano Zampini   ierr = MatGetBlockSize(mat,&bs);CHKERRQ(ierr);
2363a57a6d2fSStefano Zampini   ierr = MatGetSize(matis->A,&local_rows,&local_cols);CHKERRQ(ierr);
2364a57a6d2fSStefano Zampini   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&nsubdomains);CHKERRQ(ierr);
2365a57a6d2fSStefano Zampini 
2366a57a6d2fSStefano Zampini   /* MAT_INITIAL_MATRIX */
2367a57a6d2fSStefano Zampini   ierr = MatCreate(PetscObjectComm((PetscObject)mat),&new_mat);CHKERRQ(ierr);
2368a57a6d2fSStefano Zampini   ierr = MatSetSizes(new_mat,PETSC_DECIDE,PETSC_DECIDE,rows,cols);CHKERRQ(ierr);
2369a57a6d2fSStefano Zampini   ierr = MatSetBlockSize(new_mat,bs);CHKERRQ(ierr);
2370a57a6d2fSStefano Zampini   ierr = MatSetType(new_mat,newtype);CHKERRQ(ierr);
2371a57a6d2fSStefano Zampini   ierr = MatSetUp(new_mat);CHKERRQ(ierr);
2372a57a6d2fSStefano Zampini   ierr = MatGetLocalSize(new_mat,&lrows,&lcols);CHKERRQ(ierr);
2373a57a6d2fSStefano Zampini 
2374a57a6d2fSStefano Zampini   /*
2375a57a6d2fSStefano Zampini     preallocation
2376a57a6d2fSStefano Zampini   */
2377a57a6d2fSStefano Zampini 
2378a57a6d2fSStefano Zampini   ierr = MatPreallocateInitialize(PetscObjectComm((PetscObject)new_mat),lrows,lcols,dnz,onz);CHKERRQ(ierr);
2379a57a6d2fSStefano Zampini   /*
2380a57a6d2fSStefano Zampini      Some vectors are needed to sum up properly on shared interface dofs.
2381a57a6d2fSStefano Zampini      Note that preallocation is not exact, since it overestimates nonzeros
2382a57a6d2fSStefano Zampini   */
2383a57a6d2fSStefano Zampini /*
2384a57a6d2fSStefano Zampini   ierr = VecCreate(PetscObjectComm((PetscObject)mat),&vec_dnz);CHKERRQ(ierr);
2385c8587f34SStefano Zampini   ierr = VecSetBlockSize(vec_dnz,bs);CHKERRQ(ierr);
2386a57a6d2fSStefano Zampini   ierr = VecSetSizes(vec_dnz,PETSC_DECIDE,rows);CHKERRQ(ierr);
2387a57a6d2fSStefano Zampini   ierr = VecSetType(vec_dnz,VECSTANDARD);CHKERRQ(ierr);
2388a57a6d2fSStefano Zampini */
2389a57a6d2fSStefano Zampini   ierr = MatGetVecs(new_mat,NULL,&vec_dnz);CHKERRQ(ierr);
2390c8587f34SStefano Zampini   ierr = VecDuplicate(vec_dnz,&vec_onz);CHKERRQ(ierr);
2391e7931f94SStefano Zampini   /* All processes need to compute entire row ownership */
2392a57a6d2fSStefano Zampini   ierr = PetscMalloc(rows*sizeof(*row_ownership),&row_ownership);CHKERRQ(ierr);
2393a57a6d2fSStefano Zampini   ierr = MatGetOwnershipRanges(new_mat,(const PetscInt**)&mat_ranges);CHKERRQ(ierr);
2394a57a6d2fSStefano Zampini   for (i=0;i<nsubdomains;i++) {
2395c8587f34SStefano Zampini     for (j=mat_ranges[i];j<mat_ranges[i+1];j++) {
2396c8587f34SStefano Zampini       row_ownership[j]=i;
2397c8587f34SStefano Zampini     }
2398c8587f34SStefano Zampini   }
2399a57a6d2fSStefano Zampini   /* map indices of local mat to global values */
2400a57a6d2fSStefano Zampini   ierr = PetscMalloc(PetscMax(local_cols,local_rows)*sizeof(*global_indices),&global_indices);CHKERRQ(ierr);
2401a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*local_indices),&local_indices);CHKERRQ(ierr);
2402a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) local_indices[i]=i;
2403a57a6d2fSStefano Zampini   ierr = ISLocalToGlobalMappingApply(matis->mapping,local_rows,local_indices,global_indices);CHKERRQ(ierr);
2404a57a6d2fSStefano Zampini   ierr = PetscFree(local_indices);CHKERRQ(ierr);
2405c8587f34SStefano Zampini 
2406e7931f94SStefano Zampini   /*
2407e7931f94SStefano Zampini      my_dnz and my_onz contains exact contribution to preallocation from each local mat
2408e7931f94SStefano Zampini      then, they will be summed up properly. This way, preallocation is always sufficient
2409e7931f94SStefano Zampini   */
2410a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*my_dnz),&my_dnz);CHKERRQ(ierr);
2411a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*my_onz),&my_onz);CHKERRQ(ierr);
2412a57a6d2fSStefano Zampini   ierr = PetscMemzero(my_dnz,local_rows*sizeof(*my_dnz));CHKERRQ(ierr);
2413a57a6d2fSStefano Zampini   ierr = PetscMemzero(my_onz,local_rows*sizeof(*my_onz));CHKERRQ(ierr);
2414a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) {
2415a57a6d2fSStefano Zampini     index_row = global_indices[i];
2416a57a6d2fSStefano Zampini     for (j=i;j<local_rows;j++) {
2417a57a6d2fSStefano Zampini       owner = row_ownership[index_row];
2418a57a6d2fSStefano Zampini       index_col = global_indices[j];
2419a57a6d2fSStefano Zampini       if (index_col > mat_ranges[owner]-1 && index_col < mat_ranges[owner+1] ) { /* diag block */
2420c8587f34SStefano Zampini         my_dnz[i] += 1.0;
2421a57a6d2fSStefano Zampini       } else { /* offdiag block */
2422c8587f34SStefano Zampini         my_onz[i] += 1.0;
2423c8587f34SStefano Zampini       }
2424a57a6d2fSStefano Zampini       /* same as before, interchanging rows and cols */
2425c8587f34SStefano Zampini       if (i != j) {
2426a57a6d2fSStefano Zampini         owner = row_ownership[index_col];
2427a57a6d2fSStefano Zampini         if (index_row > mat_ranges[owner]-1 && index_row < mat_ranges[owner+1] ) {
2428c8587f34SStefano Zampini           my_dnz[j] += 1.0;
2429c8587f34SStefano Zampini         } else {
2430c8587f34SStefano Zampini           my_onz[j] += 1.0;
2431c8587f34SStefano Zampini         }
2432c8587f34SStefano Zampini       }
2433c8587f34SStefano Zampini     }
2434c8587f34SStefano Zampini   }
2435c8587f34SStefano Zampini   ierr = VecSet(vec_dnz,0.0);CHKERRQ(ierr);
2436c8587f34SStefano Zampini   ierr = VecSet(vec_onz,0.0);CHKERRQ(ierr);
243720a2ab83SStefano Zampini   if (local_rows) { /* multilevel guard */
2438a57a6d2fSStefano Zampini     ierr = VecSetValues(vec_dnz,local_rows,global_indices,my_dnz,ADD_VALUES);CHKERRQ(ierr);
2439a57a6d2fSStefano Zampini     ierr = VecSetValues(vec_onz,local_rows,global_indices,my_onz,ADD_VALUES);CHKERRQ(ierr);
2440c8587f34SStefano Zampini   }
2441c8587f34SStefano Zampini   ierr = VecAssemblyBegin(vec_dnz);CHKERRQ(ierr);
2442c8587f34SStefano Zampini   ierr = VecAssemblyBegin(vec_onz);CHKERRQ(ierr);
2443c8587f34SStefano Zampini   ierr = VecAssemblyEnd(vec_dnz);CHKERRQ(ierr);
2444c8587f34SStefano Zampini   ierr = VecAssemblyEnd(vec_onz);CHKERRQ(ierr);
2445c8587f34SStefano Zampini   ierr = PetscFree(my_dnz);CHKERRQ(ierr);
2446c8587f34SStefano Zampini   ierr = PetscFree(my_onz);CHKERRQ(ierr);
2447c8587f34SStefano Zampini   ierr = PetscFree(row_ownership);CHKERRQ(ierr);
2448a57a6d2fSStefano Zampini 
2449a57a6d2fSStefano Zampini   /* set computed preallocation in dnz and onz */
2450a57a6d2fSStefano Zampini   ierr = VecGetArray(vec_dnz,&array);CHKERRQ(ierr);
2451a57a6d2fSStefano Zampini   for (i=0; i<lrows; i++) dnz[i] = (PetscInt)PetscRealPart(array[i]);
2452a57a6d2fSStefano Zampini   ierr = VecRestoreArray(vec_dnz,&array);CHKERRQ(ierr);
2453a57a6d2fSStefano Zampini   ierr = VecGetArray(vec_onz,&array);CHKERRQ(ierr);
2454a57a6d2fSStefano Zampini   for (i=0;i<lrows;i++) onz[i] = (PetscInt)PetscRealPart(array[i]);
2455a57a6d2fSStefano Zampini   ierr = VecRestoreArray(vec_onz,&array);CHKERRQ(ierr);
2456c8587f34SStefano Zampini   ierr = VecDestroy(&vec_dnz);CHKERRQ(ierr);
2457c8587f34SStefano Zampini   ierr = VecDestroy(&vec_onz);CHKERRQ(ierr);
2458c8587f34SStefano Zampini 
2459e7931f94SStefano Zampini   /* Resize preallocation if overestimated */
2460c8587f34SStefano Zampini   for (i=0;i<lrows;i++) {
2461a57a6d2fSStefano Zampini     dnz[i] = PetscMin(dnz[i],lcols);
2462a57a6d2fSStefano Zampini     onz[i] = PetscMin(onz[i],cols-lcols);
2463c8587f34SStefano Zampini   }
2464a57a6d2fSStefano Zampini   ierr = MatMPIAIJSetPreallocation(new_mat,0,dnz,0,onz);CHKERRQ(ierr);
2465c8587f34SStefano Zampini   ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
2466a57a6d2fSStefano Zampini 
2467a57a6d2fSStefano Zampini   /*
2468e7931f94SStefano Zampini     Set values. Very Basic.
2469a57a6d2fSStefano Zampini   */
2470a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) {
2471a57a6d2fSStefano Zampini     ierr = MatGetRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2472a57a6d2fSStefano Zampini     ierr = ISLocalToGlobalMappingApply(matis->mapping,j,local_indices,global_indices);CHKERRQ(ierr);
2473a57a6d2fSStefano Zampini     ierr = ISLocalToGlobalMappingApply(matis->mapping,1,&i,&index_row);CHKERRQ(ierr);
2474a57a6d2fSStefano Zampini     ierr = MatSetValues(new_mat,1,&index_row,j,global_indices,array,ADD_VALUES);CHKERRQ(ierr);
2475a57a6d2fSStefano Zampini     ierr = MatRestoreRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2476a57a6d2fSStefano Zampini   }
247720a2ab83SStefano Zampini   ierr = MatAssemblyBegin(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2478a57a6d2fSStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
247920a2ab83SStefano Zampini   ierr = MatAssemblyEnd(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2480a57a6d2fSStefano Zampini 
2481a57a6d2fSStefano Zampini   /* get back mat */
2482a57a6d2fSStefano Zampini   *M = new_mat;
2483a57a6d2fSStefano Zampini   PetscFunctionReturn(0);
2484a57a6d2fSStefano Zampini }
2485a57a6d2fSStefano Zampini 
2486e7931f94SStefano Zampini #undef __FUNCT__
2487e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble_Private"
2488e7931f94SStefano Zampini PetscErrorCode MatISSubassemble_Private(Mat mat, PetscInt coarsening_ratio, IS* is_sends)
2489e7931f94SStefano Zampini {
2490e7931f94SStefano Zampini   Mat             subdomain_adj;
2491e7931f94SStefano Zampini   IS              new_ranks,ranks_send_to;
2492e7931f94SStefano Zampini   MatPartitioning partitioner;
2493e7931f94SStefano Zampini   Mat_IS          *matis;
2494e7931f94SStefano Zampini   PetscInt        n_neighs,*neighs,*n_shared,**shared;
2495e7931f94SStefano Zampini   PetscInt        prank;
2496e7931f94SStefano Zampini   PetscMPIInt     size,rank,color;
2497e7931f94SStefano Zampini   PetscInt        *xadj,*adjncy,*oldranks;
2498e7931f94SStefano Zampini   PetscInt        *adjncy_wgt,*v_wgt,*is_indices,*ranks_send_to_idx;
2499e7931f94SStefano Zampini   PetscInt        i,j,n_subdomains,local_size,threshold=0;
2500e7931f94SStefano Zampini   PetscErrorCode  ierr;
25012b510759SStefano Zampini   PetscBool       use_vwgt=PETSC_FALSE,use_square=PETSC_FALSE;
2502e7931f94SStefano Zampini   PetscSubcomm    subcomm;
2503a57a6d2fSStefano Zampini 
2504e7931f94SStefano Zampini   PetscFunctionBegin;
25052b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_square",&use_square,NULL);CHKERRQ(ierr);
25062b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
25072b510759SStefano Zampini   ierr = PetscOptionsGetInt(NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
2508e7931f94SStefano Zampini 
2509e7931f94SStefano Zampini   /* Get info on mapping */
2510e7931f94SStefano Zampini   matis = (Mat_IS*)(mat->data);
2511e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&local_size);CHKERRQ(ierr);
2512e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2513e7931f94SStefano Zampini 
2514e7931f94SStefano Zampini   /* build local CSR graph of subdomains' connectivity */
2515e7931f94SStefano Zampini   ierr = PetscMalloc(2*sizeof(*xadj),&xadj);CHKERRQ(ierr);
2516e7931f94SStefano Zampini   xadj[0] = 0;
2517e7931f94SStefano Zampini   xadj[1] = PetscMax(n_neighs-1,0);
2518e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy),&adjncy);CHKERRQ(ierr);
2519e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy_wgt),&adjncy_wgt);CHKERRQ(ierr);
2520e7931f94SStefano Zampini 
25212b510759SStefano Zampini   if (threshold) {
25222b510759SStefano Zampini     PetscInt* count,min_threshold;
2523e7931f94SStefano Zampini     ierr = PetscMalloc(local_size*sizeof(PetscInt),&count);CHKERRQ(ierr);
2524e7931f94SStefano Zampini     ierr = PetscMemzero(count,local_size*sizeof(PetscInt));CHKERRQ(ierr);
2525e7931f94SStefano Zampini     for (i=1;i<n_neighs;i++) {/* i=1 so I don't count myself -> faces nodes counts to 1 */
2526e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2527e7931f94SStefano Zampini         count[shared[i][j]] += 1;
2528e7931f94SStefano Zampini       }
2529e7931f94SStefano Zampini     }
25302b510759SStefano Zampini     /* adapt threshold since we dont want to lose significant connections */
25312b510759SStefano Zampini     min_threshold = n_neighs;
25322b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
25332b510759SStefano Zampini       for (j=0;j<n_shared[i];j++) {
25342b510759SStefano Zampini         min_threshold = PetscMin(count[shared[i][j]],min_threshold);
25352b510759SStefano Zampini       }
25362b510759SStefano Zampini     }
25372b510759SStefano Zampini     PetscPrintf(PETSC_COMM_SELF,"PASSED THRESHOLD %d\n",threshold);
25382b510759SStefano Zampini     threshold = PetscMax(min_threshold+1,threshold);
25392b510759SStefano Zampini     PetscPrintf(PETSC_COMM_SELF,"USING THRESHOLD %d (min %d)\n",threshold,min_threshold);
2540e7931f94SStefano Zampini     xadj[1] = 0;
25412b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
2542e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2543e7931f94SStefano Zampini         if (count[shared[i][j]] < threshold) {
2544e7931f94SStefano Zampini           adjncy[xadj[1]] = neighs[i];
2545e7931f94SStefano Zampini           adjncy_wgt[xadj[1]] = n_shared[i];
2546e7931f94SStefano Zampini           xadj[1]++;
2547e7931f94SStefano Zampini           break;
2548e7931f94SStefano Zampini         }
2549e7931f94SStefano Zampini       }
2550e7931f94SStefano Zampini     }
2551e7931f94SStefano Zampini     ierr = PetscFree(count);CHKERRQ(ierr);
2552c8587f34SStefano Zampini   } else {
2553e7931f94SStefano Zampini     if (xadj[1]) {
2554e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy,&neighs[1],xadj[1]*sizeof(*adjncy));CHKERRQ(ierr);
2555e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy_wgt,&n_shared[1],xadj[1]*sizeof(*adjncy_wgt));CHKERRQ(ierr);
2556c8587f34SStefano Zampini     }
2557e7931f94SStefano Zampini   }
2558e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingRestoreInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2559e7931f94SStefano Zampini   if (use_square) {
2560e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2561e7931f94SStefano Zampini       adjncy_wgt[i] = adjncy_wgt[i]*adjncy_wgt[i];
2562e7931f94SStefano Zampini     }
2563e7931f94SStefano Zampini   }
2564e7931f94SStefano Zampini   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2565e7931f94SStefano Zampini 
2566e7931f94SStefano Zampini   ierr = PetscMalloc(sizeof(PetscInt),&ranks_send_to_idx);CHKERRQ(ierr);
2567e7931f94SStefano Zampini 
2568e7931f94SStefano Zampini   /*
2569e7931f94SStefano Zampini     Restrict work on active processes only.
2570e7931f94SStefano Zampini   */
2571e7931f94SStefano Zampini   ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&subcomm);CHKERRQ(ierr);
2572e7931f94SStefano Zampini   ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
2573e7931f94SStefano Zampini   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
25742b510759SStefano Zampini   ierr = PetscMPIIntCast(!local_size,&color);CHKERRQ(ierr);
2575d3531aaaSJed Brown   ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
2576e7931f94SStefano Zampini   if (color) {
2577e7931f94SStefano Zampini     ierr = PetscFree(xadj);CHKERRQ(ierr);
2578e7931f94SStefano Zampini     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2579e7931f94SStefano Zampini     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
2580c8587f34SStefano Zampini   } else {
2581e7931f94SStefano Zampini     ierr = MPI_Comm_size(subcomm->comm,&size);CHKERRQ(ierr);
2582e7931f94SStefano Zampini     ierr = PetscMalloc(size*sizeof(*oldranks),&oldranks);CHKERRQ(ierr);
2583e7931f94SStefano Zampini     prank = rank;
2584e7931f94SStefano Zampini     ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm->comm);CHKERRQ(ierr);
2585e7931f94SStefano Zampini     for (i=0;i<size;i++) {
2586e7931f94SStefano Zampini       PetscPrintf(subcomm->comm,"oldranks[%d] = %d\n",i,oldranks[i]);
2587c8587f34SStefano Zampini     }
2588e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2589e7931f94SStefano Zampini       ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
2590c8587f34SStefano Zampini     }
2591e7931f94SStefano Zampini     ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2592e7931f94SStefano Zampini     ierr = MatCreateMPIAdj(subcomm->comm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
2593e7931f94SStefano Zampini     n_subdomains = (PetscInt)size;
2594e7931f94SStefano Zampini     ierr = MatView(subdomain_adj,0);CHKERRQ(ierr);
2595e7931f94SStefano Zampini 
2596e7931f94SStefano Zampini     /* Partition */
2597e7931f94SStefano Zampini     ierr = MatPartitioningCreate(subcomm->comm,&partitioner);CHKERRQ(ierr);
2598e7931f94SStefano Zampini     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
2599e7931f94SStefano Zampini     if (use_vwgt) {
2600e7931f94SStefano Zampini       ierr = PetscMalloc(sizeof(*v_wgt),&v_wgt);CHKERRQ(ierr);
2601e7931f94SStefano Zampini       v_wgt[0] = local_size;
2602e7931f94SStefano Zampini       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
2603c8587f34SStefano Zampini     }
2604e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)partitioner),"NPARTS %d\n",n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2605e7931f94SStefano Zampini     ierr = MatPartitioningSetNParts(partitioner,n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2606e7931f94SStefano Zampini     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
2607e7931f94SStefano Zampini     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
2608e7931f94SStefano Zampini     ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr);
2609e7931f94SStefano Zampini 
2610e7931f94SStefano Zampini     ierr = ISGetIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2611e7931f94SStefano Zampini     ranks_send_to_idx[0] = oldranks[is_indices[0]];
2612e7931f94SStefano Zampini     ierr = ISRestoreIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2613e7931f94SStefano Zampini     /* clean up */
2614e7931f94SStefano Zampini     ierr = PetscFree(oldranks);CHKERRQ(ierr);
2615e7931f94SStefano Zampini     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
2616e7931f94SStefano Zampini     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
2617e7931f94SStefano Zampini     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
2618e7931f94SStefano Zampini   }
2619e7931f94SStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
2620e7931f94SStefano Zampini 
2621e7931f94SStefano Zampini   /* assemble parallel IS for sends */
2622e7931f94SStefano Zampini   i = 1;
2623e7931f94SStefano Zampini   if (color) i=0;
2624e7931f94SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,&ranks_send_to);CHKERRQ(ierr);
2625e7931f94SStefano Zampini   ierr = ISView(ranks_send_to,0);CHKERRQ(ierr);
2626e7931f94SStefano Zampini 
2627e7931f94SStefano Zampini   /* get back IS */
2628e7931f94SStefano Zampini   *is_sends = ranks_send_to;
2629e7931f94SStefano Zampini   PetscFunctionReturn(0);
2630e7931f94SStefano Zampini }
2631e7931f94SStefano Zampini 
2632e7931f94SStefano Zampini typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
2633e7931f94SStefano Zampini 
2634e7931f94SStefano Zampini #undef __FUNCT__
2635e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble"
2636e7931f94SStefano Zampini PetscErrorCode MatISSubassemble(Mat mat, IS is_sends, PetscInt coarsening_ratio, Mat *mat_n)
2637e7931f94SStefano Zampini {
2638e7931f94SStefano Zampini   Mat                    local_mat,new_mat;
2639e7931f94SStefano Zampini   Mat_IS                 *matis;
2640e7931f94SStefano Zampini   IS                     is_sends_internal;
2641e7931f94SStefano Zampini   PetscInt               rows,cols;
2642e7931f94SStefano Zampini   PetscInt               i,bs,buf_size_idxs,buf_size_vals;
2643e7931f94SStefano Zampini   PetscBool              ismatis,isdense;
2644e7931f94SStefano Zampini   ISLocalToGlobalMapping l2gmap;
2645e7931f94SStefano Zampini   PetscInt*              l2gmap_indices;
2646e7931f94SStefano Zampini   const PetscInt*        is_indices;
2647e7931f94SStefano Zampini   MatType                new_local_type;
2648e7931f94SStefano Zampini   MatTypePrivate         new_local_type_private;
2649e7931f94SStefano Zampini   /* buffers */
2650e7931f94SStefano Zampini   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
2651e7931f94SStefano Zampini   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
2652e7931f94SStefano Zampini   /* MPI */
2653e7931f94SStefano Zampini   MPI_Comm               comm;
2654e7931f94SStefano Zampini   PetscMPIInt            n_sends,n_recvs,commsize;
2655e7931f94SStefano Zampini   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals;
2656e7931f94SStefano Zampini   PetscMPIInt            *onodes,*olengths_idxs,*olengths_vals;
2657e7931f94SStefano Zampini   PetscMPIInt            len,tag_idxs,tag_vals,source_dest;
2658e7931f94SStefano Zampini   MPI_Request            *send_req_idxs,*send_req_vals,*recv_req_idxs,*recv_req_vals;
2659e7931f94SStefano Zampini   PetscErrorCode         ierr;
2660e7931f94SStefano Zampini 
2661e7931f94SStefano Zampini   PetscFunctionBegin;
2662e7931f94SStefano Zampini   /* checks */
2663e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
2664e7931f94SStefano Zampini   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on an matrix object which is not of type MATIS",__FUNCT__);
2665e7931f94SStefano Zampini   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2666e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
2667e7931f94SStefano Zampini   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
2668e7931f94SStefano Zampini   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
2669e7931f94SStefano Zampini   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
2670e7931f94SStefano Zampini   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
2671e7931f94SStefano Zampini   PetscValidLogicalCollectiveInt(mat,bs,0);
2672e7931f94SStefano Zampini   /* prepare IS for sending if not provided */
2673e7931f94SStefano Zampini   if (!is_sends) {
2674e7931f94SStefano Zampini     if (!coarsening_ratio) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a coarsening ratio");
2675e7931f94SStefano Zampini     ierr = MatISSubassemble_Private(mat,coarsening_ratio,&is_sends_internal);CHKERRQ(ierr);
2676c8587f34SStefano Zampini   } else {
2677e7931f94SStefano Zampini     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
2678e7931f94SStefano Zampini     is_sends_internal = is_sends;
2679c8587f34SStefano Zampini   }
2680e7931f94SStefano Zampini 
2681e7931f94SStefano Zampini   /* get pointer of MATIS data */
2682e7931f94SStefano Zampini   matis = (Mat_IS*)mat->data;
2683e7931f94SStefano Zampini 
2684e7931f94SStefano Zampini   /* get comm */
2685e7931f94SStefano Zampini   comm = PetscObjectComm((PetscObject)mat);
2686e7931f94SStefano Zampini 
2687e7931f94SStefano Zampini   /* compute number of sends */
2688e7931f94SStefano Zampini   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
2689e7931f94SStefano Zampini   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
2690e7931f94SStefano Zampini 
2691e7931f94SStefano Zampini   /* compute number of receives */
2692e7931f94SStefano Zampini   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
2693e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*iflags),&iflags);CHKERRQ(ierr);
2694e7931f94SStefano Zampini   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
2695e7931f94SStefano Zampini   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2696e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
2697e7931f94SStefano Zampini   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
2698e7931f94SStefano Zampini   ierr = PetscFree(iflags);CHKERRQ(ierr);
2699e7931f94SStefano Zampini 
2700e7931f94SStefano Zampini   /* prepare send/receive buffers */
2701e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_idxs),&ilengths_idxs);CHKERRQ(ierr);
2702e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
2703e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_vals),&ilengths_vals);CHKERRQ(ierr);
2704e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
2705e7931f94SStefano Zampini 
2706e7931f94SStefano Zampini   /* Get data from local mat */
2707e7931f94SStefano Zampini   if (!isdense) {
2708e7931f94SStefano Zampini     /* TODO: See below some guidelines on how to prepare the local buffers */
2709e7931f94SStefano Zampini     /*
2710e7931f94SStefano Zampini        send_buffer_vals should contain the raw values of the local matrix
2711e7931f94SStefano Zampini        send_buffer_idxs should contain:
2712e7931f94SStefano Zampini        - MatType_PRIVATE type
2713e7931f94SStefano Zampini        - PetscInt        size_of_l2gmap
2714e7931f94SStefano Zampini        - PetscInt        global_row_indices[size_of_l2gmap]
2715e7931f94SStefano Zampini        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
2716e7931f94SStefano Zampini     */
2717e7931f94SStefano Zampini   } else {
2718e7931f94SStefano Zampini     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
2719e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&i);CHKERRQ(ierr);
2720e7931f94SStefano Zampini     ierr = PetscMalloc((i+2)*sizeof(PetscInt),&send_buffer_idxs);CHKERRQ(ierr);
2721e7931f94SStefano Zampini     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
2722e7931f94SStefano Zampini     send_buffer_idxs[1] = i;
2723e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2724e7931f94SStefano Zampini     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
2725e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingRestoreIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2726e7931f94SStefano Zampini     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
2727e7931f94SStefano Zampini     for (i=0;i<n_sends;i++) {
2728e7931f94SStefano Zampini       ilengths_vals[is_indices[i]] = len*len;
2729e7931f94SStefano Zampini       ilengths_idxs[is_indices[i]] = len+2;
2730c8587f34SStefano Zampini     }
2731c8587f34SStefano Zampini   }
2732e7931f94SStefano Zampini   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
2733e7931f94SStefano Zampini   buf_size_idxs = 0;
2734e7931f94SStefano Zampini   buf_size_vals = 0;
2735e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2736e7931f94SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
2737e7931f94SStefano Zampini     buf_size_vals += (PetscInt)olengths_vals[i];
2738e7931f94SStefano Zampini   }
2739e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&recv_buffer_idxs);CHKERRQ(ierr);
2740e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_vals*sizeof(PetscScalar),&recv_buffer_vals);CHKERRQ(ierr);
2741e7931f94SStefano Zampini 
2742e7931f94SStefano Zampini   /* get new tags for clean communications */
2743e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
2744e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
2745e7931f94SStefano Zampini 
2746e7931f94SStefano Zampini   /* allocate for requests */
2747e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_idxs);CHKERRQ(ierr);
2748e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_vals);CHKERRQ(ierr);
2749e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_idxs);CHKERRQ(ierr);
2750e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_vals);CHKERRQ(ierr);
2751e7931f94SStefano Zampini 
2752e7931f94SStefano Zampini   /* communications */
2753e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2754e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
2755e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2756e7931f94SStefano Zampini     source_dest = onodes[i];
2757e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
2758e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
2759e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2760e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
2761e7931f94SStefano Zampini   }
2762e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) {
2763e7931f94SStefano Zampini     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
2764e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
2765e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
2766e7931f94SStefano Zampini   }
2767e7931f94SStefano Zampini   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2768e7931f94SStefano Zampini   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
2769e7931f94SStefano Zampini 
2770e7931f94SStefano Zampini   /* assemble new l2g map */
2771e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2772e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2773e7931f94SStefano Zampini   buf_size_idxs = 0;
2774e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2775e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
2776e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2777e7931f94SStefano Zampini   }
2778e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&l2gmap_indices);CHKERRQ(ierr);
2779e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2780e7931f94SStefano Zampini   buf_size_idxs = 0;
2781e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2782e7931f94SStefano Zampini     ierr = PetscMemcpy(&l2gmap_indices[buf_size_idxs],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
2783e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
2784e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2785e7931f94SStefano Zampini   }
2786e7931f94SStefano Zampini   ierr = PetscSortRemoveDupsInt(&buf_size_idxs,l2gmap_indices);CHKERRQ(ierr);
2787e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingCreate(comm,buf_size_idxs,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
2788e7931f94SStefano Zampini   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
2789e7931f94SStefano Zampini 
2790e7931f94SStefano Zampini   /* infer new local matrix type from received local matrices type */
2791e7931f94SStefano Zampini   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
2792e7931f94SStefano 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) */
2793e7931f94SStefano Zampini   new_local_type_private = MATAIJ_PRIVATE;
2794e7931f94SStefano Zampini   new_local_type = MATSEQAIJ;
2795e7931f94SStefano Zampini   if (n_recvs) {
2796be4bc593SStefano Zampini     new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
2797e7931f94SStefano Zampini     ptr_idxs = recv_buffer_idxs;
2798e7931f94SStefano Zampini     for (i=0;i<n_recvs;i++) {
2799e7931f94SStefano Zampini       if ((PetscInt)new_local_type_private != *ptr_idxs) {
2800e7931f94SStefano Zampini         new_local_type_private = MATAIJ_PRIVATE;
2801e7931f94SStefano Zampini         break;
2802e7931f94SStefano Zampini       }
2803e7931f94SStefano Zampini       ptr_idxs += olengths_idxs[i];
2804e7931f94SStefano Zampini     }
2805e7931f94SStefano Zampini     switch (new_local_type_private) {
2806e7931f94SStefano Zampini       case MATDENSE_PRIVATE: /* subassembling of dense matrices does not give a dense matrix! */
2807e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
2808e7931f94SStefano Zampini         bs = 1;
2809e7931f94SStefano Zampini         break;
2810e7931f94SStefano Zampini       case MATAIJ_PRIVATE:
2811e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
2812e7931f94SStefano Zampini         bs = 1;
2813e7931f94SStefano Zampini         break;
2814e7931f94SStefano Zampini       case MATBAIJ_PRIVATE:
2815e7931f94SStefano Zampini         new_local_type = MATSEQBAIJ;
2816e7931f94SStefano Zampini         break;
2817e7931f94SStefano Zampini       case MATSBAIJ_PRIVATE:
2818e7931f94SStefano Zampini         new_local_type = MATSEQSBAIJ;
2819e7931f94SStefano Zampini         break;
2820e7931f94SStefano Zampini       default:
2821e7931f94SStefano Zampini         SETERRQ2(comm,PETSC_ERR_LIB,"Unkwown private type %d in %s",new_local_type_private,__FUNCT__);
2822e7931f94SStefano Zampini         break;
2823e7931f94SStefano Zampini     }
2824e7931f94SStefano Zampini   }
2825e7931f94SStefano Zampini 
2826e7931f94SStefano Zampini   /* create MATIS object */
2827e7931f94SStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
2828e7931f94SStefano Zampini   ierr = MatCreateIS(comm,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,&new_mat);CHKERRQ(ierr);
2829e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
2830e7931f94SStefano Zampini   ierr = MatISGetLocalMat(new_mat,&local_mat);CHKERRQ(ierr);
2831e7931f94SStefano Zampini   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
2832e7931f94SStefano Zampini   ierr = MatSetUp(local_mat);CHKERRQ(ierr); /* WARNING -> no preallocation yet */
2833e7931f94SStefano Zampini 
2834e7931f94SStefano Zampini   /* set values */
2835e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2836e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
2837e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2838e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2839e7931f94SStefano Zampini     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
2840e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
2841e7931f94SStefano Zampini       ierr = MatSetValues(new_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
2842e7931f94SStefano Zampini       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
2843e7931f94SStefano Zampini       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
2844e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
2845e7931f94SStefano Zampini     }
2846e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2847e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
2848e7931f94SStefano Zampini   }
2849e7931f94SStefano Zampini   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2850e7931f94SStefano Zampini   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2851e7931f94SStefano Zampini   ierr = MatAssemblyBegin(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2852e7931f94SStefano Zampini   ierr = MatAssemblyEnd(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2853e7931f94SStefano Zampini 
2854e7931f94SStefano Zampini   { /* check */
2855e7931f94SStefano Zampini     Vec       lvec,rvec;
2856e7931f94SStefano Zampini     PetscReal infty_error;
2857e7931f94SStefano Zampini 
2858e7931f94SStefano Zampini     ierr = MatGetVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
2859e7931f94SStefano Zampini     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
2860e7931f94SStefano Zampini     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
2861e7931f94SStefano Zampini     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
2862e7931f94SStefano Zampini     ierr = MatMultAdd(new_mat,rvec,lvec,lvec);CHKERRQ(ierr);
2863e7931f94SStefano Zampini     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
2864e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
2865e7931f94SStefano Zampini     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
2866e7931f94SStefano Zampini     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
2867e7931f94SStefano Zampini   }
2868e7931f94SStefano Zampini 
2869e7931f94SStefano Zampini   /* free workspace */
2870e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
2871e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
2872e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2873e7931f94SStefano Zampini   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
2874e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2875e7931f94SStefano Zampini   if (isdense) {
2876e7931f94SStefano Zampini     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2877e7931f94SStefano Zampini     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
2878e7931f94SStefano Zampini   } else {
2879e7931f94SStefano Zampini     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
2880e7931f94SStefano Zampini   }
2881e7931f94SStefano Zampini   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
2882e7931f94SStefano Zampini   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
2883e7931f94SStefano Zampini   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
2884e7931f94SStefano Zampini   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
2885e7931f94SStefano Zampini   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
2886e7931f94SStefano Zampini   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
2887e7931f94SStefano Zampini   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
2888e7931f94SStefano Zampini   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
2889e7931f94SStefano Zampini   ierr = PetscFree(onodes);CHKERRQ(ierr);
2890e7931f94SStefano Zampini   /* get back new mat */
2891e7931f94SStefano Zampini   *mat_n = new_mat;
2892e7931f94SStefano Zampini   PetscFunctionReturn(0);
2893e7931f94SStefano Zampini }
2894a57a6d2fSStefano Zampini 
2895c8587f34SStefano Zampini #undef __FUNCT__
2896c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
2897c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
2898c8587f34SStefano Zampini {
2899c8587f34SStefano Zampini   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
2900c8587f34SStefano Zampini   PC_IS                  *pcis = (PC_IS*)pc->data;
290120a2ab83SStefano Zampini   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
29029881197aSStefano Zampini   MatNullSpace           CoarseNullSpace=NULL;
290320a2ab83SStefano Zampini   ISLocalToGlobalMapping coarse_islg;
290420a2ab83SStefano Zampini   IS                     coarse_is;
2905f9eb5b7dSStefano Zampini   PetscInt               max_it,coarse_size,*local_primal_indices=NULL;
2906f9eb5b7dSStefano Zampini   PetscInt               im_active=-1,active_procs=-1;
2907f9eb5b7dSStefano Zampini   PC                     pc_temp;
2908c8587f34SStefano Zampini   PCType                 coarse_pc_type;
2909c8587f34SStefano Zampini   KSPType                coarse_ksp_type;
2910f9eb5b7dSStefano Zampini   PetscBool              multilevel_requested,multilevel_allowed;
2911f9eb5b7dSStefano Zampini   PetscBool              setsym,issym,isbddc,isnn;
2912f9eb5b7dSStefano Zampini   MatStructure           matstruct;
29139881197aSStefano Zampini   PetscErrorCode         ierr;
2914fdc09c96SStefano Zampini 
2915c8587f34SStefano Zampini   PetscFunctionBegin;
2916c8587f34SStefano Zampini   /* Assign global numbering to coarse dofs */
2917f34684f1SStefano Zampini   ierr = PCBDDCComputePrimalNumbering(pc,&coarse_size,&local_primal_indices);CHKERRQ(ierr);
2918c8587f34SStefano Zampini 
2919f9eb5b7dSStefano Zampini   /* infer some info from user */
2920f9eb5b7dSStefano Zampini   issym = PETSC_FALSE;
2921f9eb5b7dSStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
2922f9eb5b7dSStefano Zampini   multilevel_allowed = PETSC_FALSE;
2923f9eb5b7dSStefano Zampini   multilevel_requested = PETSC_FALSE;
2924f9eb5b7dSStefano Zampini   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
2925f9eb5b7dSStefano Zampini   if (multilevel_requested) {
29262b510759SStefano Zampini     /* count "active processes" */
29272b510759SStefano Zampini     im_active = !!(pcis->n);
29282b510759SStefano Zampini     ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
29292b510759SStefano Zampini     if (active_procs/pcbddc->coarsening_ratio < 2) {
2930f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_FALSE;
29312b510759SStefano Zampini     } else {
2932f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_TRUE;
2933c8587f34SStefano Zampini     }
2934c8587f34SStefano Zampini   }
2935e7931f94SStefano Zampini 
2936f9eb5b7dSStefano Zampini   /* set defaults for coarse KSP and PC */
2937f9eb5b7dSStefano Zampini   if (multilevel_allowed) {
2938c8587f34SStefano Zampini     if (issym) {
2939f9eb5b7dSStefano Zampini       coarse_ksp_type = KSPRICHARDSON;
2940f9eb5b7dSStefano Zampini     } else {
2941f9eb5b7dSStefano Zampini       coarse_ksp_type = KSPCHEBYSHEV;
2942c8587f34SStefano Zampini     }
2943f9eb5b7dSStefano Zampini     coarse_pc_type = PCBDDC;
2944f9eb5b7dSStefano Zampini   } else {
2945f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPPREONLY;
2946f9eb5b7dSStefano Zampini     coarse_pc_type = PCREDUNDANT;
2947c8587f34SStefano Zampini   }
2948c8587f34SStefano Zampini 
2949f9eb5b7dSStefano Zampini   /* create the coarse KSP object only once with defaults */
2950f9eb5b7dSStefano Zampini   if (!pcbddc->coarse_ksp) {
2951e604994aSStefano Zampini     char prefix[256],str_level[3];
2952e604994aSStefano Zampini     size_t len;
2953f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_ksp);CHKERRQ(ierr);
2954c8587f34SStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
2955f9eb5b7dSStefano Zampini     ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
2956c8587f34SStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
2957c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
2958c8587f34SStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
2959e604994aSStefano Zampini     /* prefix */
2960e604994aSStefano Zampini     ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
2961e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
2962e604994aSStefano Zampini     if (!pcbddc->current_level) {
2963e604994aSStefano Zampini       ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
2964e604994aSStefano Zampini       ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
2965c8587f34SStefano Zampini     } else {
2966e604994aSStefano Zampini       ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
2967e604994aSStefano Zampini       if (pcbddc->current_level>1) len -= 2;
2968e604994aSStefano Zampini       ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
2969e604994aSStefano Zampini       *(prefix+len)='\0';
2970e604994aSStefano Zampini       sprintf(str_level,"%d_",(int)(pcbddc->current_level));
2971e604994aSStefano Zampini       ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
2972e604994aSStefano Zampini     }
2973e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
2974f9eb5b7dSStefano Zampini   }
2975f9eb5b7dSStefano Zampini   /* allow user customization */
297685c4d303SStefano 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); */
2977f9eb5b7dSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
297885c4d303SStefano 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); */
2979f9eb5b7dSStefano Zampini 
2980f9eb5b7dSStefano Zampini   /* get some info after set from options */
2981f9eb5b7dSStefano Zampini   ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
2982f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
2983f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
2984f9eb5b7dSStefano Zampini   if (isbddc && !multilevel_allowed) { /* prevent from infinite loop if user as requested bddc pc for coarse solver */
2985f9eb5b7dSStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
2986f9eb5b7dSStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
2987f9eb5b7dSStefano Zampini     isbddc = PETSC_FALSE;
2988f9eb5b7dSStefano Zampini   }
2989f9eb5b7dSStefano Zampini 
2990f9eb5b7dSStefano Zampini   /* propagate BDDC info to the next level */
2991f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
2992f9eb5b7dSStefano Zampini   ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
2993f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
2994f9eb5b7dSStefano Zampini 
2995f9eb5b7dSStefano Zampini   /* creates temporary MATIS object for coarse matrix */
2996a57a6d2fSStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,local_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
2997a57a6d2fSStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
2998a57a6d2fSStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
2999a57a6d2fSStefano Zampini   ierr = MatCreateIS(PetscObjectComm((PetscObject)pc),1,PETSC_DECIDE,PETSC_DECIDE,coarse_size,coarse_size,coarse_islg,&coarse_mat_is);CHKERRQ(ierr);
3000a57a6d2fSStefano Zampini   ierr = MatISSetLocalMat(coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
3001e7931f94SStefano Zampini   ierr = MatAssemblyBegin(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3002e7931f94SStefano Zampini   ierr = MatAssemblyEnd(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
300320a2ab83SStefano Zampini   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
300420a2ab83SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
300520a2ab83SStefano Zampini   ierr = PetscFree(local_primal_indices);CHKERRQ(ierr);
3006fdc09c96SStefano Zampini 
3007f9eb5b7dSStefano Zampini   /* assemble coarse matrix */
3008f9eb5b7dSStefano Zampini   if (isbddc || isnn) {
3009f9eb5b7dSStefano Zampini     ierr = MatISSubassemble(coarse_mat_is,NULL,pcbddc->coarsening_ratio,&coarse_mat);CHKERRQ(ierr);
3010f9eb5b7dSStefano Zampini   } else {
30112b510759SStefano Zampini     ierr = MatConvert_IS_AIJ(coarse_mat_is,MATAIJ,MAT_INITIAL_MATRIX,&coarse_mat);CHKERRQ(ierr);
3012c8587f34SStefano Zampini   }
30132b510759SStefano Zampini   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
30149881197aSStefano Zampini 
3015f9eb5b7dSStefano Zampini   /* create local to global scatters for coarse problem */
3016f9eb5b7dSStefano Zampini   ierr = MatGetVecs(coarse_mat,&pcbddc->coarse_vec,&pcbddc->coarse_rhs);CHKERRQ(ierr);
3017f9eb5b7dSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3018f9eb5b7dSStefano Zampini   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
3019f9eb5b7dSStefano Zampini 
3020f9eb5b7dSStefano Zampini   /* propagate symmetry info to coarse matrix */
3021f9eb5b7dSStefano Zampini   ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,issym);CHKERRQ(ierr);
3022f9eb5b7dSStefano Zampini 
3023b8ffe317SStefano Zampini   /* Compute coarse null space (special handling by BDDC only) */
3024b8ffe317SStefano Zampini   if (pcbddc->NullSpace) {
3025b8ffe317SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCoarse(pc,coarse_mat,&CoarseNullSpace);CHKERRQ(ierr);
3026b8ffe317SStefano Zampini     if (isbddc) {
3027b8ffe317SStefano Zampini       ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
3028b8ffe317SStefano Zampini     } else {
3029c8587f34SStefano Zampini       ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
3030c8587f34SStefano Zampini     }
3031c8587f34SStefano Zampini   }
3032c8587f34SStefano Zampini 
3033f9eb5b7dSStefano Zampini   /* set operators */
3034f9eb5b7dSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
3035f9eb5b7dSStefano Zampini   ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat,matstruct);CHKERRQ(ierr);
3036f9eb5b7dSStefano Zampini 
3037f9eb5b7dSStefano Zampini   /* additional KSP customization */
3038f9eb5b7dSStefano Zampini   ierr = KSPGetTolerances(pcbddc->coarse_ksp,NULL,NULL,NULL,&max_it);CHKERRQ(ierr);
3039f9eb5b7dSStefano Zampini   if (max_it < 5) {
3040c8587f34SStefano Zampini     ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
3041f9eb5b7dSStefano Zampini   }
3042b8ffe317SStefano Zampini   /* ierr = KSPChebyshevSetEstimateEigenvalues(pcbddc->coarse_ksp,1.0,0.0,0.0,1.1);CHKERRQ(ierr); */
3043f9eb5b7dSStefano Zampini 
3044f9eb5b7dSStefano Zampini 
3045f9eb5b7dSStefano Zampini   /* print some info if requested */
3046f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
3047f9eb5b7dSStefano Zampini     ierr = KSPGetType(pcbddc->coarse_ksp,&coarse_ksp_type);CHKERRQ(ierr);
3048f9eb5b7dSStefano Zampini     ierr = PCGetType(pc_temp,&coarse_pc_type);CHKERRQ(ierr);
3049f9eb5b7dSStefano Zampini     if (!multilevel_allowed) {
3050f9eb5b7dSStefano Zampini       if (multilevel_requested) {
3051f9eb5b7dSStefano 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);
3052f9eb5b7dSStefano Zampini       } else if (pcbddc->max_levels) {
3053f9eb5b7dSStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
3054c8587f34SStefano Zampini       }
3055c8587f34SStefano Zampini     }
3056e604994aSStefano 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);
3057f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3058c8587f34SStefano Zampini   }
3059f9eb5b7dSStefano Zampini 
3060f9eb5b7dSStefano Zampini   /* setup coarse ksp */
3061f9eb5b7dSStefano Zampini   ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
3062f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
3063f9eb5b7dSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
3064f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3065f9eb5b7dSStefano Zampini     ierr = KSPView(pcbddc->coarse_ksp,pcbddc->dbg_viewer);CHKERRQ(ierr);
3066f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3067f9eb5b7dSStefano Zampini   }
3068f9eb5b7dSStefano Zampini 
3069c8587f34SStefano Zampini   /* Check coarse problem if requested */
307020a2ab83SStefano Zampini   if (pcbddc->dbg_flag) {
3071c8587f34SStefano Zampini     KSP       check_ksp;
30722b510759SStefano Zampini     KSPType   check_ksp_type;
3073c8587f34SStefano Zampini     PC        check_pc;
3074c8587f34SStefano Zampini     Vec       check_vec;
3075c8587f34SStefano Zampini     PetscReal abs_infty_error,infty_error,lambda_min,lambda_max;
30762b510759SStefano Zampini     PetscInt  its;
3077f9eb5b7dSStefano Zampini     PetscBool ispreonly,compute;
3078c8587f34SStefano Zampini 
30792b510759SStefano Zampini     /* Create ksp object suitable for estimation of extreme eigenvalues */
3080f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&check_ksp);CHKERRQ(ierr);
3081fdc635d7SStefano Zampini     ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
3082983f5fd7SStefano Zampini     ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,coarse_size);CHKERRQ(ierr);
30832b510759SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
30842b510759SStefano Zampini     if (ispreonly) {
30852b510759SStefano Zampini       check_ksp_type = KSPPREONLY;
3086f9eb5b7dSStefano Zampini       compute = PETSC_FALSE;
30872b510759SStefano Zampini     } else {
3088c8587f34SStefano Zampini       if (issym) check_ksp_type = KSPCG;
3089c8587f34SStefano Zampini       else check_ksp_type = KSPGMRES;
3090f9eb5b7dSStefano Zampini       compute = PETSC_TRUE;
3091c8587f34SStefano Zampini     }
3092c8587f34SStefano Zampini     ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
3093f9eb5b7dSStefano Zampini     ierr = KSPSetComputeSingularValues(check_ksp,compute);CHKERRQ(ierr);
3094c8587f34SStefano Zampini     ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
3095c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
3096c8587f34SStefano Zampini     ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
3097c8587f34SStefano Zampini     /* create random vec */
3098c8587f34SStefano Zampini     ierr = VecDuplicate(pcbddc->coarse_vec,&check_vec);CHKERRQ(ierr);
3099c8587f34SStefano Zampini     ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
3100c8587f34SStefano Zampini     if (CoarseNullSpace) {
3101c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec);CHKERRQ(ierr);
3102c8587f34SStefano Zampini     }
3103fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3104c8587f34SStefano Zampini     /* solve coarse problem */
3105c8587f34SStefano Zampini     ierr = KSPSolve(check_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
3106c8587f34SStefano Zampini     if (CoarseNullSpace) {
3107c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,pcbddc->coarse_vec);CHKERRQ(ierr);
3108c8587f34SStefano Zampini     }
3109c8587f34SStefano Zampini     /* check coarse problem residual error */
3110c8587f34SStefano Zampini     ierr = VecAXPY(check_vec,-1.0,pcbddc->coarse_vec);CHKERRQ(ierr);
3111c8587f34SStefano Zampini     ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3112fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3113c8587f34SStefano Zampini     ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
3114c8587f34SStefano Zampini     ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
3115e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem (%s) details\n",((PetscObject)(pcbddc->coarse_ksp))->prefix);CHKERRQ(ierr);
3116e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
3117e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
3118f9eb5b7dSStefano Zampini     /* get eigenvalue estimation if preonly has not been requested */
31192b510759SStefano Zampini     if (!ispreonly) {
3120c8587f34SStefano Zampini       ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
312120a2ab83SStefano Zampini       ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
3122f9eb5b7dSStefano 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);
3123c8587f34SStefano Zampini     }
31242b510759SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3125c8587f34SStefano Zampini     ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
3126c8587f34SStefano Zampini   }
31272b510759SStefano Zampini   /* free memory */
3128c8587f34SStefano Zampini   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
3129fdc635d7SStefano Zampini   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
3130c8587f34SStefano Zampini   PetscFunctionReturn(0);
3131c8587f34SStefano Zampini }
3132674ae819SStefano Zampini 
3133f34684f1SStefano Zampini #undef __FUNCT__
3134f34684f1SStefano Zampini #define __FUNCT__ "PCBDDCComputePrimalNumbering"
3135f34684f1SStefano Zampini PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
3136f34684f1SStefano Zampini {
3137f34684f1SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3138f34684f1SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
3139f34684f1SStefano Zampini   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
3140f34684f1SStefano Zampini   PetscInt       i,j,coarse_size;
3141f34684f1SStefano Zampini   PetscInt       *local_primal_indices,*auxlocal_primal,*aux_idx;
3142f34684f1SStefano Zampini   PetscErrorCode ierr;
3143f34684f1SStefano Zampini 
3144f34684f1SStefano Zampini   PetscFunctionBegin;
3145f34684f1SStefano Zampini   /* get indices in local ordering for vertices and constraints */
3146f34684f1SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&auxlocal_primal);CHKERRQ(ierr);
3147f34684f1SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&i,&aux_idx);CHKERRQ(ierr);
3148f34684f1SStefano Zampini   ierr = PetscMemcpy(auxlocal_primal,aux_idx,i*sizeof(PetscInt));CHKERRQ(ierr);
3149f34684f1SStefano Zampini   ierr = PetscFree(aux_idx);CHKERRQ(ierr);
3150f34684f1SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&j,&aux_idx);CHKERRQ(ierr);
3151f34684f1SStefano Zampini   ierr = PetscMemcpy(&auxlocal_primal[i],aux_idx,j*sizeof(PetscInt));CHKERRQ(ierr);
3152f34684f1SStefano Zampini   ierr = PetscFree(aux_idx);CHKERRQ(ierr);
3153f34684f1SStefano Zampini 
3154f34684f1SStefano Zampini   /* Compute global number of coarse dofs */
3155f34684f1SStefano Zampini   ierr = PCBDDCSubsetNumbering(PetscObjectComm((PetscObject)(pc->pmat)),matis->mapping,pcbddc->local_primal_size,auxlocal_primal,NULL,&coarse_size,&local_primal_indices);CHKERRQ(ierr);
3156f34684f1SStefano Zampini 
3157f34684f1SStefano Zampini   /* check numbering */
3158f34684f1SStefano Zampini   if (pcbddc->dbg_flag) {
3159f34684f1SStefano Zampini     PetscScalar coarsesum,*array;
3160f34684f1SStefano Zampini 
3161f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3162f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3163f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
3164f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
3165f34684f1SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
3166f34684f1SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,auxlocal_primal[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
3167f34684f1SStefano Zampini     }
3168f34684f1SStefano Zampini     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
3169f34684f1SStefano Zampini     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
3170f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3171f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3172f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3173f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3174f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3175f34684f1SStefano Zampini     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3176f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3177f34684f1SStefano Zampini       if (array[i] == 1.0) {
3178f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %d owned by a single process!\n",PetscGlobalRank,i);CHKERRQ(ierr);
3179f34684f1SStefano Zampini       }
3180f34684f1SStefano Zampini     }
3181f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3182f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3183f34684f1SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
3184f34684f1SStefano Zampini     }
3185f34684f1SStefano Zampini     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3186f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3187f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3188f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3189f34684f1SStefano Zampini     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
3190f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
3191f34684f1SStefano Zampini     if (pcbddc->dbg_flag > 1) {
3192f34684f1SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
3193f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3194f34684f1SStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
3195f34684f1SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
3196f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_primal_indices[%d]=%d \n",i,local_primal_indices[i]);
3197f34684f1SStefano Zampini       }
3198f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3199f34684f1SStefano Zampini     }
3200f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3201f34684f1SStefano Zampini   }
3202f34684f1SStefano Zampini   ierr = PetscFree(auxlocal_primal);CHKERRQ(ierr);
3203f34684f1SStefano Zampini   /* get back data */
3204f34684f1SStefano Zampini   *coarse_size_n = coarse_size;
3205f34684f1SStefano Zampini   *local_primal_indices_n = local_primal_indices;
3206674ae819SStefano Zampini   PetscFunctionReturn(0);
3207674ae819SStefano Zampini }
3208674ae819SStefano Zampini 
3209