xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 93bd9ae7ebd6e32f9ba30cca0adcbe3c21787c25)
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;
165c0553b1fSStefano Zampini   PetscBool              setsym=PETSC_FALSE,issym=PETSC_FALSE,unsymmetric_check;
16645a1bb75SStefano Zampini   /* matrix type (vector type propagated downstream from vec1_C and local matrix type) */
16788ebb749SStefano Zampini   MatType                impMatType;
16825084f0cSStefano Zampini   /* some shortcuts to scalars */
16925084f0cSStefano Zampini   PetscScalar            zero=0.0,one=1.0,m_one=-1.0;
17025084f0cSStefano Zampini   /* for debugging purposes */
17188ebb749SStefano Zampini   PetscReal              *coarsefunctions_errors,*constraints_errors;
17288ebb749SStefano Zampini 
17388ebb749SStefano Zampini   PetscFunctionBegin;
17425084f0cSStefano Zampini   /* get number of vertices and their local indices */
17525084f0cSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
17688ebb749SStefano Zampini   n_constraints = pcbddc->local_primal_size-n_vertices;
17788ebb749SStefano Zampini   /* Set Non-overlapping dimensions */
17888ebb749SStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
17988ebb749SStefano Zampini   n_R = pcis->n-n_vertices;
18088ebb749SStefano Zampini 
18188ebb749SStefano Zampini   /* Set types for local objects needed by BDDC precondtioner */
18288ebb749SStefano Zampini   impMatType = MATSEQDENSE;
18388ebb749SStefano Zampini 
18488ebb749SStefano Zampini   /* Allocating some extra storage just to be safe */
18588ebb749SStefano Zampini   ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&auxindices);CHKERRQ(ierr);
18688ebb749SStefano Zampini   for (i=0;i<pcis->n;i++) auxindices[i]=i;
18788ebb749SStefano Zampini 
18888ebb749SStefano Zampini   /* vertices in boundary numbering */
18988ebb749SStefano Zampini   ierr = PetscMalloc(n_vertices*sizeof(PetscInt),&idx_V_B);CHKERRQ(ierr);
19088ebb749SStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(pcis->is_B_local,&BtoNmap);CHKERRQ(ierr);
19188ebb749SStefano Zampini   ierr = ISGlobalToLocalMappingApply(BtoNmap,IS_GTOLM_DROP,n_vertices,vertices,&i,idx_V_B);CHKERRQ(ierr);
19288ebb749SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&BtoNmap);CHKERRQ(ierr);
19388ebb749SStefano Zampini   if (i != n_vertices) {
19488ebb749SStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %d != %d\n",n_vertices,i);
19588ebb749SStefano Zampini   }
19688ebb749SStefano Zampini 
19788ebb749SStefano Zampini   /* Precompute stuffs needed for preprocessing and application of BDDC*/
19888ebb749SStefano Zampini   if (n_constraints) {
19945a1bb75SStefano Zampini     /* work vectors */
20045a1bb75SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec1_C);CHKERRQ(ierr);
20145a1bb75SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec2_C);CHKERRQ(ierr);
20245a1bb75SStefano Zampini     /* auxiliary matrices */
20388ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->local_auxmat2);CHKERRQ(ierr);
20425084f0cSStefano Zampini     ierr = MatSetSizes(pcbddc->local_auxmat2,n_R,n_constraints,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
20588ebb749SStefano Zampini     ierr = MatSetType(pcbddc->local_auxmat2,impMatType);CHKERRQ(ierr);
20625084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->local_auxmat2);CHKERRQ(ierr);
20788ebb749SStefano Zampini 
20825084f0cSStefano Zampini     /* Extract constraints on R nodes: C_{CR}  */
20925084f0cSStefano Zampini     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
2108ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
21125084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
21288ebb749SStefano Zampini 
21388ebb749SStefano Zampini     /* Assemble local_auxmat2 = - A_{RR}^{-1} C^T_{CR} needed by BDDC application */
21488ebb749SStefano Zampini     for (i=0;i<n_constraints;i++) {
21588ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
21688ebb749SStefano Zampini       /* Get row of constraint matrix in R numbering */
21725084f0cSStefano Zampini       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
21825084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_R,size_of_constraint,row_cmat_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
21925084f0cSStefano Zampini       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
22025084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_R);CHKERRQ(ierr);
22125084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_R);CHKERRQ(ierr);
22288ebb749SStefano Zampini       /* Solve for row of constraint matrix in R numbering */
22388ebb749SStefano Zampini       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
22425084f0cSStefano Zampini       /* Set values in local_auxmat2 */
22525084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
22688ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->local_auxmat2,n_R,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
22725084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
22888ebb749SStefano Zampini     }
22988ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
23088ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
23125084f0cSStefano Zampini     ierr = MatScale(pcbddc->local_auxmat2,m_one);CHKERRQ(ierr);
23288ebb749SStefano Zampini 
23388ebb749SStefano Zampini     /* Assemble explicitly M1 = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1} needed in preproc  */
23425084f0cSStefano Zampini     ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
23525084f0cSStefano Zampini     ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
23688ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&M1);CHKERRQ(ierr);
23788ebb749SStefano Zampini     ierr = MatSetSizes(M1,n_constraints,n_constraints,n_constraints,n_constraints);CHKERRQ(ierr);
23888ebb749SStefano Zampini     ierr = MatSetType(M1,impMatType);CHKERRQ(ierr);
23925084f0cSStefano Zampini     ierr = MatSetUp(M1);CHKERRQ(ierr);
24025084f0cSStefano Zampini     ierr = MatDuplicate(M1,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
24125084f0cSStefano Zampini     ierr = MatZeroEntries(M2);CHKERRQ(ierr);
24225084f0cSStefano Zampini     ierr = VecSet(vec1_C,m_one);CHKERRQ(ierr);
24325084f0cSStefano Zampini     ierr = MatDiagonalSet(M2,vec1_C,INSERT_VALUES);CHKERRQ(ierr);
24425084f0cSStefano Zampini     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
24525084f0cSStefano Zampini     ierr = MatDestroy(&M2);CHKERRQ(ierr);
24625084f0cSStefano Zampini     ierr = MatDestroy(&M3);CHKERRQ(ierr);
24788ebb749SStefano Zampini     /* Assemble local_auxmat1 = M1*C_{CR} needed by BDDC application in KSP and in preproc */
24888ebb749SStefano Zampini     ierr = MatMatMult(M1,C_CR,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
24988ebb749SStefano Zampini   }
25088ebb749SStefano Zampini 
25188ebb749SStefano Zampini   /* Get submatrices from subdomain matrix */
25288ebb749SStefano Zampini   if (n_vertices) {
2533a50541eSStefano Zampini     PetscInt ibs,mbs;
2543a50541eSStefano Zampini     PetscBool issbaij;
255af732b37SStefano Zampini     Mat newmat;
2563a50541eSStefano Zampini 
2573a50541eSStefano Zampini     ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
2589577ea80SStefano Zampini     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
2599577ea80SStefano Zampini     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
2603a50541eSStefano Zampini     if (ibs != mbs) { /* need to convert to SEQAIJ */
2619577ea80SStefano Zampini       ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
2629577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
2639577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
2649577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
2659577ea80SStefano Zampini       ierr = MatDestroy(&newmat);CHKERRQ(ierr);
2669577ea80SStefano Zampini     } else {
2673a50541eSStefano Zampini       /* this is safe */
2689577ea80SStefano Zampini       ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
2693a50541eSStefano Zampini       ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
2703a50541eSStefano Zampini       if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
2713a50541eSStefano Zampini         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
27245a1bb75SStefano Zampini         /* which of the two approaches is faster? */
2733a50541eSStefano Zampini         /* ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
2743a50541eSStefano Zampini         ierr = MatCreateTranspose(A_RV,&A_VR);CHKERRQ(ierr);*/
2753a50541eSStefano Zampini         ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
2763a50541eSStefano Zampini         ierr = MatCreateTranspose(A_VR,&A_RV);CHKERRQ(ierr);
2773a50541eSStefano Zampini         ierr = MatDestroy(&newmat);CHKERRQ(ierr);
2783a50541eSStefano Zampini       } else {
2799577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
2809577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
2819577ea80SStefano Zampini       }
2823a50541eSStefano Zampini     }
28345a1bb75SStefano Zampini     ierr = MatGetVecs(A_RV,&vec1_V,NULL);CHKERRQ(ierr);
28445a1bb75SStefano Zampini     ierr = VecDuplicate(vec1_V,&vec2_V);CHKERRQ(ierr);
28525084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
28688ebb749SStefano Zampini   }
28788ebb749SStefano Zampini 
28888ebb749SStefano Zampini   /* Matrix of coarse basis functions (local) */
28988ebb749SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
29088ebb749SStefano Zampini   ierr = MatSetSizes(pcbddc->coarse_phi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
29188ebb749SStefano Zampini   ierr = MatSetType(pcbddc->coarse_phi_B,impMatType);CHKERRQ(ierr);
29225084f0cSStefano Zampini   ierr = MatSetUp(pcbddc->coarse_phi_B);CHKERRQ(ierr);
2938eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
29488ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
29588ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_phi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
29688ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_phi_D,impMatType);CHKERRQ(ierr);
29725084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_phi_D);CHKERRQ(ierr);
29888ebb749SStefano Zampini   }
29988ebb749SStefano Zampini 
30025084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
3018ce42a96SStefano Zampini     ierr = ISGetIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
30288ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*coarsefunctions_errors),&coarsefunctions_errors);CHKERRQ(ierr);
30388ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*constraints_errors),&constraints_errors);CHKERRQ(ierr);
30488ebb749SStefano Zampini   }
30588ebb749SStefano Zampini   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
30688ebb749SStefano Zampini   ierr = PetscMalloc((pcbddc->local_primal_size)*(pcbddc->local_primal_size)*sizeof(PetscScalar),&coarse_submat_vals);CHKERRQ(ierr);
30788ebb749SStefano Zampini 
30888ebb749SStefano Zampini   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
30925084f0cSStefano Zampini 
31025084f0cSStefano Zampini   /* vertices */
31188ebb749SStefano Zampini   for (i=0;i<n_vertices;i++) {
31245a1bb75SStefano Zampini     /* this should not be needed, but MatMult_BAIJ is broken when using compressed row routines */
31345a1bb75SStefano Zampini     ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
31488ebb749SStefano Zampini     ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
31588ebb749SStefano Zampini     ierr = VecSetValue(vec1_V,i,one,INSERT_VALUES);CHKERRQ(ierr);
31688ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
31788ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
31825084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on constraints multipliers */
31988ebb749SStefano Zampini     ierr = MatMult(A_RV,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
32088ebb749SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
32188ebb749SStefano Zampini     ierr = VecScale(pcbddc->vec1_R,m_one);CHKERRQ(ierr);
32288ebb749SStefano Zampini     if (n_constraints) {
32388ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec1_R,vec1_C);CHKERRQ(ierr);
32488ebb749SStefano Zampini       ierr = MatMultAdd(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
32588ebb749SStefano Zampini       ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
32688ebb749SStefano Zampini     }
32788ebb749SStefano Zampini     ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
32888ebb749SStefano Zampini     ierr = MatMultAdd(A_VV,vec1_V,vec2_V,vec2_V);CHKERRQ(ierr);
32988ebb749SStefano Zampini 
33088ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
33188ebb749SStefano Zampini     /* coarse basis functions */
33288ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
33388ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
33488ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
33525084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
33688ebb749SStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
33725084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
33888ebb749SStefano Zampini     ierr = MatSetValue(pcbddc->coarse_phi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
3398eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
34088ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
34188ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
34225084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
34388ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
34425084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
34588ebb749SStefano Zampini     }
34625084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
34725084f0cSStefano Zampini     ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
34825084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
34925084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
35088ebb749SStefano Zampini     if (n_constraints) {
35125084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
35225084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
35325084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
35488ebb749SStefano Zampini     }
35588ebb749SStefano Zampini 
35625084f0cSStefano Zampini     /* check */
35725084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
35825084f0cSStefano Zampini       /* assemble subdomain vector on local nodes */
35988ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
36025084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
36125084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
36225084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
36325084f0cSStefano Zampini       ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
36425084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
36525084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
36688ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers (i.e. primal nodes) */
36788ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
36825084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
36925084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
37025084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
37188ebb749SStefano Zampini       if (n_constraints) {
37225084f0cSStefano Zampini         ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
37325084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
37425084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
37588ebb749SStefano Zampini       }
37625084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
37725084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
37888ebb749SStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
37988ebb749SStefano Zampini       /* check saddle point solution */
38088ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
38188ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
38288ebb749SStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i]);CHKERRQ(ierr);
38388ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
38425084f0cSStefano Zampini       /* shift by the identity matrix */
38525084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
38625084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
38725084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
38888ebb749SStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i]);CHKERRQ(ierr);
38988ebb749SStefano Zampini     }
39088ebb749SStefano Zampini   }
39188ebb749SStefano Zampini 
39225084f0cSStefano Zampini   /* constraints */
39388ebb749SStefano Zampini   for (i=0;i<n_constraints;i++) {
39488ebb749SStefano Zampini     ierr = VecSet(vec2_C,zero);CHKERRQ(ierr);
39588ebb749SStefano Zampini     ierr = VecSetValue(vec2_C,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
39688ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec2_C);CHKERRQ(ierr);
39788ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec2_C);CHKERRQ(ierr);
39825084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on vertices multipliers */
39988ebb749SStefano Zampini     ierr = MatMult(M1,vec2_C,vec1_C);CHKERRQ(ierr);
40088ebb749SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
40188ebb749SStefano Zampini     ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
40225084f0cSStefano Zampini     if (n_vertices) {
40325084f0cSStefano Zampini       ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
40425084f0cSStefano Zampini     }
40588ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
40688ebb749SStefano Zampini     /* coarse basis functions */
40725084f0cSStefano Zampini     j = i+n_vertices; /* don't touch this! */
40888ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
40988ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
41088ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
41125084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
41225084f0cSStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
41325084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
4148eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
41588ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
41688ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
41725084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
41825084f0cSStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
41925084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
42088ebb749SStefano Zampini     }
42125084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
42288ebb749SStefano Zampini     if (n_vertices) {
42325084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
42425084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
42525084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
42688ebb749SStefano Zampini     }
42725084f0cSStefano Zampini     ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
42825084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
42925084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
43088ebb749SStefano Zampini 
43125084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
43288ebb749SStefano Zampini       /* assemble subdomain vector on nodes */
43388ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
43425084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
43525084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
43625084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
43725084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
43825084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
43988ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers */
44088ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
44188ebb749SStefano Zampini       if (n_vertices) {
44225084f0cSStefano Zampini         ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
44325084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
44425084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
44588ebb749SStefano Zampini       }
44625084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
44725084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
44825084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
44925084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
45025084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
45125084f0cSStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
45288ebb749SStefano Zampini       /* check saddle point solution */
45388ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
45488ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
45525084f0cSStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[j]);CHKERRQ(ierr);
45688ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
45725084f0cSStefano Zampini       /* shift by the identity matrix */
45825084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,j,m_one,ADD_VALUES);CHKERRQ(ierr);
45925084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
46025084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
46125084f0cSStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[j]);CHKERRQ(ierr);
46288ebb749SStefano Zampini     }
46388ebb749SStefano Zampini   }
46425084f0cSStefano Zampini   /* call assembling routines for local coarse basis */
46588ebb749SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
46688ebb749SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4678eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
46888ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
46988ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
47088ebb749SStefano Zampini   }
47125084f0cSStefano Zampini 
47288ebb749SStefano Zampini   /* compute other basis functions for non-symmetric problems */
47388ebb749SStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
47488ebb749SStefano Zampini   if (!setsym || (setsym && !issym)) {
47588ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
47688ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_psi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
47788ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_psi_B,impMatType);CHKERRQ(ierr);
47825084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_psi_B);CHKERRQ(ierr);
4798eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
48088ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
48188ebb749SStefano Zampini       ierr = MatSetSizes(pcbddc->coarse_psi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
48288ebb749SStefano Zampini       ierr = MatSetType(pcbddc->coarse_psi_D,impMatType);CHKERRQ(ierr);
48325084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->coarse_psi_D);CHKERRQ(ierr);
48488ebb749SStefano Zampini     }
48588ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
48688ebb749SStefano Zampini       if (n_constraints) {
48788ebb749SStefano Zampini         ierr = VecSet(vec1_C,zero);CHKERRQ(ierr);
48888ebb749SStefano Zampini         for (j=0;j<n_constraints;j++) {
48925084f0cSStefano Zampini           ierr = VecSetValue(vec1_C,j,coarse_submat_vals[(j+n_vertices)*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
49088ebb749SStefano Zampini         }
49125084f0cSStefano Zampini         ierr = VecAssemblyBegin(vec1_C);CHKERRQ(ierr);
49225084f0cSStefano Zampini         ierr = VecAssemblyEnd(vec1_C);CHKERRQ(ierr);
49388ebb749SStefano Zampini       }
49488ebb749SStefano Zampini       if (i<n_vertices) {
49588ebb749SStefano Zampini         ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
49688ebb749SStefano Zampini         ierr = VecSetValue(vec1_V,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
49788ebb749SStefano Zampini         ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
49888ebb749SStefano Zampini         ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
49988ebb749SStefano Zampini         ierr = MatMultTranspose(A_VR,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
50088ebb749SStefano Zampini         if (n_constraints) {
50188ebb749SStefano Zampini           ierr = MatMultTransposeAdd(C_CR,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
50288ebb749SStefano Zampini         }
50388ebb749SStefano Zampini       } else {
50488ebb749SStefano Zampini         ierr = MatMultTranspose(C_CR,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
50588ebb749SStefano Zampini       }
50688ebb749SStefano Zampini       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
50788ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
50888ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
50988ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
51025084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
51188ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_psi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
51225084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
51388ebb749SStefano Zampini       if (i<n_vertices) {
51488ebb749SStefano Zampini         ierr = MatSetValue(pcbddc->coarse_psi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
51588ebb749SStefano Zampini       }
5168eeda7d8SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
51788ebb749SStefano Zampini         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
51888ebb749SStefano Zampini         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
51925084f0cSStefano Zampini         ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
52088ebb749SStefano Zampini         ierr = MatSetValues(pcbddc->coarse_psi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
52125084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
52288ebb749SStefano Zampini       }
52388ebb749SStefano Zampini 
52425084f0cSStefano Zampini       if (pcbddc->dbg_flag) {
52588ebb749SStefano Zampini         /* assemble subdomain vector on nodes */
52688ebb749SStefano Zampini         ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
52725084f0cSStefano Zampini         ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
52825084f0cSStefano Zampini         ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
52925084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
53025084f0cSStefano Zampini         if (i<n_vertices) {
53125084f0cSStefano Zampini           ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
53288ebb749SStefano Zampini         }
53325084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
53425084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
53525084f0cSStefano Zampini         /* assemble subdomain vector of lagrange multipliers */
53625084f0cSStefano Zampini         for (j=0;j<pcbddc->local_primal_size;j++) {
53725084f0cSStefano Zampini           ierr = VecSetValue(pcbddc->vec1_P,j,-coarse_submat_vals[j*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
53825084f0cSStefano Zampini         }
53925084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
54025084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
54188ebb749SStefano Zampini         /* check saddle point solution */
54288ebb749SStefano Zampini         ierr = MatMultTranspose(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
54388ebb749SStefano Zampini         ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
54488ebb749SStefano Zampini         ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
54588ebb749SStefano Zampini         ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
54625084f0cSStefano Zampini         /* shift by the identity matrix */
54725084f0cSStefano Zampini         ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
54825084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
54925084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
55088ebb749SStefano Zampini         ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
55188ebb749SStefano Zampini       }
55288ebb749SStefano Zampini     }
55388ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
55488ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5558eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
55688ebb749SStefano Zampini       ierr = MatAssemblyBegin(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
55788ebb749SStefano Zampini       ierr = MatAssemblyEnd(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
55888ebb749SStefano Zampini     }
559c0553b1fSStefano Zampini     unsymmetric_check = PETSC_TRUE;
560c0553b1fSStefano Zampini   } else { /* take references to already computed coarse basis */
561c0553b1fSStefano Zampini     unsymmetric_check = PETSC_FALSE;
562c0553b1fSStefano Zampini     ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
563c0553b1fSStefano Zampini     pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
564c0553b1fSStefano Zampini     if (pcbddc->coarse_phi_D) {
565c0553b1fSStefano Zampini       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
566c0553b1fSStefano Zampini       pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
567c0553b1fSStefano Zampini     }
56888ebb749SStefano Zampini   }
56988ebb749SStefano Zampini   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
57088ebb749SStefano Zampini   /* Checking coarse_sub_mat and coarse basis functios */
57188ebb749SStefano Zampini   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
57288ebb749SStefano Zampini   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
57325084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
57488ebb749SStefano Zampini     Mat         coarse_sub_mat;
57525084f0cSStefano Zampini     Mat         AUXMAT,TM1,TM2,TM3,TM4;
57688ebb749SStefano Zampini     Mat         coarse_phi_D,coarse_phi_B;
57788ebb749SStefano Zampini     Mat         coarse_psi_D,coarse_psi_B;
57888ebb749SStefano Zampini     Mat         A_II,A_BB,A_IB,A_BI;
57988ebb749SStefano Zampini     MatType     checkmattype=MATSEQAIJ;
58088ebb749SStefano Zampini     PetscReal   real_value;
58188ebb749SStefano Zampini 
58288ebb749SStefano Zampini     ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
58388ebb749SStefano Zampini     ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
58488ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
58588ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
58688ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
58788ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
588c0553b1fSStefano Zampini     if (unsymmetric_check) {
58988ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
59088ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
59188ebb749SStefano Zampini     }
59288ebb749SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
59388ebb749SStefano Zampini 
59425084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
59525084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat and local basis functions\n");CHKERRQ(ierr);
59625084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
597c0553b1fSStefano Zampini     if (unsymmetric_check) {
59888ebb749SStefano Zampini       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
59988ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
60088ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
60188ebb749SStefano Zampini       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
60288ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
60388ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
60488ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
60588ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
60688ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
60788ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
60888ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
60988ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
61088ebb749SStefano Zampini     } else {
61188ebb749SStefano Zampini       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
61288ebb749SStefano Zampini       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
61388ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
61488ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
61588ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
61688ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
61788ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
61888ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
61988ebb749SStefano Zampini     }
62088ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
62188ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
62288ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
62388ebb749SStefano Zampini     ierr = MatConvert(TM1,MATSEQDENSE,MAT_REUSE_MATRIX,&TM1);CHKERRQ(ierr);
62488ebb749SStefano Zampini     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
62588ebb749SStefano Zampini     ierr = MatNorm(TM1,NORM_INFINITY,&real_value);CHKERRQ(ierr);
62625084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"----------------------------------\n");CHKERRQ(ierr);
62725084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d \n",PetscGlobalRank);CHKERRQ(ierr);
62825084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"matrix error = % 1.14e\n",real_value);CHKERRQ(ierr);
62925084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (phi) errors\n");CHKERRQ(ierr);
63088ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
63125084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,coarsefunctions_errors[i]);CHKERRQ(ierr);
63288ebb749SStefano Zampini     }
63325084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (phi) errors\n");CHKERRQ(ierr);
63488ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
63525084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,constraints_errors[i]);CHKERRQ(ierr);
63688ebb749SStefano Zampini     }
637c0553b1fSStefano Zampini     if (unsymmetric_check) {
63825084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (psi) errors\n");CHKERRQ(ierr);
63988ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
64025084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,coarsefunctions_errors[i]);CHKERRQ(ierr);
64188ebb749SStefano Zampini       }
64225084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (psi) errors\n");CHKERRQ(ierr);
64388ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
64425084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,constraints_errors[i]);CHKERRQ(ierr);
64588ebb749SStefano Zampini       }
64688ebb749SStefano Zampini     }
64725084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
64888ebb749SStefano Zampini     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
64988ebb749SStefano Zampini     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
65088ebb749SStefano Zampini     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
65188ebb749SStefano Zampini     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
65288ebb749SStefano Zampini     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
65388ebb749SStefano Zampini     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
65488ebb749SStefano Zampini     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
65588ebb749SStefano Zampini     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
65688ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
65788ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
658c0553b1fSStefano Zampini     if (unsymmetric_check) {
65988ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
66088ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
66188ebb749SStefano Zampini     }
66288ebb749SStefano Zampini     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
6638ce42a96SStefano Zampini     ierr = ISRestoreIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
66488ebb749SStefano Zampini     ierr = PetscFree(coarsefunctions_errors);CHKERRQ(ierr);
66588ebb749SStefano Zampini     ierr = PetscFree(constraints_errors);CHKERRQ(ierr);
66688ebb749SStefano Zampini   }
66788ebb749SStefano Zampini   /* free memory */
66888ebb749SStefano Zampini   if (n_vertices) {
66988ebb749SStefano Zampini     ierr = PetscFree(vertices);CHKERRQ(ierr);
67088ebb749SStefano Zampini     ierr = VecDestroy(&vec1_V);CHKERRQ(ierr);
67188ebb749SStefano Zampini     ierr = VecDestroy(&vec2_V);CHKERRQ(ierr);
67288ebb749SStefano Zampini     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
67388ebb749SStefano Zampini     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
67488ebb749SStefano Zampini     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
67588ebb749SStefano Zampini   }
67688ebb749SStefano Zampini   if (n_constraints) {
67788ebb749SStefano Zampini     ierr = VecDestroy(&vec1_C);CHKERRQ(ierr);
67888ebb749SStefano Zampini     ierr = VecDestroy(&vec2_C);CHKERRQ(ierr);
67988ebb749SStefano Zampini     ierr = MatDestroy(&M1);CHKERRQ(ierr);
68088ebb749SStefano Zampini     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
68188ebb749SStefano Zampini   }
68288ebb749SStefano Zampini   ierr = PetscFree(auxindices);CHKERRQ(ierr);
6838629588bSStefano Zampini   /* get back data */
6848629588bSStefano Zampini   *coarse_submat_vals_n = coarse_submat_vals;
68588ebb749SStefano Zampini   PetscFunctionReturn(0);
68688ebb749SStefano Zampini }
68788ebb749SStefano Zampini 
68888ebb749SStefano Zampini #undef __FUNCT__
689aa0d41d4SStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalMatrices"
690aa0d41d4SStefano Zampini PetscErrorCode PCBDDCSetUpLocalMatrices(PC pc)
691aa0d41d4SStefano Zampini {
692aa0d41d4SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
693aa0d41d4SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
694aa0d41d4SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
6959577ea80SStefano Zampini   PetscBool         issbaij,isbaij;
696aa0d41d4SStefano Zampini   /* manage repeated solves */
697aa0d41d4SStefano Zampini   MatReuse          reuse;
698aa0d41d4SStefano Zampini   MatStructure      matstruct;
699aa0d41d4SStefano Zampini   PetscErrorCode    ierr;
700aa0d41d4SStefano Zampini 
701aa0d41d4SStefano Zampini   PetscFunctionBegin;
702aa0d41d4SStefano Zampini   /* get mat flags */
703aa0d41d4SStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
704aa0d41d4SStefano Zampini   reuse = MAT_INITIAL_MATRIX;
705aa0d41d4SStefano Zampini   if (pc->setupcalled) {
706aa0d41d4SStefano Zampini     /* when matstruct is SAME_PRECONDITIONER, we shouldn't be here */
707aa0d41d4SStefano Zampini     if (matstruct == SAME_PRECONDITIONER) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen");
708aa0d41d4SStefano Zampini     if (matstruct == SAME_NONZERO_PATTERN) {
709aa0d41d4SStefano Zampini       reuse = MAT_REUSE_MATRIX;
710aa0d41d4SStefano Zampini     } else {
711aa0d41d4SStefano Zampini       reuse = MAT_INITIAL_MATRIX;
712aa0d41d4SStefano Zampini     }
713aa0d41d4SStefano Zampini   }
714aa0d41d4SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
715aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
716aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
717aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
718aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BB);CHKERRQ(ierr);
719aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
720aa0d41d4SStefano Zampini   }
721aa0d41d4SStefano Zampini 
722aa0d41d4SStefano Zampini   /* transform local matrices if needed */
723aa0d41d4SStefano Zampini   if (pcbddc->use_change_of_basis) {
724aa0d41d4SStefano Zampini     Mat         change_mat_all;
725aa0d41d4SStefano Zampini     PetscScalar *row_cmat_values;
726aa0d41d4SStefano Zampini     PetscInt    *row_cmat_indices;
727aa0d41d4SStefano Zampini     PetscInt    *nnz,*is_indices,*temp_indices;
728aa0d41d4SStefano Zampini     PetscInt    i,j,k,n_D,n_B;
729aa0d41d4SStefano Zampini 
730aa0d41d4SStefano Zampini     /* Get Non-overlapping dimensions */
731aa0d41d4SStefano Zampini     n_B = pcis->n_B;
732aa0d41d4SStefano Zampini     n_D = pcis->n-n_B;
733aa0d41d4SStefano Zampini 
734aa0d41d4SStefano Zampini     /* compute nonzero structure of change of basis on all local nodes */
735aa0d41d4SStefano Zampini     ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
736aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
737aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) nnz[is_indices[i]] = 1;
738aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
739aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
740aa0d41d4SStefano Zampini     k=1;
741aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
742aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
743aa0d41d4SStefano Zampini       nnz[is_indices[i]]=j;
744aa0d41d4SStefano Zampini       if (k < j) k = j;
745aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
746aa0d41d4SStefano Zampini     }
747aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
748aa0d41d4SStefano Zampini     /* assemble change of basis matrix on the whole set of local dofs */
749aa0d41d4SStefano Zampini     ierr = PetscMalloc(k*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
750aa0d41d4SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&change_mat_all);CHKERRQ(ierr);
751aa0d41d4SStefano Zampini     ierr = MatSetSizes(change_mat_all,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
752aa0d41d4SStefano Zampini     ierr = MatSetType(change_mat_all,MATSEQAIJ);CHKERRQ(ierr);
753aa0d41d4SStefano Zampini     ierr = MatSeqAIJSetPreallocation(change_mat_all,0,nnz);CHKERRQ(ierr);
754aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
755aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) {
756aa0d41d4SStefano Zampini       ierr = MatSetValue(change_mat_all,is_indices[i],is_indices[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
757aa0d41d4SStefano Zampini     }
758aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
759aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
760aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
761aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
762aa0d41d4SStefano Zampini       for (k=0; k<j; k++) temp_indices[k]=is_indices[row_cmat_indices[k]];
763aa0d41d4SStefano Zampini       ierr = MatSetValues(change_mat_all,1,&is_indices[i],j,temp_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
764aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
765aa0d41d4SStefano Zampini     }
766aa0d41d4SStefano Zampini     ierr = MatAssemblyBegin(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
767aa0d41d4SStefano Zampini     ierr = MatAssemblyEnd(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7689577ea80SStefano Zampini     /* TODO: HOW TO WORK WITH BAIJ and SBAIJ? PtAP not provided */
7699577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
7709577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQBAIJ,&isbaij);CHKERRQ(ierr);
7719577ea80SStefano Zampini     if (!issbaij && !isbaij) {
772aa0d41d4SStefano Zampini       ierr = MatPtAP(matis->A,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
773aa0d41d4SStefano Zampini     } else {
774aa0d41d4SStefano Zampini       Mat work_mat;
775aa0d41d4SStefano Zampini       ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
776aa0d41d4SStefano Zampini       ierr = MatPtAP(work_mat,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
777aa0d41d4SStefano Zampini       ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
778aa0d41d4SStefano Zampini     }
77945a1bb75SStefano Zampini     /*
78045a1bb75SStefano Zampini     ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
78145a1bb75SStefano Zampini     ierr = MatView(change_mat_all,(PetscViewer)0);CHKERRQ(ierr);
78245a1bb75SStefano Zampini     */
783aa0d41d4SStefano Zampini     ierr = MatDestroy(&change_mat_all);CHKERRQ(ierr);
784aa0d41d4SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
785aa0d41d4SStefano Zampini     ierr = PetscFree(temp_indices);CHKERRQ(ierr);
786aa0d41d4SStefano Zampini   } else {
787aa0d41d4SStefano Zampini     /* without change of basis, the local matrix is unchanged */
788aa0d41d4SStefano Zampini     if (!pcbddc->local_mat) {
789aa0d41d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)matis->A);CHKERRQ(ierr);
790aa0d41d4SStefano Zampini       pcbddc->local_mat = matis->A;
791aa0d41d4SStefano Zampini     }
792aa0d41d4SStefano Zampini   }
793aa0d41d4SStefano Zampini 
794aa0d41d4SStefano Zampini   /* get submatrices */
795aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_I_local,reuse,&pcis->A_II);CHKERRQ(ierr);
7969577ea80SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_B_local,reuse,&pcis->A_BB);CHKERRQ(ierr);
7979577ea80SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
7989577ea80SStefano Zampini   if (!issbaij) {
799aa0d41d4SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
800aa0d41d4SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
8019577ea80SStefano Zampini   } else {
8029577ea80SStefano Zampini     Mat newmat;
8039577ea80SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
8049577ea80SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
8059577ea80SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
8069577ea80SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
8079577ea80SStefano Zampini   }
808aa0d41d4SStefano Zampini   PetscFunctionReturn(0);
809aa0d41d4SStefano Zampini }
810aa0d41d4SStefano Zampini 
811aa0d41d4SStefano Zampini #undef __FUNCT__
812a64d13efSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalScatters"
8138ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
814a64d13efSStefano Zampini {
815a64d13efSStefano Zampini   PC_IS*         pcis = (PC_IS*)(pc->data);
816a64d13efSStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8178ce42a96SStefano Zampini   IS             is_aux1,is_aux2;
818a64d13efSStefano Zampini   PetscInt       *vertices,*aux_array1,*aux_array2,*is_indices,*idx_R_local;
8193a50541eSStefano Zampini   PetscInt       n_vertices,i,j,n_R,n_D,n_B;
8203a50541eSStefano Zampini   PetscInt       vbs,bs;
8214641a718SStefano Zampini   PetscBT        bitmask;
822a64d13efSStefano Zampini   PetscErrorCode ierr;
823a64d13efSStefano Zampini 
824a64d13efSStefano Zampini   PetscFunctionBegin;
825a64d13efSStefano Zampini   /* Set Non-overlapping dimensions */
826a64d13efSStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
827a64d13efSStefano Zampini   /* get vertex indices from constraint matrix */
828a64d13efSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
8293a50541eSStefano Zampini 
8304641a718SStefano Zampini   /* create auxiliary bitmask */
8314641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
8324641a718SStefano Zampini   for (i=0;i<n_vertices;i++) {
8334641a718SStefano Zampini     ierr = PetscBTSet(bitmask,vertices[i]);CHKERRQ(ierr);
8344641a718SStefano Zampini   }
8353a50541eSStefano Zampini 
836a64d13efSStefano Zampini   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
837a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n-n_vertices)*sizeof(PetscInt),&idx_R_local);CHKERRQ(ierr);
838a64d13efSStefano Zampini   for (i=0, n_R=0; i<pcis->n; i++) {
8394641a718SStefano Zampini     if (!PetscBTLookup(bitmask,i)) {
840a64d13efSStefano Zampini       idx_R_local[n_R] = i;
841a64d13efSStefano Zampini       n_R++;
842a64d13efSStefano Zampini     }
843a64d13efSStefano Zampini   }
8443a50541eSStefano Zampini 
8453a50541eSStefano Zampini   /* Block code */
8463a50541eSStefano Zampini   vbs = 1;
8473a50541eSStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
8483a50541eSStefano Zampini   if (bs>1 && !(n_vertices%bs)) {
8493a50541eSStefano Zampini     PetscBool is_blocked = PETSC_TRUE;
8503a50541eSStefano Zampini     PetscInt  *vary;
8513a50541eSStefano Zampini     /* Verify if the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
8523a50541eSStefano Zampini     ierr = PetscMalloc(pcis->n/bs*sizeof(PetscInt),&vary);CHKERRQ(ierr);
8533a50541eSStefano Zampini     ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
8543a50541eSStefano Zampini     for (i=0; i<n_vertices; i++) vary[vertices[i]/bs]++;
8553a50541eSStefano Zampini     for (i=0; i<n_vertices; i++) {
8563a50541eSStefano Zampini       if (vary[i]!=0 && vary[i]!=bs) {
8573a50541eSStefano Zampini         is_blocked = PETSC_FALSE;
8583a50541eSStefano Zampini         break;
8593a50541eSStefano Zampini       }
8603a50541eSStefano Zampini     }
8613a50541eSStefano Zampini     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
8623a50541eSStefano Zampini       vbs = bs;
8633a50541eSStefano Zampini       for (i=0;i<n_R/vbs;i++) {
8643a50541eSStefano Zampini         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
8653a50541eSStefano Zampini       }
8663a50541eSStefano Zampini     }
8673a50541eSStefano Zampini     ierr = PetscFree(vary);CHKERRQ(ierr);
8683a50541eSStefano Zampini   }
869a64d13efSStefano Zampini   ierr = PetscFree(vertices);CHKERRQ(ierr);
8703a50541eSStefano Zampini   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
8713a50541eSStefano Zampini   ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
872a64d13efSStefano Zampini 
873a64d13efSStefano Zampini   /* print some info if requested */
874a64d13efSStefano Zampini   if (pcbddc->dbg_flag) {
875a64d13efSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
876a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
877a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
878a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
8793a50541eSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"r_size = %d, v_size = %d, constraints = %d, local_primal_size = %d\n",n_R,n_vertices,pcbddc->local_primal_size-n_vertices,pcbddc->local_primal_size);CHKERRQ(ierr);
880a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr);
881a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
882a64d13efSStefano Zampini   }
883a64d13efSStefano Zampini 
884a64d13efSStefano Zampini   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
8853a50541eSStefano Zampini   ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
886a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
887a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array2);CHKERRQ(ierr);
888a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
8894641a718SStefano Zampini   for (i=0; i<n_D; i++) {
8904641a718SStefano Zampini     ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
8914641a718SStefano Zampini   }
892a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
893a64d13efSStefano Zampini   for (i=0, j=0; i<n_R; i++) {
8944641a718SStefano Zampini     if (!PetscBTLookup(bitmask,idx_R_local[i])) {
8954641a718SStefano Zampini       aux_array1[j++] = i;
896a64d13efSStefano Zampini     }
897a64d13efSStefano Zampini   }
898a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
899a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
900a64d13efSStefano Zampini   for (i=0, j=0; i<n_B; i++) {
9014641a718SStefano Zampini     if (!PetscBTLookup(bitmask,is_indices[i])) {
9024641a718SStefano Zampini       aux_array2[j++] = i;
903a64d13efSStefano Zampini     }
904a64d13efSStefano Zampini   }
905a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
906a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
907a64d13efSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
908a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
909a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
910a64d13efSStefano Zampini 
9118eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
912a64d13efSStefano Zampini     ierr = PetscMalloc(n_D*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
913a64d13efSStefano Zampini     for (i=0, j=0; i<n_R; i++) {
9144641a718SStefano Zampini       if (PetscBTLookup(bitmask,idx_R_local[i])) {
9154641a718SStefano Zampini         aux_array1[j++] = i;
916a64d13efSStefano Zampini       }
917a64d13efSStefano Zampini     }
918a64d13efSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
919a64d13efSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
920a64d13efSStefano Zampini     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
921a64d13efSStefano Zampini   }
9224641a718SStefano Zampini   ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
9233a50541eSStefano Zampini   ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
924a64d13efSStefano Zampini   PetscFunctionReturn(0);
925a64d13efSStefano Zampini }
926a64d13efSStefano Zampini 
927304d26faSStefano Zampini 
928304d26faSStefano Zampini #undef __FUNCT__
929304d26faSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
9308ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc)
931304d26faSStefano Zampini {
932304d26faSStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
933304d26faSStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
934304d26faSStefano Zampini   PC             pc_temp;
935304d26faSStefano Zampini   Mat            A_RR;
936304d26faSStefano Zampini   Vec            vec1,vec2,vec3;
937304d26faSStefano Zampini   MatStructure   matstruct;
938304d26faSStefano Zampini   PetscScalar    m_one = -1.0;
939304d26faSStefano Zampini   PetscReal      value;
940af732b37SStefano Zampini   PetscInt       n_D,n_R,ibs,mbs;
9419577ea80SStefano Zampini   PetscBool      use_exact,use_exact_reduced,issbaij;
942304d26faSStefano Zampini   PetscErrorCode ierr;
943e604994aSStefano Zampini   /* prefixes stuff */
944e604994aSStefano Zampini   char           dir_prefix[256],neu_prefix[256],str_level[3];
945e604994aSStefano Zampini   size_t         len;
946304d26faSStefano Zampini 
947304d26faSStefano Zampini   PetscFunctionBegin;
948304d26faSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
949304d26faSStefano Zampini 
950e604994aSStefano Zampini   /* compute prefixes */
951e604994aSStefano Zampini   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
952e604994aSStefano Zampini   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
953e604994aSStefano Zampini   if (!pcbddc->current_level) {
954e604994aSStefano Zampini     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
955e604994aSStefano Zampini     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
956e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
957e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
958e604994aSStefano Zampini   } else {
959e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
960e604994aSStefano Zampini     sprintf(str_level,"%d_",(int)(pcbddc->current_level));
961e604994aSStefano Zampini     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
962e604994aSStefano Zampini     len -= 15; /* remove "pc_bddc_coarse_" */
963e604994aSStefano Zampini     if (pcbddc->current_level>1) len -= 2; /* remove "X_" with X level number (works with 9 levels max) */
964e604994aSStefano Zampini     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
965e604994aSStefano Zampini     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
966e604994aSStefano Zampini     *(dir_prefix+len)='\0';
967e604994aSStefano Zampini     *(neu_prefix+len)='\0';
968e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
969e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
970e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
971e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
972e604994aSStefano Zampini   }
973e604994aSStefano Zampini 
974304d26faSStefano Zampini   /* DIRICHLET PROBLEM */
975ac78edfcSStefano Zampini   /* Matrix for Dirichlet problem is pcis->A_II */
9768ce42a96SStefano Zampini   ierr = ISGetSize(pcis->is_I_local,&n_D);CHKERRQ(ierr);
977304d26faSStefano Zampini   if (!pcbddc->ksp_D) { /* create object if not yet build */
978304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
979304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
980304d26faSStefano Zampini     /* default */
981304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
982e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
9839577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
984304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
9859577ea80SStefano Zampini     if (issbaij) {
9869577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
9879577ea80SStefano Zampini     } else {
988304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
9899577ea80SStefano Zampini     }
990304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
991304d26faSStefano Zampini   }
992304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II,matstruct);CHKERRQ(ierr);
993304d26faSStefano Zampini   /* Allow user's customization */
994304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
995304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
996304d26faSStefano Zampini   if (!n_D) {
997304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
998304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
999304d26faSStefano Zampini   }
1000304d26faSStefano Zampini   /* Set Up KSP for Dirichlet problem of BDDC */
1001304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
1002304d26faSStefano Zampini   /* set ksp_D into pcis data */
1003304d26faSStefano Zampini   ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
1004304d26faSStefano Zampini   ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
1005304d26faSStefano Zampini   pcis->ksp_D = pcbddc->ksp_D;
1006304d26faSStefano Zampini 
1007304d26faSStefano Zampini   /* NEUMANN PROBLEM */
1008304d26faSStefano Zampini   /* Matrix for Neumann problem is A_RR -> we need to create it */
10098ce42a96SStefano Zampini   ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
1010af732b37SStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
1011af732b37SStefano Zampini   ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
10123a50541eSStefano Zampini   if (ibs != mbs) {
1013af732b37SStefano Zampini     Mat newmat;
1014af732b37SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
1015af732b37SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
1016af732b37SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
1017af732b37SStefano Zampini   } else {
10188ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
1019af732b37SStefano Zampini   }
1020304d26faSStefano Zampini   if (!pcbddc->ksp_R) { /* create object if not yet build */
1021304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
1022304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
1023304d26faSStefano Zampini     /* default */
1024304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
1025e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
1026304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
10279577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
10289577ea80SStefano Zampini     if (issbaij) {
10299577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
10309577ea80SStefano Zampini     } else {
1031304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
10329577ea80SStefano Zampini     }
1033304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1034304d26faSStefano Zampini   }
1035304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR,matstruct);CHKERRQ(ierr);
1036304d26faSStefano Zampini   /* Allow user's customization */
1037304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
1038304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1039304d26faSStefano Zampini   if (!n_R) {
1040304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
1041304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1042304d26faSStefano Zampini   }
1043304d26faSStefano Zampini   /* Set Up KSP for Neumann problem of BDDC */
1044304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
1045304d26faSStefano Zampini 
1046304d26faSStefano Zampini   /* check Dirichlet and Neumann solvers and adapt them if a nullspace correction is needed */
1047304d26faSStefano Zampini 
1048304d26faSStefano Zampini   /* Dirichlet */
1049304d26faSStefano Zampini   ierr = MatGetVecs(pcis->A_II,&vec1,&vec2);CHKERRQ(ierr);
1050304d26faSStefano Zampini   ierr = VecDuplicate(vec1,&vec3);CHKERRQ(ierr);
1051304d26faSStefano Zampini   ierr = VecSetRandom(vec1,NULL);CHKERRQ(ierr);
1052304d26faSStefano Zampini   ierr = MatMult(pcis->A_II,vec1,vec2);CHKERRQ(ierr);
1053304d26faSStefano Zampini   ierr = KSPSolve(pcbddc->ksp_D,vec2,vec3);CHKERRQ(ierr);
1054304d26faSStefano Zampini   ierr = VecAXPY(vec3,m_one,vec1);CHKERRQ(ierr);
1055304d26faSStefano Zampini   ierr = VecNorm(vec3,NORM_INFINITY,&value);CHKERRQ(ierr);
1056304d26faSStefano Zampini   ierr = VecDestroy(&vec1);CHKERRQ(ierr);
1057304d26faSStefano Zampini   ierr = VecDestroy(&vec2);CHKERRQ(ierr);
1058304d26faSStefano Zampini   ierr = VecDestroy(&vec3);CHKERRQ(ierr);
1059304d26faSStefano Zampini   /* need to be adapted? */
1060b8ffe317SStefano Zampini   use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1061b8ffe317SStefano Zampini   ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1062b8ffe317SStefano Zampini   ierr = PCBDDCSetUseExactDirichlet(pc,use_exact_reduced);CHKERRQ(ierr);
1063304d26faSStefano Zampini   /* print info */
1064304d26faSStefano Zampini   if (pcbddc->dbg_flag) {
1065304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1066304d26faSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
1067304d26faSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Checking solution of Dirichlet and Neumann problems\n");CHKERRQ(ierr);
1068e604994aSStefano 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);
1069304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1070304d26faSStefano Zampini   }
1071b8ffe317SStefano Zampini   if (pcbddc->NullSpace && !use_exact_reduced && !pcbddc->switch_static) {
10728ce42a96SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcis->is_I_local);CHKERRQ(ierr);
1073304d26faSStefano Zampini   }
1074304d26faSStefano Zampini 
1075304d26faSStefano Zampini   /* Neumann */
1076304d26faSStefano Zampini   ierr = MatGetVecs(A_RR,&vec1,&vec2);CHKERRQ(ierr);
1077304d26faSStefano Zampini   ierr = VecDuplicate(vec1,&vec3);CHKERRQ(ierr);
1078304d26faSStefano Zampini   ierr = VecSetRandom(vec1,NULL);CHKERRQ(ierr);
1079304d26faSStefano Zampini   ierr = MatMult(A_RR,vec1,vec2);CHKERRQ(ierr);
1080304d26faSStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,vec2,vec3);CHKERRQ(ierr);
1081304d26faSStefano Zampini   ierr = VecAXPY(vec3,m_one,vec1);CHKERRQ(ierr);
1082304d26faSStefano Zampini   ierr = VecNorm(vec3,NORM_INFINITY,&value);CHKERRQ(ierr);
1083304d26faSStefano Zampini   ierr = VecDestroy(&vec1);CHKERRQ(ierr);
1084304d26faSStefano Zampini   ierr = VecDestroy(&vec2);CHKERRQ(ierr);
1085304d26faSStefano Zampini   ierr = VecDestroy(&vec3);CHKERRQ(ierr);
1086304d26faSStefano Zampini   /* need to be adapted? */
1087b8ffe317SStefano Zampini   use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1088b8ffe317SStefano Zampini   ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1089304d26faSStefano Zampini   /* print info */
1090304d26faSStefano Zampini   if (pcbddc->dbg_flag) {
1091e604994aSStefano 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);
1092304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1093304d26faSStefano Zampini   }
1094b8ffe317SStefano Zampini   if (pcbddc->NullSpace && !use_exact_reduced) { /* is it the right logic? */
10958ce42a96SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcbddc->is_R_local);CHKERRQ(ierr);
1096304d26faSStefano Zampini   }
1097304d26faSStefano Zampini   /* free Neumann problem's matrix */
1098304d26faSStefano Zampini   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1099304d26faSStefano Zampini   PetscFunctionReturn(0);
1100304d26faSStefano Zampini }
1101304d26faSStefano Zampini 
1102304d26faSStefano Zampini #undef __FUNCT__
1103ba15a52eSStefano Zampini #define __FUNCT__ "PCBDDCSolveSubstructureCorrection"
110420c7b377SStefano Zampini static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec rhs, Vec sol, Vec work, PetscBool applytranspose)
1105674ae819SStefano Zampini {
1106674ae819SStefano Zampini   PetscErrorCode ierr;
1107674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1108674ae819SStefano Zampini 
1109674ae819SStefano Zampini   PetscFunctionBegin;
111020c7b377SStefano Zampini   if (applytranspose) {
1111674ae819SStefano Zampini     if (pcbddc->local_auxmat1) {
111220c7b377SStefano Zampini       ierr = MatMultTranspose(pcbddc->local_auxmat2,rhs,work);CHKERRQ(ierr);
111320c7b377SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,work,rhs,rhs);CHKERRQ(ierr);
111420c7b377SStefano Zampini     }
111520c7b377SStefano Zampini     ierr = KSPSolveTranspose(pcbddc->ksp_R,rhs,sol);CHKERRQ(ierr);
111620c7b377SStefano Zampini   } else {
111720c7b377SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,rhs,sol);CHKERRQ(ierr);
111820c7b377SStefano Zampini     if (pcbddc->local_auxmat1) {
111920c7b377SStefano Zampini       ierr = MatMult(pcbddc->local_auxmat1,sol,work);CHKERRQ(ierr);
112020c7b377SStefano Zampini       ierr = MatMultAdd(pcbddc->local_auxmat2,work,sol,sol);CHKERRQ(ierr);
112120c7b377SStefano Zampini     }
1122674ae819SStefano Zampini   }
1123674ae819SStefano Zampini   PetscFunctionReturn(0);
1124674ae819SStefano Zampini }
1125674ae819SStefano Zampini 
1126dc359a40SStefano Zampini /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
1127674ae819SStefano Zampini #undef __FUNCT__
1128674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
1129dc359a40SStefano Zampini PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
1130674ae819SStefano Zampini {
1131674ae819SStefano Zampini   PetscErrorCode ierr;
1132674ae819SStefano Zampini   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
1133674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)  (pc->data);
1134674ae819SStefano Zampini   const PetscScalar zero = 0.0;
1135674ae819SStefano Zampini 
1136674ae819SStefano Zampini   PetscFunctionBegin;
1137dc359a40SStefano Zampini   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
1138dc359a40SStefano Zampini   if (applytranspose) {
1139dc359a40SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
1140dc359a40SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
1141dc359a40SStefano Zampini   } else {
114215aaf578SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
11438eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
1144dc359a40SStefano Zampini   }
1145674ae819SStefano Zampini   /* Scatter data of coarse_rhs */
1146c7317a19SStefano Zampini   ierr = VecSet(pcbddc->coarse_rhs,zero);CHKERRQ(ierr);
1147674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1148674ae819SStefano Zampini 
1149674ae819SStefano Zampini   /* Local solution on R nodes */
1150674ae819SStefano Zampini   ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
1151674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1152674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
11538eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1154674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1155674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1156674ae819SStefano Zampini   }
115720c7b377SStefano Zampini   ierr = PCBDDCSolveSubstructureCorrection(pc,pcbddc->vec1_R,pcbddc->vec2_R,pcbddc->vec1_C,applytranspose);CHKERRQ(ierr);
1158674ae819SStefano Zampini   ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1159674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1160674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
11618eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1162674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1163674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1164674ae819SStefano Zampini   }
1165674ae819SStefano Zampini 
1166674ae819SStefano Zampini   /* Coarse solution */
1167674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1168c7317a19SStefano Zampini   /* TODO remove null space when doing multilevel */
1169*93bd9ae7SStefano Zampini   if (applytranspose) {
1170*93bd9ae7SStefano Zampini     ierr = KSPSolveTranspose(pcbddc->coarse_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
1171*93bd9ae7SStefano Zampini   } else {
1172674ae819SStefano Zampini     ierr = KSPSolve(pcbddc->coarse_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
1173*93bd9ae7SStefano Zampini   }
1174674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1175674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd  (pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1176674ae819SStefano Zampini 
1177674ae819SStefano Zampini   /* Sum contributions from two levels */
1178dc359a40SStefano Zampini   if (applytranspose) {
1179dc359a40SStefano Zampini     ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
1180dc359a40SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1181dc359a40SStefano Zampini   } else {
1182674ae819SStefano Zampini     ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
11838eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1184dc359a40SStefano Zampini   }
1185674ae819SStefano Zampini   PetscFunctionReturn(0);
1186674ae819SStefano Zampini }
1187674ae819SStefano Zampini 
1188674ae819SStefano Zampini #undef __FUNCT__
1189674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
1190674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1191674ae819SStefano Zampini {
1192674ae819SStefano Zampini   PetscErrorCode ierr;
1193674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1194674ae819SStefano Zampini 
1195674ae819SStefano Zampini   PetscFunctionBegin;
1196674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1197674ae819SStefano Zampini   PetscFunctionReturn(0);
1198674ae819SStefano Zampini }
1199674ae819SStefano Zampini 
1200674ae819SStefano Zampini #undef __FUNCT__
1201674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
1202674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1203674ae819SStefano Zampini {
1204674ae819SStefano Zampini   PetscErrorCode ierr;
1205674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1206674ae819SStefano Zampini 
1207674ae819SStefano Zampini   PetscFunctionBegin;
1208674ae819SStefano Zampini   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1209674ae819SStefano Zampini   PetscFunctionReturn(0);
1210674ae819SStefano Zampini }
1211674ae819SStefano Zampini 
1212984c4197SStefano Zampini /* uncomment for testing purposes */
1213984c4197SStefano Zampini /* #define PETSC_MISSING_LAPACK_GESVD 1 */
1214674ae819SStefano Zampini #undef __FUNCT__
1215674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp"
1216674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
1217674ae819SStefano Zampini {
1218674ae819SStefano Zampini   PetscErrorCode    ierr;
1219674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
1220674ae819SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
1221674ae819SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
1222984c4197SStefano Zampini   /* constraint and (optionally) change of basis matrix implemented as SeqAIJ */
1223674ae819SStefano Zampini   MatType           impMatType=MATSEQAIJ;
1224984c4197SStefano Zampini   /* one and zero */
1225984c4197SStefano Zampini   PetscScalar       one=1.0,zero=0.0;
1226984c4197SStefano Zampini   /* space to store constraints and their local indices */
1227984c4197SStefano Zampini   PetscScalar       *temp_quadrature_constraint;
1228984c4197SStefano Zampini   PetscInt          *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B;
1229984c4197SStefano Zampini   /* iterators */
1230984c4197SStefano Zampini   PetscInt          i,j,k,total_counts,temp_start_ptr;
1231984c4197SStefano Zampini   /* stuff to store connected components stored in pcbddc->mat_graph */
1232984c4197SStefano Zampini   IS                ISForVertices,*ISForFaces,*ISForEdges,*used_IS;
1233984c4197SStefano Zampini   PetscInt          n_ISForFaces,n_ISForEdges;
1234984c4197SStefano Zampini   /* near null space stuff */
1235674ae819SStefano Zampini   MatNullSpace      nearnullsp;
1236674ae819SStefano Zampini   const Vec         *nearnullvecs;
1237674ae819SStefano Zampini   Vec               *localnearnullsp;
1238984c4197SStefano Zampini   PetscBool         nnsp_has_cnst;
1239984c4197SStefano Zampini   PetscInt          nnsp_size;
1240984c4197SStefano Zampini   PetscScalar       *array;
1241984c4197SStefano Zampini   /* BLAS integers */
1242e310c8b4SStefano Zampini   PetscBLASInt      lwork,lierr;
1243e310c8b4SStefano Zampini   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
1244c4303822SStefano Zampini   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
1245984c4197SStefano Zampini   /* LAPACK working arrays for SVD or POD */
1246242a89d7SStefano Zampini   PetscBool         skip_lapack;
1247984c4197SStefano Zampini   PetscScalar       *work;
1248984c4197SStefano Zampini   PetscReal         *singular_vals;
1249984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1250984c4197SStefano Zampini   PetscReal         *rwork;
1251674ae819SStefano Zampini #endif
1252984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1253e310c8b4SStefano Zampini   PetscBLASInt      Blas_one_2=1;
1254984c4197SStefano Zampini   PetscScalar       *temp_basis,*correlation_mat;
1255b7d8b9f8SStefano Zampini #else
1256b7d8b9f8SStefano Zampini   PetscBLASInt      dummy_int_1=1,dummy_int_2=1;
1257b7d8b9f8SStefano Zampini   PetscScalar       dummy_scalar_1=0.0,dummy_scalar_2=0.0;
1258984c4197SStefano Zampini #endif
1259984c4197SStefano Zampini   /* change of basis */
1260984c4197SStefano Zampini   PetscInt          *aux_primal_numbering,*aux_primal_minloc,*global_indices;
1261a717540cSStefano Zampini   PetscBool         boolforchange,qr_needed;
1262a717540cSStefano Zampini   PetscBT           touched,change_basis,qr_needed_idx;
1263984c4197SStefano Zampini   /* auxiliary stuff */
1264984c4197SStefano Zampini   PetscInt          *nnz,*is_indices,*local_to_B;
1265984c4197SStefano Zampini   /* some quantities */
126645a1bb75SStefano Zampini   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
1267984c4197SStefano Zampini   PetscInt          size_of_constraint,max_size_of_constraint,max_constraints,temp_constraints;
1268984c4197SStefano Zampini 
1269674ae819SStefano Zampini 
1270674ae819SStefano Zampini   PetscFunctionBegin;
1271674ae819SStefano Zampini   /* Get index sets for faces, edges and vertices from graph */
12728eeda7d8SStefano Zampini   if (!pcbddc->use_faces && !pcbddc->use_edges && !pcbddc->use_vertices) {
12738eeda7d8SStefano Zampini     pcbddc->use_vertices = PETSC_TRUE;
1274674ae819SStefano Zampini   }
12758eeda7d8SStefano Zampini   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,pcbddc->use_faces,pcbddc->use_edges,pcbddc->use_vertices,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);
1276b8ffe317SStefano Zampini   /* HACK: provide functions to set change of basis */
1277b8ffe317SStefano Zampini   if (!ISForVertices && pcbddc->NullSpace) {
1278b8ffe317SStefano Zampini     pcbddc->use_change_of_basis = PETSC_TRUE;
1279b8ffe317SStefano Zampini     pcbddc->use_change_on_faces = PETSC_FALSE;
1280b8ffe317SStefano Zampini   }
1281984c4197SStefano Zampini   /* print some info */
1282674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
1283674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1284674ae819SStefano Zampini     i = 0;
1285674ae819SStefano Zampini     if (ISForVertices) {
1286674ae819SStefano Zampini       ierr = ISGetSize(ISForVertices,&i);CHKERRQ(ierr);
1287674ae819SStefano Zampini     }
1288674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices\n",PetscGlobalRank,i);CHKERRQ(ierr);
1289674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges\n",PetscGlobalRank,n_ISForEdges);CHKERRQ(ierr);
129015aaf578SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces\n",PetscGlobalRank,n_ISForFaces);CHKERRQ(ierr);
1291674ae819SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1292674ae819SStefano Zampini   }
1293674ae819SStefano Zampini   /* check if near null space is attached to global mat */
1294674ae819SStefano Zampini   ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
1295674ae819SStefano Zampini   if (nearnullsp) {
1296674ae819SStefano Zampini     ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
1297984c4197SStefano Zampini   } else { /* if near null space is not provided BDDC uses constants by default */
1298984c4197SStefano Zampini     nnsp_size = 0;
1299674ae819SStefano Zampini     nnsp_has_cnst = PETSC_TRUE;
1300674ae819SStefano Zampini   }
1301984c4197SStefano Zampini   /* get max number of constraints on a single cc */
1302984c4197SStefano Zampini   max_constraints = nnsp_size;
1303984c4197SStefano Zampini   if (nnsp_has_cnst) max_constraints++;
1304984c4197SStefano Zampini 
1305674ae819SStefano Zampini   /*
1306674ae819SStefano Zampini        Evaluate maximum storage size needed by the procedure
1307674ae819SStefano Zampini        - temp_indices will contain start index of each constraint stored as follows
1308674ae819SStefano 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
1309674ae819SStefano 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
1310674ae819SStefano Zampini        - temp_quadrature_constraint  [temp_indices[i],...,temp[indices[i+1]-1] will contain the scalars representing the constraint itself
1311674ae819SStefano Zampini                                                                                                                                                          */
1312674ae819SStefano Zampini   total_counts = n_ISForFaces+n_ISForEdges;
1313984c4197SStefano Zampini   total_counts *= max_constraints;
1314674ae819SStefano Zampini   n_vertices = 0;
1315674ae819SStefano Zampini   if (ISForVertices) {
1316674ae819SStefano Zampini     ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
1317674ae819SStefano Zampini   }
1318674ae819SStefano Zampini   total_counts += n_vertices;
1319674ae819SStefano Zampini   ierr = PetscMalloc((total_counts+1)*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
13204641a718SStefano Zampini   ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
1321674ae819SStefano Zampini   total_counts = 0;
1322674ae819SStefano Zampini   max_size_of_constraint = 0;
1323674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1324674ae819SStefano Zampini     if (i<n_ISForEdges) {
1325674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1326674ae819SStefano Zampini     } else {
1327674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1328674ae819SStefano Zampini     }
1329674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
1330674ae819SStefano Zampini     total_counts += j;
1331674ae819SStefano Zampini     max_size_of_constraint = PetscMax(j,max_size_of_constraint);
1332674ae819SStefano Zampini   }
1333984c4197SStefano Zampini   total_counts *= max_constraints;
1334674ae819SStefano Zampini   total_counts += n_vertices;
1335674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&temp_quadrature_constraint);CHKERRQ(ierr);
1336674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint);CHKERRQ(ierr);
1337674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint_B);CHKERRQ(ierr);
1338984c4197SStefano Zampini   /* local to boundary numbering */
1339674ae819SStefano Zampini   ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&local_to_B);CHKERRQ(ierr);
1340674ae819SStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1341984c4197SStefano Zampini   for (i=0;i<pcis->n;i++) local_to_B[i]=-1;
1342984c4197SStefano Zampini   for (i=0;i<pcis->n_B;i++) local_to_B[is_indices[i]]=i;
1343674ae819SStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1344984c4197SStefano Zampini   /* get local part of global near null space vectors */
1345984c4197SStefano Zampini   ierr = PetscMalloc(nnsp_size*sizeof(Vec),&localnearnullsp);CHKERRQ(ierr);
1346984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1347984c4197SStefano Zampini     ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
1348984c4197SStefano Zampini     ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1349984c4197SStefano Zampini     ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1350984c4197SStefano Zampini   }
1351674ae819SStefano Zampini 
1352242a89d7SStefano Zampini   /* whether or not to skip lapack calls */
1353242a89d7SStefano Zampini   skip_lapack = PETSC_TRUE;
1354242a89d7SStefano Zampini   if (n_ISForFaces+n_ISForEdges) skip_lapack = PETSC_FALSE;
1355242a89d7SStefano Zampini 
1356984c4197SStefano Zampini   /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
1357242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1358674ae819SStefano Zampini     PetscScalar temp_work;
1359674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1360984c4197SStefano Zampini     /* Proper Orthogonal Decomposition (POD) using the snapshot method */
1361984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*max_constraints*sizeof(PetscScalar),&correlation_mat);CHKERRQ(ierr);
1362984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1363984c4197SStefano Zampini     ierr = PetscMalloc(max_size_of_constraint*max_constraints*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr);
1364674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1365984c4197SStefano Zampini     ierr = PetscMalloc(3*max_constraints*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1366674ae819SStefano Zampini #endif
1367674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1368c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
1369c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
1370674ae819SStefano Zampini     lwork = -1;
1371674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1372674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1373c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
1374674ae819SStefano Zampini #else
1375c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
1376674ae819SStefano Zampini #endif
1377674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1378984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
1379674ae819SStefano Zampini #else /* on missing GESVD */
1380674ae819SStefano Zampini     /* SVD */
1381674ae819SStefano Zampini     PetscInt max_n,min_n;
1382674ae819SStefano Zampini     max_n = max_size_of_constraint;
1383984c4197SStefano Zampini     min_n = max_constraints;
1384984c4197SStefano Zampini     if (max_size_of_constraint < max_constraints) {
1385674ae819SStefano Zampini       min_n = max_size_of_constraint;
1386984c4197SStefano Zampini       max_n = max_constraints;
1387674ae819SStefano Zampini     }
1388674ae819SStefano Zampini     ierr = PetscMalloc(min_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1389674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1390674ae819SStefano Zampini     ierr = PetscMalloc(5*min_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1391674ae819SStefano Zampini #endif
1392674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1393674ae819SStefano Zampini     lwork = -1;
1394e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
1395e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
1396b7d8b9f8SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
1397674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1398674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1399e310c8b4SStefano 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));
1400674ae819SStefano Zampini #else
1401e310c8b4SStefano 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));
1402674ae819SStefano Zampini #endif
1403674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1404984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
1405984c4197SStefano Zampini #endif /* on missing GESVD */
1406674ae819SStefano Zampini     /* Allocate optimal workspace */
1407674ae819SStefano Zampini     ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
1408984c4197SStefano Zampini     ierr = PetscMalloc((PetscInt)lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
1409674ae819SStefano Zampini   }
1410674ae819SStefano Zampini   /* Now we can loop on constraining sets */
1411674ae819SStefano Zampini   total_counts = 0;
1412674ae819SStefano Zampini   temp_indices[0] = 0;
1413674ae819SStefano Zampini   /* vertices */
1414674ae819SStefano Zampini   if (ISForVertices) {
1415674ae819SStefano Zampini     ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1416674ae819SStefano Zampini     if (nnsp_has_cnst) { /* consider all vertices */
1417674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1418674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1419674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
1420674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1421674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1422674ae819SStefano Zampini         total_counts++;
1423674ae819SStefano Zampini       }
1424674ae819SStefano Zampini     } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
1425984c4197SStefano Zampini       PetscBool used_vertex;
1426674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1427674ae819SStefano Zampini         used_vertex = PETSC_FALSE;
1428674ae819SStefano Zampini         k = 0;
1429674ae819SStefano Zampini         while (!used_vertex && k<nnsp_size) {
1430984c4197SStefano Zampini           ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1431984c4197SStefano Zampini           if (PetscAbsScalar(array[is_indices[i]])>0.0) {
1432674ae819SStefano Zampini             temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1433674ae819SStefano Zampini             temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
1434674ae819SStefano Zampini             temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1435674ae819SStefano Zampini             temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1436674ae819SStefano Zampini             total_counts++;
1437674ae819SStefano Zampini             used_vertex = PETSC_TRUE;
1438674ae819SStefano Zampini           }
1439984c4197SStefano Zampini           ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1440674ae819SStefano Zampini           k++;
1441674ae819SStefano Zampini         }
1442674ae819SStefano Zampini       }
1443674ae819SStefano Zampini     }
1444674ae819SStefano Zampini     ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1445674ae819SStefano Zampini     n_vertices = total_counts;
1446674ae819SStefano Zampini   }
1447984c4197SStefano Zampini 
1448674ae819SStefano Zampini   /* edges and faces */
1449674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1450674ae819SStefano Zampini     if (i<n_ISForEdges) {
1451674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1452984c4197SStefano Zampini       boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
1453674ae819SStefano Zampini     } else {
1454674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1455984c4197SStefano Zampini       boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
1456674ae819SStefano Zampini     }
1457674ae819SStefano Zampini     temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
1458674ae819SStefano Zampini     temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
1459674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
1460674ae819SStefano Zampini     ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1461984c4197SStefano Zampini     /* change of basis should not be performed on local periodic nodes */
1462984c4197SStefano Zampini     if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
1463674ae819SStefano Zampini     if (nnsp_has_cnst) {
14645b08dc53SStefano Zampini       PetscScalar quad_value;
1465674ae819SStefano Zampini       temp_constraints++;
1466674ae819SStefano Zampini       quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
1467674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1468674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
1469674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
1470674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
1471674ae819SStefano Zampini       }
1472674ae819SStefano Zampini       temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
1473674ae819SStefano Zampini       total_counts++;
1474674ae819SStefano Zampini     }
1475674ae819SStefano Zampini     for (k=0;k<nnsp_size;k++) {
1476984c4197SStefano Zampini       PetscReal real_value;
1477984c4197SStefano Zampini       ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1478674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1479674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
1480674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
1481984c4197SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=array[is_indices[j]];
1482674ae819SStefano Zampini       }
1483984c4197SStefano Zampini       ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1484984c4197SStefano Zampini       /* check if array is null on the connected component */
1485e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1486e310c8b4SStefano Zampini       PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_one));
14875b08dc53SStefano Zampini       if (real_value > 0.0) { /* keep indices and values */
1488674ae819SStefano Zampini         temp_constraints++;
1489674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
1490674ae819SStefano Zampini         total_counts++;
1491674ae819SStefano Zampini       }
1492674ae819SStefano Zampini     }
1493674ae819SStefano Zampini     ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
149445a1bb75SStefano Zampini     valid_constraints = temp_constraints;
1495eb97c9d2SStefano 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 */
1496eb97c9d2SStefano Zampini     if (!pcbddc->use_nnsp_true && temp_constraints) {
1497984c4197SStefano Zampini       PetscReal tol = 1.0e-8; /* tolerance for retaining eigenmodes */
1498674ae819SStefano Zampini 
1499674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1500984c4197SStefano Zampini       /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
1501984c4197SStefano Zampini          POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
1502984c4197SStefano Zampini          -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
1503984c4197SStefano Zampini             the constraints basis will differ (by a complex factor with absolute value equal to 1)
1504984c4197SStefano Zampini             from that computed using LAPACKgesvd
1505984c4197SStefano Zampini          -> This is due to a different computation of eigenvectors in LAPACKheev
1506984c4197SStefano Zampini          -> The quality of the POD-computed basis will be the same */
1507984c4197SStefano Zampini       ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
1508674ae819SStefano Zampini       /* Store upper triangular part of correlation matrix */
1509e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1510984c4197SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1511674ae819SStefano Zampini       for (j=0;j<temp_constraints;j++) {
1512674ae819SStefano Zampini         for (k=0;k<j+1;k++) {
1513e310c8b4SStefano 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));
1514674ae819SStefano Zampini         }
1515674ae819SStefano Zampini       }
1516e310c8b4SStefano Zampini       /* compute eigenvalues and eigenvectors of correlation matrix */
1517e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1518e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
1519674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1520c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
1521674ae819SStefano Zampini #else
1522c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
1523674ae819SStefano Zampini #endif
1524674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1525984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
1526984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
1527674ae819SStefano Zampini       j=0;
1528984c4197SStefano Zampini       while (j < temp_constraints && singular_vals[j] < tol) j++;
1529674ae819SStefano Zampini       total_counts=total_counts-j;
153045a1bb75SStefano Zampini       valid_constraints = temp_constraints-j;
1531e310c8b4SStefano Zampini       /* scale and copy POD basis into used quadrature memory */
1532c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1533c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1534c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
1535c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1536c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
1537c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1538674ae819SStefano Zampini       if (j<temp_constraints) {
1539984c4197SStefano Zampini         PetscInt ii;
1540984c4197SStefano Zampini         for (k=j;k<temp_constraints;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]);
1541674ae819SStefano Zampini         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1542c4303822SStefano 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));
1543674ae819SStefano Zampini         ierr = PetscFPTrapPop();CHKERRQ(ierr);
1544984c4197SStefano Zampini         for (k=0;k<temp_constraints-j;k++) {
1545674ae819SStefano Zampini           for (ii=0;ii<size_of_constraint;ii++) {
1546984c4197SStefano 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];
1547674ae819SStefano Zampini           }
1548674ae819SStefano Zampini         }
1549674ae819SStefano Zampini       }
1550674ae819SStefano Zampini #else  /* on missing GESVD */
1551e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1552e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1553b7d8b9f8SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1554674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1555674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1556e310c8b4SStefano 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));
1557674ae819SStefano Zampini #else
1558e310c8b4SStefano 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));
1559674ae819SStefano Zampini #endif
1560984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
1561674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1562984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
1563e310c8b4SStefano Zampini       k = temp_constraints;
1564e310c8b4SStefano Zampini       if (k > size_of_constraint) k = size_of_constraint;
1565674ae819SStefano Zampini       j = 0;
1566e310c8b4SStefano Zampini       while (j < k && singular_vals[k-j-1] < tol) j++;
1567e310c8b4SStefano Zampini       total_counts = total_counts-temp_constraints+k-j;
156845a1bb75SStefano Zampini       valid_constraints = k-j;
1569984c4197SStefano Zampini #endif /* on missing GESVD */
1570674ae819SStefano Zampini     }
157145a1bb75SStefano Zampini     /* setting change_of_basis flag is safe now */
157245a1bb75SStefano Zampini     if (boolforchange) {
157345a1bb75SStefano Zampini       for (j=0;j<valid_constraints;j++) {
157445a1bb75SStefano Zampini         PetscBTSet(change_basis,total_counts-j-1);
157545a1bb75SStefano Zampini       }
157645a1bb75SStefano Zampini     }
1577674ae819SStefano Zampini   }
1578674ae819SStefano Zampini   /* free index sets of faces, edges and vertices */
1579674ae819SStefano Zampini   for (i=0;i<n_ISForFaces;i++) {
1580674ae819SStefano Zampini     ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
1581674ae819SStefano Zampini   }
1582674ae819SStefano Zampini   ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
1583674ae819SStefano Zampini   for (i=0;i<n_ISForEdges;i++) {
1584674ae819SStefano Zampini     ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
1585674ae819SStefano Zampini   }
1586674ae819SStefano Zampini   ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
1587674ae819SStefano Zampini   ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
1588674ae819SStefano Zampini 
1589984c4197SStefano Zampini   /* free workspace */
1590242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1591984c4197SStefano Zampini     ierr = PetscFree(work);CHKERRQ(ierr);
1592984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1593984c4197SStefano Zampini     ierr = PetscFree(rwork);CHKERRQ(ierr);
1594984c4197SStefano Zampini #endif
1595984c4197SStefano Zampini     ierr = PetscFree(singular_vals);CHKERRQ(ierr);
1596984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1597984c4197SStefano Zampini     ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
1598984c4197SStefano Zampini     ierr = PetscFree(temp_basis);CHKERRQ(ierr);
1599984c4197SStefano Zampini #endif
1600984c4197SStefano Zampini   }
1601984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1602984c4197SStefano Zampini     ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
1603984c4197SStefano Zampini   }
1604984c4197SStefano Zampini   ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
1605984c4197SStefano Zampini 
1606674ae819SStefano Zampini   /* set quantities in pcbddc data structure */
1607984c4197SStefano Zampini   /* n_vertices defines the number of subdomain corners in the primal space */
1608674ae819SStefano Zampini   /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */
1609984c4197SStefano Zampini   pcbddc->local_primal_size = total_counts;
1610674ae819SStefano Zampini   pcbddc->n_vertices = n_vertices;
1611984c4197SStefano Zampini   pcbddc->n_constraints = pcbddc->local_primal_size-pcbddc->n_vertices;
1612674ae819SStefano Zampini 
1613674ae819SStefano Zampini   /* Create constraint matrix */
1614674ae819SStefano Zampini   /* The constraint matrix is used to compute the l2g map of primal dofs */
1615674ae819SStefano Zampini   /* so we need to set it up properly either with or without change of basis */
1616674ae819SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1617674ae819SStefano Zampini   ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr);
1618984c4197SStefano Zampini   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
1619984c4197SStefano Zampini   /* array to compute a local numbering of constraints : vertices first then constraints */
1620984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_numbering);CHKERRQ(ierr);
1621984c4197SStefano Zampini   /* array to select the proper local node (of minimum index with respect to global ordering) when changing the basis */
1622984c4197SStefano 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 */
1623984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_minloc);CHKERRQ(ierr);
1624984c4197SStefano Zampini   /* auxiliary stuff for basis change */
1625984c4197SStefano Zampini   ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&global_indices);CHKERRQ(ierr);
16264641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n_B,&touched);CHKERRQ(ierr);
1627984c4197SStefano Zampini 
1628984c4197SStefano Zampini   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
1629984c4197SStefano Zampini   total_primal_vertices=0;
1630984c4197SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
1631674ae819SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
1632984c4197SStefano Zampini     if (size_of_constraint == 1) {
16334641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]]);CHKERRQ(ierr);
1634984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]];
1635984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=0;
1636984c4197SStefano Zampini       total_primal_vertices++;
16374641a718SStefano Zampini     } else if (PetscBTLookup(change_basis,i)) { /* Same procedure used in PCBDDCGetPrimalConstraintsLocalIdx */
1638984c4197SStefano Zampini       PetscInt min_loc,min_index;
1639984c4197SStefano Zampini       ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],global_indices);CHKERRQ(ierr);
1640984c4197SStefano Zampini       /* find first untouched local node */
1641674ae819SStefano Zampini       k = 0;
16424641a718SStefano Zampini       while (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) k++;
1643984c4197SStefano Zampini       min_index = global_indices[k];
1644984c4197SStefano Zampini       min_loc = k;
1645984c4197SStefano Zampini       /* search the minimum among global nodes already untouched on the cc */
1646984c4197SStefano Zampini       for (k=1;k<size_of_constraint;k++) {
1647984c4197SStefano Zampini         /* there can be more than one constraint on a single connected component */
16484641a718SStefano Zampini         if (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k]) && min_index > global_indices[k]) {
1649984c4197SStefano Zampini           min_index = global_indices[k];
1650984c4197SStefano Zampini           min_loc = k;
1651674ae819SStefano Zampini         }
1652674ae819SStefano Zampini       }
16534641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]+min_loc]);CHKERRQ(ierr);
1654984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]+min_loc];
1655984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=min_loc;
1656984c4197SStefano Zampini       total_primal_vertices++;
1657984c4197SStefano Zampini     }
1658984c4197SStefano Zampini   }
1659a717540cSStefano Zampini   /* determine if a QR strategy is needed for change of basis */
1660a717540cSStefano Zampini   qr_needed = PETSC_FALSE;
1661a717540cSStefano Zampini   ierr = PetscBTCreate(pcbddc->local_primal_size,&qr_needed_idx);CHKERRQ(ierr);
1662a717540cSStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1663a717540cSStefano Zampini     if (PetscBTLookup(change_basis,i)) {
1664a717540cSStefano Zampini       size_of_constraint = temp_indices[i+1]-temp_indices[i];
1665a717540cSStefano Zampini       j = 0;
1666a717540cSStefano Zampini       for (k=0;k<size_of_constraint;k++) {
1667a717540cSStefano Zampini         if (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) {
1668a717540cSStefano Zampini           j++;
1669a717540cSStefano Zampini         }
1670a717540cSStefano Zampini       }
1671a717540cSStefano Zampini       /* found more than one primal dof on the cc */
1672a717540cSStefano Zampini       if (j > 1) {
1673a717540cSStefano Zampini         PetscBTSet(qr_needed_idx,i);
1674a717540cSStefano Zampini         qr_needed = PETSC_TRUE;
1675a717540cSStefano Zampini       }
1676a717540cSStefano Zampini     }
1677a717540cSStefano Zampini   }
1678984c4197SStefano Zampini   /* free workspace */
1679984c4197SStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
168045a1bb75SStefano Zampini 
1681674ae819SStefano Zampini   /* permute indices in order to have a sorted set of vertices */
1682a717540cSStefano Zampini   ierr = PetscSortInt(total_primal_vertices,aux_primal_numbering);CHKERRQ(ierr);
1683984c4197SStefano Zampini 
1684984c4197SStefano Zampini   /* nonzero structure of constraint matrix */
1685984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1686984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) nnz[i]=1;
1687984c4197SStefano Zampini   j=total_primal_vertices;
1688984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
16894641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1690674ae819SStefano Zampini       nnz[j]=temp_indices[i+1]-temp_indices[i];
1691674ae819SStefano Zampini       j++;
1692674ae819SStefano Zampini     }
1693674ae819SStefano Zampini   }
1694674ae819SStefano Zampini   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
1695674ae819SStefano Zampini   ierr = PetscFree(nnz);CHKERRQ(ierr);
1696674ae819SStefano Zampini   /* set values in constraint matrix */
1697984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) {
1698984c4197SStefano Zampini     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,aux_primal_numbering[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
1699674ae819SStefano Zampini   }
1700984c4197SStefano Zampini   total_counts = total_primal_vertices;
1701984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
17024641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1703674ae819SStefano Zampini       size_of_constraint=temp_indices[i+1]-temp_indices[i];
1704674ae819SStefano 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);
1705674ae819SStefano Zampini       total_counts++;
1706674ae819SStefano Zampini     }
1707674ae819SStefano Zampini   }
1708674ae819SStefano Zampini   /* assembling */
1709674ae819SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1710674ae819SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1711984c4197SStefano Zampini   /*
171245a1bb75SStefano Zampini   ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
1713984c4197SStefano Zampini   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
1714984c4197SStefano Zampini   */
1715674ae819SStefano Zampini   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
1716674ae819SStefano Zampini   if (pcbddc->use_change_of_basis) {
1717026de310SStefano Zampini     /* dual and primal dofs on a single cc */
1718984c4197SStefano Zampini     PetscInt     dual_dofs,primal_dofs;
1719026de310SStefano Zampini     /* iterator on aux_primal_minloc (ordered as read from nearnullspace: vertices, edges and then constraints) */
1720026de310SStefano Zampini     PetscInt     primal_counter;
1721984c4197SStefano Zampini     /* working stuff for GEQRF */
1722984c4197SStefano Zampini     PetscScalar  *qr_basis,*qr_tau,*qr_work,lqr_work_t;
1723984c4197SStefano Zampini     PetscBLASInt lqr_work;
1724984c4197SStefano Zampini     /* working stuff for UNGQR */
1725984c4197SStefano Zampini     PetscScalar  *gqr_work,lgqr_work_t;
1726984c4197SStefano Zampini     PetscBLASInt lgqr_work;
1727984c4197SStefano Zampini     /* working stuff for TRTRS */
1728984c4197SStefano Zampini     PetscScalar  *trs_rhs;
17293f08241aSStefano Zampini     PetscBLASInt Blas_NRHS;
1730984c4197SStefano Zampini     /* pointers for values insertion into change of basis matrix */
1731984c4197SStefano Zampini     PetscInt     *start_rows,*start_cols;
1732984c4197SStefano Zampini     PetscScalar  *start_vals;
1733984c4197SStefano Zampini     /* working stuff for values insertion */
17344641a718SStefano Zampini     PetscBT      is_primal;
1735984c4197SStefano Zampini 
1736a717540cSStefano Zampini     /* change of basis acts on local interfaces -> dimension is n_B x n_B */
1737a717540cSStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
1738a717540cSStefano Zampini     ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr);
1739a717540cSStefano Zampini     ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr);
1740a717540cSStefano Zampini     /* work arrays */
1741a717540cSStefano Zampini     ierr = PetscMalloc(pcis->n_B*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1742a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) nnz[i]=1;
1743a717540cSStefano Zampini     /* nonzeros per row */
1744a717540cSStefano Zampini     for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1745a717540cSStefano Zampini       if (PetscBTLookup(change_basis,i)) {
1746a717540cSStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
1747a717540cSStefano Zampini         if (PetscBTLookup(qr_needed_idx,i)) {
1748a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1749a717540cSStefano Zampini         } else {
1750a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = 2;
1751a717540cSStefano Zampini           /* get local primal index on the cc */
1752a717540cSStefano Zampini           j = 0;
1753a717540cSStefano Zampini           while (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+j])) j++;
1754a717540cSStefano Zampini           nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1755a717540cSStefano Zampini         }
1756a717540cSStefano Zampini       }
1757a717540cSStefano Zampini     }
1758a717540cSStefano Zampini     ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
1759a717540cSStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
1760a717540cSStefano Zampini     /* Set initial identity in the matrix */
1761a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) {
1762a717540cSStefano Zampini       ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
1763a717540cSStefano Zampini     }
1764a717540cSStefano Zampini 
1765a717540cSStefano Zampini     if (pcbddc->dbg_flag) {
1766a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1767a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
1768a717540cSStefano Zampini     }
1769a717540cSStefano Zampini 
1770a717540cSStefano Zampini 
1771a717540cSStefano Zampini     /* Now we loop on the constraints which need a change of basis */
1772a717540cSStefano Zampini     /*
1773a717540cSStefano Zampini        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
1774a717540cSStefano Zampini        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
1775a717540cSStefano Zampini 
1776a717540cSStefano Zampini        Basic blocks of change of basis matrix T computed
1777a717540cSStefano Zampini 
1778a717540cSStefano Zampini           - Using the following block transformation if there is only a primal dof on the cc
1779a717540cSStefano Zampini             (in the example, primal dof is the last one of the edge in LOCAL ordering
1780a717540cSStefano Zampini              in this code, primal dof is the first one of the edge in GLOBAL ordering)
1781a717540cSStefano Zampini             | 1        0   ...        0     1 |
1782a717540cSStefano Zampini             | 0        1   ...        0     1 |
1783a717540cSStefano Zampini             |              ...                |
1784a717540cSStefano Zampini             | 0        ...            1     1 |
1785a717540cSStefano Zampini             | -s_1/s_n ...    -s_{n-1}/-s_n 1 |
1786a717540cSStefano Zampini 
1787a717540cSStefano Zampini           - via QR decomposition of constraints otherwise
1788a717540cSStefano Zampini     */
1789a717540cSStefano Zampini     if (qr_needed) {
1790984c4197SStefano Zampini       /* space to store Q */
1791984c4197SStefano Zampini       ierr = PetscMalloc((max_size_of_constraint)*(max_size_of_constraint)*sizeof(PetscScalar),&qr_basis);CHKERRQ(ierr);
1792984c4197SStefano Zampini       /* first we issue queries for optimal work */
17933f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
17943f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
17953f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1796984c4197SStefano Zampini       lqr_work = -1;
17973f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
1798984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
1799984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
1800984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lqr_work_t)*sizeof(*qr_work),&qr_work);CHKERRQ(ierr);
1801984c4197SStefano Zampini       lgqr_work = -1;
18023f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
18033f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
18043f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
18053f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
18063f08241aSStefano Zampini       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
18073f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
1808984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
1809984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
1810984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lgqr_work_t)*sizeof(*gqr_work),&gqr_work);CHKERRQ(ierr);
1811984c4197SStefano Zampini       /* array to store scaling factors for reflectors */
1812984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*sizeof(*qr_tau),&qr_tau);CHKERRQ(ierr);
1813984c4197SStefano Zampini       /* array to store rhs and solution of triangular solver */
1814984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*max_constraints*sizeof(*trs_rhs),&trs_rhs);CHKERRQ(ierr);
1815a717540cSStefano Zampini       /* allocating workspace for check */
1816a717540cSStefano Zampini       if (pcbddc->dbg_flag) {
1817a717540cSStefano Zampini         ierr = PetscMalloc(max_size_of_constraint*(max_constraints+max_size_of_constraint)*sizeof(*work),&work);CHKERRQ(ierr);
1818a717540cSStefano Zampini       }
1819a717540cSStefano Zampini     }
1820984c4197SStefano Zampini     /* array to store whether a node is primal or not */
18214641a718SStefano Zampini     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
18224641a718SStefano Zampini     for (i=0;i<total_primal_vertices;i++) {
18234641a718SStefano Zampini       ierr = PetscBTSet(is_primal,local_to_B[aux_primal_numbering[i]]);CHKERRQ(ierr);
18244641a718SStefano Zampini     }
1825984c4197SStefano Zampini 
1826a717540cSStefano Zampini     /* loop on constraints and see whether or not they need a change of basis and compute it */
1827026de310SStefano Zampini     /* -> using implicit ordering contained in temp_indices data */
1828026de310SStefano Zampini     total_counts = pcbddc->n_vertices;
1829026de310SStefano Zampini     primal_counter = total_counts;
1830026de310SStefano Zampini     while (total_counts<pcbddc->local_primal_size) {
1831026de310SStefano Zampini       primal_dofs = 1;
18324641a718SStefano Zampini       if (PetscBTLookup(change_basis,total_counts)) {
1833026de310SStefano Zampini         /* get all constraints with same support: if more then one constraint is present on the cc then surely indices are stored contiguosly */
1834026de310SStefano 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]]) {
1835026de310SStefano Zampini           primal_dofs++;
1836674ae819SStefano Zampini         }
1837984c4197SStefano Zampini         /* get constraint info */
1838026de310SStefano Zampini         size_of_constraint = temp_indices[total_counts+1]-temp_indices[total_counts];
1839984c4197SStefano Zampini         dual_dofs = size_of_constraint-primal_dofs;
1840984c4197SStefano Zampini 
1841984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
1842a717540cSStefano 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);
1843674ae819SStefano Zampini         }
1844984c4197SStefano Zampini 
1845a717540cSStefano Zampini         if (primal_dofs > 1) { /* QR */
1846a717540cSStefano Zampini 
1847a717540cSStefano Zampini           /* copy quadrature constraints for change of basis check */
1848a717540cSStefano Zampini           if (pcbddc->dbg_flag) {
1849a717540cSStefano Zampini             ierr = PetscMemcpy(work,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1850a717540cSStefano Zampini           }
1851984c4197SStefano Zampini           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
1852026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1853984c4197SStefano Zampini 
1854984c4197SStefano Zampini           /* compute QR decomposition of constraints */
18553f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
18563f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
18573f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1858674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
18593f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
1860984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
1861674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1862984c4197SStefano Zampini 
1863984c4197SStefano Zampini           /* explictly compute R^-T */
1864984c4197SStefano Zampini           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
1865984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
18663f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
18673f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
18683f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
18693f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
1870984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
18713f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
1872984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
1873984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1874984c4197SStefano Zampini 
1875a717540cSStefano Zampini           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
18763f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
18773f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
18783f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
18793f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1880984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
18813f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
1882984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
1883984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1884984c4197SStefano Zampini 
1885984c4197SStefano Zampini           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
1886984c4197SStefano Zampini              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
1887984c4197SStefano Zampini              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
18883f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
18893f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
18903f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
18913f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
18923f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
18933f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1894984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1895c4303822SStefano 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));
1896984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1897026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1898984c4197SStefano Zampini 
1899984c4197SStefano Zampini           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
1900026de310SStefano Zampini           start_rows = &temp_indices_to_constraint_B[temp_indices[total_counts]];
1901984c4197SStefano Zampini           /* insert cols for primal dofs */
1902984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) {
1903984c4197SStefano Zampini             start_vals = &qr_basis[j*size_of_constraint];
1904026de310SStefano Zampini             start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter+j]];
1905984c4197SStefano Zampini             ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1906984c4197SStefano Zampini           }
1907984c4197SStefano Zampini           /* insert cols for dual dofs */
1908984c4197SStefano Zampini           for (j=0,k=0;j<dual_dofs;k++) {
19094641a718SStefano Zampini             if (!PetscBTLookup(is_primal,temp_indices_to_constraint_B[temp_indices[total_counts]+k])) {
1910984c4197SStefano Zampini               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
1911026de310SStefano Zampini               start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+k];
1912984c4197SStefano Zampini               ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1913984c4197SStefano Zampini               j++;
1914674ae819SStefano Zampini             }
1915674ae819SStefano Zampini           }
1916984c4197SStefano Zampini 
1917984c4197SStefano Zampini           /* check change of basis */
1918984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
1919984c4197SStefano Zampini             PetscInt   ii,jj;
1920984c4197SStefano Zampini             PetscBool valid_qr=PETSC_TRUE;
1921c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
1922c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1923c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
1924c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1925c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
1926c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
1927984c4197SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1928c4303822SStefano 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));
1929984c4197SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
1930984c4197SStefano Zampini             for (jj=0;jj<size_of_constraint;jj++) {
1931984c4197SStefano Zampini               for (ii=0;ii<primal_dofs;ii++) {
1932984c4197SStefano Zampini                 if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
1933984c4197SStefano Zampini                 if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
1934674ae819SStefano Zampini               }
1935674ae819SStefano Zampini             }
1936984c4197SStefano Zampini             if (!valid_qr) {
1937984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
1938984c4197SStefano Zampini               for (jj=0;jj<size_of_constraint;jj++) {
1939984c4197SStefano Zampini                 for (ii=0;ii<primal_dofs;ii++) {
1940984c4197SStefano Zampini                   if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
1941984c4197SStefano 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]));
1942674ae819SStefano Zampini                   }
1943984c4197SStefano Zampini                   if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
1944984c4197SStefano 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]));
1945984c4197SStefano Zampini                   }
1946984c4197SStefano Zampini                 }
1947984c4197SStefano Zampini               }
1948674ae819SStefano Zampini             } else {
1949984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
1950674ae819SStefano Zampini             }
1951674ae819SStefano Zampini           }
1952a717540cSStefano Zampini         } else { /* simple transformation block */
1953a717540cSStefano Zampini           PetscInt row,col;
1954a717540cSStefano Zampini           PetscScalar val;
1955a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) {
1956a717540cSStefano Zampini             row = temp_indices_to_constraint_B[temp_indices[total_counts]+j];
1957a717540cSStefano Zampini             if (!PetscBTLookup(is_primal,row)) {
1958a717540cSStefano Zampini               col = temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
1959a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
1960a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,1.0,INSERT_VALUES);CHKERRQ(ierr);
1961a717540cSStefano Zampini             } else {
1962a717540cSStefano Zampini               for (k=0;k<size_of_constraint;k++) {
1963a717540cSStefano Zampini                 col = temp_indices_to_constraint_B[temp_indices[total_counts]+k];
1964a717540cSStefano Zampini                 if (row != col) {
1965a717540cSStefano Zampini                   val = -temp_quadrature_constraint[temp_indices[total_counts]+k]/temp_quadrature_constraint[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
1966a717540cSStefano Zampini                 } else {
1967a717540cSStefano Zampini                   val = 1.0;
1968a717540cSStefano Zampini                 }
1969a717540cSStefano Zampini                 ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
1970a717540cSStefano Zampini               }
1971a717540cSStefano Zampini             }
1972a717540cSStefano Zampini           }
1973a717540cSStefano Zampini         }
1974026de310SStefano Zampini         /* increment primal counter */
1975026de310SStefano Zampini         primal_counter += primal_dofs;
1976984c4197SStefano Zampini       } else {
1977984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
1978026de310SStefano 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);
1979674ae819SStefano Zampini         }
1980674ae819SStefano Zampini       }
1981026de310SStefano Zampini       /* increment constraint counter total_counts */
1982026de310SStefano Zampini       total_counts += primal_dofs;
1983674ae819SStefano Zampini     }
1984a717540cSStefano Zampini 
1985a717540cSStefano Zampini     /* free workspace */
1986a717540cSStefano Zampini     if (qr_needed) {
1987984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
1988984c4197SStefano Zampini         ierr = PetscFree(work);CHKERRQ(ierr);
1989984c4197SStefano Zampini       }
1990984c4197SStefano Zampini       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
1991984c4197SStefano Zampini       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
1992984c4197SStefano Zampini       ierr = PetscFree(qr_work);CHKERRQ(ierr);
1993984c4197SStefano Zampini       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
1994984c4197SStefano Zampini       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
1995674ae819SStefano Zampini     }
1996a717540cSStefano Zampini     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
1997674ae819SStefano Zampini     /* assembling */
1998674ae819SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1999674ae819SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2000984c4197SStefano Zampini     /*
200145a1bb75SStefano Zampini     ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
2002984c4197SStefano Zampini     ierr = MatView(pcbddc->ChangeOfBasisMatrix,(PetscViewer)0);CHKERRQ(ierr);
2003984c4197SStefano Zampini     */
2004674ae819SStefano Zampini   }
2005a717540cSStefano Zampini 
2006a717540cSStefano Zampini   /* flush dbg viewer */
2007b8ffe317SStefano Zampini   if (pcbddc->dbg_flag) {
2008b8ffe317SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2009b8ffe317SStefano Zampini   }
2010a717540cSStefano Zampini 
2011e310c8b4SStefano Zampini   /* free workspace */
2012a717540cSStefano Zampini   ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2013a717540cSStefano Zampini   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
2014984c4197SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2015984c4197SStefano Zampini   ierr = PetscFree(aux_primal_minloc);CHKERRQ(ierr);
2016674ae819SStefano Zampini   ierr = PetscFree(temp_indices);CHKERRQ(ierr);
20174641a718SStefano Zampini   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
2018674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr);
2019674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
2020674ae819SStefano Zampini   ierr = PetscFree(local_to_B);CHKERRQ(ierr);
2021674ae819SStefano Zampini   ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr);
2022674ae819SStefano Zampini   PetscFunctionReturn(0);
2023674ae819SStefano Zampini }
2024674ae819SStefano Zampini 
2025674ae819SStefano Zampini #undef __FUNCT__
2026674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
2027674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
2028674ae819SStefano Zampini {
2029674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
2030674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
2031674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
2032674ae819SStefano Zampini   PetscInt    bs,ierr,i,vertex_size;
2033674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
2034674ae819SStefano Zampini 
2035674ae819SStefano Zampini   PetscFunctionBegin;
2036674ae819SStefano Zampini   /* Init local Graph struct */
2037674ae819SStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr);
2038674ae819SStefano Zampini 
2039575ad6abSStefano Zampini   /* Check validity of the csr graph passed in by the user */
2040575ad6abSStefano Zampini   if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) {
2041575ad6abSStefano Zampini     ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
2042575ad6abSStefano Zampini   }
20439577ea80SStefano Zampini 
2044674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
2045674ae819SStefano Zampini   if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) {
2046674ae819SStefano Zampini     Mat mat_adj;
2047674ae819SStefano Zampini     const PetscInt *xadj,*adjncy;
2048674ae819SStefano Zampini     PetscBool flg_row=PETSC_TRUE;
2049674ae819SStefano Zampini 
2050674ae819SStefano Zampini     ierr = MatConvert(matis->A,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr);
2051674ae819SStefano Zampini     ierr = MatGetRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2052674ae819SStefano Zampini     if (!flg_row) {
2053674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ called in %s\n",__FUNCT__);
2054674ae819SStefano Zampini     }
2055674ae819SStefano Zampini     ierr = PCBDDCSetLocalAdjacencyGraph(pc,i,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
2056674ae819SStefano Zampini     ierr = MatRestoreRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2057674ae819SStefano Zampini     if (!flg_row) {
2058674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__);
2059674ae819SStefano Zampini     }
2060674ae819SStefano Zampini     ierr = MatDestroy(&mat_adj);CHKERRQ(ierr);
2061674ae819SStefano Zampini   }
2062674ae819SStefano Zampini 
2063674ae819SStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting */
2064674ae819SStefano Zampini   vertex_size = 1;
20659577ea80SStefano Zampini   if (!pcbddc->user_provided_isfordofs) {
2066674ae819SStefano Zampini     if (!pcbddc->n_ISForDofs) {
2067674ae819SStefano Zampini       IS *custom_ISForDofs;
2068674ae819SStefano Zampini 
2069674ae819SStefano Zampini       ierr = MatGetBlockSize(matis->A,&bs);CHKERRQ(ierr);
2070674ae819SStefano Zampini       ierr = PetscMalloc(bs*sizeof(IS),&custom_ISForDofs);CHKERRQ(ierr);
2071674ae819SStefano Zampini       for (i=0;i<bs;i++) {
2072674ae819SStefano Zampini         ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n/bs,i,bs,&custom_ISForDofs[i]);CHKERRQ(ierr);
2073674ae819SStefano Zampini       }
2074674ae819SStefano Zampini       ierr = PCBDDCSetDofsSplitting(pc,bs,custom_ISForDofs);CHKERRQ(ierr);
20759577ea80SStefano Zampini       pcbddc->user_provided_isfordofs = PETSC_FALSE;
2076674ae819SStefano Zampini       /* remove my references to IS objects */
2077674ae819SStefano Zampini       for (i=0;i<bs;i++) {
2078674ae819SStefano Zampini         ierr = ISDestroy(&custom_ISForDofs[i]);CHKERRQ(ierr);
2079674ae819SStefano Zampini       }
2080674ae819SStefano Zampini       ierr = PetscFree(custom_ISForDofs);CHKERRQ(ierr);
20819577ea80SStefano Zampini     }
20829577ea80SStefano Zampini   } else { /* mat block size as vertex size (used for elasticity with rigid body modes as nearnullspace) */
2083674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
2084674ae819SStefano Zampini   }
2085674ae819SStefano Zampini 
2086674ae819SStefano Zampini   /* Setup of Graph */
2087674ae819SStefano Zampini   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundaries,pcbddc->DirichletBoundaries,pcbddc->n_ISForDofs,pcbddc->ISForDofs,pcbddc->user_primal_vertices);
2088674ae819SStefano Zampini 
2089674ae819SStefano Zampini   /* Graph's connected components analysis */
2090674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
2091674ae819SStefano Zampini 
2092674ae819SStefano Zampini   /* print some info to stdout */
2093674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
2094e49050b4SStefano Zampini     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer);
2095674ae819SStefano Zampini   }
2096674ae819SStefano Zampini   PetscFunctionReturn(0);
2097674ae819SStefano Zampini }
2098674ae819SStefano Zampini 
2099674ae819SStefano Zampini #undef __FUNCT__
2100674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx"
2101f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt **vertices_idx)
2102674ae819SStefano Zampini {
2103674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2104674ae819SStefano Zampini   PetscInt       *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size;
2105674ae819SStefano Zampini   PetscErrorCode ierr;
2106674ae819SStefano Zampini 
2107674ae819SStefano Zampini   PetscFunctionBegin;
2108674ae819SStefano Zampini   n = 0;
2109674ae819SStefano Zampini   vertices = 0;
2110674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2111674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr);
2112b120a5c6SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2113b120a5c6SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2114b120a5c6SStefano Zampini       if (size_of_constraint == 1) n++;
2115b120a5c6SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2116b120a5c6SStefano Zampini     }
2117811e8ca2SStefano Zampini     if (vertices_idx) {
2118b120a5c6SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&vertices);CHKERRQ(ierr);
2119b120a5c6SStefano Zampini       n = 0;
2120674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2121674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2122674ae819SStefano Zampini         if (size_of_constraint == 1) {
2123674ae819SStefano Zampini           vertices[n++]=row_cmat_indices[0];
2124674ae819SStefano Zampini         }
2125674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2126674ae819SStefano Zampini       }
2127674ae819SStefano Zampini     }
2128811e8ca2SStefano Zampini   }
2129674ae819SStefano Zampini   *n_vertices = n;
2130811e8ca2SStefano Zampini   if (vertices_idx) *vertices_idx = vertices;
2131674ae819SStefano Zampini   PetscFunctionReturn(0);
2132674ae819SStefano Zampini }
2133674ae819SStefano Zampini 
2134674ae819SStefano Zampini #undef __FUNCT__
2135674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx"
2136f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt **constraints_idx)
2137674ae819SStefano Zampini {
2138674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2139674ae819SStefano Zampini   PetscInt       *constraints_index,*row_cmat_indices,*row_cmat_global_indices;
2140674ae819SStefano Zampini   PetscInt       n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc;
21414641a718SStefano Zampini   PetscBT        touched;
2142674ae819SStefano Zampini   PetscErrorCode ierr;
2143674ae819SStefano Zampini 
2144f34684f1SStefano Zampini     /* This function assumes that the number of local constraints per connected component
2145f34684f1SStefano Zampini        is not greater than the number of nodes defined for the connected component
2146f34684f1SStefano Zampini        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
2147674ae819SStefano Zampini   PetscFunctionBegin;
2148674ae819SStefano Zampini   n = 0;
2149674ae819SStefano Zampini   constraints_index = 0;
2150674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2151674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr);
2152674ae819SStefano Zampini     max_size_of_constraint = 0;
2153674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2154674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2155674ae819SStefano Zampini       if (size_of_constraint > 1) {
2156674ae819SStefano Zampini         n++;
2157674ae819SStefano Zampini       }
2158674ae819SStefano Zampini       max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint);
2159674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2160674ae819SStefano Zampini     }
2161811e8ca2SStefano Zampini     if (constraints_idx) {
2162674ae819SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&constraints_index);CHKERRQ(ierr);
2163674ae819SStefano Zampini       ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&row_cmat_global_indices);CHKERRQ(ierr);
21644641a718SStefano Zampini       ierr = PetscBTCreate(local_size,&touched);CHKERRQ(ierr);
2165674ae819SStefano Zampini       n = 0;
2166674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2167674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2168674ae819SStefano Zampini         if (size_of_constraint > 1) {
2169674ae819SStefano Zampini           ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr);
217082d3d8afSStefano Zampini           /* find first untouched local node */
217182d3d8afSStefano Zampini           j = 0;
21724641a718SStefano Zampini           while (PetscBTLookup(touched,row_cmat_indices[j])) j++;
217382d3d8afSStefano Zampini           min_index = row_cmat_global_indices[j];
217482d3d8afSStefano Zampini           min_loc = j;
217582d3d8afSStefano Zampini           /* search the minimum among nodes not yet touched on the connected component
217682d3d8afSStefano Zampini              since there can be more than one constraint on a single cc */
2177674ae819SStefano Zampini           for (j=1;j<size_of_constraint;j++) {
21784641a718SStefano Zampini             if (!PetscBTLookup(touched,row_cmat_indices[j]) && min_index > row_cmat_global_indices[j]) {
2179674ae819SStefano Zampini               min_index = row_cmat_global_indices[j];
2180674ae819SStefano Zampini               min_loc = j;
2181674ae819SStefano Zampini             }
2182674ae819SStefano Zampini           }
21834641a718SStefano Zampini           ierr = PetscBTSet(touched,row_cmat_indices[min_loc]);CHKERRQ(ierr);
2184674ae819SStefano Zampini           constraints_index[n++] = row_cmat_indices[min_loc];
2185674ae819SStefano Zampini         }
2186674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2187674ae819SStefano Zampini       }
21884641a718SStefano Zampini       ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2189674ae819SStefano Zampini       ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr);
2190811e8ca2SStefano Zampini     }
2191811e8ca2SStefano Zampini   }
2192674ae819SStefano Zampini   *n_constraints = n;
2193811e8ca2SStefano Zampini   if (constraints_idx) *constraints_idx = constraints_index;
2194674ae819SStefano Zampini   PetscFunctionReturn(0);
2195674ae819SStefano Zampini }
2196674ae819SStefano Zampini 
2197674ae819SStefano Zampini /* the next two functions has been adapted from pcis.c */
2198674ae819SStefano Zampini #undef __FUNCT__
2199674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchur"
2200674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchur(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2201674ae819SStefano Zampini {
2202674ae819SStefano Zampini   PetscErrorCode ierr;
2203674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2204674ae819SStefano Zampini 
2205674ae819SStefano Zampini   PetscFunctionBegin;
2206674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2207674ae819SStefano Zampini   ierr = MatMult(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2208674ae819SStefano Zampini   ierr = MatMult(pcis->A_IB,v,vec1_D);CHKERRQ(ierr);
2209674ae819SStefano Zampini   ierr = KSPSolve(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2210674ae819SStefano Zampini   ierr = MatMult(pcis->A_BI,vec2_D,vec2_B);CHKERRQ(ierr);
2211674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2212674ae819SStefano Zampini   PetscFunctionReturn(0);
2213674ae819SStefano Zampini }
2214674ae819SStefano Zampini 
2215674ae819SStefano Zampini #undef __FUNCT__
2216674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchurTranspose"
2217674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchurTranspose(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2218674ae819SStefano Zampini {
2219674ae819SStefano Zampini   PetscErrorCode ierr;
2220674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2221674ae819SStefano Zampini 
2222674ae819SStefano Zampini   PetscFunctionBegin;
2223674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2224674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2225674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BI,v,vec1_D);CHKERRQ(ierr);
2226674ae819SStefano Zampini   ierr = KSPSolveTranspose(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2227674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_IB,vec2_D,vec2_B);CHKERRQ(ierr);
2228674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2229674ae819SStefano Zampini   PetscFunctionReturn(0);
2230674ae819SStefano Zampini }
2231674ae819SStefano Zampini 
2232674ae819SStefano Zampini #undef __FUNCT__
2233674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
2234674ae819SStefano 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[])
2235674ae819SStefano Zampini {
2236674ae819SStefano Zampini   Vec            local_vec,global_vec;
2237674ae819SStefano Zampini   IS             seqis,paris;
2238674ae819SStefano Zampini   VecScatter     scatter_ctx;
2239674ae819SStefano Zampini   PetscScalar    *array;
2240674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
2241674ae819SStefano Zampini   PetscScalar    globalsum;
2242674ae819SStefano Zampini   PetscInt       i,j,s;
2243674ae819SStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local;
2244674ae819SStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm,max_global;
2245674ae819SStefano Zampini   PetscMPIInt    *dof_sizes,*dof_displs;
2246674ae819SStefano Zampini   PetscBool      first_found;
2247674ae819SStefano Zampini   PetscErrorCode ierr;
2248674ae819SStefano Zampini 
2249674ae819SStefano Zampini   PetscFunctionBegin;
2250674ae819SStefano Zampini   /* mpi buffers */
2251674ae819SStefano Zampini   MPI_Comm_size(comm,&size_prec_comm);
2252674ae819SStefano Zampini   MPI_Comm_rank(comm,&rank_prec_comm);
2253674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
2254674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_sizes),&dof_sizes);CHKERRQ(ierr);
2255674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_displs),&dof_displs);CHKERRQ(ierr);
2256674ae819SStefano Zampini   /* get maximum size of subset */
2257674ae819SStefano Zampini   ierr = PetscMalloc(n_local_dofs*sizeof(PetscInt),&temp_global_dofs);CHKERRQ(ierr);
2258674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
2259674ae819SStefano Zampini   max_local = 0;
2260674ae819SStefano Zampini   if (n_local_dofs) {
2261674ae819SStefano Zampini     max_local = temp_global_dofs[0];
2262674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2263674ae819SStefano Zampini       if (max_local < temp_global_dofs[i] ) {
2264674ae819SStefano Zampini         max_local = temp_global_dofs[i];
2265674ae819SStefano Zampini       }
2266674ae819SStefano Zampini     }
2267674ae819SStefano Zampini   }
2268674ae819SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);
2269674ae819SStefano Zampini   max_global++;
2270674ae819SStefano Zampini   max_local = 0;
2271674ae819SStefano Zampini   if (n_local_dofs) {
2272674ae819SStefano Zampini     max_local = local_dofs[0];
2273674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2274674ae819SStefano Zampini       if (max_local < local_dofs[i] ) {
2275674ae819SStefano Zampini         max_local = local_dofs[i];
2276674ae819SStefano Zampini       }
2277674ae819SStefano Zampini     }
2278674ae819SStefano Zampini   }
2279674ae819SStefano Zampini   max_local++;
2280674ae819SStefano Zampini   /* allocate workspace */
2281674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
2282674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
2283674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
2284674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
2285674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
2286674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
2287674ae819SStefano Zampini   /* create scatter */
2288674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
2289674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
2290674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
2291674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
2292674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
2293674ae819SStefano Zampini   /* init array */
2294674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
2295674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2296674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2297674ae819SStefano Zampini   if (local_dofs_mult) {
2298674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2299674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
2300674ae819SStefano Zampini     }
2301674ae819SStefano Zampini   } else {
2302674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2303674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
2304674ae819SStefano Zampini     }
2305674ae819SStefano Zampini   }
2306674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2307674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
2308674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2309674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2310674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
23115b08dc53SStefano Zampini   *n_global_subset = (PetscInt)PetscRealPart(globalsum);
2312674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
2313674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
2314674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
2315674ae819SStefano Zampini   nlocals = 0;
2316674ae819SStefano Zampini   first_index = -1;
2317674ae819SStefano Zampini   first_found = PETSC_FALSE;
2318674ae819SStefano Zampini   for (i=0;i<s;i++) {
23195b08dc53SStefano Zampini     if (!first_found && PetscRealPart(array[i]) > 0.0) {
2320674ae819SStefano Zampini       first_found = PETSC_TRUE;
2321674ae819SStefano Zampini       first_index = i;
2322674ae819SStefano Zampini     }
23235b08dc53SStefano Zampini     nlocals += (PetscInt)PetscRealPart(array[i]);
2324674ae819SStefano Zampini   }
2325674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2326674ae819SStefano Zampini   if (!rank_prec_comm) {
2327674ae819SStefano Zampini     dof_displs[0]=0;
2328674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
2329674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
2330674ae819SStefano Zampini     }
2331674ae819SStefano Zampini   }
2332674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2333674ae819SStefano Zampini   if (first_found) {
2334674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
2335674ae819SStefano Zampini     old_index = first_index;
2336674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
23375b08dc53SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) {
2338674ae819SStefano Zampini         array[i] += array[old_index];
2339674ae819SStefano Zampini         old_index = i;
2340674ae819SStefano Zampini       }
2341674ae819SStefano Zampini     }
2342674ae819SStefano Zampini   }
2343674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
2344674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2345674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2346674ae819SStefano Zampini   ierr = VecScatterEnd  (scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2347674ae819SStefano Zampini   /* get global ordering of local dofs */
2348674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2349674ae819SStefano Zampini   if (local_dofs_mult) {
2350674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
23515b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i];
2352674ae819SStefano Zampini     }
2353674ae819SStefano Zampini   } else {
2354674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
23555b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1;
2356674ae819SStefano Zampini     }
2357674ae819SStefano Zampini   }
2358674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2359674ae819SStefano Zampini   /* free workspace */
2360674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
2361674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
2362674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
2363674ae819SStefano Zampini   ierr = PetscFree(dof_sizes);CHKERRQ(ierr);
2364674ae819SStefano Zampini   ierr = PetscFree(dof_displs);CHKERRQ(ierr);
2365674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
2366674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
2367674ae819SStefano Zampini   PetscFunctionReturn(0);
2368674ae819SStefano Zampini }
23699a7d3425SStefano Zampini 
23709a7d3425SStefano Zampini #undef __FUNCT__
23719a7d3425SStefano Zampini #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
23729a7d3425SStefano Zampini PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
23739a7d3425SStefano Zampini {
23749a7d3425SStefano Zampini   PetscInt       i,j;
23759a7d3425SStefano Zampini   PetscScalar    *alphas;
23769a7d3425SStefano Zampini   PetscErrorCode ierr;
23779a7d3425SStefano Zampini 
23789a7d3425SStefano Zampini   PetscFunctionBegin;
23799a7d3425SStefano Zampini   /* this implements stabilized Gram-Schmidt */
23809a7d3425SStefano Zampini   ierr = PetscMalloc(n*sizeof(PetscScalar),&alphas);CHKERRQ(ierr);
23819a7d3425SStefano Zampini   for (i=0;i<n;i++) {
23829a7d3425SStefano Zampini     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
23839a7d3425SStefano Zampini     if (i<n) { ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],&alphas[i+1]);CHKERRQ(ierr); }
23849a7d3425SStefano Zampini     for (j=i+1;j<n;j++) { ierr = VecAXPY(vecs[j],PetscConj(-alphas[j]),vecs[i]);CHKERRQ(ierr); }
23859a7d3425SStefano Zampini   }
23869a7d3425SStefano Zampini   ierr = PetscFree(alphas);CHKERRQ(ierr);
23879a7d3425SStefano Zampini   PetscFunctionReturn(0);
23889a7d3425SStefano Zampini }
23899a7d3425SStefano Zampini 
2390a57a6d2fSStefano Zampini /* Currently support MAT_INITIAL_MATRIX only, with partial support to block matrices */
2391c8587f34SStefano Zampini #undef __FUNCT__
2392a57a6d2fSStefano Zampini #define __FUNCT__ "MatConvert_IS_AIJ"
2393a57a6d2fSStefano Zampini static PetscErrorCode MatConvert_IS_AIJ(Mat mat, MatType newtype,MatReuse reuse,Mat *M)
2394c8587f34SStefano Zampini {
2395a57a6d2fSStefano Zampini   Mat new_mat;
2396a57a6d2fSStefano Zampini   Mat_IS *matis = (Mat_IS*)(mat->data);
2397a57a6d2fSStefano Zampini   /* info on mat */
2398a57a6d2fSStefano Zampini   PetscInt bs,rows,cols;
2399a57a6d2fSStefano Zampini   PetscInt lrows,lcols;
2400a57a6d2fSStefano Zampini   PetscInt local_rows,local_cols;
2401e7931f94SStefano Zampini   PetscMPIInt nsubdomains;
2402c8587f34SStefano Zampini   /* preallocation */
2403c8587f34SStefano Zampini   Vec vec_dnz,vec_onz;
2404c8587f34SStefano Zampini   PetscScalar *my_dnz,*my_onz,*array;
2405a57a6d2fSStefano Zampini   PetscInt *dnz,*onz,*mat_ranges,*row_ownership;
2406a57a6d2fSStefano Zampini   PetscInt  index_row,index_col,owner;
2407a57a6d2fSStefano Zampini   PetscInt  *local_indices,*global_indices;
2408a57a6d2fSStefano Zampini   /* work */
2409a57a6d2fSStefano Zampini   PetscInt i,j;
2410a57a6d2fSStefano Zampini   PetscErrorCode ierr;
2411c8587f34SStefano Zampini 
2412a57a6d2fSStefano Zampini   PetscFunctionBegin;
2413a57a6d2fSStefano Zampini   /* CHECKS */
2414a57a6d2fSStefano Zampini   /* get info from mat */
2415a57a6d2fSStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
2416a57a6d2fSStefano Zampini   ierr = MatGetBlockSize(mat,&bs);CHKERRQ(ierr);
2417a57a6d2fSStefano Zampini   ierr = MatGetSize(matis->A,&local_rows,&local_cols);CHKERRQ(ierr);
2418a57a6d2fSStefano Zampini   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&nsubdomains);CHKERRQ(ierr);
2419a57a6d2fSStefano Zampini 
2420a57a6d2fSStefano Zampini   /* MAT_INITIAL_MATRIX */
2421a57a6d2fSStefano Zampini   ierr = MatCreate(PetscObjectComm((PetscObject)mat),&new_mat);CHKERRQ(ierr);
2422a57a6d2fSStefano Zampini   ierr = MatSetSizes(new_mat,PETSC_DECIDE,PETSC_DECIDE,rows,cols);CHKERRQ(ierr);
2423a57a6d2fSStefano Zampini   ierr = MatSetBlockSize(new_mat,bs);CHKERRQ(ierr);
2424a57a6d2fSStefano Zampini   ierr = MatSetType(new_mat,newtype);CHKERRQ(ierr);
2425a57a6d2fSStefano Zampini   ierr = MatSetUp(new_mat);CHKERRQ(ierr);
2426a57a6d2fSStefano Zampini   ierr = MatGetLocalSize(new_mat,&lrows,&lcols);CHKERRQ(ierr);
2427a57a6d2fSStefano Zampini 
2428a57a6d2fSStefano Zampini   /*
2429a57a6d2fSStefano Zampini     preallocation
2430a57a6d2fSStefano Zampini   */
2431a57a6d2fSStefano Zampini 
2432a57a6d2fSStefano Zampini   ierr = MatPreallocateInitialize(PetscObjectComm((PetscObject)new_mat),lrows,lcols,dnz,onz);CHKERRQ(ierr);
2433a57a6d2fSStefano Zampini   /*
2434a57a6d2fSStefano Zampini      Some vectors are needed to sum up properly on shared interface dofs.
2435a57a6d2fSStefano Zampini      Note that preallocation is not exact, since it overestimates nonzeros
2436a57a6d2fSStefano Zampini   */
2437a57a6d2fSStefano Zampini /*
2438a57a6d2fSStefano Zampini   ierr = VecCreate(PetscObjectComm((PetscObject)mat),&vec_dnz);CHKERRQ(ierr);
2439c8587f34SStefano Zampini   ierr = VecSetBlockSize(vec_dnz,bs);CHKERRQ(ierr);
2440a57a6d2fSStefano Zampini   ierr = VecSetSizes(vec_dnz,PETSC_DECIDE,rows);CHKERRQ(ierr);
2441a57a6d2fSStefano Zampini   ierr = VecSetType(vec_dnz,VECSTANDARD);CHKERRQ(ierr);
2442a57a6d2fSStefano Zampini */
2443a57a6d2fSStefano Zampini   ierr = MatGetVecs(new_mat,NULL,&vec_dnz);CHKERRQ(ierr);
2444c8587f34SStefano Zampini   ierr = VecDuplicate(vec_dnz,&vec_onz);CHKERRQ(ierr);
2445e7931f94SStefano Zampini   /* All processes need to compute entire row ownership */
2446a57a6d2fSStefano Zampini   ierr = PetscMalloc(rows*sizeof(*row_ownership),&row_ownership);CHKERRQ(ierr);
2447a57a6d2fSStefano Zampini   ierr = MatGetOwnershipRanges(new_mat,(const PetscInt**)&mat_ranges);CHKERRQ(ierr);
2448a57a6d2fSStefano Zampini   for (i=0;i<nsubdomains;i++) {
2449c8587f34SStefano Zampini     for (j=mat_ranges[i];j<mat_ranges[i+1];j++) {
2450c8587f34SStefano Zampini       row_ownership[j]=i;
2451c8587f34SStefano Zampini     }
2452c8587f34SStefano Zampini   }
2453a57a6d2fSStefano Zampini   /* map indices of local mat to global values */
2454a57a6d2fSStefano Zampini   ierr = PetscMalloc(PetscMax(local_cols,local_rows)*sizeof(*global_indices),&global_indices);CHKERRQ(ierr);
2455a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*local_indices),&local_indices);CHKERRQ(ierr);
2456a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) local_indices[i]=i;
2457a57a6d2fSStefano Zampini   ierr = ISLocalToGlobalMappingApply(matis->mapping,local_rows,local_indices,global_indices);CHKERRQ(ierr);
2458a57a6d2fSStefano Zampini   ierr = PetscFree(local_indices);CHKERRQ(ierr);
2459c8587f34SStefano Zampini 
2460e7931f94SStefano Zampini   /*
2461e7931f94SStefano Zampini      my_dnz and my_onz contains exact contribution to preallocation from each local mat
2462e7931f94SStefano Zampini      then, they will be summed up properly. This way, preallocation is always sufficient
2463e7931f94SStefano Zampini   */
2464a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*my_dnz),&my_dnz);CHKERRQ(ierr);
2465a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*my_onz),&my_onz);CHKERRQ(ierr);
2466a57a6d2fSStefano Zampini   ierr = PetscMemzero(my_dnz,local_rows*sizeof(*my_dnz));CHKERRQ(ierr);
2467a57a6d2fSStefano Zampini   ierr = PetscMemzero(my_onz,local_rows*sizeof(*my_onz));CHKERRQ(ierr);
2468a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) {
2469a57a6d2fSStefano Zampini     index_row = global_indices[i];
2470a57a6d2fSStefano Zampini     for (j=i;j<local_rows;j++) {
2471a57a6d2fSStefano Zampini       owner = row_ownership[index_row];
2472a57a6d2fSStefano Zampini       index_col = global_indices[j];
2473a57a6d2fSStefano Zampini       if (index_col > mat_ranges[owner]-1 && index_col < mat_ranges[owner+1] ) { /* diag block */
2474c8587f34SStefano Zampini         my_dnz[i] += 1.0;
2475a57a6d2fSStefano Zampini       } else { /* offdiag block */
2476c8587f34SStefano Zampini         my_onz[i] += 1.0;
2477c8587f34SStefano Zampini       }
2478a57a6d2fSStefano Zampini       /* same as before, interchanging rows and cols */
2479c8587f34SStefano Zampini       if (i != j) {
2480a57a6d2fSStefano Zampini         owner = row_ownership[index_col];
2481a57a6d2fSStefano Zampini         if (index_row > mat_ranges[owner]-1 && index_row < mat_ranges[owner+1] ) {
2482c8587f34SStefano Zampini           my_dnz[j] += 1.0;
2483c8587f34SStefano Zampini         } else {
2484c8587f34SStefano Zampini           my_onz[j] += 1.0;
2485c8587f34SStefano Zampini         }
2486c8587f34SStefano Zampini       }
2487c8587f34SStefano Zampini     }
2488c8587f34SStefano Zampini   }
2489c8587f34SStefano Zampini   ierr = VecSet(vec_dnz,0.0);CHKERRQ(ierr);
2490c8587f34SStefano Zampini   ierr = VecSet(vec_onz,0.0);CHKERRQ(ierr);
249120a2ab83SStefano Zampini   if (local_rows) { /* multilevel guard */
2492a57a6d2fSStefano Zampini     ierr = VecSetValues(vec_dnz,local_rows,global_indices,my_dnz,ADD_VALUES);CHKERRQ(ierr);
2493a57a6d2fSStefano Zampini     ierr = VecSetValues(vec_onz,local_rows,global_indices,my_onz,ADD_VALUES);CHKERRQ(ierr);
2494c8587f34SStefano Zampini   }
2495c8587f34SStefano Zampini   ierr = VecAssemblyBegin(vec_dnz);CHKERRQ(ierr);
2496c8587f34SStefano Zampini   ierr = VecAssemblyBegin(vec_onz);CHKERRQ(ierr);
2497c8587f34SStefano Zampini   ierr = VecAssemblyEnd(vec_dnz);CHKERRQ(ierr);
2498c8587f34SStefano Zampini   ierr = VecAssemblyEnd(vec_onz);CHKERRQ(ierr);
2499c8587f34SStefano Zampini   ierr = PetscFree(my_dnz);CHKERRQ(ierr);
2500c8587f34SStefano Zampini   ierr = PetscFree(my_onz);CHKERRQ(ierr);
2501c8587f34SStefano Zampini   ierr = PetscFree(row_ownership);CHKERRQ(ierr);
2502a57a6d2fSStefano Zampini 
2503a57a6d2fSStefano Zampini   /* set computed preallocation in dnz and onz */
2504a57a6d2fSStefano Zampini   ierr = VecGetArray(vec_dnz,&array);CHKERRQ(ierr);
2505a57a6d2fSStefano Zampini   for (i=0; i<lrows; i++) dnz[i] = (PetscInt)PetscRealPart(array[i]);
2506a57a6d2fSStefano Zampini   ierr = VecRestoreArray(vec_dnz,&array);CHKERRQ(ierr);
2507a57a6d2fSStefano Zampini   ierr = VecGetArray(vec_onz,&array);CHKERRQ(ierr);
2508a57a6d2fSStefano Zampini   for (i=0;i<lrows;i++) onz[i] = (PetscInt)PetscRealPart(array[i]);
2509a57a6d2fSStefano Zampini   ierr = VecRestoreArray(vec_onz,&array);CHKERRQ(ierr);
2510c8587f34SStefano Zampini   ierr = VecDestroy(&vec_dnz);CHKERRQ(ierr);
2511c8587f34SStefano Zampini   ierr = VecDestroy(&vec_onz);CHKERRQ(ierr);
2512c8587f34SStefano Zampini 
2513e7931f94SStefano Zampini   /* Resize preallocation if overestimated */
2514c8587f34SStefano Zampini   for (i=0;i<lrows;i++) {
2515a57a6d2fSStefano Zampini     dnz[i] = PetscMin(dnz[i],lcols);
2516a57a6d2fSStefano Zampini     onz[i] = PetscMin(onz[i],cols-lcols);
2517c8587f34SStefano Zampini   }
2518a57a6d2fSStefano Zampini   ierr = MatMPIAIJSetPreallocation(new_mat,0,dnz,0,onz);CHKERRQ(ierr);
2519c8587f34SStefano Zampini   ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
2520a57a6d2fSStefano Zampini 
2521a57a6d2fSStefano Zampini   /*
2522e7931f94SStefano Zampini     Set values. Very Basic.
2523a57a6d2fSStefano Zampini   */
2524a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) {
2525a57a6d2fSStefano Zampini     ierr = MatGetRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2526a57a6d2fSStefano Zampini     ierr = ISLocalToGlobalMappingApply(matis->mapping,j,local_indices,global_indices);CHKERRQ(ierr);
2527a57a6d2fSStefano Zampini     ierr = ISLocalToGlobalMappingApply(matis->mapping,1,&i,&index_row);CHKERRQ(ierr);
2528a57a6d2fSStefano Zampini     ierr = MatSetValues(new_mat,1,&index_row,j,global_indices,array,ADD_VALUES);CHKERRQ(ierr);
2529a57a6d2fSStefano Zampini     ierr = MatRestoreRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2530a57a6d2fSStefano Zampini   }
253120a2ab83SStefano Zampini   ierr = MatAssemblyBegin(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2532a57a6d2fSStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
253320a2ab83SStefano Zampini   ierr = MatAssemblyEnd(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2534a57a6d2fSStefano Zampini 
2535a57a6d2fSStefano Zampini   /* get back mat */
2536a57a6d2fSStefano Zampini   *M = new_mat;
2537a57a6d2fSStefano Zampini   PetscFunctionReturn(0);
2538a57a6d2fSStefano Zampini }
2539a57a6d2fSStefano Zampini 
2540e7931f94SStefano Zampini #undef __FUNCT__
2541e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble_Private"
2542e7931f94SStefano Zampini PetscErrorCode MatISSubassemble_Private(Mat mat, PetscInt coarsening_ratio, IS* is_sends)
2543e7931f94SStefano Zampini {
2544e7931f94SStefano Zampini   Mat             subdomain_adj;
2545e7931f94SStefano Zampini   IS              new_ranks,ranks_send_to;
2546e7931f94SStefano Zampini   MatPartitioning partitioner;
2547e7931f94SStefano Zampini   Mat_IS          *matis;
2548e7931f94SStefano Zampini   PetscInt        n_neighs,*neighs,*n_shared,**shared;
2549e7931f94SStefano Zampini   PetscInt        prank;
2550e7931f94SStefano Zampini   PetscMPIInt     size,rank,color;
2551e7931f94SStefano Zampini   PetscInt        *xadj,*adjncy,*oldranks;
2552e7931f94SStefano Zampini   PetscInt        *adjncy_wgt,*v_wgt,*is_indices,*ranks_send_to_idx;
2553e7931f94SStefano Zampini   PetscInt        i,j,n_subdomains,local_size,threshold=0;
2554e7931f94SStefano Zampini   PetscErrorCode  ierr;
25552b510759SStefano Zampini   PetscBool       use_vwgt=PETSC_FALSE,use_square=PETSC_FALSE;
2556e7931f94SStefano Zampini   PetscSubcomm    subcomm;
2557a57a6d2fSStefano Zampini 
2558e7931f94SStefano Zampini   PetscFunctionBegin;
25592b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_square",&use_square,NULL);CHKERRQ(ierr);
25602b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
25612b510759SStefano Zampini   ierr = PetscOptionsGetInt(NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
2562e7931f94SStefano Zampini 
2563e7931f94SStefano Zampini   /* Get info on mapping */
2564e7931f94SStefano Zampini   matis = (Mat_IS*)(mat->data);
2565e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&local_size);CHKERRQ(ierr);
2566e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2567e7931f94SStefano Zampini 
2568e7931f94SStefano Zampini   /* build local CSR graph of subdomains' connectivity */
2569e7931f94SStefano Zampini   ierr = PetscMalloc(2*sizeof(*xadj),&xadj);CHKERRQ(ierr);
2570e7931f94SStefano Zampini   xadj[0] = 0;
2571e7931f94SStefano Zampini   xadj[1] = PetscMax(n_neighs-1,0);
2572e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy),&adjncy);CHKERRQ(ierr);
2573e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy_wgt),&adjncy_wgt);CHKERRQ(ierr);
2574e7931f94SStefano Zampini 
25752b510759SStefano Zampini   if (threshold) {
25762b510759SStefano Zampini     PetscInt* count,min_threshold;
2577e7931f94SStefano Zampini     ierr = PetscMalloc(local_size*sizeof(PetscInt),&count);CHKERRQ(ierr);
2578e7931f94SStefano Zampini     ierr = PetscMemzero(count,local_size*sizeof(PetscInt));CHKERRQ(ierr);
2579e7931f94SStefano Zampini     for (i=1;i<n_neighs;i++) {/* i=1 so I don't count myself -> faces nodes counts to 1 */
2580e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2581e7931f94SStefano Zampini         count[shared[i][j]] += 1;
2582e7931f94SStefano Zampini       }
2583e7931f94SStefano Zampini     }
25842b510759SStefano Zampini     /* adapt threshold since we dont want to lose significant connections */
25852b510759SStefano Zampini     min_threshold = n_neighs;
25862b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
25872b510759SStefano Zampini       for (j=0;j<n_shared[i];j++) {
25882b510759SStefano Zampini         min_threshold = PetscMin(count[shared[i][j]],min_threshold);
25892b510759SStefano Zampini       }
25902b510759SStefano Zampini     }
25912b510759SStefano Zampini     PetscPrintf(PETSC_COMM_SELF,"PASSED THRESHOLD %d\n",threshold);
25922b510759SStefano Zampini     threshold = PetscMax(min_threshold+1,threshold);
25932b510759SStefano Zampini     PetscPrintf(PETSC_COMM_SELF,"USING THRESHOLD %d (min %d)\n",threshold,min_threshold);
2594e7931f94SStefano Zampini     xadj[1] = 0;
25952b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
2596e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2597e7931f94SStefano Zampini         if (count[shared[i][j]] < threshold) {
2598e7931f94SStefano Zampini           adjncy[xadj[1]] = neighs[i];
2599e7931f94SStefano Zampini           adjncy_wgt[xadj[1]] = n_shared[i];
2600e7931f94SStefano Zampini           xadj[1]++;
2601e7931f94SStefano Zampini           break;
2602e7931f94SStefano Zampini         }
2603e7931f94SStefano Zampini       }
2604e7931f94SStefano Zampini     }
2605e7931f94SStefano Zampini     ierr = PetscFree(count);CHKERRQ(ierr);
2606c8587f34SStefano Zampini   } else {
2607e7931f94SStefano Zampini     if (xadj[1]) {
2608e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy,&neighs[1],xadj[1]*sizeof(*adjncy));CHKERRQ(ierr);
2609e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy_wgt,&n_shared[1],xadj[1]*sizeof(*adjncy_wgt));CHKERRQ(ierr);
2610c8587f34SStefano Zampini     }
2611e7931f94SStefano Zampini   }
2612e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingRestoreInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2613e7931f94SStefano Zampini   if (use_square) {
2614e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2615e7931f94SStefano Zampini       adjncy_wgt[i] = adjncy_wgt[i]*adjncy_wgt[i];
2616e7931f94SStefano Zampini     }
2617e7931f94SStefano Zampini   }
2618e7931f94SStefano Zampini   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2619e7931f94SStefano Zampini 
2620e7931f94SStefano Zampini   ierr = PetscMalloc(sizeof(PetscInt),&ranks_send_to_idx);CHKERRQ(ierr);
2621e7931f94SStefano Zampini 
2622e7931f94SStefano Zampini   /*
2623e7931f94SStefano Zampini     Restrict work on active processes only.
2624e7931f94SStefano Zampini   */
2625e7931f94SStefano Zampini   ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&subcomm);CHKERRQ(ierr);
2626e7931f94SStefano Zampini   ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
2627e7931f94SStefano Zampini   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
26282b510759SStefano Zampini   ierr = PetscMPIIntCast(!local_size,&color);CHKERRQ(ierr);
2629d3531aaaSJed Brown   ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
2630e7931f94SStefano Zampini   if (color) {
2631e7931f94SStefano Zampini     ierr = PetscFree(xadj);CHKERRQ(ierr);
2632e7931f94SStefano Zampini     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2633e7931f94SStefano Zampini     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
2634c8587f34SStefano Zampini   } else {
2635e7931f94SStefano Zampini     ierr = MPI_Comm_size(subcomm->comm,&size);CHKERRQ(ierr);
2636e7931f94SStefano Zampini     ierr = PetscMalloc(size*sizeof(*oldranks),&oldranks);CHKERRQ(ierr);
2637e7931f94SStefano Zampini     prank = rank;
2638e7931f94SStefano Zampini     ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm->comm);CHKERRQ(ierr);
2639e7931f94SStefano Zampini     for (i=0;i<size;i++) {
2640e7931f94SStefano Zampini       PetscPrintf(subcomm->comm,"oldranks[%d] = %d\n",i,oldranks[i]);
2641c8587f34SStefano Zampini     }
2642e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2643e7931f94SStefano Zampini       ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
2644c8587f34SStefano Zampini     }
2645e7931f94SStefano Zampini     ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2646e7931f94SStefano Zampini     ierr = MatCreateMPIAdj(subcomm->comm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
2647e7931f94SStefano Zampini     n_subdomains = (PetscInt)size;
2648e7931f94SStefano Zampini     ierr = MatView(subdomain_adj,0);CHKERRQ(ierr);
2649e7931f94SStefano Zampini 
2650e7931f94SStefano Zampini     /* Partition */
2651e7931f94SStefano Zampini     ierr = MatPartitioningCreate(subcomm->comm,&partitioner);CHKERRQ(ierr);
2652e7931f94SStefano Zampini     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
2653e7931f94SStefano Zampini     if (use_vwgt) {
2654e7931f94SStefano Zampini       ierr = PetscMalloc(sizeof(*v_wgt),&v_wgt);CHKERRQ(ierr);
2655e7931f94SStefano Zampini       v_wgt[0] = local_size;
2656e7931f94SStefano Zampini       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
2657c8587f34SStefano Zampini     }
2658e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)partitioner),"NPARTS %d\n",n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2659e7931f94SStefano Zampini     ierr = MatPartitioningSetNParts(partitioner,n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2660e7931f94SStefano Zampini     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
2661e7931f94SStefano Zampini     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
2662e7931f94SStefano Zampini     ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr);
2663e7931f94SStefano Zampini 
2664e7931f94SStefano Zampini     ierr = ISGetIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2665e7931f94SStefano Zampini     ranks_send_to_idx[0] = oldranks[is_indices[0]];
2666e7931f94SStefano Zampini     ierr = ISRestoreIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2667e7931f94SStefano Zampini     /* clean up */
2668e7931f94SStefano Zampini     ierr = PetscFree(oldranks);CHKERRQ(ierr);
2669e7931f94SStefano Zampini     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
2670e7931f94SStefano Zampini     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
2671e7931f94SStefano Zampini     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
2672e7931f94SStefano Zampini   }
2673e7931f94SStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
2674e7931f94SStefano Zampini 
2675e7931f94SStefano Zampini   /* assemble parallel IS for sends */
2676e7931f94SStefano Zampini   i = 1;
2677e7931f94SStefano Zampini   if (color) i=0;
2678e7931f94SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,&ranks_send_to);CHKERRQ(ierr);
2679e7931f94SStefano Zampini   ierr = ISView(ranks_send_to,0);CHKERRQ(ierr);
2680e7931f94SStefano Zampini 
2681e7931f94SStefano Zampini   /* get back IS */
2682e7931f94SStefano Zampini   *is_sends = ranks_send_to;
2683e7931f94SStefano Zampini   PetscFunctionReturn(0);
2684e7931f94SStefano Zampini }
2685e7931f94SStefano Zampini 
2686e7931f94SStefano Zampini typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
2687e7931f94SStefano Zampini 
2688e7931f94SStefano Zampini #undef __FUNCT__
2689e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble"
2690e7931f94SStefano Zampini PetscErrorCode MatISSubassemble(Mat mat, IS is_sends, PetscInt coarsening_ratio, Mat *mat_n)
2691e7931f94SStefano Zampini {
2692e7931f94SStefano Zampini   Mat                    local_mat,new_mat;
2693e7931f94SStefano Zampini   Mat_IS                 *matis;
2694e7931f94SStefano Zampini   IS                     is_sends_internal;
2695e7931f94SStefano Zampini   PetscInt               rows,cols;
2696e7931f94SStefano Zampini   PetscInt               i,bs,buf_size_idxs,buf_size_vals;
2697e7931f94SStefano Zampini   PetscBool              ismatis,isdense;
2698e7931f94SStefano Zampini   ISLocalToGlobalMapping l2gmap;
2699e7931f94SStefano Zampini   PetscInt*              l2gmap_indices;
2700e7931f94SStefano Zampini   const PetscInt*        is_indices;
2701e7931f94SStefano Zampini   MatType                new_local_type;
2702e7931f94SStefano Zampini   MatTypePrivate         new_local_type_private;
2703e7931f94SStefano Zampini   /* buffers */
2704e7931f94SStefano Zampini   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
2705e7931f94SStefano Zampini   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
2706e7931f94SStefano Zampini   /* MPI */
2707e7931f94SStefano Zampini   MPI_Comm               comm;
2708e7931f94SStefano Zampini   PetscMPIInt            n_sends,n_recvs,commsize;
2709e7931f94SStefano Zampini   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals;
2710e7931f94SStefano Zampini   PetscMPIInt            *onodes,*olengths_idxs,*olengths_vals;
2711e7931f94SStefano Zampini   PetscMPIInt            len,tag_idxs,tag_vals,source_dest;
2712e7931f94SStefano Zampini   MPI_Request            *send_req_idxs,*send_req_vals,*recv_req_idxs,*recv_req_vals;
2713e7931f94SStefano Zampini   PetscErrorCode         ierr;
2714e7931f94SStefano Zampini 
2715e7931f94SStefano Zampini   PetscFunctionBegin;
2716e7931f94SStefano Zampini   /* checks */
2717e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
2718e7931f94SStefano Zampini   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on an matrix object which is not of type MATIS",__FUNCT__);
2719e7931f94SStefano Zampini   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2720e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
2721e7931f94SStefano Zampini   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
2722e7931f94SStefano Zampini   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
2723e7931f94SStefano Zampini   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
2724e7931f94SStefano Zampini   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
2725e7931f94SStefano Zampini   PetscValidLogicalCollectiveInt(mat,bs,0);
2726e7931f94SStefano Zampini   /* prepare IS for sending if not provided */
2727e7931f94SStefano Zampini   if (!is_sends) {
2728e7931f94SStefano Zampini     if (!coarsening_ratio) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a coarsening ratio");
2729e7931f94SStefano Zampini     ierr = MatISSubassemble_Private(mat,coarsening_ratio,&is_sends_internal);CHKERRQ(ierr);
2730c8587f34SStefano Zampini   } else {
2731e7931f94SStefano Zampini     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
2732e7931f94SStefano Zampini     is_sends_internal = is_sends;
2733c8587f34SStefano Zampini   }
2734e7931f94SStefano Zampini 
2735e7931f94SStefano Zampini   /* get pointer of MATIS data */
2736e7931f94SStefano Zampini   matis = (Mat_IS*)mat->data;
2737e7931f94SStefano Zampini 
2738e7931f94SStefano Zampini   /* get comm */
2739e7931f94SStefano Zampini   comm = PetscObjectComm((PetscObject)mat);
2740e7931f94SStefano Zampini 
2741e7931f94SStefano Zampini   /* compute number of sends */
2742e7931f94SStefano Zampini   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
2743e7931f94SStefano Zampini   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
2744e7931f94SStefano Zampini 
2745e7931f94SStefano Zampini   /* compute number of receives */
2746e7931f94SStefano Zampini   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
2747e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*iflags),&iflags);CHKERRQ(ierr);
2748e7931f94SStefano Zampini   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
2749e7931f94SStefano Zampini   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2750e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
2751e7931f94SStefano Zampini   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
2752e7931f94SStefano Zampini   ierr = PetscFree(iflags);CHKERRQ(ierr);
2753e7931f94SStefano Zampini 
2754e7931f94SStefano Zampini   /* prepare send/receive buffers */
2755e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_idxs),&ilengths_idxs);CHKERRQ(ierr);
2756e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
2757e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_vals),&ilengths_vals);CHKERRQ(ierr);
2758e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
2759e7931f94SStefano Zampini 
2760e7931f94SStefano Zampini   /* Get data from local mat */
2761e7931f94SStefano Zampini   if (!isdense) {
2762e7931f94SStefano Zampini     /* TODO: See below some guidelines on how to prepare the local buffers */
2763e7931f94SStefano Zampini     /*
2764e7931f94SStefano Zampini        send_buffer_vals should contain the raw values of the local matrix
2765e7931f94SStefano Zampini        send_buffer_idxs should contain:
2766e7931f94SStefano Zampini        - MatType_PRIVATE type
2767e7931f94SStefano Zampini        - PetscInt        size_of_l2gmap
2768e7931f94SStefano Zampini        - PetscInt        global_row_indices[size_of_l2gmap]
2769e7931f94SStefano Zampini        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
2770e7931f94SStefano Zampini     */
2771e7931f94SStefano Zampini   } else {
2772e7931f94SStefano Zampini     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
2773e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&i);CHKERRQ(ierr);
2774e7931f94SStefano Zampini     ierr = PetscMalloc((i+2)*sizeof(PetscInt),&send_buffer_idxs);CHKERRQ(ierr);
2775e7931f94SStefano Zampini     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
2776e7931f94SStefano Zampini     send_buffer_idxs[1] = i;
2777e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2778e7931f94SStefano Zampini     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
2779e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingRestoreIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2780e7931f94SStefano Zampini     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
2781e7931f94SStefano Zampini     for (i=0;i<n_sends;i++) {
2782e7931f94SStefano Zampini       ilengths_vals[is_indices[i]] = len*len;
2783e7931f94SStefano Zampini       ilengths_idxs[is_indices[i]] = len+2;
2784c8587f34SStefano Zampini     }
2785c8587f34SStefano Zampini   }
2786e7931f94SStefano Zampini   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
2787e7931f94SStefano Zampini   buf_size_idxs = 0;
2788e7931f94SStefano Zampini   buf_size_vals = 0;
2789e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2790e7931f94SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
2791e7931f94SStefano Zampini     buf_size_vals += (PetscInt)olengths_vals[i];
2792e7931f94SStefano Zampini   }
2793e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&recv_buffer_idxs);CHKERRQ(ierr);
2794e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_vals*sizeof(PetscScalar),&recv_buffer_vals);CHKERRQ(ierr);
2795e7931f94SStefano Zampini 
2796e7931f94SStefano Zampini   /* get new tags for clean communications */
2797e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
2798e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
2799e7931f94SStefano Zampini 
2800e7931f94SStefano Zampini   /* allocate for requests */
2801e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_idxs);CHKERRQ(ierr);
2802e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_vals);CHKERRQ(ierr);
2803e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_idxs);CHKERRQ(ierr);
2804e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_vals);CHKERRQ(ierr);
2805e7931f94SStefano Zampini 
2806e7931f94SStefano Zampini   /* communications */
2807e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2808e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
2809e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2810e7931f94SStefano Zampini     source_dest = onodes[i];
2811e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
2812e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
2813e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2814e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
2815e7931f94SStefano Zampini   }
2816e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) {
2817e7931f94SStefano Zampini     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
2818e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
2819e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
2820e7931f94SStefano Zampini   }
2821e7931f94SStefano Zampini   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2822e7931f94SStefano Zampini   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
2823e7931f94SStefano Zampini 
2824e7931f94SStefano Zampini   /* assemble new l2g map */
2825e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2826e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2827e7931f94SStefano Zampini   buf_size_idxs = 0;
2828e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2829e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
2830e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2831e7931f94SStefano Zampini   }
2832e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&l2gmap_indices);CHKERRQ(ierr);
2833e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2834e7931f94SStefano Zampini   buf_size_idxs = 0;
2835e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2836e7931f94SStefano Zampini     ierr = PetscMemcpy(&l2gmap_indices[buf_size_idxs],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
2837e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
2838e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2839e7931f94SStefano Zampini   }
2840e7931f94SStefano Zampini   ierr = PetscSortRemoveDupsInt(&buf_size_idxs,l2gmap_indices);CHKERRQ(ierr);
2841e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingCreate(comm,buf_size_idxs,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
2842e7931f94SStefano Zampini   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
2843e7931f94SStefano Zampini 
2844e7931f94SStefano Zampini   /* infer new local matrix type from received local matrices type */
2845e7931f94SStefano Zampini   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
2846e7931f94SStefano 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) */
2847e7931f94SStefano Zampini   new_local_type_private = MATAIJ_PRIVATE;
2848e7931f94SStefano Zampini   new_local_type = MATSEQAIJ;
2849e7931f94SStefano Zampini   if (n_recvs) {
2850be4bc593SStefano Zampini     new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
2851e7931f94SStefano Zampini     ptr_idxs = recv_buffer_idxs;
2852e7931f94SStefano Zampini     for (i=0;i<n_recvs;i++) {
2853e7931f94SStefano Zampini       if ((PetscInt)new_local_type_private != *ptr_idxs) {
2854e7931f94SStefano Zampini         new_local_type_private = MATAIJ_PRIVATE;
2855e7931f94SStefano Zampini         break;
2856e7931f94SStefano Zampini       }
2857e7931f94SStefano Zampini       ptr_idxs += olengths_idxs[i];
2858e7931f94SStefano Zampini     }
2859e7931f94SStefano Zampini     switch (new_local_type_private) {
2860e7931f94SStefano Zampini       case MATDENSE_PRIVATE: /* subassembling of dense matrices does not give a dense matrix! */
2861e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
2862e7931f94SStefano Zampini         bs = 1;
2863e7931f94SStefano Zampini         break;
2864e7931f94SStefano Zampini       case MATAIJ_PRIVATE:
2865e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
2866e7931f94SStefano Zampini         bs = 1;
2867e7931f94SStefano Zampini         break;
2868e7931f94SStefano Zampini       case MATBAIJ_PRIVATE:
2869e7931f94SStefano Zampini         new_local_type = MATSEQBAIJ;
2870e7931f94SStefano Zampini         break;
2871e7931f94SStefano Zampini       case MATSBAIJ_PRIVATE:
2872e7931f94SStefano Zampini         new_local_type = MATSEQSBAIJ;
2873e7931f94SStefano Zampini         break;
2874e7931f94SStefano Zampini       default:
2875e7931f94SStefano Zampini         SETERRQ2(comm,PETSC_ERR_LIB,"Unkwown private type %d in %s",new_local_type_private,__FUNCT__);
2876e7931f94SStefano Zampini         break;
2877e7931f94SStefano Zampini     }
2878e7931f94SStefano Zampini   }
2879e7931f94SStefano Zampini 
2880e7931f94SStefano Zampini   /* create MATIS object */
2881e7931f94SStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
2882e7931f94SStefano Zampini   ierr = MatCreateIS(comm,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,&new_mat);CHKERRQ(ierr);
2883e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
2884e7931f94SStefano Zampini   ierr = MatISGetLocalMat(new_mat,&local_mat);CHKERRQ(ierr);
2885e7931f94SStefano Zampini   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
2886e7931f94SStefano Zampini   ierr = MatSetUp(local_mat);CHKERRQ(ierr); /* WARNING -> no preallocation yet */
2887e7931f94SStefano Zampini 
2888e7931f94SStefano Zampini   /* set values */
2889e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2890e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
2891e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2892e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2893e7931f94SStefano Zampini     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
2894e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
2895e7931f94SStefano Zampini       ierr = MatSetValues(new_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
2896e7931f94SStefano Zampini       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
2897e7931f94SStefano Zampini       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
2898e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
2899e7931f94SStefano Zampini     }
2900e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2901e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
2902e7931f94SStefano Zampini   }
2903e7931f94SStefano Zampini   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2904e7931f94SStefano Zampini   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2905e7931f94SStefano Zampini   ierr = MatAssemblyBegin(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2906e7931f94SStefano Zampini   ierr = MatAssemblyEnd(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2907e7931f94SStefano Zampini 
2908e7931f94SStefano Zampini   { /* check */
2909e7931f94SStefano Zampini     Vec       lvec,rvec;
2910e7931f94SStefano Zampini     PetscReal infty_error;
2911e7931f94SStefano Zampini 
2912e7931f94SStefano Zampini     ierr = MatGetVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
2913e7931f94SStefano Zampini     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
2914e7931f94SStefano Zampini     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
2915e7931f94SStefano Zampini     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
2916e7931f94SStefano Zampini     ierr = MatMultAdd(new_mat,rvec,lvec,lvec);CHKERRQ(ierr);
2917e7931f94SStefano Zampini     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
2918e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
2919e7931f94SStefano Zampini     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
2920e7931f94SStefano Zampini     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
2921e7931f94SStefano Zampini   }
2922e7931f94SStefano Zampini 
2923e7931f94SStefano Zampini   /* free workspace */
2924e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
2925e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
2926e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2927e7931f94SStefano Zampini   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
2928e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2929e7931f94SStefano Zampini   if (isdense) {
2930e7931f94SStefano Zampini     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2931e7931f94SStefano Zampini     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
2932e7931f94SStefano Zampini   } else {
2933e7931f94SStefano Zampini     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
2934e7931f94SStefano Zampini   }
2935e7931f94SStefano Zampini   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
2936e7931f94SStefano Zampini   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
2937e7931f94SStefano Zampini   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
2938e7931f94SStefano Zampini   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
2939e7931f94SStefano Zampini   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
2940e7931f94SStefano Zampini   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
2941e7931f94SStefano Zampini   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
2942e7931f94SStefano Zampini   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
2943e7931f94SStefano Zampini   ierr = PetscFree(onodes);CHKERRQ(ierr);
2944e7931f94SStefano Zampini   /* get back new mat */
2945e7931f94SStefano Zampini   *mat_n = new_mat;
2946e7931f94SStefano Zampini   PetscFunctionReturn(0);
2947e7931f94SStefano Zampini }
2948a57a6d2fSStefano Zampini 
2949c8587f34SStefano Zampini #undef __FUNCT__
2950c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
2951c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
2952c8587f34SStefano Zampini {
2953c8587f34SStefano Zampini   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
2954c8587f34SStefano Zampini   PC_IS                  *pcis = (PC_IS*)pc->data;
295520a2ab83SStefano Zampini   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
29569881197aSStefano Zampini   MatNullSpace           CoarseNullSpace=NULL;
295720a2ab83SStefano Zampini   ISLocalToGlobalMapping coarse_islg;
295820a2ab83SStefano Zampini   IS                     coarse_is;
2959f9eb5b7dSStefano Zampini   PetscInt               max_it,coarse_size,*local_primal_indices=NULL;
2960f9eb5b7dSStefano Zampini   PetscInt               im_active=-1,active_procs=-1;
2961f9eb5b7dSStefano Zampini   PC                     pc_temp;
2962c8587f34SStefano Zampini   PCType                 coarse_pc_type;
2963c8587f34SStefano Zampini   KSPType                coarse_ksp_type;
2964f9eb5b7dSStefano Zampini   PetscBool              multilevel_requested,multilevel_allowed;
2965f9eb5b7dSStefano Zampini   PetscBool              setsym,issym,isbddc,isnn;
2966f9eb5b7dSStefano Zampini   MatStructure           matstruct;
29679881197aSStefano Zampini   PetscErrorCode         ierr;
2968fdc09c96SStefano Zampini 
2969c8587f34SStefano Zampini   PetscFunctionBegin;
2970c8587f34SStefano Zampini   /* Assign global numbering to coarse dofs */
2971f34684f1SStefano Zampini   ierr = PCBDDCComputePrimalNumbering(pc,&coarse_size,&local_primal_indices);CHKERRQ(ierr);
2972c8587f34SStefano Zampini 
2973f9eb5b7dSStefano Zampini   /* infer some info from user */
2974f9eb5b7dSStefano Zampini   issym = PETSC_FALSE;
2975f9eb5b7dSStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
2976f9eb5b7dSStefano Zampini   multilevel_allowed = PETSC_FALSE;
2977f9eb5b7dSStefano Zampini   multilevel_requested = PETSC_FALSE;
2978f9eb5b7dSStefano Zampini   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
2979f9eb5b7dSStefano Zampini   if (multilevel_requested) {
29802b510759SStefano Zampini     /* count "active processes" */
29812b510759SStefano Zampini     im_active = !!(pcis->n);
29822b510759SStefano Zampini     ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
29832b510759SStefano Zampini     if (active_procs/pcbddc->coarsening_ratio < 2) {
2984f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_FALSE;
29852b510759SStefano Zampini     } else {
2986f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_TRUE;
2987c8587f34SStefano Zampini     }
2988c8587f34SStefano Zampini   }
2989e7931f94SStefano Zampini 
2990f9eb5b7dSStefano Zampini   /* set defaults for coarse KSP and PC */
2991f9eb5b7dSStefano Zampini   if (multilevel_allowed) {
2992c8587f34SStefano Zampini     if (issym) {
2993f9eb5b7dSStefano Zampini       coarse_ksp_type = KSPRICHARDSON;
2994f9eb5b7dSStefano Zampini     } else {
2995f9eb5b7dSStefano Zampini       coarse_ksp_type = KSPCHEBYSHEV;
2996c8587f34SStefano Zampini     }
2997f9eb5b7dSStefano Zampini     coarse_pc_type = PCBDDC;
2998f9eb5b7dSStefano Zampini   } else {
2999f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPPREONLY;
3000f9eb5b7dSStefano Zampini     coarse_pc_type = PCREDUNDANT;
3001c8587f34SStefano Zampini   }
3002c8587f34SStefano Zampini 
3003f9eb5b7dSStefano Zampini   /* create the coarse KSP object only once with defaults */
3004f9eb5b7dSStefano Zampini   if (!pcbddc->coarse_ksp) {
3005e604994aSStefano Zampini     char prefix[256],str_level[3];
3006e604994aSStefano Zampini     size_t len;
3007f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_ksp);CHKERRQ(ierr);
3008c8587f34SStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
3009f9eb5b7dSStefano Zampini     ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
3010c8587f34SStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
3011c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3012c8587f34SStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
3013e604994aSStefano Zampini     /* prefix */
3014e604994aSStefano Zampini     ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
3015e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
3016e604994aSStefano Zampini     if (!pcbddc->current_level) {
3017e604994aSStefano Zampini       ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
3018e604994aSStefano Zampini       ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
3019c8587f34SStefano Zampini     } else {
3020e604994aSStefano Zampini       ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
3021e604994aSStefano Zampini       if (pcbddc->current_level>1) len -= 2;
3022e604994aSStefano Zampini       ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
3023e604994aSStefano Zampini       *(prefix+len)='\0';
3024e604994aSStefano Zampini       sprintf(str_level,"%d_",(int)(pcbddc->current_level));
3025e604994aSStefano Zampini       ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
3026e604994aSStefano Zampini     }
3027e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
3028f9eb5b7dSStefano Zampini   }
3029f9eb5b7dSStefano Zampini   /* allow user customization */
303085c4d303SStefano 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); */
3031f9eb5b7dSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
303285c4d303SStefano 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); */
3033f9eb5b7dSStefano Zampini 
3034f9eb5b7dSStefano Zampini   /* get some info after set from options */
3035f9eb5b7dSStefano Zampini   ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3036f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
3037f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
3038f9eb5b7dSStefano Zampini   if (isbddc && !multilevel_allowed) { /* prevent from infinite loop if user as requested bddc pc for coarse solver */
3039f9eb5b7dSStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
3040f9eb5b7dSStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
3041f9eb5b7dSStefano Zampini     isbddc = PETSC_FALSE;
3042f9eb5b7dSStefano Zampini   }
3043f9eb5b7dSStefano Zampini 
3044f9eb5b7dSStefano Zampini   /* propagate BDDC info to the next level */
3045f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
3046f9eb5b7dSStefano Zampini   ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
3047f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
3048f9eb5b7dSStefano Zampini 
3049f9eb5b7dSStefano Zampini   /* creates temporary MATIS object for coarse matrix */
3050a57a6d2fSStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,local_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
3051a57a6d2fSStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
3052a57a6d2fSStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
3053a57a6d2fSStefano Zampini   ierr = MatCreateIS(PetscObjectComm((PetscObject)pc),1,PETSC_DECIDE,PETSC_DECIDE,coarse_size,coarse_size,coarse_islg,&coarse_mat_is);CHKERRQ(ierr);
3054a57a6d2fSStefano Zampini   ierr = MatISSetLocalMat(coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
3055e7931f94SStefano Zampini   ierr = MatAssemblyBegin(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3056e7931f94SStefano Zampini   ierr = MatAssemblyEnd(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
305720a2ab83SStefano Zampini   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
305820a2ab83SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
305920a2ab83SStefano Zampini   ierr = PetscFree(local_primal_indices);CHKERRQ(ierr);
3060fdc09c96SStefano Zampini 
3061f9eb5b7dSStefano Zampini   /* assemble coarse matrix */
3062f9eb5b7dSStefano Zampini   if (isbddc || isnn) {
3063f9eb5b7dSStefano Zampini     ierr = MatISSubassemble(coarse_mat_is,NULL,pcbddc->coarsening_ratio,&coarse_mat);CHKERRQ(ierr);
3064f9eb5b7dSStefano Zampini   } else {
30652b510759SStefano Zampini     ierr = MatConvert_IS_AIJ(coarse_mat_is,MATAIJ,MAT_INITIAL_MATRIX,&coarse_mat);CHKERRQ(ierr);
3066c8587f34SStefano Zampini   }
30672b510759SStefano Zampini   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
30689881197aSStefano Zampini 
3069f9eb5b7dSStefano Zampini   /* create local to global scatters for coarse problem */
3070f9eb5b7dSStefano Zampini   ierr = MatGetVecs(coarse_mat,&pcbddc->coarse_vec,&pcbddc->coarse_rhs);CHKERRQ(ierr);
3071f9eb5b7dSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3072f9eb5b7dSStefano Zampini   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
3073f9eb5b7dSStefano Zampini 
3074f9eb5b7dSStefano Zampini   /* propagate symmetry info to coarse matrix */
3075f9eb5b7dSStefano Zampini   ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,issym);CHKERRQ(ierr);
3076f9eb5b7dSStefano Zampini 
3077b8ffe317SStefano Zampini   /* Compute coarse null space (special handling by BDDC only) */
3078b8ffe317SStefano Zampini   if (pcbddc->NullSpace) {
3079b8ffe317SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCoarse(pc,coarse_mat,&CoarseNullSpace);CHKERRQ(ierr);
3080b8ffe317SStefano Zampini     if (isbddc) {
3081b8ffe317SStefano Zampini       ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
3082b8ffe317SStefano Zampini     } else {
3083c8587f34SStefano Zampini       ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
3084c8587f34SStefano Zampini     }
3085c8587f34SStefano Zampini   }
3086c8587f34SStefano Zampini 
3087f9eb5b7dSStefano Zampini   /* set operators */
3088f9eb5b7dSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
3089f9eb5b7dSStefano Zampini   ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat,matstruct);CHKERRQ(ierr);
3090f9eb5b7dSStefano Zampini 
3091f9eb5b7dSStefano Zampini   /* additional KSP customization */
3092f9eb5b7dSStefano Zampini   ierr = KSPGetTolerances(pcbddc->coarse_ksp,NULL,NULL,NULL,&max_it);CHKERRQ(ierr);
3093f9eb5b7dSStefano Zampini   if (max_it < 5) {
3094c8587f34SStefano Zampini     ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
3095f9eb5b7dSStefano Zampini   }
3096b8ffe317SStefano Zampini   /* ierr = KSPChebyshevSetEstimateEigenvalues(pcbddc->coarse_ksp,1.0,0.0,0.0,1.1);CHKERRQ(ierr); */
3097f9eb5b7dSStefano Zampini 
3098f9eb5b7dSStefano Zampini 
3099f9eb5b7dSStefano Zampini   /* print some info if requested */
3100f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
3101f9eb5b7dSStefano Zampini     ierr = KSPGetType(pcbddc->coarse_ksp,&coarse_ksp_type);CHKERRQ(ierr);
3102f9eb5b7dSStefano Zampini     ierr = PCGetType(pc_temp,&coarse_pc_type);CHKERRQ(ierr);
3103f9eb5b7dSStefano Zampini     if (!multilevel_allowed) {
3104f9eb5b7dSStefano Zampini       if (multilevel_requested) {
3105f9eb5b7dSStefano 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);
3106f9eb5b7dSStefano Zampini       } else if (pcbddc->max_levels) {
3107f9eb5b7dSStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
3108c8587f34SStefano Zampini       }
3109c8587f34SStefano Zampini     }
3110e604994aSStefano 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);
3111f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3112c8587f34SStefano Zampini   }
3113f9eb5b7dSStefano Zampini 
3114f9eb5b7dSStefano Zampini   /* setup coarse ksp */
3115f9eb5b7dSStefano Zampini   ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
3116f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
3117f9eb5b7dSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
3118f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3119f9eb5b7dSStefano Zampini     ierr = KSPView(pcbddc->coarse_ksp,pcbddc->dbg_viewer);CHKERRQ(ierr);
3120f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3121f9eb5b7dSStefano Zampini   }
3122f9eb5b7dSStefano Zampini 
3123c8587f34SStefano Zampini   /* Check coarse problem if requested */
312420a2ab83SStefano Zampini   if (pcbddc->dbg_flag) {
3125c8587f34SStefano Zampini     KSP       check_ksp;
31262b510759SStefano Zampini     KSPType   check_ksp_type;
3127c8587f34SStefano Zampini     PC        check_pc;
3128c8587f34SStefano Zampini     Vec       check_vec;
3129c8587f34SStefano Zampini     PetscReal abs_infty_error,infty_error,lambda_min,lambda_max;
31302b510759SStefano Zampini     PetscInt  its;
3131f9eb5b7dSStefano Zampini     PetscBool ispreonly,compute;
3132c8587f34SStefano Zampini 
31332b510759SStefano Zampini     /* Create ksp object suitable for estimation of extreme eigenvalues */
3134f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&check_ksp);CHKERRQ(ierr);
3135fdc635d7SStefano Zampini     ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
3136983f5fd7SStefano Zampini     ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,coarse_size);CHKERRQ(ierr);
31372b510759SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
31382b510759SStefano Zampini     if (ispreonly) {
31392b510759SStefano Zampini       check_ksp_type = KSPPREONLY;
3140f9eb5b7dSStefano Zampini       compute = PETSC_FALSE;
31412b510759SStefano Zampini     } else {
3142c8587f34SStefano Zampini       if (issym) check_ksp_type = KSPCG;
3143c8587f34SStefano Zampini       else check_ksp_type = KSPGMRES;
3144f9eb5b7dSStefano Zampini       compute = PETSC_TRUE;
3145c8587f34SStefano Zampini     }
3146c8587f34SStefano Zampini     ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
3147f9eb5b7dSStefano Zampini     ierr = KSPSetComputeSingularValues(check_ksp,compute);CHKERRQ(ierr);
3148c8587f34SStefano Zampini     ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
3149c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
3150c8587f34SStefano Zampini     ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
3151c8587f34SStefano Zampini     /* create random vec */
3152c8587f34SStefano Zampini     ierr = VecDuplicate(pcbddc->coarse_vec,&check_vec);CHKERRQ(ierr);
3153c8587f34SStefano Zampini     ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
3154c8587f34SStefano Zampini     if (CoarseNullSpace) {
3155c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec);CHKERRQ(ierr);
3156c8587f34SStefano Zampini     }
3157fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3158c8587f34SStefano Zampini     /* solve coarse problem */
3159c8587f34SStefano Zampini     ierr = KSPSolve(check_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
3160c8587f34SStefano Zampini     if (CoarseNullSpace) {
3161c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,pcbddc->coarse_vec);CHKERRQ(ierr);
3162c8587f34SStefano Zampini     }
3163c8587f34SStefano Zampini     /* check coarse problem residual error */
3164c8587f34SStefano Zampini     ierr = VecAXPY(check_vec,-1.0,pcbddc->coarse_vec);CHKERRQ(ierr);
3165c8587f34SStefano Zampini     ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3166fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3167c8587f34SStefano Zampini     ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
3168c8587f34SStefano Zampini     ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
3169e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem (%s) details\n",((PetscObject)(pcbddc->coarse_ksp))->prefix);CHKERRQ(ierr);
3170e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
3171e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
3172f9eb5b7dSStefano Zampini     /* get eigenvalue estimation if preonly has not been requested */
31732b510759SStefano Zampini     if (!ispreonly) {
3174c8587f34SStefano Zampini       ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
317520a2ab83SStefano Zampini       ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
3176f9eb5b7dSStefano 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);
3177c8587f34SStefano Zampini     }
31782b510759SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3179c8587f34SStefano Zampini     ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
3180c8587f34SStefano Zampini   }
31812b510759SStefano Zampini   /* free memory */
3182c8587f34SStefano Zampini   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
3183fdc635d7SStefano Zampini   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
3184c8587f34SStefano Zampini   PetscFunctionReturn(0);
3185c8587f34SStefano Zampini }
3186674ae819SStefano Zampini 
3187f34684f1SStefano Zampini #undef __FUNCT__
3188f34684f1SStefano Zampini #define __FUNCT__ "PCBDDCComputePrimalNumbering"
3189f34684f1SStefano Zampini PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
3190f34684f1SStefano Zampini {
3191f34684f1SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3192f34684f1SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
3193f34684f1SStefano Zampini   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
3194f34684f1SStefano Zampini   PetscInt       i,j,coarse_size;
3195f34684f1SStefano Zampini   PetscInt       *local_primal_indices,*auxlocal_primal,*aux_idx;
3196f34684f1SStefano Zampini   PetscErrorCode ierr;
3197f34684f1SStefano Zampini 
3198f34684f1SStefano Zampini   PetscFunctionBegin;
3199f34684f1SStefano Zampini   /* get indices in local ordering for vertices and constraints */
3200f34684f1SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&auxlocal_primal);CHKERRQ(ierr);
3201f34684f1SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&i,&aux_idx);CHKERRQ(ierr);
3202f34684f1SStefano Zampini   ierr = PetscMemcpy(auxlocal_primal,aux_idx,i*sizeof(PetscInt));CHKERRQ(ierr);
3203f34684f1SStefano Zampini   ierr = PetscFree(aux_idx);CHKERRQ(ierr);
3204f34684f1SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&j,&aux_idx);CHKERRQ(ierr);
3205f34684f1SStefano Zampini   ierr = PetscMemcpy(&auxlocal_primal[i],aux_idx,j*sizeof(PetscInt));CHKERRQ(ierr);
3206f34684f1SStefano Zampini   ierr = PetscFree(aux_idx);CHKERRQ(ierr);
3207f34684f1SStefano Zampini 
3208f34684f1SStefano Zampini   /* Compute global number of coarse dofs */
3209f34684f1SStefano Zampini   ierr = PCBDDCSubsetNumbering(PetscObjectComm((PetscObject)(pc->pmat)),matis->mapping,pcbddc->local_primal_size,auxlocal_primal,NULL,&coarse_size,&local_primal_indices);CHKERRQ(ierr);
3210f34684f1SStefano Zampini 
3211f34684f1SStefano Zampini   /* check numbering */
3212f34684f1SStefano Zampini   if (pcbddc->dbg_flag) {
3213f34684f1SStefano Zampini     PetscScalar coarsesum,*array;
3214f34684f1SStefano Zampini 
3215f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3216f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3217f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
3218f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
3219f34684f1SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
3220f34684f1SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,auxlocal_primal[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
3221f34684f1SStefano Zampini     }
3222f34684f1SStefano Zampini     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
3223f34684f1SStefano Zampini     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
3224f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3225f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3226f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3227f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3228f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3229f34684f1SStefano Zampini     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3230f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3231f34684f1SStefano Zampini       if (array[i] == 1.0) {
3232f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %d owned by a single process!\n",PetscGlobalRank,i);CHKERRQ(ierr);
3233f34684f1SStefano Zampini       }
3234f34684f1SStefano Zampini     }
3235f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3236f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3237f34684f1SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
3238f34684f1SStefano Zampini     }
3239f34684f1SStefano Zampini     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3240f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3241f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3242f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3243f34684f1SStefano Zampini     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
3244f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
3245f34684f1SStefano Zampini     if (pcbddc->dbg_flag > 1) {
3246f34684f1SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
3247f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3248f34684f1SStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
3249f34684f1SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
325045a1bb75SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_primal_indices[%d]=%d (%d)\n",i,local_primal_indices[i],auxlocal_primal[i]);
3251f34684f1SStefano Zampini       }
3252f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3253f34684f1SStefano Zampini     }
3254f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3255f34684f1SStefano Zampini   }
3256f34684f1SStefano Zampini   ierr = PetscFree(auxlocal_primal);CHKERRQ(ierr);
3257f34684f1SStefano Zampini   /* get back data */
3258f34684f1SStefano Zampini   *coarse_size_n = coarse_size;
3259f34684f1SStefano Zampini   *local_primal_indices_n = local_primal_indices;
3260674ae819SStefano Zampini   PetscFunctionReturn(0);
3261674ae819SStefano Zampini }
3262674ae819SStefano Zampini 
3263