xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 63602bcaa893421da8af814d137379896d1618ad)
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   PetscErrorCode ierr;
51674ae819SStefano Zampini 
52674ae819SStefano Zampini   PetscFunctionBegin;
53674ae819SStefano Zampini   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
54674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
55674ae819SStefano Zampini   ierr = MatNullSpaceDestroy(&pcbddc->NullSpace);CHKERRQ(ierr);
56674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
57785d1243SStefano Zampini   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
58674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
59785d1243SStefano Zampini   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
60*63602bcaSStefano Zampini   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
61*63602bcaSStefano Zampini   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
62674ae819SStefano Zampini   PetscFunctionReturn(0);
63674ae819SStefano Zampini }
64674ae819SStefano Zampini 
65674ae819SStefano Zampini #undef __FUNCT__
66674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetTopography"
67674ae819SStefano Zampini PetscErrorCode PCBDDCResetTopography(PC pc)
68674ae819SStefano Zampini {
69674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
70674ae819SStefano Zampini   PetscErrorCode ierr;
71674ae819SStefano Zampini 
72674ae819SStefano Zampini   PetscFunctionBegin;
73674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
74674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
75674ae819SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
76674ae819SStefano Zampini   PetscFunctionReturn(0);
77674ae819SStefano Zampini }
78674ae819SStefano Zampini 
79674ae819SStefano Zampini #undef __FUNCT__
80674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetSolvers"
81674ae819SStefano Zampini PetscErrorCode PCBDDCResetSolvers(PC pc)
82674ae819SStefano Zampini {
83674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
84674ae819SStefano Zampini   PetscErrorCode ierr;
85674ae819SStefano Zampini 
86674ae819SStefano Zampini   PetscFunctionBegin;
87674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
88674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_rhs);CHKERRQ(ierr);
89674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
90674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
9115aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
9215aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
93674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
94674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
95674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
96674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
97674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
98674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
99674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec4_D);CHKERRQ(ierr);
1008ce42a96SStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
101674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
102674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
103674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
104674ae819SStefano Zampini   PetscFunctionReturn(0);
105674ae819SStefano Zampini }
106674ae819SStefano Zampini 
107674ae819SStefano Zampini #undef __FUNCT__
1086bfb1811SStefano Zampini #define __FUNCT__ "PCBDDCCreateWorkVectors"
1096bfb1811SStefano Zampini PetscErrorCode PCBDDCCreateWorkVectors(PC pc)
1106bfb1811SStefano Zampini {
1116bfb1811SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1126bfb1811SStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
1136bfb1811SStefano Zampini   VecType        impVecType;
1146bfb1811SStefano Zampini   PetscInt       n_vertices,n_constraints,local_primal_size,n_R;
1156bfb1811SStefano Zampini   PetscErrorCode ierr;
1166bfb1811SStefano Zampini 
1176bfb1811SStefano Zampini   PetscFunctionBegin;
1186bfb1811SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,NULL);CHKERRQ(ierr);
1196bfb1811SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&n_constraints,NULL);CHKERRQ(ierr);
1206bfb1811SStefano Zampini   local_primal_size = n_constraints+n_vertices;
1216bfb1811SStefano Zampini   n_R = pcis->n-n_vertices;
1226bfb1811SStefano Zampini   /* local work vectors */
1236bfb1811SStefano Zampini   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
1246bfb1811SStefano Zampini   ierr = VecDuplicate(pcis->vec1_D,&pcbddc->vec4_D);CHKERRQ(ierr);
1256bfb1811SStefano Zampini   ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
1266bfb1811SStefano Zampini   ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
1276bfb1811SStefano Zampini   ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
1286bfb1811SStefano Zampini   ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
12983b7ccabSStefano Zampini   ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
1306bfb1811SStefano Zampini   ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,local_primal_size);CHKERRQ(ierr);
1316bfb1811SStefano Zampini   ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
13283b7ccabSStefano Zampini   if (n_constraints) {
13383b7ccabSStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
13483b7ccabSStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
13583b7ccabSStefano Zampini     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
13683b7ccabSStefano Zampini   }
1376bfb1811SStefano Zampini   PetscFunctionReturn(0);
1386bfb1811SStefano Zampini }
1396bfb1811SStefano Zampini 
1406bfb1811SStefano Zampini #undef __FUNCT__
14147f4ddc3SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCorrection"
14247f4ddc3SStefano Zampini PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
14388ebb749SStefano Zampini {
14425084f0cSStefano Zampini   PetscErrorCode         ierr;
14525084f0cSStefano Zampini   /* pointers to pcis and pcbddc */
14688ebb749SStefano Zampini   PC_IS*                 pcis = (PC_IS*)pc->data;
14788ebb749SStefano Zampini   PC_BDDC*               pcbddc = (PC_BDDC*)pc->data;
14825084f0cSStefano Zampini   /* submatrices of local problem */
14988ebb749SStefano Zampini   Mat                    A_RV,A_VR,A_VV;
15025084f0cSStefano Zampini   /* working matrices */
15125084f0cSStefano Zampini   Mat                    M1,M2,M3,C_CR;
15225084f0cSStefano Zampini   /* working vectors */
15325084f0cSStefano Zampini   Vec                    vec1_C,vec2_C,vec1_V,vec2_V;
15425084f0cSStefano Zampini   /* additional working stuff */
15525084f0cSStefano Zampini   IS                     is_aux;
15688ebb749SStefano Zampini   ISLocalToGlobalMapping BtoNmap;
15725084f0cSStefano Zampini   PetscScalar            *coarse_submat_vals; /* TODO: use a PETSc matrix */
15825084f0cSStefano Zampini   const PetscScalar      *array,*row_cmat_values;
15925084f0cSStefano Zampini   const PetscInt         *row_cmat_indices,*idx_R_local;
16025084f0cSStefano Zampini   PetscInt               *vertices,*idx_V_B,*auxindices;
16125084f0cSStefano Zampini   PetscInt               n_vertices,n_constraints,size_of_constraint;
16225084f0cSStefano Zampini   PetscInt               i,j,n_R,n_D,n_B;
16388ebb749SStefano Zampini   PetscBool              setsym=PETSC_FALSE,issym=PETSC_FALSE;
16445a1bb75SStefano Zampini   /* matrix type (vector type propagated downstream from vec1_C and local matrix type) */
16588ebb749SStefano Zampini   MatType                impMatType;
16625084f0cSStefano Zampini   /* some shortcuts to scalars */
16725084f0cSStefano Zampini   PetscScalar            zero=0.0,one=1.0,m_one=-1.0;
16825084f0cSStefano Zampini   /* for debugging purposes */
16988ebb749SStefano Zampini   PetscReal              *coarsefunctions_errors,*constraints_errors;
17088ebb749SStefano Zampini 
17188ebb749SStefano Zampini   PetscFunctionBegin;
17225084f0cSStefano Zampini   /* get number of vertices and their local indices */
17325084f0cSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
17488ebb749SStefano Zampini   n_constraints = pcbddc->local_primal_size-n_vertices;
17588ebb749SStefano Zampini   /* Set Non-overlapping dimensions */
17688ebb749SStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
17788ebb749SStefano Zampini   n_R = pcis->n-n_vertices;
17888ebb749SStefano Zampini 
17988ebb749SStefano Zampini   /* Set types for local objects needed by BDDC precondtioner */
18088ebb749SStefano Zampini   impMatType = MATSEQDENSE;
18188ebb749SStefano Zampini 
18288ebb749SStefano Zampini   /* Allocating some extra storage just to be safe */
18388ebb749SStefano Zampini   ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&auxindices);CHKERRQ(ierr);
18488ebb749SStefano Zampini   for (i=0;i<pcis->n;i++) auxindices[i]=i;
18588ebb749SStefano Zampini 
18688ebb749SStefano Zampini   /* vertices in boundary numbering */
18788ebb749SStefano Zampini   ierr = PetscMalloc(n_vertices*sizeof(PetscInt),&idx_V_B);CHKERRQ(ierr);
18888ebb749SStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(pcis->is_B_local,&BtoNmap);CHKERRQ(ierr);
18988ebb749SStefano Zampini   ierr = ISGlobalToLocalMappingApply(BtoNmap,IS_GTOLM_DROP,n_vertices,vertices,&i,idx_V_B);CHKERRQ(ierr);
19088ebb749SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&BtoNmap);CHKERRQ(ierr);
19188ebb749SStefano Zampini   if (i != n_vertices) {
19288ebb749SStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %d != %d\n",n_vertices,i);
19388ebb749SStefano Zampini   }
19488ebb749SStefano Zampini 
19588ebb749SStefano Zampini   /* Precompute stuffs needed for preprocessing and application of BDDC*/
19688ebb749SStefano Zampini   if (n_constraints) {
19745a1bb75SStefano Zampini     /* work vectors */
19845a1bb75SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec1_C);CHKERRQ(ierr);
19945a1bb75SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec2_C);CHKERRQ(ierr);
20045a1bb75SStefano Zampini     /* auxiliary matrices */
20188ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->local_auxmat2);CHKERRQ(ierr);
20225084f0cSStefano Zampini     ierr = MatSetSizes(pcbddc->local_auxmat2,n_R,n_constraints,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
20388ebb749SStefano Zampini     ierr = MatSetType(pcbddc->local_auxmat2,impMatType);CHKERRQ(ierr);
20425084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->local_auxmat2);CHKERRQ(ierr);
20588ebb749SStefano Zampini 
20625084f0cSStefano Zampini     /* Extract constraints on R nodes: C_{CR}  */
20725084f0cSStefano Zampini     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
2088ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
20925084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
21088ebb749SStefano Zampini 
21188ebb749SStefano Zampini     /* Assemble local_auxmat2 = - A_{RR}^{-1} C^T_{CR} needed by BDDC application */
21288ebb749SStefano Zampini     for (i=0;i<n_constraints;i++) {
21388ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
21488ebb749SStefano Zampini       /* Get row of constraint matrix in R numbering */
21525084f0cSStefano Zampini       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
21625084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_R,size_of_constraint,row_cmat_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
21725084f0cSStefano Zampini       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
21825084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_R);CHKERRQ(ierr);
21925084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_R);CHKERRQ(ierr);
22088ebb749SStefano Zampini       /* Solve for row of constraint matrix in R numbering */
22188ebb749SStefano Zampini       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
22225084f0cSStefano Zampini       /* Set values in local_auxmat2 */
22325084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
22488ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->local_auxmat2,n_R,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
22525084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
22688ebb749SStefano Zampini     }
22788ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
22888ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
22925084f0cSStefano Zampini     ierr = MatScale(pcbddc->local_auxmat2,m_one);CHKERRQ(ierr);
23088ebb749SStefano Zampini 
23188ebb749SStefano Zampini     /* Assemble explicitly M1 = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1} needed in preproc  */
23225084f0cSStefano Zampini     ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
23325084f0cSStefano Zampini     ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
23488ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&M1);CHKERRQ(ierr);
23588ebb749SStefano Zampini     ierr = MatSetSizes(M1,n_constraints,n_constraints,n_constraints,n_constraints);CHKERRQ(ierr);
23688ebb749SStefano Zampini     ierr = MatSetType(M1,impMatType);CHKERRQ(ierr);
23725084f0cSStefano Zampini     ierr = MatSetUp(M1);CHKERRQ(ierr);
23825084f0cSStefano Zampini     ierr = MatDuplicate(M1,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
23925084f0cSStefano Zampini     ierr = MatZeroEntries(M2);CHKERRQ(ierr);
24025084f0cSStefano Zampini     ierr = VecSet(vec1_C,m_one);CHKERRQ(ierr);
24125084f0cSStefano Zampini     ierr = MatDiagonalSet(M2,vec1_C,INSERT_VALUES);CHKERRQ(ierr);
24225084f0cSStefano Zampini     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
24325084f0cSStefano Zampini     ierr = MatDestroy(&M2);CHKERRQ(ierr);
24425084f0cSStefano Zampini     ierr = MatDestroy(&M3);CHKERRQ(ierr);
24588ebb749SStefano Zampini     /* Assemble local_auxmat1 = M1*C_{CR} needed by BDDC application in KSP and in preproc */
24688ebb749SStefano Zampini     ierr = MatMatMult(M1,C_CR,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
24788ebb749SStefano Zampini   }
24888ebb749SStefano Zampini 
24988ebb749SStefano Zampini   /* Get submatrices from subdomain matrix */
25088ebb749SStefano Zampini   if (n_vertices) {
2513a50541eSStefano Zampini     PetscInt ibs,mbs;
2523a50541eSStefano Zampini     PetscBool issbaij;
253af732b37SStefano Zampini     Mat newmat;
2543a50541eSStefano Zampini 
2553a50541eSStefano Zampini     ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
2569577ea80SStefano Zampini     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
2579577ea80SStefano Zampini     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
2583a50541eSStefano Zampini     if (ibs != mbs) { /* need to convert to SEQAIJ */
2599577ea80SStefano Zampini       ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
2609577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
2619577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
2629577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
2639577ea80SStefano Zampini       ierr = MatDestroy(&newmat);CHKERRQ(ierr);
2649577ea80SStefano Zampini     } else {
2653a50541eSStefano Zampini       /* this is safe */
2669577ea80SStefano Zampini       ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
2673a50541eSStefano Zampini       ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
2683a50541eSStefano Zampini       if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
2693a50541eSStefano Zampini         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
27045a1bb75SStefano Zampini         /* which of the two approaches is faster? */
2713a50541eSStefano Zampini         /* ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
2723a50541eSStefano Zampini         ierr = MatCreateTranspose(A_RV,&A_VR);CHKERRQ(ierr);*/
2733a50541eSStefano Zampini         ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
2743a50541eSStefano Zampini         ierr = MatCreateTranspose(A_VR,&A_RV);CHKERRQ(ierr);
2753a50541eSStefano Zampini         ierr = MatDestroy(&newmat);CHKERRQ(ierr);
2763a50541eSStefano Zampini       } else {
2779577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
2789577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
2799577ea80SStefano Zampini       }
2803a50541eSStefano Zampini     }
28145a1bb75SStefano Zampini     ierr = MatGetVecs(A_RV,&vec1_V,NULL);CHKERRQ(ierr);
28245a1bb75SStefano Zampini     ierr = VecDuplicate(vec1_V,&vec2_V);CHKERRQ(ierr);
28325084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
28488ebb749SStefano Zampini   }
28588ebb749SStefano Zampini 
28688ebb749SStefano Zampini   /* Matrix of coarse basis functions (local) */
28788ebb749SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
28888ebb749SStefano Zampini   ierr = MatSetSizes(pcbddc->coarse_phi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
28988ebb749SStefano Zampini   ierr = MatSetType(pcbddc->coarse_phi_B,impMatType);CHKERRQ(ierr);
29025084f0cSStefano Zampini   ierr = MatSetUp(pcbddc->coarse_phi_B);CHKERRQ(ierr);
2918eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
29288ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
29388ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_phi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
29488ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_phi_D,impMatType);CHKERRQ(ierr);
29525084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_phi_D);CHKERRQ(ierr);
29688ebb749SStefano Zampini   }
29788ebb749SStefano Zampini 
29825084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
2998ce42a96SStefano Zampini     ierr = ISGetIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
30088ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*coarsefunctions_errors),&coarsefunctions_errors);CHKERRQ(ierr);
30188ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*constraints_errors),&constraints_errors);CHKERRQ(ierr);
30288ebb749SStefano Zampini   }
30388ebb749SStefano Zampini   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
30488ebb749SStefano Zampini   ierr = PetscMalloc((pcbddc->local_primal_size)*(pcbddc->local_primal_size)*sizeof(PetscScalar),&coarse_submat_vals);CHKERRQ(ierr);
30588ebb749SStefano Zampini 
30688ebb749SStefano Zampini   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
30725084f0cSStefano Zampini 
30825084f0cSStefano Zampini   /* vertices */
30988ebb749SStefano Zampini   for (i=0;i<n_vertices;i++) {
31045a1bb75SStefano Zampini     /* this should not be needed, but MatMult_BAIJ is broken when using compressed row routines */
31145a1bb75SStefano Zampini     ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
31288ebb749SStefano Zampini     ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
31388ebb749SStefano Zampini     ierr = VecSetValue(vec1_V,i,one,INSERT_VALUES);CHKERRQ(ierr);
31488ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
31588ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
31625084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on constraints multipliers */
31788ebb749SStefano Zampini     ierr = MatMult(A_RV,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
31888ebb749SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
31988ebb749SStefano Zampini     ierr = VecScale(pcbddc->vec1_R,m_one);CHKERRQ(ierr);
32088ebb749SStefano Zampini     if (n_constraints) {
32188ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec1_R,vec1_C);CHKERRQ(ierr);
32288ebb749SStefano Zampini       ierr = MatMultAdd(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
32388ebb749SStefano Zampini       ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
32488ebb749SStefano Zampini     }
32588ebb749SStefano Zampini     ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
32688ebb749SStefano Zampini     ierr = MatMultAdd(A_VV,vec1_V,vec2_V,vec2_V);CHKERRQ(ierr);
32788ebb749SStefano Zampini 
32888ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
32988ebb749SStefano Zampini     /* coarse basis functions */
33088ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
33188ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
33288ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
33325084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
33488ebb749SStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
33525084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
33688ebb749SStefano Zampini     ierr = MatSetValue(pcbddc->coarse_phi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
3378eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
33888ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
33988ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
34025084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
34188ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
34225084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
34388ebb749SStefano Zampini     }
34425084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
34525084f0cSStefano Zampini     ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
34625084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
34725084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
34888ebb749SStefano Zampini     if (n_constraints) {
34925084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
35025084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
35125084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
35288ebb749SStefano Zampini     }
35388ebb749SStefano Zampini 
35425084f0cSStefano Zampini     /* check */
35525084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
35625084f0cSStefano Zampini       /* assemble subdomain vector on local nodes */
35788ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
35825084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
35925084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
36025084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
36125084f0cSStefano Zampini       ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
36225084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
36325084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
36488ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers (i.e. primal nodes) */
36588ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
36625084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
36725084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
36825084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
36988ebb749SStefano Zampini       if (n_constraints) {
37025084f0cSStefano Zampini         ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
37125084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
37225084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
37388ebb749SStefano Zampini       }
37425084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
37525084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
37688ebb749SStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
37788ebb749SStefano Zampini       /* check saddle point solution */
37888ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
37988ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
38088ebb749SStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i]);CHKERRQ(ierr);
38188ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
38225084f0cSStefano Zampini       /* shift by the identity matrix */
38325084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
38425084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
38525084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
38688ebb749SStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i]);CHKERRQ(ierr);
38788ebb749SStefano Zampini     }
38888ebb749SStefano Zampini   }
38988ebb749SStefano Zampini 
39025084f0cSStefano Zampini   /* constraints */
39188ebb749SStefano Zampini   for (i=0;i<n_constraints;i++) {
39288ebb749SStefano Zampini     ierr = VecSet(vec2_C,zero);CHKERRQ(ierr);
39388ebb749SStefano Zampini     ierr = VecSetValue(vec2_C,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
39488ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec2_C);CHKERRQ(ierr);
39588ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec2_C);CHKERRQ(ierr);
39625084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on vertices multipliers */
39788ebb749SStefano Zampini     ierr = MatMult(M1,vec2_C,vec1_C);CHKERRQ(ierr);
39888ebb749SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
39988ebb749SStefano Zampini     ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
40025084f0cSStefano Zampini     if (n_vertices) {
40125084f0cSStefano Zampini       ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
40225084f0cSStefano Zampini     }
40388ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
40488ebb749SStefano Zampini     /* coarse basis functions */
40525084f0cSStefano Zampini     j = i+n_vertices; /* don't touch this! */
40688ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
40788ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40888ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40925084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
41025084f0cSStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
41125084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
4128eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
41388ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
41488ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
41525084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
41625084f0cSStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
41725084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
41888ebb749SStefano Zampini     }
41925084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
42088ebb749SStefano Zampini     if (n_vertices) {
42125084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
42225084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
42325084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
42488ebb749SStefano Zampini     }
42525084f0cSStefano Zampini     ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
42625084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
42725084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
42888ebb749SStefano Zampini 
42925084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
43088ebb749SStefano Zampini       /* assemble subdomain vector on nodes */
43188ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
43225084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
43325084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
43425084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
43525084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
43625084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
43788ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers */
43888ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
43988ebb749SStefano Zampini       if (n_vertices) {
44025084f0cSStefano Zampini         ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
44125084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
44225084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
44388ebb749SStefano Zampini       }
44425084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
44525084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
44625084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
44725084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
44825084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
44925084f0cSStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
45088ebb749SStefano Zampini       /* check saddle point solution */
45188ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
45288ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
45325084f0cSStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[j]);CHKERRQ(ierr);
45488ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
45525084f0cSStefano Zampini       /* shift by the identity matrix */
45625084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,j,m_one,ADD_VALUES);CHKERRQ(ierr);
45725084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
45825084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
45925084f0cSStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[j]);CHKERRQ(ierr);
46088ebb749SStefano Zampini     }
46188ebb749SStefano Zampini   }
46225084f0cSStefano Zampini   /* call assembling routines for local coarse basis */
46388ebb749SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
46488ebb749SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4658eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
46688ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
46788ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
46888ebb749SStefano Zampini   }
46925084f0cSStefano Zampini 
47088ebb749SStefano Zampini   /* compute other basis functions for non-symmetric problems */
47188ebb749SStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
47288ebb749SStefano Zampini   if (!setsym || (setsym && !issym)) {
47388ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
47488ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_psi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
47588ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_psi_B,impMatType);CHKERRQ(ierr);
47625084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_psi_B);CHKERRQ(ierr);
4778eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
47888ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
47988ebb749SStefano Zampini       ierr = MatSetSizes(pcbddc->coarse_psi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
48088ebb749SStefano Zampini       ierr = MatSetType(pcbddc->coarse_psi_D,impMatType);CHKERRQ(ierr);
48125084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->coarse_psi_D);CHKERRQ(ierr);
48288ebb749SStefano Zampini     }
48388ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
48488ebb749SStefano Zampini       if (n_constraints) {
48588ebb749SStefano Zampini         ierr = VecSet(vec1_C,zero);CHKERRQ(ierr);
48688ebb749SStefano Zampini         for (j=0;j<n_constraints;j++) {
48725084f0cSStefano Zampini           ierr = VecSetValue(vec1_C,j,coarse_submat_vals[(j+n_vertices)*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
48888ebb749SStefano Zampini         }
48925084f0cSStefano Zampini         ierr = VecAssemblyBegin(vec1_C);CHKERRQ(ierr);
49025084f0cSStefano Zampini         ierr = VecAssemblyEnd(vec1_C);CHKERRQ(ierr);
49188ebb749SStefano Zampini       }
49288ebb749SStefano Zampini       if (i<n_vertices) {
49388ebb749SStefano Zampini         ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
49488ebb749SStefano Zampini         ierr = VecSetValue(vec1_V,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
49588ebb749SStefano Zampini         ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
49688ebb749SStefano Zampini         ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
49788ebb749SStefano Zampini         ierr = MatMultTranspose(A_VR,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
49888ebb749SStefano Zampini         if (n_constraints) {
49988ebb749SStefano Zampini           ierr = MatMultTransposeAdd(C_CR,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
50088ebb749SStefano Zampini         }
50188ebb749SStefano Zampini       } else {
50288ebb749SStefano Zampini         ierr = MatMultTranspose(C_CR,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
50388ebb749SStefano Zampini       }
50488ebb749SStefano Zampini       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
50588ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
50688ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
50788ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
50825084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
50988ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_psi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
51025084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
51188ebb749SStefano Zampini       if (i<n_vertices) {
51288ebb749SStefano Zampini         ierr = MatSetValue(pcbddc->coarse_psi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
51388ebb749SStefano Zampini       }
5148eeda7d8SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
51588ebb749SStefano Zampini         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
51688ebb749SStefano Zampini         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
51725084f0cSStefano Zampini         ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
51888ebb749SStefano Zampini         ierr = MatSetValues(pcbddc->coarse_psi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
51925084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
52088ebb749SStefano Zampini       }
52188ebb749SStefano Zampini 
52225084f0cSStefano Zampini       if (pcbddc->dbg_flag) {
52388ebb749SStefano Zampini         /* assemble subdomain vector on nodes */
52488ebb749SStefano Zampini         ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
52525084f0cSStefano Zampini         ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
52625084f0cSStefano Zampini         ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
52725084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
52825084f0cSStefano Zampini         if (i<n_vertices) {
52925084f0cSStefano Zampini           ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
53088ebb749SStefano Zampini         }
53125084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
53225084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
53325084f0cSStefano Zampini         /* assemble subdomain vector of lagrange multipliers */
53425084f0cSStefano Zampini         for (j=0;j<pcbddc->local_primal_size;j++) {
53525084f0cSStefano Zampini           ierr = VecSetValue(pcbddc->vec1_P,j,-coarse_submat_vals[j*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
53625084f0cSStefano Zampini         }
53725084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
53825084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
53988ebb749SStefano Zampini         /* check saddle point solution */
54088ebb749SStefano Zampini         ierr = MatMultTranspose(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
54188ebb749SStefano Zampini         ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
54288ebb749SStefano Zampini         ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
54388ebb749SStefano Zampini         ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
54425084f0cSStefano Zampini         /* shift by the identity matrix */
54525084f0cSStefano Zampini         ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
54625084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
54725084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
54888ebb749SStefano Zampini         ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
54988ebb749SStefano Zampini       }
55088ebb749SStefano Zampini     }
55188ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
55288ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5538eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
55488ebb749SStefano Zampini       ierr = MatAssemblyBegin(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
55588ebb749SStefano Zampini       ierr = MatAssemblyEnd(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
55688ebb749SStefano Zampini     }
55788ebb749SStefano Zampini   }
55888ebb749SStefano Zampini   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
55988ebb749SStefano Zampini   /* Checking coarse_sub_mat and coarse basis functios */
56088ebb749SStefano Zampini   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
56188ebb749SStefano Zampini   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
56225084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
56388ebb749SStefano Zampini     Mat         coarse_sub_mat;
56425084f0cSStefano Zampini     Mat         AUXMAT,TM1,TM2,TM3,TM4;
56588ebb749SStefano Zampini     Mat         coarse_phi_D,coarse_phi_B;
56688ebb749SStefano Zampini     Mat         coarse_psi_D,coarse_psi_B;
56788ebb749SStefano Zampini     Mat         A_II,A_BB,A_IB,A_BI;
56888ebb749SStefano Zampini     MatType     checkmattype=MATSEQAIJ;
56988ebb749SStefano Zampini     PetscReal   real_value;
57088ebb749SStefano Zampini 
57188ebb749SStefano Zampini     ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
57288ebb749SStefano Zampini     ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
57388ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
57488ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
57588ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
57688ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
57788ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
57888ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
57988ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
58088ebb749SStefano Zampini     }
58188ebb749SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
58288ebb749SStefano Zampini 
58325084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
58425084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat and local basis functions\n");CHKERRQ(ierr);
58525084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
58688ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
58788ebb749SStefano Zampini       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
58888ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
58988ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
59088ebb749SStefano Zampini       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
59188ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
59288ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
59388ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
59488ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
59588ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
59688ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
59788ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
59888ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
59988ebb749SStefano Zampini     } else {
60088ebb749SStefano Zampini       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
60188ebb749SStefano Zampini       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
60288ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
60388ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
60488ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
60588ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
60688ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
60788ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
60888ebb749SStefano Zampini     }
60988ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
61088ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
61188ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
61288ebb749SStefano Zampini     ierr = MatConvert(TM1,MATSEQDENSE,MAT_REUSE_MATRIX,&TM1);CHKERRQ(ierr);
61388ebb749SStefano Zampini     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
61488ebb749SStefano Zampini     ierr = MatNorm(TM1,NORM_INFINITY,&real_value);CHKERRQ(ierr);
61525084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"----------------------------------\n");CHKERRQ(ierr);
61625084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d \n",PetscGlobalRank);CHKERRQ(ierr);
61725084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"matrix error = % 1.14e\n",real_value);CHKERRQ(ierr);
61825084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (phi) errors\n");CHKERRQ(ierr);
61988ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
62025084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,coarsefunctions_errors[i]);CHKERRQ(ierr);
62188ebb749SStefano Zampini     }
62225084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (phi) errors\n");CHKERRQ(ierr);
62388ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
62425084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,constraints_errors[i]);CHKERRQ(ierr);
62588ebb749SStefano Zampini     }
62688ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
62725084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (psi) errors\n");CHKERRQ(ierr);
62888ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
62925084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,coarsefunctions_errors[i]);CHKERRQ(ierr);
63088ebb749SStefano Zampini       }
63125084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (psi) errors\n");CHKERRQ(ierr);
63288ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
63325084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,constraints_errors[i]);CHKERRQ(ierr);
63488ebb749SStefano Zampini       }
63588ebb749SStefano Zampini     }
63625084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
63788ebb749SStefano Zampini     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
63888ebb749SStefano Zampini     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
63988ebb749SStefano Zampini     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
64088ebb749SStefano Zampini     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
64188ebb749SStefano Zampini     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
64288ebb749SStefano Zampini     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
64388ebb749SStefano Zampini     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
64488ebb749SStefano Zampini     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
64588ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
64688ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
64788ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
64888ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
64988ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
65088ebb749SStefano Zampini     }
65188ebb749SStefano Zampini     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
6528ce42a96SStefano Zampini     ierr = ISRestoreIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
65388ebb749SStefano Zampini     ierr = PetscFree(coarsefunctions_errors);CHKERRQ(ierr);
65488ebb749SStefano Zampini     ierr = PetscFree(constraints_errors);CHKERRQ(ierr);
65588ebb749SStefano Zampini   }
65688ebb749SStefano Zampini   /* free memory */
65788ebb749SStefano Zampini   if (n_vertices) {
65888ebb749SStefano Zampini     ierr = PetscFree(vertices);CHKERRQ(ierr);
65988ebb749SStefano Zampini     ierr = VecDestroy(&vec1_V);CHKERRQ(ierr);
66088ebb749SStefano Zampini     ierr = VecDestroy(&vec2_V);CHKERRQ(ierr);
66188ebb749SStefano Zampini     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
66288ebb749SStefano Zampini     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
66388ebb749SStefano Zampini     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
66488ebb749SStefano Zampini   }
66588ebb749SStefano Zampini   if (n_constraints) {
66688ebb749SStefano Zampini     ierr = VecDestroy(&vec1_C);CHKERRQ(ierr);
66788ebb749SStefano Zampini     ierr = VecDestroy(&vec2_C);CHKERRQ(ierr);
66888ebb749SStefano Zampini     ierr = MatDestroy(&M1);CHKERRQ(ierr);
66988ebb749SStefano Zampini     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
67088ebb749SStefano Zampini   }
67188ebb749SStefano Zampini   ierr = PetscFree(auxindices);CHKERRQ(ierr);
6728629588bSStefano Zampini   /* get back data */
6738629588bSStefano Zampini   *coarse_submat_vals_n = coarse_submat_vals;
67488ebb749SStefano Zampini   PetscFunctionReturn(0);
67588ebb749SStefano Zampini }
67688ebb749SStefano Zampini 
67788ebb749SStefano Zampini #undef __FUNCT__
678aa0d41d4SStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalMatrices"
679aa0d41d4SStefano Zampini PetscErrorCode PCBDDCSetUpLocalMatrices(PC pc)
680aa0d41d4SStefano Zampini {
681aa0d41d4SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
682aa0d41d4SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
683aa0d41d4SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
6849577ea80SStefano Zampini   PetscBool         issbaij,isbaij;
685aa0d41d4SStefano Zampini   /* manage repeated solves */
686aa0d41d4SStefano Zampini   MatReuse          reuse;
687aa0d41d4SStefano Zampini   MatStructure      matstruct;
688aa0d41d4SStefano Zampini   PetscErrorCode    ierr;
689aa0d41d4SStefano Zampini 
690aa0d41d4SStefano Zampini   PetscFunctionBegin;
691aa0d41d4SStefano Zampini   /* get mat flags */
692aa0d41d4SStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
693aa0d41d4SStefano Zampini   reuse = MAT_INITIAL_MATRIX;
694aa0d41d4SStefano Zampini   if (pc->setupcalled) {
695aa0d41d4SStefano Zampini     /* when matstruct is SAME_PRECONDITIONER, we shouldn't be here */
696aa0d41d4SStefano Zampini     if (matstruct == SAME_PRECONDITIONER) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen");
697aa0d41d4SStefano Zampini     if (matstruct == SAME_NONZERO_PATTERN) {
698aa0d41d4SStefano Zampini       reuse = MAT_REUSE_MATRIX;
699aa0d41d4SStefano Zampini     } else {
700aa0d41d4SStefano Zampini       reuse = MAT_INITIAL_MATRIX;
701aa0d41d4SStefano Zampini     }
702aa0d41d4SStefano Zampini   }
703aa0d41d4SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
704aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
705aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
706aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
707aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BB);CHKERRQ(ierr);
708aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
709aa0d41d4SStefano Zampini   }
710aa0d41d4SStefano Zampini 
711aa0d41d4SStefano Zampini   /* transform local matrices if needed */
712aa0d41d4SStefano Zampini   if (pcbddc->use_change_of_basis) {
713aa0d41d4SStefano Zampini     Mat         change_mat_all;
714aa0d41d4SStefano Zampini     PetscScalar *row_cmat_values;
715aa0d41d4SStefano Zampini     PetscInt    *row_cmat_indices;
716aa0d41d4SStefano Zampini     PetscInt    *nnz,*is_indices,*temp_indices;
717aa0d41d4SStefano Zampini     PetscInt    i,j,k,n_D,n_B;
718aa0d41d4SStefano Zampini 
719aa0d41d4SStefano Zampini     /* Get Non-overlapping dimensions */
720aa0d41d4SStefano Zampini     n_B = pcis->n_B;
721aa0d41d4SStefano Zampini     n_D = pcis->n-n_B;
722aa0d41d4SStefano Zampini 
723aa0d41d4SStefano Zampini     /* compute nonzero structure of change of basis on all local nodes */
724aa0d41d4SStefano Zampini     ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
725aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
726aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) nnz[is_indices[i]] = 1;
727aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
728aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
729aa0d41d4SStefano Zampini     k=1;
730aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
731aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
732aa0d41d4SStefano Zampini       nnz[is_indices[i]]=j;
733aa0d41d4SStefano Zampini       if (k < j) k = j;
734aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
735aa0d41d4SStefano Zampini     }
736aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
737aa0d41d4SStefano Zampini     /* assemble change of basis matrix on the whole set of local dofs */
738aa0d41d4SStefano Zampini     ierr = PetscMalloc(k*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
739aa0d41d4SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&change_mat_all);CHKERRQ(ierr);
740aa0d41d4SStefano Zampini     ierr = MatSetSizes(change_mat_all,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
741aa0d41d4SStefano Zampini     ierr = MatSetType(change_mat_all,MATSEQAIJ);CHKERRQ(ierr);
742aa0d41d4SStefano Zampini     ierr = MatSeqAIJSetPreallocation(change_mat_all,0,nnz);CHKERRQ(ierr);
743aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
744aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) {
745aa0d41d4SStefano Zampini       ierr = MatSetValue(change_mat_all,is_indices[i],is_indices[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
746aa0d41d4SStefano Zampini     }
747aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
748aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
749aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
750aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
751aa0d41d4SStefano Zampini       for (k=0; k<j; k++) temp_indices[k]=is_indices[row_cmat_indices[k]];
752aa0d41d4SStefano Zampini       ierr = MatSetValues(change_mat_all,1,&is_indices[i],j,temp_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
753aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
754aa0d41d4SStefano Zampini     }
755aa0d41d4SStefano Zampini     ierr = MatAssemblyBegin(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
756aa0d41d4SStefano Zampini     ierr = MatAssemblyEnd(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7579577ea80SStefano Zampini     /* TODO: HOW TO WORK WITH BAIJ and SBAIJ? PtAP not provided */
7589577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
7599577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQBAIJ,&isbaij);CHKERRQ(ierr);
7609577ea80SStefano Zampini     if (!issbaij && !isbaij) {
761aa0d41d4SStefano Zampini       ierr = MatPtAP(matis->A,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
762aa0d41d4SStefano Zampini     } else {
763aa0d41d4SStefano Zampini       Mat work_mat;
764aa0d41d4SStefano Zampini       ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
765aa0d41d4SStefano Zampini       ierr = MatPtAP(work_mat,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
766aa0d41d4SStefano Zampini       ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
767aa0d41d4SStefano Zampini     }
76845a1bb75SStefano Zampini     /*
76945a1bb75SStefano Zampini     ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
77045a1bb75SStefano Zampini     ierr = MatView(change_mat_all,(PetscViewer)0);CHKERRQ(ierr);
77145a1bb75SStefano Zampini     */
772aa0d41d4SStefano Zampini     ierr = MatDestroy(&change_mat_all);CHKERRQ(ierr);
773aa0d41d4SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
774aa0d41d4SStefano Zampini     ierr = PetscFree(temp_indices);CHKERRQ(ierr);
775aa0d41d4SStefano Zampini   } else {
776aa0d41d4SStefano Zampini     /* without change of basis, the local matrix is unchanged */
777aa0d41d4SStefano Zampini     if (!pcbddc->local_mat) {
778aa0d41d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)matis->A);CHKERRQ(ierr);
779aa0d41d4SStefano Zampini       pcbddc->local_mat = matis->A;
780aa0d41d4SStefano Zampini     }
781aa0d41d4SStefano Zampini   }
782aa0d41d4SStefano Zampini 
783aa0d41d4SStefano Zampini   /* get submatrices */
784aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_I_local,reuse,&pcis->A_II);CHKERRQ(ierr);
7859577ea80SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_B_local,reuse,&pcis->A_BB);CHKERRQ(ierr);
7869577ea80SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
7879577ea80SStefano Zampini   if (!issbaij) {
788aa0d41d4SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
789aa0d41d4SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
7909577ea80SStefano Zampini   } else {
7919577ea80SStefano Zampini     Mat newmat;
7929577ea80SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
7939577ea80SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
7949577ea80SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
7959577ea80SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
7969577ea80SStefano Zampini   }
797aa0d41d4SStefano Zampini   PetscFunctionReturn(0);
798aa0d41d4SStefano Zampini }
799aa0d41d4SStefano Zampini 
800aa0d41d4SStefano Zampini #undef __FUNCT__
801a64d13efSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalScatters"
8028ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
803a64d13efSStefano Zampini {
804a64d13efSStefano Zampini   PC_IS*         pcis = (PC_IS*)(pc->data);
805a64d13efSStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8068ce42a96SStefano Zampini   IS             is_aux1,is_aux2;
807a64d13efSStefano Zampini   PetscInt       *vertices,*aux_array1,*aux_array2,*is_indices,*idx_R_local;
8083a50541eSStefano Zampini   PetscInt       n_vertices,i,j,n_R,n_D,n_B;
8093a50541eSStefano Zampini   PetscInt       vbs,bs;
8104641a718SStefano Zampini   PetscBT        bitmask;
811a64d13efSStefano Zampini   PetscErrorCode ierr;
812a64d13efSStefano Zampini 
813a64d13efSStefano Zampini   PetscFunctionBegin;
814a64d13efSStefano Zampini   /* Set Non-overlapping dimensions */
815a64d13efSStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
816a64d13efSStefano Zampini   /* get vertex indices from constraint matrix */
817a64d13efSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
8183a50541eSStefano Zampini 
8194641a718SStefano Zampini   /* create auxiliary bitmask */
8204641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
8214641a718SStefano Zampini   for (i=0;i<n_vertices;i++) {
8224641a718SStefano Zampini     ierr = PetscBTSet(bitmask,vertices[i]);CHKERRQ(ierr);
8234641a718SStefano Zampini   }
8243a50541eSStefano Zampini 
825a64d13efSStefano Zampini   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
826a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n-n_vertices)*sizeof(PetscInt),&idx_R_local);CHKERRQ(ierr);
827a64d13efSStefano Zampini   for (i=0, n_R=0; i<pcis->n; i++) {
8284641a718SStefano Zampini     if (!PetscBTLookup(bitmask,i)) {
829a64d13efSStefano Zampini       idx_R_local[n_R] = i;
830a64d13efSStefano Zampini       n_R++;
831a64d13efSStefano Zampini     }
832a64d13efSStefano Zampini   }
8333a50541eSStefano Zampini 
8343a50541eSStefano Zampini   /* Block code */
8353a50541eSStefano Zampini   vbs = 1;
8363a50541eSStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
8373a50541eSStefano Zampini   if (bs>1 && !(n_vertices%bs)) {
8383a50541eSStefano Zampini     PetscBool is_blocked = PETSC_TRUE;
8393a50541eSStefano Zampini     PetscInt  *vary;
8403a50541eSStefano Zampini     /* Verify if the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
8413a50541eSStefano Zampini     ierr = PetscMalloc(pcis->n/bs*sizeof(PetscInt),&vary);CHKERRQ(ierr);
8423a50541eSStefano Zampini     ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
8433a50541eSStefano Zampini     for (i=0; i<n_vertices; i++) vary[vertices[i]/bs]++;
8443a50541eSStefano Zampini     for (i=0; i<n_vertices; i++) {
8453a50541eSStefano Zampini       if (vary[i]!=0 && vary[i]!=bs) {
8463a50541eSStefano Zampini         is_blocked = PETSC_FALSE;
8473a50541eSStefano Zampini         break;
8483a50541eSStefano Zampini       }
8493a50541eSStefano Zampini     }
8503a50541eSStefano Zampini     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
8513a50541eSStefano Zampini       vbs = bs;
8523a50541eSStefano Zampini       for (i=0;i<n_R/vbs;i++) {
8533a50541eSStefano Zampini         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
8543a50541eSStefano Zampini       }
8553a50541eSStefano Zampini     }
8563a50541eSStefano Zampini     ierr = PetscFree(vary);CHKERRQ(ierr);
8573a50541eSStefano Zampini   }
858a64d13efSStefano Zampini   ierr = PetscFree(vertices);CHKERRQ(ierr);
8593a50541eSStefano Zampini   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
8603a50541eSStefano Zampini   ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
861a64d13efSStefano Zampini 
862a64d13efSStefano Zampini   /* print some info if requested */
863a64d13efSStefano Zampini   if (pcbddc->dbg_flag) {
864a64d13efSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
865a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
866a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
867a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
8683a50541eSStefano 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);
869a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr);
870a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
871a64d13efSStefano Zampini   }
872a64d13efSStefano Zampini 
873a64d13efSStefano Zampini   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
8743a50541eSStefano Zampini   ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
875a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
876a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array2);CHKERRQ(ierr);
877a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
8784641a718SStefano Zampini   for (i=0; i<n_D; i++) {
8794641a718SStefano Zampini     ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
8804641a718SStefano Zampini   }
881a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
882a64d13efSStefano Zampini   for (i=0, j=0; i<n_R; i++) {
8834641a718SStefano Zampini     if (!PetscBTLookup(bitmask,idx_R_local[i])) {
8844641a718SStefano Zampini       aux_array1[j++] = i;
885a64d13efSStefano Zampini     }
886a64d13efSStefano Zampini   }
887a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
888a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
889a64d13efSStefano Zampini   for (i=0, j=0; i<n_B; i++) {
8904641a718SStefano Zampini     if (!PetscBTLookup(bitmask,is_indices[i])) {
8914641a718SStefano Zampini       aux_array2[j++] = i;
892a64d13efSStefano Zampini     }
893a64d13efSStefano Zampini   }
894a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
895a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
896a64d13efSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
897a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
898a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
899a64d13efSStefano Zampini 
9008eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
901a64d13efSStefano Zampini     ierr = PetscMalloc(n_D*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
902a64d13efSStefano Zampini     for (i=0, j=0; i<n_R; i++) {
9034641a718SStefano Zampini       if (PetscBTLookup(bitmask,idx_R_local[i])) {
9044641a718SStefano Zampini         aux_array1[j++] = i;
905a64d13efSStefano Zampini       }
906a64d13efSStefano Zampini     }
907a64d13efSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
908a64d13efSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
909a64d13efSStefano Zampini     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
910a64d13efSStefano Zampini   }
9114641a718SStefano Zampini   ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
9123a50541eSStefano Zampini   ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
913a64d13efSStefano Zampini   PetscFunctionReturn(0);
914a64d13efSStefano Zampini }
915a64d13efSStefano Zampini 
916304d26faSStefano Zampini 
917304d26faSStefano Zampini #undef __FUNCT__
918304d26faSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
9198ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc)
920304d26faSStefano Zampini {
921304d26faSStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
922304d26faSStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
923304d26faSStefano Zampini   PC             pc_temp;
924304d26faSStefano Zampini   Mat            A_RR;
925304d26faSStefano Zampini   Vec            vec1,vec2,vec3;
926304d26faSStefano Zampini   MatStructure   matstruct;
927304d26faSStefano Zampini   PetscScalar    m_one = -1.0;
928304d26faSStefano Zampini   PetscReal      value;
929af732b37SStefano Zampini   PetscInt       n_D,n_R,ibs,mbs;
9309577ea80SStefano Zampini   PetscBool      use_exact,use_exact_reduced,issbaij;
931304d26faSStefano Zampini   PetscErrorCode ierr;
932e604994aSStefano Zampini   /* prefixes stuff */
933e604994aSStefano Zampini   char           dir_prefix[256],neu_prefix[256],str_level[3];
934e604994aSStefano Zampini   size_t         len;
935304d26faSStefano Zampini 
936304d26faSStefano Zampini   PetscFunctionBegin;
937304d26faSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
938304d26faSStefano Zampini 
939e604994aSStefano Zampini   /* compute prefixes */
940e604994aSStefano Zampini   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
941e604994aSStefano Zampini   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
942e604994aSStefano Zampini   if (!pcbddc->current_level) {
943e604994aSStefano Zampini     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
944e604994aSStefano Zampini     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
945e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
946e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
947e604994aSStefano Zampini   } else {
948e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
949e604994aSStefano Zampini     sprintf(str_level,"%d_",(int)(pcbddc->current_level));
950e604994aSStefano Zampini     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
951e604994aSStefano Zampini     len -= 15; /* remove "pc_bddc_coarse_" */
952e604994aSStefano Zampini     if (pcbddc->current_level>1) len -= 2; /* remove "X_" with X level number (works with 9 levels max) */
953e604994aSStefano Zampini     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
954e604994aSStefano Zampini     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
955e604994aSStefano Zampini     *(dir_prefix+len)='\0';
956e604994aSStefano Zampini     *(neu_prefix+len)='\0';
957e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
958e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
959e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
960e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
961e604994aSStefano Zampini   }
962e604994aSStefano Zampini 
963304d26faSStefano Zampini   /* DIRICHLET PROBLEM */
964ac78edfcSStefano Zampini   /* Matrix for Dirichlet problem is pcis->A_II */
9658ce42a96SStefano Zampini   ierr = ISGetSize(pcis->is_I_local,&n_D);CHKERRQ(ierr);
966304d26faSStefano Zampini   if (!pcbddc->ksp_D) { /* create object if not yet build */
967304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
968304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
969304d26faSStefano Zampini     /* default */
970304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
971e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
9729577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
973304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
9749577ea80SStefano Zampini     if (issbaij) {
9759577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
9769577ea80SStefano Zampini     } else {
977304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
9789577ea80SStefano Zampini     }
979304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
980304d26faSStefano Zampini   }
981304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II,matstruct);CHKERRQ(ierr);
982304d26faSStefano Zampini   /* Allow user's customization */
983304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
984304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
985304d26faSStefano Zampini   if (!n_D) {
986304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
987304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
988304d26faSStefano Zampini   }
989304d26faSStefano Zampini   /* Set Up KSP for Dirichlet problem of BDDC */
990304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
991304d26faSStefano Zampini   /* set ksp_D into pcis data */
992304d26faSStefano Zampini   ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
993304d26faSStefano Zampini   ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
994304d26faSStefano Zampini   pcis->ksp_D = pcbddc->ksp_D;
995304d26faSStefano Zampini 
996304d26faSStefano Zampini   /* NEUMANN PROBLEM */
997304d26faSStefano Zampini   /* Matrix for Neumann problem is A_RR -> we need to create it */
9988ce42a96SStefano Zampini   ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
999af732b37SStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
1000af732b37SStefano Zampini   ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
10013a50541eSStefano Zampini   if (ibs != mbs) {
1002af732b37SStefano Zampini     Mat newmat;
1003af732b37SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
1004af732b37SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
1005af732b37SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
1006af732b37SStefano Zampini   } else {
10078ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
1008af732b37SStefano Zampini   }
1009304d26faSStefano Zampini   if (!pcbddc->ksp_R) { /* create object if not yet build */
1010304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
1011304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
1012304d26faSStefano Zampini     /* default */
1013304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
1014e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
1015304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
10169577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
10179577ea80SStefano Zampini     if (issbaij) {
10189577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
10199577ea80SStefano Zampini     } else {
1020304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
10219577ea80SStefano Zampini     }
1022304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1023304d26faSStefano Zampini   }
1024304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR,matstruct);CHKERRQ(ierr);
1025304d26faSStefano Zampini   /* Allow user's customization */
1026304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
1027304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1028304d26faSStefano Zampini   if (!n_R) {
1029304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
1030304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1031304d26faSStefano Zampini   }
1032304d26faSStefano Zampini   /* Set Up KSP for Neumann problem of BDDC */
1033304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
1034304d26faSStefano Zampini 
1035304d26faSStefano Zampini   /* check Dirichlet and Neumann solvers and adapt them if a nullspace correction is needed */
1036304d26faSStefano Zampini 
1037304d26faSStefano Zampini   /* Dirichlet */
1038304d26faSStefano Zampini   ierr = MatGetVecs(pcis->A_II,&vec1,&vec2);CHKERRQ(ierr);
1039304d26faSStefano Zampini   ierr = VecDuplicate(vec1,&vec3);CHKERRQ(ierr);
1040304d26faSStefano Zampini   ierr = VecSetRandom(vec1,NULL);CHKERRQ(ierr);
1041304d26faSStefano Zampini   ierr = MatMult(pcis->A_II,vec1,vec2);CHKERRQ(ierr);
1042304d26faSStefano Zampini   ierr = KSPSolve(pcbddc->ksp_D,vec2,vec3);CHKERRQ(ierr);
1043304d26faSStefano Zampini   ierr = VecAXPY(vec3,m_one,vec1);CHKERRQ(ierr);
1044304d26faSStefano Zampini   ierr = VecNorm(vec3,NORM_INFINITY,&value);CHKERRQ(ierr);
1045304d26faSStefano Zampini   ierr = VecDestroy(&vec1);CHKERRQ(ierr);
1046304d26faSStefano Zampini   ierr = VecDestroy(&vec2);CHKERRQ(ierr);
1047304d26faSStefano Zampini   ierr = VecDestroy(&vec3);CHKERRQ(ierr);
1048304d26faSStefano Zampini   /* need to be adapted? */
1049b8ffe317SStefano Zampini   use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1050b8ffe317SStefano Zampini   ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1051b8ffe317SStefano Zampini   ierr = PCBDDCSetUseExactDirichlet(pc,use_exact_reduced);CHKERRQ(ierr);
1052304d26faSStefano Zampini   /* print info */
1053304d26faSStefano Zampini   if (pcbddc->dbg_flag) {
1054304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1055304d26faSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
1056304d26faSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Checking solution of Dirichlet and Neumann problems\n");CHKERRQ(ierr);
1057e604994aSStefano 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);
1058304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1059304d26faSStefano Zampini   }
1060b8ffe317SStefano Zampini   if (pcbddc->NullSpace && !use_exact_reduced && !pcbddc->switch_static) {
10618ce42a96SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcis->is_I_local);CHKERRQ(ierr);
1062304d26faSStefano Zampini   }
1063304d26faSStefano Zampini 
1064304d26faSStefano Zampini   /* Neumann */
1065304d26faSStefano Zampini   ierr = MatGetVecs(A_RR,&vec1,&vec2);CHKERRQ(ierr);
1066304d26faSStefano Zampini   ierr = VecDuplicate(vec1,&vec3);CHKERRQ(ierr);
1067304d26faSStefano Zampini   ierr = VecSetRandom(vec1,NULL);CHKERRQ(ierr);
1068304d26faSStefano Zampini   ierr = MatMult(A_RR,vec1,vec2);CHKERRQ(ierr);
1069304d26faSStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,vec2,vec3);CHKERRQ(ierr);
1070304d26faSStefano Zampini   ierr = VecAXPY(vec3,m_one,vec1);CHKERRQ(ierr);
1071304d26faSStefano Zampini   ierr = VecNorm(vec3,NORM_INFINITY,&value);CHKERRQ(ierr);
1072304d26faSStefano Zampini   ierr = VecDestroy(&vec1);CHKERRQ(ierr);
1073304d26faSStefano Zampini   ierr = VecDestroy(&vec2);CHKERRQ(ierr);
1074304d26faSStefano Zampini   ierr = VecDestroy(&vec3);CHKERRQ(ierr);
1075304d26faSStefano Zampini   /* need to be adapted? */
1076b8ffe317SStefano Zampini   use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1077b8ffe317SStefano Zampini   ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1078304d26faSStefano Zampini   /* print info */
1079304d26faSStefano Zampini   if (pcbddc->dbg_flag) {
1080e604994aSStefano 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);
1081304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1082304d26faSStefano Zampini   }
1083b8ffe317SStefano Zampini   if (pcbddc->NullSpace && !use_exact_reduced) { /* is it the right logic? */
10848ce42a96SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcbddc->is_R_local);CHKERRQ(ierr);
1085304d26faSStefano Zampini   }
1086304d26faSStefano Zampini   /* free Neumann problem's matrix */
1087304d26faSStefano Zampini   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1088304d26faSStefano Zampini   PetscFunctionReturn(0);
1089304d26faSStefano Zampini }
1090304d26faSStefano Zampini 
1091304d26faSStefano Zampini #undef __FUNCT__
1092674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSolveSaddlePoint"
1093674ae819SStefano Zampini static PetscErrorCode  PCBDDCSolveSaddlePoint(PC pc)
1094674ae819SStefano Zampini {
1095674ae819SStefano Zampini   PetscErrorCode ierr;
1096674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1097674ae819SStefano Zampini 
1098674ae819SStefano Zampini   PetscFunctionBegin;
1099674ae819SStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
1100674ae819SStefano Zampini   if (pcbddc->local_auxmat1) {
1101674ae819SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec2_R,pcbddc->vec1_C);CHKERRQ(ierr);
1102674ae819SStefano Zampini     ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
1103674ae819SStefano Zampini   }
1104674ae819SStefano Zampini   PetscFunctionReturn(0);
1105674ae819SStefano Zampini }
1106674ae819SStefano Zampini 
1107674ae819SStefano Zampini #undef __FUNCT__
1108674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
1109674ae819SStefano Zampini PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc)
1110674ae819SStefano Zampini {
1111674ae819SStefano Zampini   PetscErrorCode ierr;
1112674ae819SStefano Zampini   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
1113674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)  (pc->data);
1114674ae819SStefano Zampini   const PetscScalar zero = 0.0;
1115674ae819SStefano Zampini 
1116674ae819SStefano Zampini   PetscFunctionBegin;
111715aaf578SStefano Zampini   /* Application of PHI^T (or PSI^T)  */
111815aaf578SStefano Zampini   if (pcbddc->coarse_psi_B) {
111915aaf578SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
11208eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
112115aaf578SStefano Zampini   } else {
1122674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
11238eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
112415aaf578SStefano Zampini   }
1125674ae819SStefano Zampini   /* Scatter data of coarse_rhs */
1126674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { ierr = VecSet(pcbddc->coarse_rhs,zero);CHKERRQ(ierr); }
1127674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1128674ae819SStefano Zampini 
1129674ae819SStefano Zampini   /* Local solution on R nodes */
1130674ae819SStefano Zampini   ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
1131674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1132674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
11338eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1134674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1135674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1136674ae819SStefano Zampini   }
1137674ae819SStefano Zampini   ierr = PCBDDCSolveSaddlePoint(pc);CHKERRQ(ierr);
1138674ae819SStefano Zampini   ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1139674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1140674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
11418eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1142674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1143674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1144674ae819SStefano Zampini   }
1145674ae819SStefano Zampini 
1146674ae819SStefano Zampini   /* Coarse solution */
1147674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1148674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { /* TODO remove null space when doing multilevel */
1149674ae819SStefano Zampini     ierr = KSPSolve(pcbddc->coarse_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
1150674ae819SStefano Zampini   }
1151674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1152674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd  (pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1153674ae819SStefano Zampini 
1154674ae819SStefano Zampini   /* Sum contributions from two levels */
1155674ae819SStefano Zampini   ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
11568eeda7d8SStefano Zampini   if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1157674ae819SStefano Zampini   PetscFunctionReturn(0);
1158674ae819SStefano Zampini }
1159674ae819SStefano Zampini 
1160674ae819SStefano Zampini #undef __FUNCT__
1161674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
1162674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1163674ae819SStefano Zampini {
1164674ae819SStefano Zampini   PetscErrorCode ierr;
1165674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1166674ae819SStefano Zampini 
1167674ae819SStefano Zampini   PetscFunctionBegin;
1168674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1169674ae819SStefano Zampini   PetscFunctionReturn(0);
1170674ae819SStefano Zampini }
1171674ae819SStefano Zampini 
1172674ae819SStefano Zampini #undef __FUNCT__
1173674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
1174674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1175674ae819SStefano Zampini {
1176674ae819SStefano Zampini   PetscErrorCode ierr;
1177674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1178674ae819SStefano Zampini 
1179674ae819SStefano Zampini   PetscFunctionBegin;
1180674ae819SStefano Zampini   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1181674ae819SStefano Zampini   PetscFunctionReturn(0);
1182674ae819SStefano Zampini }
1183674ae819SStefano Zampini 
1184984c4197SStefano Zampini /* uncomment for testing purposes */
1185984c4197SStefano Zampini /* #define PETSC_MISSING_LAPACK_GESVD 1 */
1186674ae819SStefano Zampini #undef __FUNCT__
1187674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp"
1188674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
1189674ae819SStefano Zampini {
1190674ae819SStefano Zampini   PetscErrorCode    ierr;
1191674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
1192674ae819SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
1193674ae819SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
1194984c4197SStefano Zampini   /* constraint and (optionally) change of basis matrix implemented as SeqAIJ */
1195674ae819SStefano Zampini   MatType           impMatType=MATSEQAIJ;
1196984c4197SStefano Zampini   /* one and zero */
1197984c4197SStefano Zampini   PetscScalar       one=1.0,zero=0.0;
1198984c4197SStefano Zampini   /* space to store constraints and their local indices */
1199984c4197SStefano Zampini   PetscScalar       *temp_quadrature_constraint;
1200984c4197SStefano Zampini   PetscInt          *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B;
1201984c4197SStefano Zampini   /* iterators */
1202984c4197SStefano Zampini   PetscInt          i,j,k,total_counts,temp_start_ptr;
1203984c4197SStefano Zampini   /* stuff to store connected components stored in pcbddc->mat_graph */
1204984c4197SStefano Zampini   IS                ISForVertices,*ISForFaces,*ISForEdges,*used_IS;
1205984c4197SStefano Zampini   PetscInt          n_ISForFaces,n_ISForEdges;
1206984c4197SStefano Zampini   /* near null space stuff */
1207674ae819SStefano Zampini   MatNullSpace      nearnullsp;
1208674ae819SStefano Zampini   const Vec         *nearnullvecs;
1209674ae819SStefano Zampini   Vec               *localnearnullsp;
1210984c4197SStefano Zampini   PetscBool         nnsp_has_cnst;
1211984c4197SStefano Zampini   PetscInt          nnsp_size;
1212984c4197SStefano Zampini   PetscScalar       *array;
1213984c4197SStefano Zampini   /* BLAS integers */
1214e310c8b4SStefano Zampini   PetscBLASInt      lwork,lierr;
1215e310c8b4SStefano Zampini   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
1216c4303822SStefano Zampini   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
1217984c4197SStefano Zampini   /* LAPACK working arrays for SVD or POD */
1218242a89d7SStefano Zampini   PetscBool         skip_lapack;
1219984c4197SStefano Zampini   PetscScalar       *work;
1220984c4197SStefano Zampini   PetscReal         *singular_vals;
1221984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1222984c4197SStefano Zampini   PetscReal         *rwork;
1223674ae819SStefano Zampini #endif
1224984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1225e310c8b4SStefano Zampini   PetscBLASInt      Blas_one_2=1;
1226984c4197SStefano Zampini   PetscScalar       *temp_basis,*correlation_mat;
1227b7d8b9f8SStefano Zampini #else
1228b7d8b9f8SStefano Zampini   PetscBLASInt      dummy_int_1=1,dummy_int_2=1;
1229b7d8b9f8SStefano Zampini   PetscScalar       dummy_scalar_1=0.0,dummy_scalar_2=0.0;
1230984c4197SStefano Zampini #endif
1231984c4197SStefano Zampini   /* change of basis */
1232984c4197SStefano Zampini   PetscInt          *aux_primal_numbering,*aux_primal_minloc,*global_indices;
1233a717540cSStefano Zampini   PetscBool         boolforchange,qr_needed;
1234a717540cSStefano Zampini   PetscBT           touched,change_basis,qr_needed_idx;
1235984c4197SStefano Zampini   /* auxiliary stuff */
1236984c4197SStefano Zampini   PetscInt          *nnz,*is_indices,*local_to_B;
1237984c4197SStefano Zampini   /* some quantities */
123845a1bb75SStefano Zampini   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
1239984c4197SStefano Zampini   PetscInt          size_of_constraint,max_size_of_constraint,max_constraints,temp_constraints;
1240984c4197SStefano Zampini 
1241674ae819SStefano Zampini 
1242674ae819SStefano Zampini   PetscFunctionBegin;
1243674ae819SStefano Zampini   /* Get index sets for faces, edges and vertices from graph */
12448eeda7d8SStefano Zampini   if (!pcbddc->use_faces && !pcbddc->use_edges && !pcbddc->use_vertices) {
12458eeda7d8SStefano Zampini     pcbddc->use_vertices = PETSC_TRUE;
1246674ae819SStefano Zampini   }
12478eeda7d8SStefano Zampini   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,pcbddc->use_faces,pcbddc->use_edges,pcbddc->use_vertices,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);
1248b8ffe317SStefano Zampini   /* HACK: provide functions to set change of basis */
1249b8ffe317SStefano Zampini   if (!ISForVertices && pcbddc->NullSpace) {
1250b8ffe317SStefano Zampini     pcbddc->use_change_of_basis = PETSC_TRUE;
1251b8ffe317SStefano Zampini     pcbddc->use_change_on_faces = PETSC_FALSE;
1252b8ffe317SStefano Zampini   }
1253984c4197SStefano Zampini   /* print some info */
1254674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
1255674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1256674ae819SStefano Zampini     i = 0;
1257674ae819SStefano Zampini     if (ISForVertices) {
1258674ae819SStefano Zampini       ierr = ISGetSize(ISForVertices,&i);CHKERRQ(ierr);
1259674ae819SStefano Zampini     }
1260674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices\n",PetscGlobalRank,i);CHKERRQ(ierr);
1261674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges\n",PetscGlobalRank,n_ISForEdges);CHKERRQ(ierr);
126215aaf578SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces\n",PetscGlobalRank,n_ISForFaces);CHKERRQ(ierr);
1263674ae819SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1264674ae819SStefano Zampini   }
1265674ae819SStefano Zampini   /* check if near null space is attached to global mat */
1266674ae819SStefano Zampini   ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
1267674ae819SStefano Zampini   if (nearnullsp) {
1268674ae819SStefano Zampini     ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
1269984c4197SStefano Zampini   } else { /* if near null space is not provided BDDC uses constants by default */
1270984c4197SStefano Zampini     nnsp_size = 0;
1271674ae819SStefano Zampini     nnsp_has_cnst = PETSC_TRUE;
1272674ae819SStefano Zampini   }
1273984c4197SStefano Zampini   /* get max number of constraints on a single cc */
1274984c4197SStefano Zampini   max_constraints = nnsp_size;
1275984c4197SStefano Zampini   if (nnsp_has_cnst) max_constraints++;
1276984c4197SStefano Zampini 
1277674ae819SStefano Zampini   /*
1278674ae819SStefano Zampini        Evaluate maximum storage size needed by the procedure
1279674ae819SStefano Zampini        - temp_indices will contain start index of each constraint stored as follows
1280674ae819SStefano 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
1281674ae819SStefano 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
1282674ae819SStefano Zampini        - temp_quadrature_constraint  [temp_indices[i],...,temp[indices[i+1]-1] will contain the scalars representing the constraint itself
1283674ae819SStefano Zampini                                                                                                                                                          */
1284674ae819SStefano Zampini   total_counts = n_ISForFaces+n_ISForEdges;
1285984c4197SStefano Zampini   total_counts *= max_constraints;
1286674ae819SStefano Zampini   n_vertices = 0;
1287674ae819SStefano Zampini   if (ISForVertices) {
1288674ae819SStefano Zampini     ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
1289674ae819SStefano Zampini   }
1290674ae819SStefano Zampini   total_counts += n_vertices;
1291674ae819SStefano Zampini   ierr = PetscMalloc((total_counts+1)*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
12924641a718SStefano Zampini   ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
1293674ae819SStefano Zampini   total_counts = 0;
1294674ae819SStefano Zampini   max_size_of_constraint = 0;
1295674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1296674ae819SStefano Zampini     if (i<n_ISForEdges) {
1297674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1298674ae819SStefano Zampini     } else {
1299674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1300674ae819SStefano Zampini     }
1301674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
1302674ae819SStefano Zampini     total_counts += j;
1303674ae819SStefano Zampini     max_size_of_constraint = PetscMax(j,max_size_of_constraint);
1304674ae819SStefano Zampini   }
1305984c4197SStefano Zampini   total_counts *= max_constraints;
1306674ae819SStefano Zampini   total_counts += n_vertices;
1307674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&temp_quadrature_constraint);CHKERRQ(ierr);
1308674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint);CHKERRQ(ierr);
1309674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint_B);CHKERRQ(ierr);
1310984c4197SStefano Zampini   /* local to boundary numbering */
1311674ae819SStefano Zampini   ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&local_to_B);CHKERRQ(ierr);
1312674ae819SStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1313984c4197SStefano Zampini   for (i=0;i<pcis->n;i++) local_to_B[i]=-1;
1314984c4197SStefano Zampini   for (i=0;i<pcis->n_B;i++) local_to_B[is_indices[i]]=i;
1315674ae819SStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1316984c4197SStefano Zampini   /* get local part of global near null space vectors */
1317984c4197SStefano Zampini   ierr = PetscMalloc(nnsp_size*sizeof(Vec),&localnearnullsp);CHKERRQ(ierr);
1318984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1319984c4197SStefano Zampini     ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
1320984c4197SStefano Zampini     ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1321984c4197SStefano Zampini     ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1322984c4197SStefano Zampini   }
1323674ae819SStefano Zampini 
1324242a89d7SStefano Zampini   /* whether or not to skip lapack calls */
1325242a89d7SStefano Zampini   skip_lapack = PETSC_TRUE;
1326242a89d7SStefano Zampini   if (n_ISForFaces+n_ISForEdges) skip_lapack = PETSC_FALSE;
1327242a89d7SStefano Zampini 
1328984c4197SStefano Zampini   /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
1329242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1330674ae819SStefano Zampini     PetscScalar temp_work;
1331674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1332984c4197SStefano Zampini     /* Proper Orthogonal Decomposition (POD) using the snapshot method */
1333984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*max_constraints*sizeof(PetscScalar),&correlation_mat);CHKERRQ(ierr);
1334984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1335984c4197SStefano Zampini     ierr = PetscMalloc(max_size_of_constraint*max_constraints*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr);
1336674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1337984c4197SStefano Zampini     ierr = PetscMalloc(3*max_constraints*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1338674ae819SStefano Zampini #endif
1339674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1340c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
1341c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
1342674ae819SStefano Zampini     lwork = -1;
1343674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1344674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1345c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
1346674ae819SStefano Zampini #else
1347c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
1348674ae819SStefano Zampini #endif
1349674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1350984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
1351674ae819SStefano Zampini #else /* on missing GESVD */
1352674ae819SStefano Zampini     /* SVD */
1353674ae819SStefano Zampini     PetscInt max_n,min_n;
1354674ae819SStefano Zampini     max_n = max_size_of_constraint;
1355984c4197SStefano Zampini     min_n = max_constraints;
1356984c4197SStefano Zampini     if (max_size_of_constraint < max_constraints) {
1357674ae819SStefano Zampini       min_n = max_size_of_constraint;
1358984c4197SStefano Zampini       max_n = max_constraints;
1359674ae819SStefano Zampini     }
1360674ae819SStefano Zampini     ierr = PetscMalloc(min_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1361674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1362674ae819SStefano Zampini     ierr = PetscMalloc(5*min_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1363674ae819SStefano Zampini #endif
1364674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1365674ae819SStefano Zampini     lwork = -1;
1366e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
1367e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
1368b7d8b9f8SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
1369674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1370674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1371e310c8b4SStefano 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));
1372674ae819SStefano Zampini #else
1373e310c8b4SStefano 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));
1374674ae819SStefano Zampini #endif
1375674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1376984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
1377984c4197SStefano Zampini #endif /* on missing GESVD */
1378674ae819SStefano Zampini     /* Allocate optimal workspace */
1379674ae819SStefano Zampini     ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
1380984c4197SStefano Zampini     ierr = PetscMalloc((PetscInt)lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
1381674ae819SStefano Zampini   }
1382674ae819SStefano Zampini   /* Now we can loop on constraining sets */
1383674ae819SStefano Zampini   total_counts = 0;
1384674ae819SStefano Zampini   temp_indices[0] = 0;
1385674ae819SStefano Zampini   /* vertices */
1386674ae819SStefano Zampini   if (ISForVertices) {
1387674ae819SStefano Zampini     ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1388674ae819SStefano Zampini     if (nnsp_has_cnst) { /* consider all vertices */
1389674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1390674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1391674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
1392674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1393674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1394674ae819SStefano Zampini         total_counts++;
1395674ae819SStefano Zampini       }
1396674ae819SStefano Zampini     } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
1397984c4197SStefano Zampini       PetscBool used_vertex;
1398674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1399674ae819SStefano Zampini         used_vertex = PETSC_FALSE;
1400674ae819SStefano Zampini         k = 0;
1401674ae819SStefano Zampini         while (!used_vertex && k<nnsp_size) {
1402984c4197SStefano Zampini           ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1403984c4197SStefano Zampini           if (PetscAbsScalar(array[is_indices[i]])>0.0) {
1404674ae819SStefano Zampini             temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1405674ae819SStefano Zampini             temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
1406674ae819SStefano Zampini             temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1407674ae819SStefano Zampini             temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1408674ae819SStefano Zampini             total_counts++;
1409674ae819SStefano Zampini             used_vertex = PETSC_TRUE;
1410674ae819SStefano Zampini           }
1411984c4197SStefano Zampini           ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1412674ae819SStefano Zampini           k++;
1413674ae819SStefano Zampini         }
1414674ae819SStefano Zampini       }
1415674ae819SStefano Zampini     }
1416674ae819SStefano Zampini     ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1417674ae819SStefano Zampini     n_vertices = total_counts;
1418674ae819SStefano Zampini   }
1419984c4197SStefano Zampini 
1420674ae819SStefano Zampini   /* edges and faces */
1421674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1422674ae819SStefano Zampini     if (i<n_ISForEdges) {
1423674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1424984c4197SStefano Zampini       boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
1425674ae819SStefano Zampini     } else {
1426674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1427984c4197SStefano Zampini       boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
1428674ae819SStefano Zampini     }
1429674ae819SStefano Zampini     temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
1430674ae819SStefano Zampini     temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
1431674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
1432674ae819SStefano Zampini     ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1433984c4197SStefano Zampini     /* change of basis should not be performed on local periodic nodes */
1434984c4197SStefano Zampini     if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
1435674ae819SStefano Zampini     if (nnsp_has_cnst) {
14365b08dc53SStefano Zampini       PetscScalar quad_value;
1437674ae819SStefano Zampini       temp_constraints++;
1438674ae819SStefano Zampini       quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
1439674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1440674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
1441674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
1442674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
1443674ae819SStefano Zampini       }
1444674ae819SStefano Zampini       temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
1445674ae819SStefano Zampini       total_counts++;
1446674ae819SStefano Zampini     }
1447674ae819SStefano Zampini     for (k=0;k<nnsp_size;k++) {
1448984c4197SStefano Zampini       PetscReal real_value;
1449984c4197SStefano Zampini       ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1450674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1451674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
1452674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
1453984c4197SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=array[is_indices[j]];
1454674ae819SStefano Zampini       }
1455984c4197SStefano Zampini       ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1456984c4197SStefano Zampini       /* check if array is null on the connected component */
1457e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1458e310c8b4SStefano Zampini       PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_one));
14595b08dc53SStefano Zampini       if (real_value > 0.0) { /* keep indices and values */
1460674ae819SStefano Zampini         temp_constraints++;
1461674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
1462674ae819SStefano Zampini         total_counts++;
1463674ae819SStefano Zampini       }
1464674ae819SStefano Zampini     }
1465674ae819SStefano Zampini     ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
146645a1bb75SStefano Zampini     valid_constraints = temp_constraints;
1467eb97c9d2SStefano 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 */
1468eb97c9d2SStefano Zampini     if (!pcbddc->use_nnsp_true && temp_constraints) {
1469984c4197SStefano Zampini       PetscReal tol = 1.0e-8; /* tolerance for retaining eigenmodes */
1470674ae819SStefano Zampini 
1471674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1472984c4197SStefano Zampini       /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
1473984c4197SStefano Zampini          POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
1474984c4197SStefano Zampini          -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
1475984c4197SStefano Zampini             the constraints basis will differ (by a complex factor with absolute value equal to 1)
1476984c4197SStefano Zampini             from that computed using LAPACKgesvd
1477984c4197SStefano Zampini          -> This is due to a different computation of eigenvectors in LAPACKheev
1478984c4197SStefano Zampini          -> The quality of the POD-computed basis will be the same */
1479984c4197SStefano Zampini       ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
1480674ae819SStefano Zampini       /* Store upper triangular part of correlation matrix */
1481e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1482984c4197SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1483674ae819SStefano Zampini       for (j=0;j<temp_constraints;j++) {
1484674ae819SStefano Zampini         for (k=0;k<j+1;k++) {
1485e310c8b4SStefano 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));
1486674ae819SStefano Zampini         }
1487674ae819SStefano Zampini       }
1488e310c8b4SStefano Zampini       /* compute eigenvalues and eigenvectors of correlation matrix */
1489e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1490e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
1491674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1492c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
1493674ae819SStefano Zampini #else
1494c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
1495674ae819SStefano Zampini #endif
1496674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1497984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
1498984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
1499674ae819SStefano Zampini       j=0;
1500984c4197SStefano Zampini       while (j < temp_constraints && singular_vals[j] < tol) j++;
1501674ae819SStefano Zampini       total_counts=total_counts-j;
150245a1bb75SStefano Zampini       valid_constraints = temp_constraints-j;
1503e310c8b4SStefano Zampini       /* scale and copy POD basis into used quadrature memory */
1504c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1505c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1506c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
1507c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1508c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
1509c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1510674ae819SStefano Zampini       if (j<temp_constraints) {
1511984c4197SStefano Zampini         PetscInt ii;
1512984c4197SStefano Zampini         for (k=j;k<temp_constraints;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]);
1513674ae819SStefano Zampini         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1514c4303822SStefano 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));
1515674ae819SStefano Zampini         ierr = PetscFPTrapPop();CHKERRQ(ierr);
1516984c4197SStefano Zampini         for (k=0;k<temp_constraints-j;k++) {
1517674ae819SStefano Zampini           for (ii=0;ii<size_of_constraint;ii++) {
1518984c4197SStefano 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];
1519674ae819SStefano Zampini           }
1520674ae819SStefano Zampini         }
1521674ae819SStefano Zampini       }
1522674ae819SStefano Zampini #else  /* on missing GESVD */
1523e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1524e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1525b7d8b9f8SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1526674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1527674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1528e310c8b4SStefano 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));
1529674ae819SStefano Zampini #else
1530e310c8b4SStefano 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));
1531674ae819SStefano Zampini #endif
1532984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
1533674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1534984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
1535e310c8b4SStefano Zampini       k = temp_constraints;
1536e310c8b4SStefano Zampini       if (k > size_of_constraint) k = size_of_constraint;
1537674ae819SStefano Zampini       j = 0;
1538e310c8b4SStefano Zampini       while (j < k && singular_vals[k-j-1] < tol) j++;
1539e310c8b4SStefano Zampini       total_counts = total_counts-temp_constraints+k-j;
154045a1bb75SStefano Zampini       valid_constraints = k-j;
1541984c4197SStefano Zampini #endif /* on missing GESVD */
1542674ae819SStefano Zampini     }
154345a1bb75SStefano Zampini     /* setting change_of_basis flag is safe now */
154445a1bb75SStefano Zampini     if (boolforchange) {
154545a1bb75SStefano Zampini       for (j=0;j<valid_constraints;j++) {
154645a1bb75SStefano Zampini         PetscBTSet(change_basis,total_counts-j-1);
154745a1bb75SStefano Zampini       }
154845a1bb75SStefano Zampini     }
1549674ae819SStefano Zampini   }
1550674ae819SStefano Zampini   /* free index sets of faces, edges and vertices */
1551674ae819SStefano Zampini   for (i=0;i<n_ISForFaces;i++) {
1552674ae819SStefano Zampini     ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
1553674ae819SStefano Zampini   }
1554674ae819SStefano Zampini   ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
1555674ae819SStefano Zampini   for (i=0;i<n_ISForEdges;i++) {
1556674ae819SStefano Zampini     ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
1557674ae819SStefano Zampini   }
1558674ae819SStefano Zampini   ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
1559674ae819SStefano Zampini   ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
1560674ae819SStefano Zampini 
1561984c4197SStefano Zampini   /* free workspace */
1562242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1563984c4197SStefano Zampini     ierr = PetscFree(work);CHKERRQ(ierr);
1564984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1565984c4197SStefano Zampini     ierr = PetscFree(rwork);CHKERRQ(ierr);
1566984c4197SStefano Zampini #endif
1567984c4197SStefano Zampini     ierr = PetscFree(singular_vals);CHKERRQ(ierr);
1568984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1569984c4197SStefano Zampini     ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
1570984c4197SStefano Zampini     ierr = PetscFree(temp_basis);CHKERRQ(ierr);
1571984c4197SStefano Zampini #endif
1572984c4197SStefano Zampini   }
1573984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1574984c4197SStefano Zampini     ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
1575984c4197SStefano Zampini   }
1576984c4197SStefano Zampini   ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
1577984c4197SStefano Zampini 
1578674ae819SStefano Zampini   /* set quantities in pcbddc data structure */
1579984c4197SStefano Zampini   /* n_vertices defines the number of subdomain corners in the primal space */
1580674ae819SStefano Zampini   /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */
1581984c4197SStefano Zampini   pcbddc->local_primal_size = total_counts;
1582674ae819SStefano Zampini   pcbddc->n_vertices = n_vertices;
1583984c4197SStefano Zampini   pcbddc->n_constraints = pcbddc->local_primal_size-pcbddc->n_vertices;
1584674ae819SStefano Zampini 
1585674ae819SStefano Zampini   /* Create constraint matrix */
1586674ae819SStefano Zampini   /* The constraint matrix is used to compute the l2g map of primal dofs */
1587674ae819SStefano Zampini   /* so we need to set it up properly either with or without change of basis */
1588674ae819SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1589674ae819SStefano Zampini   ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr);
1590984c4197SStefano Zampini   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
1591984c4197SStefano Zampini   /* array to compute a local numbering of constraints : vertices first then constraints */
1592984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_numbering);CHKERRQ(ierr);
1593984c4197SStefano Zampini   /* array to select the proper local node (of minimum index with respect to global ordering) when changing the basis */
1594984c4197SStefano Zampini   /* note: it should not be needed since IS for faces and edges are already sorted by global ordering when analyzing the graph but... just in case */
1595984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_minloc);CHKERRQ(ierr);
1596984c4197SStefano Zampini   /* auxiliary stuff for basis change */
1597984c4197SStefano Zampini   ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&global_indices);CHKERRQ(ierr);
15984641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n_B,&touched);CHKERRQ(ierr);
1599984c4197SStefano Zampini 
1600984c4197SStefano Zampini   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
1601984c4197SStefano Zampini   total_primal_vertices=0;
1602984c4197SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
1603674ae819SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
1604984c4197SStefano Zampini     if (size_of_constraint == 1) {
16054641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]]);CHKERRQ(ierr);
1606984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]];
1607984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=0;
1608984c4197SStefano Zampini       total_primal_vertices++;
16094641a718SStefano Zampini     } else if (PetscBTLookup(change_basis,i)) { /* Same procedure used in PCBDDCGetPrimalConstraintsLocalIdx */
1610984c4197SStefano Zampini       PetscInt min_loc,min_index;
1611984c4197SStefano Zampini       ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],global_indices);CHKERRQ(ierr);
1612984c4197SStefano Zampini       /* find first untouched local node */
1613674ae819SStefano Zampini       k = 0;
16144641a718SStefano Zampini       while (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) k++;
1615984c4197SStefano Zampini       min_index = global_indices[k];
1616984c4197SStefano Zampini       min_loc = k;
1617984c4197SStefano Zampini       /* search the minimum among global nodes already untouched on the cc */
1618984c4197SStefano Zampini       for (k=1;k<size_of_constraint;k++) {
1619984c4197SStefano Zampini         /* there can be more than one constraint on a single connected component */
16204641a718SStefano Zampini         if (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k]) && min_index > global_indices[k]) {
1621984c4197SStefano Zampini           min_index = global_indices[k];
1622984c4197SStefano Zampini           min_loc = k;
1623674ae819SStefano Zampini         }
1624674ae819SStefano Zampini       }
16254641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]+min_loc]);CHKERRQ(ierr);
1626984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]+min_loc];
1627984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=min_loc;
1628984c4197SStefano Zampini       total_primal_vertices++;
1629984c4197SStefano Zampini     }
1630984c4197SStefano Zampini   }
1631a717540cSStefano Zampini   /* determine if a QR strategy is needed for change of basis */
1632a717540cSStefano Zampini   qr_needed = PETSC_FALSE;
1633a717540cSStefano Zampini   ierr = PetscBTCreate(pcbddc->local_primal_size,&qr_needed_idx);CHKERRQ(ierr);
1634a717540cSStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1635a717540cSStefano Zampini     if (PetscBTLookup(change_basis,i)) {
1636a717540cSStefano Zampini       size_of_constraint = temp_indices[i+1]-temp_indices[i];
1637a717540cSStefano Zampini       j = 0;
1638a717540cSStefano Zampini       for (k=0;k<size_of_constraint;k++) {
1639a717540cSStefano Zampini         if (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) {
1640a717540cSStefano Zampini           j++;
1641a717540cSStefano Zampini         }
1642a717540cSStefano Zampini       }
1643a717540cSStefano Zampini       /* found more than one primal dof on the cc */
1644a717540cSStefano Zampini       if (j > 1) {
1645a717540cSStefano Zampini         PetscBTSet(qr_needed_idx,i);
1646a717540cSStefano Zampini         qr_needed = PETSC_TRUE;
1647a717540cSStefano Zampini       }
1648a717540cSStefano Zampini     }
1649a717540cSStefano Zampini   }
1650984c4197SStefano Zampini   /* free workspace */
1651984c4197SStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
165245a1bb75SStefano Zampini 
1653674ae819SStefano Zampini   /* permute indices in order to have a sorted set of vertices */
1654a717540cSStefano Zampini   ierr = PetscSortInt(total_primal_vertices,aux_primal_numbering);CHKERRQ(ierr);
1655984c4197SStefano Zampini 
1656984c4197SStefano Zampini   /* nonzero structure of constraint matrix */
1657984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1658984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) nnz[i]=1;
1659984c4197SStefano Zampini   j=total_primal_vertices;
1660984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
16614641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1662674ae819SStefano Zampini       nnz[j]=temp_indices[i+1]-temp_indices[i];
1663674ae819SStefano Zampini       j++;
1664674ae819SStefano Zampini     }
1665674ae819SStefano Zampini   }
1666674ae819SStefano Zampini   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
1667674ae819SStefano Zampini   ierr = PetscFree(nnz);CHKERRQ(ierr);
1668674ae819SStefano Zampini   /* set values in constraint matrix */
1669984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) {
1670984c4197SStefano Zampini     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,aux_primal_numbering[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
1671674ae819SStefano Zampini   }
1672984c4197SStefano Zampini   total_counts = total_primal_vertices;
1673984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
16744641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1675674ae819SStefano Zampini       size_of_constraint=temp_indices[i+1]-temp_indices[i];
1676674ae819SStefano 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);
1677674ae819SStefano Zampini       total_counts++;
1678674ae819SStefano Zampini     }
1679674ae819SStefano Zampini   }
1680674ae819SStefano Zampini   /* assembling */
1681674ae819SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1682674ae819SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1683984c4197SStefano Zampini   /*
168445a1bb75SStefano Zampini   ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
1685984c4197SStefano Zampini   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
1686984c4197SStefano Zampini   */
1687674ae819SStefano Zampini   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
1688674ae819SStefano Zampini   if (pcbddc->use_change_of_basis) {
1689026de310SStefano Zampini     /* dual and primal dofs on a single cc */
1690984c4197SStefano Zampini     PetscInt     dual_dofs,primal_dofs;
1691026de310SStefano Zampini     /* iterator on aux_primal_minloc (ordered as read from nearnullspace: vertices, edges and then constraints) */
1692026de310SStefano Zampini     PetscInt     primal_counter;
1693984c4197SStefano Zampini     /* working stuff for GEQRF */
1694984c4197SStefano Zampini     PetscScalar  *qr_basis,*qr_tau,*qr_work,lqr_work_t;
1695984c4197SStefano Zampini     PetscBLASInt lqr_work;
1696984c4197SStefano Zampini     /* working stuff for UNGQR */
1697984c4197SStefano Zampini     PetscScalar  *gqr_work,lgqr_work_t;
1698984c4197SStefano Zampini     PetscBLASInt lgqr_work;
1699984c4197SStefano Zampini     /* working stuff for TRTRS */
1700984c4197SStefano Zampini     PetscScalar  *trs_rhs;
17013f08241aSStefano Zampini     PetscBLASInt Blas_NRHS;
1702984c4197SStefano Zampini     /* pointers for values insertion into change of basis matrix */
1703984c4197SStefano Zampini     PetscInt     *start_rows,*start_cols;
1704984c4197SStefano Zampini     PetscScalar  *start_vals;
1705984c4197SStefano Zampini     /* working stuff for values insertion */
17064641a718SStefano Zampini     PetscBT      is_primal;
1707984c4197SStefano Zampini 
1708a717540cSStefano Zampini     /* change of basis acts on local interfaces -> dimension is n_B x n_B */
1709a717540cSStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
1710a717540cSStefano Zampini     ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr);
1711a717540cSStefano Zampini     ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr);
1712a717540cSStefano Zampini     /* work arrays */
1713a717540cSStefano Zampini     ierr = PetscMalloc(pcis->n_B*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1714a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) nnz[i]=1;
1715a717540cSStefano Zampini     /* nonzeros per row */
1716a717540cSStefano Zampini     for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1717a717540cSStefano Zampini       if (PetscBTLookup(change_basis,i)) {
1718a717540cSStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
1719a717540cSStefano Zampini         if (PetscBTLookup(qr_needed_idx,i)) {
1720a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1721a717540cSStefano Zampini         } else {
1722a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = 2;
1723a717540cSStefano Zampini           /* get local primal index on the cc */
1724a717540cSStefano Zampini           j = 0;
1725a717540cSStefano Zampini           while (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+j])) j++;
1726a717540cSStefano Zampini           nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1727a717540cSStefano Zampini         }
1728a717540cSStefano Zampini       }
1729a717540cSStefano Zampini     }
1730a717540cSStefano Zampini     ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
1731a717540cSStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
1732a717540cSStefano Zampini     /* Set initial identity in the matrix */
1733a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) {
1734a717540cSStefano Zampini       ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
1735a717540cSStefano Zampini     }
1736a717540cSStefano Zampini 
1737a717540cSStefano Zampini     if (pcbddc->dbg_flag) {
1738a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1739a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
1740a717540cSStefano Zampini     }
1741a717540cSStefano Zampini 
1742a717540cSStefano Zampini 
1743a717540cSStefano Zampini     /* Now we loop on the constraints which need a change of basis */
1744a717540cSStefano Zampini     /*
1745a717540cSStefano Zampini        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
1746a717540cSStefano Zampini        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
1747a717540cSStefano Zampini 
1748a717540cSStefano Zampini        Basic blocks of change of basis matrix T computed
1749a717540cSStefano Zampini 
1750a717540cSStefano Zampini           - Using the following block transformation if there is only a primal dof on the cc
1751a717540cSStefano Zampini             (in the example, primal dof is the last one of the edge in LOCAL ordering
1752a717540cSStefano Zampini              in this code, primal dof is the first one of the edge in GLOBAL ordering)
1753a717540cSStefano Zampini             | 1        0   ...        0     1 |
1754a717540cSStefano Zampini             | 0        1   ...        0     1 |
1755a717540cSStefano Zampini             |              ...                |
1756a717540cSStefano Zampini             | 0        ...            1     1 |
1757a717540cSStefano Zampini             | -s_1/s_n ...    -s_{n-1}/-s_n 1 |
1758a717540cSStefano Zampini 
1759a717540cSStefano Zampini           - via QR decomposition of constraints otherwise
1760a717540cSStefano Zampini     */
1761a717540cSStefano Zampini     if (qr_needed) {
1762984c4197SStefano Zampini       /* space to store Q */
1763984c4197SStefano Zampini       ierr = PetscMalloc((max_size_of_constraint)*(max_size_of_constraint)*sizeof(PetscScalar),&qr_basis);CHKERRQ(ierr);
1764984c4197SStefano Zampini       /* first we issue queries for optimal work */
17653f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
17663f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
17673f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1768984c4197SStefano Zampini       lqr_work = -1;
17693f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
1770984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
1771984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
1772984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lqr_work_t)*sizeof(*qr_work),&qr_work);CHKERRQ(ierr);
1773984c4197SStefano Zampini       lgqr_work = -1;
17743f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
17753f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
17763f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
17773f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
17783f08241aSStefano Zampini       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
17793f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
1780984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
1781984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
1782984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lgqr_work_t)*sizeof(*gqr_work),&gqr_work);CHKERRQ(ierr);
1783984c4197SStefano Zampini       /* array to store scaling factors for reflectors */
1784984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*sizeof(*qr_tau),&qr_tau);CHKERRQ(ierr);
1785984c4197SStefano Zampini       /* array to store rhs and solution of triangular solver */
1786984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*max_constraints*sizeof(*trs_rhs),&trs_rhs);CHKERRQ(ierr);
1787a717540cSStefano Zampini       /* allocating workspace for check */
1788a717540cSStefano Zampini       if (pcbddc->dbg_flag) {
1789a717540cSStefano Zampini         ierr = PetscMalloc(max_size_of_constraint*(max_constraints+max_size_of_constraint)*sizeof(*work),&work);CHKERRQ(ierr);
1790a717540cSStefano Zampini       }
1791a717540cSStefano Zampini     }
1792984c4197SStefano Zampini     /* array to store whether a node is primal or not */
17934641a718SStefano Zampini     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
17944641a718SStefano Zampini     for (i=0;i<total_primal_vertices;i++) {
17954641a718SStefano Zampini       ierr = PetscBTSet(is_primal,local_to_B[aux_primal_numbering[i]]);CHKERRQ(ierr);
17964641a718SStefano Zampini     }
1797984c4197SStefano Zampini 
1798a717540cSStefano Zampini     /* loop on constraints and see whether or not they need a change of basis and compute it */
1799026de310SStefano Zampini     /* -> using implicit ordering contained in temp_indices data */
1800026de310SStefano Zampini     total_counts = pcbddc->n_vertices;
1801026de310SStefano Zampini     primal_counter = total_counts;
1802026de310SStefano Zampini     while (total_counts<pcbddc->local_primal_size) {
1803026de310SStefano Zampini       primal_dofs = 1;
18044641a718SStefano Zampini       if (PetscBTLookup(change_basis,total_counts)) {
1805026de310SStefano Zampini         /* get all constraints with same support: if more then one constraint is present on the cc then surely indices are stored contiguosly */
1806026de310SStefano 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]]) {
1807026de310SStefano Zampini           primal_dofs++;
1808674ae819SStefano Zampini         }
1809984c4197SStefano Zampini         /* get constraint info */
1810026de310SStefano Zampini         size_of_constraint = temp_indices[total_counts+1]-temp_indices[total_counts];
1811984c4197SStefano Zampini         dual_dofs = size_of_constraint-primal_dofs;
1812984c4197SStefano Zampini 
1813984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
1814a717540cSStefano 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);
1815674ae819SStefano Zampini         }
1816984c4197SStefano Zampini 
1817a717540cSStefano Zampini         if (primal_dofs > 1) { /* QR */
1818a717540cSStefano Zampini 
1819a717540cSStefano Zampini           /* copy quadrature constraints for change of basis check */
1820a717540cSStefano Zampini           if (pcbddc->dbg_flag) {
1821a717540cSStefano Zampini             ierr = PetscMemcpy(work,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1822a717540cSStefano Zampini           }
1823984c4197SStefano Zampini           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
1824026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1825984c4197SStefano Zampini 
1826984c4197SStefano Zampini           /* compute QR decomposition of constraints */
18273f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
18283f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
18293f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1830674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
18313f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
1832984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
1833674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1834984c4197SStefano Zampini 
1835984c4197SStefano Zampini           /* explictly compute R^-T */
1836984c4197SStefano Zampini           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
1837984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
18383f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
18393f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
18403f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
18413f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
1842984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
18433f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
1844984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
1845984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1846984c4197SStefano Zampini 
1847a717540cSStefano Zampini           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
18483f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
18493f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
18503f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
18513f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1852984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
18533f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
1854984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
1855984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1856984c4197SStefano Zampini 
1857984c4197SStefano Zampini           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
1858984c4197SStefano Zampini              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
1859984c4197SStefano Zampini              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
18603f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
18613f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
18623f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
18633f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
18643f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
18653f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1866984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1867c4303822SStefano 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));
1868984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1869026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1870984c4197SStefano Zampini 
1871984c4197SStefano Zampini           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
1872026de310SStefano Zampini           start_rows = &temp_indices_to_constraint_B[temp_indices[total_counts]];
1873984c4197SStefano Zampini           /* insert cols for primal dofs */
1874984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) {
1875984c4197SStefano Zampini             start_vals = &qr_basis[j*size_of_constraint];
1876026de310SStefano Zampini             start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter+j]];
1877984c4197SStefano Zampini             ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1878984c4197SStefano Zampini           }
1879984c4197SStefano Zampini           /* insert cols for dual dofs */
1880984c4197SStefano Zampini           for (j=0,k=0;j<dual_dofs;k++) {
18814641a718SStefano Zampini             if (!PetscBTLookup(is_primal,temp_indices_to_constraint_B[temp_indices[total_counts]+k])) {
1882984c4197SStefano Zampini               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
1883026de310SStefano Zampini               start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+k];
1884984c4197SStefano Zampini               ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1885984c4197SStefano Zampini               j++;
1886674ae819SStefano Zampini             }
1887674ae819SStefano Zampini           }
1888984c4197SStefano Zampini 
1889984c4197SStefano Zampini           /* check change of basis */
1890984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
1891984c4197SStefano Zampini             PetscInt   ii,jj;
1892984c4197SStefano Zampini             PetscBool valid_qr=PETSC_TRUE;
1893c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
1894c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1895c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
1896c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1897c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
1898c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
1899984c4197SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1900c4303822SStefano 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));
1901984c4197SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
1902984c4197SStefano Zampini             for (jj=0;jj<size_of_constraint;jj++) {
1903984c4197SStefano Zampini               for (ii=0;ii<primal_dofs;ii++) {
1904984c4197SStefano Zampini                 if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
1905984c4197SStefano Zampini                 if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
1906674ae819SStefano Zampini               }
1907674ae819SStefano Zampini             }
1908984c4197SStefano Zampini             if (!valid_qr) {
1909984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
1910984c4197SStefano Zampini               for (jj=0;jj<size_of_constraint;jj++) {
1911984c4197SStefano Zampini                 for (ii=0;ii<primal_dofs;ii++) {
1912984c4197SStefano Zampini                   if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
1913984c4197SStefano 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]));
1914674ae819SStefano Zampini                   }
1915984c4197SStefano Zampini                   if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
1916984c4197SStefano 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]));
1917984c4197SStefano Zampini                   }
1918984c4197SStefano Zampini                 }
1919984c4197SStefano Zampini               }
1920674ae819SStefano Zampini             } else {
1921984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
1922674ae819SStefano Zampini             }
1923674ae819SStefano Zampini           }
1924a717540cSStefano Zampini         } else { /* simple transformation block */
1925a717540cSStefano Zampini           PetscInt row,col;
1926a717540cSStefano Zampini           PetscScalar val;
1927a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) {
1928a717540cSStefano Zampini             row = temp_indices_to_constraint_B[temp_indices[total_counts]+j];
1929a717540cSStefano Zampini             if (!PetscBTLookup(is_primal,row)) {
1930a717540cSStefano Zampini               col = temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
1931a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
1932a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,1.0,INSERT_VALUES);CHKERRQ(ierr);
1933a717540cSStefano Zampini             } else {
1934a717540cSStefano Zampini               for (k=0;k<size_of_constraint;k++) {
1935a717540cSStefano Zampini                 col = temp_indices_to_constraint_B[temp_indices[total_counts]+k];
1936a717540cSStefano Zampini                 if (row != col) {
1937a717540cSStefano Zampini                   val = -temp_quadrature_constraint[temp_indices[total_counts]+k]/temp_quadrature_constraint[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
1938a717540cSStefano Zampini                 } else {
1939a717540cSStefano Zampini                   val = 1.0;
1940a717540cSStefano Zampini                 }
1941a717540cSStefano Zampini                 ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
1942a717540cSStefano Zampini               }
1943a717540cSStefano Zampini             }
1944a717540cSStefano Zampini           }
1945a717540cSStefano Zampini         }
1946026de310SStefano Zampini         /* increment primal counter */
1947026de310SStefano Zampini         primal_counter += primal_dofs;
1948984c4197SStefano Zampini       } else {
1949984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
1950026de310SStefano 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);
1951674ae819SStefano Zampini         }
1952674ae819SStefano Zampini       }
1953026de310SStefano Zampini       /* increment constraint counter total_counts */
1954026de310SStefano Zampini       total_counts += primal_dofs;
1955674ae819SStefano Zampini     }
1956a717540cSStefano Zampini 
1957a717540cSStefano Zampini     /* free workspace */
1958a717540cSStefano Zampini     if (qr_needed) {
1959984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
1960984c4197SStefano Zampini         ierr = PetscFree(work);CHKERRQ(ierr);
1961984c4197SStefano Zampini       }
1962984c4197SStefano Zampini       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
1963984c4197SStefano Zampini       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
1964984c4197SStefano Zampini       ierr = PetscFree(qr_work);CHKERRQ(ierr);
1965984c4197SStefano Zampini       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
1966984c4197SStefano Zampini       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
1967674ae819SStefano Zampini     }
1968a717540cSStefano Zampini     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
1969674ae819SStefano Zampini     /* assembling */
1970674ae819SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1971674ae819SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1972984c4197SStefano Zampini     /*
197345a1bb75SStefano Zampini     ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
1974984c4197SStefano Zampini     ierr = MatView(pcbddc->ChangeOfBasisMatrix,(PetscViewer)0);CHKERRQ(ierr);
1975984c4197SStefano Zampini     */
1976674ae819SStefano Zampini   }
1977a717540cSStefano Zampini 
1978a717540cSStefano Zampini   /* flush dbg viewer */
1979b8ffe317SStefano Zampini   if (pcbddc->dbg_flag) {
1980b8ffe317SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1981b8ffe317SStefano Zampini   }
1982a717540cSStefano Zampini 
1983e310c8b4SStefano Zampini   /* free workspace */
1984a717540cSStefano Zampini   ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
1985a717540cSStefano Zampini   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
1986984c4197SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
1987984c4197SStefano Zampini   ierr = PetscFree(aux_primal_minloc);CHKERRQ(ierr);
1988674ae819SStefano Zampini   ierr = PetscFree(temp_indices);CHKERRQ(ierr);
19894641a718SStefano Zampini   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
1990674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr);
1991674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
1992674ae819SStefano Zampini   ierr = PetscFree(local_to_B);CHKERRQ(ierr);
1993674ae819SStefano Zampini   ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr);
1994674ae819SStefano Zampini   PetscFunctionReturn(0);
1995674ae819SStefano Zampini }
1996674ae819SStefano Zampini 
1997674ae819SStefano Zampini #undef __FUNCT__
1998674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
1999674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
2000674ae819SStefano Zampini {
2001674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
2002674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
2003674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
2004*63602bcaSStefano Zampini   PetscInt    ierr,i,vertex_size;
2005674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
2006674ae819SStefano Zampini 
2007674ae819SStefano Zampini   PetscFunctionBegin;
2008674ae819SStefano Zampini   /* Init local Graph struct */
2009674ae819SStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr);
2010674ae819SStefano Zampini 
2011575ad6abSStefano Zampini   /* Check validity of the csr graph passed in by the user */
2012575ad6abSStefano Zampini   if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) {
2013575ad6abSStefano Zampini     ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
2014575ad6abSStefano Zampini   }
20159577ea80SStefano Zampini 
2016674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
2017674ae819SStefano Zampini   if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) {
2018674ae819SStefano Zampini     Mat mat_adj;
2019674ae819SStefano Zampini     const PetscInt *xadj,*adjncy;
2020674ae819SStefano Zampini     PetscBool flg_row=PETSC_TRUE;
2021674ae819SStefano Zampini 
2022674ae819SStefano Zampini     ierr = MatConvert(matis->A,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr);
2023674ae819SStefano Zampini     ierr = MatGetRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2024674ae819SStefano Zampini     if (!flg_row) {
2025674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ called in %s\n",__FUNCT__);
2026674ae819SStefano Zampini     }
2027674ae819SStefano Zampini     ierr = PCBDDCSetLocalAdjacencyGraph(pc,i,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
2028674ae819SStefano Zampini     ierr = MatRestoreRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2029674ae819SStefano Zampini     if (!flg_row) {
2030674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__);
2031674ae819SStefano Zampini     }
2032674ae819SStefano Zampini     ierr = MatDestroy(&mat_adj);CHKERRQ(ierr);
2033674ae819SStefano Zampini   }
2034674ae819SStefano Zampini 
2035*63602bcaSStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting or PCBDDCSetDofsSplittingLocal */
2036674ae819SStefano Zampini   vertex_size = 1;
2037*63602bcaSStefano Zampini   if (pcbddc->user_provided_isfordofs) {
2038*63602bcaSStefano Zampini     if (pcbddc->n_ISForDofs) { /* need to convert from global to local and remove references to global dofs splitting */
2039*63602bcaSStefano Zampini       ierr = PetscMalloc(pcbddc->n_ISForDofs*sizeof(IS),&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
2040*63602bcaSStefano Zampini       for (i=0;i<pcbddc->n_ISForDofs;i++) {
2041*63602bcaSStefano Zampini         ierr = PCBDDCGlobalToLocal(pc,matis->ctx,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
2042*63602bcaSStefano Zampini         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
2043674ae819SStefano Zampini       }
2044*63602bcaSStefano Zampini       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
2045*63602bcaSStefano Zampini       pcbddc->n_ISForDofs = 0;
2046*63602bcaSStefano Zampini       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
2047674ae819SStefano Zampini     }
2048*63602bcaSStefano Zampini     /* mat block size as vertex size (used for elasticity with rigid body modes as nearnullspace) */
2049674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
2050*63602bcaSStefano Zampini   } else {
2051*63602bcaSStefano Zampini     if (!pcbddc->n_ISForDofsLocal) { /* field split not present, create it in local ordering */
2052*63602bcaSStefano Zampini       ierr = MatGetBlockSize(pc->pmat,&pcbddc->n_ISForDofsLocal);CHKERRQ(ierr);
2053*63602bcaSStefano Zampini       ierr = PetscMalloc(pcbddc->n_ISForDofsLocal*sizeof(IS),&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
2054*63602bcaSStefano Zampini       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
2055*63602bcaSStefano Zampini         ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),pcis->n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
2056*63602bcaSStefano Zampini       }
2057*63602bcaSStefano Zampini     }
2058674ae819SStefano Zampini   }
2059674ae819SStefano Zampini 
2060674ae819SStefano Zampini   /* Setup of Graph */
2061785d1243SStefano Zampini   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) { /* need to convert from global to local */
2062e456f2a8SStefano Zampini     ierr = PCBDDCGlobalToLocal(pc,matis->ctx,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
2063785d1243SStefano Zampini   }
2064785d1243SStefano Zampini   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) { /* need to convert from global to local */
2065e456f2a8SStefano Zampini     ierr = PCBDDCGlobalToLocal(pc,matis->ctx,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
2066785d1243SStefano Zampini   }
2067*63602bcaSStefano Zampini   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices);
2068674ae819SStefano Zampini 
2069674ae819SStefano Zampini   /* Graph's connected components analysis */
2070674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
2071674ae819SStefano Zampini 
2072674ae819SStefano Zampini   /* print some info to stdout */
2073674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
2074e49050b4SStefano Zampini     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer);
2075674ae819SStefano Zampini   }
2076674ae819SStefano Zampini   PetscFunctionReturn(0);
2077674ae819SStefano Zampini }
2078674ae819SStefano Zampini 
2079674ae819SStefano Zampini #undef __FUNCT__
2080674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx"
2081f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt **vertices_idx)
2082674ae819SStefano Zampini {
2083674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2084674ae819SStefano Zampini   PetscInt       *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size;
2085674ae819SStefano Zampini   PetscErrorCode ierr;
2086674ae819SStefano Zampini 
2087674ae819SStefano Zampini   PetscFunctionBegin;
2088674ae819SStefano Zampini   n = 0;
2089674ae819SStefano Zampini   vertices = 0;
2090674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2091674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr);
2092b120a5c6SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2093b120a5c6SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2094b120a5c6SStefano Zampini       if (size_of_constraint == 1) n++;
2095b120a5c6SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2096b120a5c6SStefano Zampini     }
2097811e8ca2SStefano Zampini     if (vertices_idx) {
2098b120a5c6SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&vertices);CHKERRQ(ierr);
2099b120a5c6SStefano Zampini       n = 0;
2100674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2101674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2102674ae819SStefano Zampini         if (size_of_constraint == 1) {
2103674ae819SStefano Zampini           vertices[n++]=row_cmat_indices[0];
2104674ae819SStefano Zampini         }
2105674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2106674ae819SStefano Zampini       }
2107674ae819SStefano Zampini     }
2108811e8ca2SStefano Zampini   }
2109674ae819SStefano Zampini   *n_vertices = n;
2110811e8ca2SStefano Zampini   if (vertices_idx) *vertices_idx = vertices;
2111674ae819SStefano Zampini   PetscFunctionReturn(0);
2112674ae819SStefano Zampini }
2113674ae819SStefano Zampini 
2114674ae819SStefano Zampini #undef __FUNCT__
2115674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx"
2116f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt **constraints_idx)
2117674ae819SStefano Zampini {
2118674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2119674ae819SStefano Zampini   PetscInt       *constraints_index,*row_cmat_indices,*row_cmat_global_indices;
2120674ae819SStefano Zampini   PetscInt       n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc;
21214641a718SStefano Zampini   PetscBT        touched;
2122674ae819SStefano Zampini   PetscErrorCode ierr;
2123674ae819SStefano Zampini 
2124f34684f1SStefano Zampini     /* This function assumes that the number of local constraints per connected component
2125f34684f1SStefano Zampini        is not greater than the number of nodes defined for the connected component
2126f34684f1SStefano Zampini        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
2127674ae819SStefano Zampini   PetscFunctionBegin;
2128674ae819SStefano Zampini   n = 0;
2129674ae819SStefano Zampini   constraints_index = 0;
2130674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2131674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr);
2132674ae819SStefano Zampini     max_size_of_constraint = 0;
2133674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2134674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2135674ae819SStefano Zampini       if (size_of_constraint > 1) {
2136674ae819SStefano Zampini         n++;
2137674ae819SStefano Zampini       }
2138674ae819SStefano Zampini       max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint);
2139674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2140674ae819SStefano Zampini     }
2141811e8ca2SStefano Zampini     if (constraints_idx) {
2142674ae819SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&constraints_index);CHKERRQ(ierr);
2143674ae819SStefano Zampini       ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&row_cmat_global_indices);CHKERRQ(ierr);
21444641a718SStefano Zampini       ierr = PetscBTCreate(local_size,&touched);CHKERRQ(ierr);
2145674ae819SStefano Zampini       n = 0;
2146674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2147674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2148674ae819SStefano Zampini         if (size_of_constraint > 1) {
2149674ae819SStefano Zampini           ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr);
215082d3d8afSStefano Zampini           /* find first untouched local node */
215182d3d8afSStefano Zampini           j = 0;
21524641a718SStefano Zampini           while (PetscBTLookup(touched,row_cmat_indices[j])) j++;
215382d3d8afSStefano Zampini           min_index = row_cmat_global_indices[j];
215482d3d8afSStefano Zampini           min_loc = j;
215582d3d8afSStefano Zampini           /* search the minimum among nodes not yet touched on the connected component
215682d3d8afSStefano Zampini              since there can be more than one constraint on a single cc */
2157674ae819SStefano Zampini           for (j=1;j<size_of_constraint;j++) {
21584641a718SStefano Zampini             if (!PetscBTLookup(touched,row_cmat_indices[j]) && min_index > row_cmat_global_indices[j]) {
2159674ae819SStefano Zampini               min_index = row_cmat_global_indices[j];
2160674ae819SStefano Zampini               min_loc = j;
2161674ae819SStefano Zampini             }
2162674ae819SStefano Zampini           }
21634641a718SStefano Zampini           ierr = PetscBTSet(touched,row_cmat_indices[min_loc]);CHKERRQ(ierr);
2164674ae819SStefano Zampini           constraints_index[n++] = row_cmat_indices[min_loc];
2165674ae819SStefano Zampini         }
2166674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2167674ae819SStefano Zampini       }
21684641a718SStefano Zampini       ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2169674ae819SStefano Zampini       ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr);
2170811e8ca2SStefano Zampini     }
2171811e8ca2SStefano Zampini   }
2172674ae819SStefano Zampini   *n_constraints = n;
2173811e8ca2SStefano Zampini   if (constraints_idx) *constraints_idx = constraints_index;
2174674ae819SStefano Zampini   PetscFunctionReturn(0);
2175674ae819SStefano Zampini }
2176674ae819SStefano Zampini 
2177674ae819SStefano Zampini /* the next two functions has been adapted from pcis.c */
2178674ae819SStefano Zampini #undef __FUNCT__
2179674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchur"
2180674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchur(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2181674ae819SStefano Zampini {
2182674ae819SStefano Zampini   PetscErrorCode ierr;
2183674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2184674ae819SStefano Zampini 
2185674ae819SStefano Zampini   PetscFunctionBegin;
2186674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2187674ae819SStefano Zampini   ierr = MatMult(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2188674ae819SStefano Zampini   ierr = MatMult(pcis->A_IB,v,vec1_D);CHKERRQ(ierr);
2189674ae819SStefano Zampini   ierr = KSPSolve(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2190674ae819SStefano Zampini   ierr = MatMult(pcis->A_BI,vec2_D,vec2_B);CHKERRQ(ierr);
2191674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2192674ae819SStefano Zampini   PetscFunctionReturn(0);
2193674ae819SStefano Zampini }
2194674ae819SStefano Zampini 
2195674ae819SStefano Zampini #undef __FUNCT__
2196674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchurTranspose"
2197674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchurTranspose(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2198674ae819SStefano Zampini {
2199674ae819SStefano Zampini   PetscErrorCode ierr;
2200674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2201674ae819SStefano Zampini 
2202674ae819SStefano Zampini   PetscFunctionBegin;
2203674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2204674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2205674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BI,v,vec1_D);CHKERRQ(ierr);
2206674ae819SStefano Zampini   ierr = KSPSolveTranspose(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2207674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_IB,vec2_D,vec2_B);CHKERRQ(ierr);
2208674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2209674ae819SStefano Zampini   PetscFunctionReturn(0);
2210674ae819SStefano Zampini }
2211674ae819SStefano Zampini 
2212674ae819SStefano Zampini #undef __FUNCT__
2213674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
2214674ae819SStefano 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[])
2215674ae819SStefano Zampini {
2216674ae819SStefano Zampini   Vec            local_vec,global_vec;
2217674ae819SStefano Zampini   IS             seqis,paris;
2218674ae819SStefano Zampini   VecScatter     scatter_ctx;
2219674ae819SStefano Zampini   PetscScalar    *array;
2220674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
2221674ae819SStefano Zampini   PetscScalar    globalsum;
2222674ae819SStefano Zampini   PetscInt       i,j,s;
2223674ae819SStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local;
2224674ae819SStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm,max_global;
2225674ae819SStefano Zampini   PetscMPIInt    *dof_sizes,*dof_displs;
2226674ae819SStefano Zampini   PetscBool      first_found;
2227674ae819SStefano Zampini   PetscErrorCode ierr;
2228674ae819SStefano Zampini 
2229674ae819SStefano Zampini   PetscFunctionBegin;
2230674ae819SStefano Zampini   /* mpi buffers */
2231674ae819SStefano Zampini   MPI_Comm_size(comm,&size_prec_comm);
2232674ae819SStefano Zampini   MPI_Comm_rank(comm,&rank_prec_comm);
2233674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
2234674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_sizes),&dof_sizes);CHKERRQ(ierr);
2235674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_displs),&dof_displs);CHKERRQ(ierr);
2236674ae819SStefano Zampini   /* get maximum size of subset */
2237674ae819SStefano Zampini   ierr = PetscMalloc(n_local_dofs*sizeof(PetscInt),&temp_global_dofs);CHKERRQ(ierr);
2238674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
2239674ae819SStefano Zampini   max_local = 0;
2240674ae819SStefano Zampini   if (n_local_dofs) {
2241674ae819SStefano Zampini     max_local = temp_global_dofs[0];
2242674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2243674ae819SStefano Zampini       if (max_local < temp_global_dofs[i] ) {
2244674ae819SStefano Zampini         max_local = temp_global_dofs[i];
2245674ae819SStefano Zampini       }
2246674ae819SStefano Zampini     }
2247674ae819SStefano Zampini   }
2248674ae819SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);
2249674ae819SStefano Zampini   max_global++;
2250674ae819SStefano Zampini   max_local = 0;
2251674ae819SStefano Zampini   if (n_local_dofs) {
2252674ae819SStefano Zampini     max_local = local_dofs[0];
2253674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2254674ae819SStefano Zampini       if (max_local < local_dofs[i] ) {
2255674ae819SStefano Zampini         max_local = local_dofs[i];
2256674ae819SStefano Zampini       }
2257674ae819SStefano Zampini     }
2258674ae819SStefano Zampini   }
2259674ae819SStefano Zampini   max_local++;
2260674ae819SStefano Zampini   /* allocate workspace */
2261674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
2262674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
2263674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
2264674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
2265674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
2266674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
2267674ae819SStefano Zampini   /* create scatter */
2268674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
2269674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
2270674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
2271674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
2272674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
2273674ae819SStefano Zampini   /* init array */
2274674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
2275674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2276674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2277674ae819SStefano Zampini   if (local_dofs_mult) {
2278674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2279674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
2280674ae819SStefano Zampini     }
2281674ae819SStefano Zampini   } else {
2282674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2283674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
2284674ae819SStefano Zampini     }
2285674ae819SStefano Zampini   }
2286674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2287674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
2288674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2289674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2290674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
22915b08dc53SStefano Zampini   *n_global_subset = (PetscInt)PetscRealPart(globalsum);
2292674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
2293674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
2294674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
2295674ae819SStefano Zampini   nlocals = 0;
2296674ae819SStefano Zampini   first_index = -1;
2297674ae819SStefano Zampini   first_found = PETSC_FALSE;
2298674ae819SStefano Zampini   for (i=0;i<s;i++) {
22995b08dc53SStefano Zampini     if (!first_found && PetscRealPart(array[i]) > 0.0) {
2300674ae819SStefano Zampini       first_found = PETSC_TRUE;
2301674ae819SStefano Zampini       first_index = i;
2302674ae819SStefano Zampini     }
23035b08dc53SStefano Zampini     nlocals += (PetscInt)PetscRealPart(array[i]);
2304674ae819SStefano Zampini   }
2305674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2306674ae819SStefano Zampini   if (!rank_prec_comm) {
2307674ae819SStefano Zampini     dof_displs[0]=0;
2308674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
2309674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
2310674ae819SStefano Zampini     }
2311674ae819SStefano Zampini   }
2312674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2313674ae819SStefano Zampini   if (first_found) {
2314674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
2315674ae819SStefano Zampini     old_index = first_index;
2316674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
23175b08dc53SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) {
2318674ae819SStefano Zampini         array[i] += array[old_index];
2319674ae819SStefano Zampini         old_index = i;
2320674ae819SStefano Zampini       }
2321674ae819SStefano Zampini     }
2322674ae819SStefano Zampini   }
2323674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
2324674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2325674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2326674ae819SStefano Zampini   ierr = VecScatterEnd  (scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2327674ae819SStefano Zampini   /* get global ordering of local dofs */
2328674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2329674ae819SStefano Zampini   if (local_dofs_mult) {
2330674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
23315b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i];
2332674ae819SStefano Zampini     }
2333674ae819SStefano Zampini   } else {
2334674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
23355b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1;
2336674ae819SStefano Zampini     }
2337674ae819SStefano Zampini   }
2338674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2339674ae819SStefano Zampini   /* free workspace */
2340674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
2341674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
2342674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
2343674ae819SStefano Zampini   ierr = PetscFree(dof_sizes);CHKERRQ(ierr);
2344674ae819SStefano Zampini   ierr = PetscFree(dof_displs);CHKERRQ(ierr);
2345674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
2346674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
2347674ae819SStefano Zampini   PetscFunctionReturn(0);
2348674ae819SStefano Zampini }
23499a7d3425SStefano Zampini 
23509a7d3425SStefano Zampini #undef __FUNCT__
23519a7d3425SStefano Zampini #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
23529a7d3425SStefano Zampini PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
23539a7d3425SStefano Zampini {
23549a7d3425SStefano Zampini   PetscInt       i,j;
23559a7d3425SStefano Zampini   PetscScalar    *alphas;
23569a7d3425SStefano Zampini   PetscErrorCode ierr;
23579a7d3425SStefano Zampini 
23589a7d3425SStefano Zampini   PetscFunctionBegin;
23599a7d3425SStefano Zampini   /* this implements stabilized Gram-Schmidt */
23609a7d3425SStefano Zampini   ierr = PetscMalloc(n*sizeof(PetscScalar),&alphas);CHKERRQ(ierr);
23619a7d3425SStefano Zampini   for (i=0;i<n;i++) {
23629a7d3425SStefano Zampini     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
23639a7d3425SStefano Zampini     if (i<n) { ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],&alphas[i+1]);CHKERRQ(ierr); }
23649a7d3425SStefano Zampini     for (j=i+1;j<n;j++) { ierr = VecAXPY(vecs[j],PetscConj(-alphas[j]),vecs[i]);CHKERRQ(ierr); }
23659a7d3425SStefano Zampini   }
23669a7d3425SStefano Zampini   ierr = PetscFree(alphas);CHKERRQ(ierr);
23679a7d3425SStefano Zampini   PetscFunctionReturn(0);
23689a7d3425SStefano Zampini }
23699a7d3425SStefano Zampini 
2370a57a6d2fSStefano Zampini /* Currently support MAT_INITIAL_MATRIX only, with partial support to block matrices */
2371c8587f34SStefano Zampini #undef __FUNCT__
2372a57a6d2fSStefano Zampini #define __FUNCT__ "MatConvert_IS_AIJ"
2373a57a6d2fSStefano Zampini static PetscErrorCode MatConvert_IS_AIJ(Mat mat, MatType newtype,MatReuse reuse,Mat *M)
2374c8587f34SStefano Zampini {
2375a57a6d2fSStefano Zampini   Mat new_mat;
2376a57a6d2fSStefano Zampini   Mat_IS *matis = (Mat_IS*)(mat->data);
2377a57a6d2fSStefano Zampini   /* info on mat */
2378a57a6d2fSStefano Zampini   PetscInt bs,rows,cols;
2379a57a6d2fSStefano Zampini   PetscInt lrows,lcols;
2380a57a6d2fSStefano Zampini   PetscInt local_rows,local_cols;
2381e7931f94SStefano Zampini   PetscMPIInt nsubdomains;
2382c8587f34SStefano Zampini   /* preallocation */
2383c8587f34SStefano Zampini   Vec vec_dnz,vec_onz;
2384c8587f34SStefano Zampini   PetscScalar *my_dnz,*my_onz,*array;
2385a57a6d2fSStefano Zampini   PetscInt *dnz,*onz,*mat_ranges,*row_ownership;
2386a57a6d2fSStefano Zampini   PetscInt  index_row,index_col,owner;
2387a57a6d2fSStefano Zampini   PetscInt  *local_indices,*global_indices;
2388a57a6d2fSStefano Zampini   /* work */
2389a57a6d2fSStefano Zampini   PetscInt i,j;
2390a57a6d2fSStefano Zampini   PetscErrorCode ierr;
2391c8587f34SStefano Zampini 
2392a57a6d2fSStefano Zampini   PetscFunctionBegin;
2393a57a6d2fSStefano Zampini   /* CHECKS */
2394a57a6d2fSStefano Zampini   /* get info from mat */
2395a57a6d2fSStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
2396a57a6d2fSStefano Zampini   ierr = MatGetBlockSize(mat,&bs);CHKERRQ(ierr);
2397a57a6d2fSStefano Zampini   ierr = MatGetSize(matis->A,&local_rows,&local_cols);CHKERRQ(ierr);
2398a57a6d2fSStefano Zampini   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&nsubdomains);CHKERRQ(ierr);
2399a57a6d2fSStefano Zampini 
2400a57a6d2fSStefano Zampini   /* MAT_INITIAL_MATRIX */
2401a57a6d2fSStefano Zampini   ierr = MatCreate(PetscObjectComm((PetscObject)mat),&new_mat);CHKERRQ(ierr);
2402a57a6d2fSStefano Zampini   ierr = MatSetSizes(new_mat,PETSC_DECIDE,PETSC_DECIDE,rows,cols);CHKERRQ(ierr);
2403a57a6d2fSStefano Zampini   ierr = MatSetBlockSize(new_mat,bs);CHKERRQ(ierr);
2404a57a6d2fSStefano Zampini   ierr = MatSetType(new_mat,newtype);CHKERRQ(ierr);
2405a57a6d2fSStefano Zampini   ierr = MatSetUp(new_mat);CHKERRQ(ierr);
2406a57a6d2fSStefano Zampini   ierr = MatGetLocalSize(new_mat,&lrows,&lcols);CHKERRQ(ierr);
2407a57a6d2fSStefano Zampini 
2408a57a6d2fSStefano Zampini   /*
2409a57a6d2fSStefano Zampini     preallocation
2410a57a6d2fSStefano Zampini   */
2411a57a6d2fSStefano Zampini 
2412a57a6d2fSStefano Zampini   ierr = MatPreallocateInitialize(PetscObjectComm((PetscObject)new_mat),lrows,lcols,dnz,onz);CHKERRQ(ierr);
2413a57a6d2fSStefano Zampini   /*
2414a57a6d2fSStefano Zampini      Some vectors are needed to sum up properly on shared interface dofs.
2415a57a6d2fSStefano Zampini      Note that preallocation is not exact, since it overestimates nonzeros
2416a57a6d2fSStefano Zampini   */
2417a57a6d2fSStefano Zampini /*
2418a57a6d2fSStefano Zampini   ierr = VecCreate(PetscObjectComm((PetscObject)mat),&vec_dnz);CHKERRQ(ierr);
2419c8587f34SStefano Zampini   ierr = VecSetBlockSize(vec_dnz,bs);CHKERRQ(ierr);
2420a57a6d2fSStefano Zampini   ierr = VecSetSizes(vec_dnz,PETSC_DECIDE,rows);CHKERRQ(ierr);
2421a57a6d2fSStefano Zampini   ierr = VecSetType(vec_dnz,VECSTANDARD);CHKERRQ(ierr);
2422a57a6d2fSStefano Zampini */
2423a57a6d2fSStefano Zampini   ierr = MatGetVecs(new_mat,NULL,&vec_dnz);CHKERRQ(ierr);
2424c8587f34SStefano Zampini   ierr = VecDuplicate(vec_dnz,&vec_onz);CHKERRQ(ierr);
2425e7931f94SStefano Zampini   /* All processes need to compute entire row ownership */
2426a57a6d2fSStefano Zampini   ierr = PetscMalloc(rows*sizeof(*row_ownership),&row_ownership);CHKERRQ(ierr);
2427a57a6d2fSStefano Zampini   ierr = MatGetOwnershipRanges(new_mat,(const PetscInt**)&mat_ranges);CHKERRQ(ierr);
2428a57a6d2fSStefano Zampini   for (i=0;i<nsubdomains;i++) {
2429c8587f34SStefano Zampini     for (j=mat_ranges[i];j<mat_ranges[i+1];j++) {
2430c8587f34SStefano Zampini       row_ownership[j]=i;
2431c8587f34SStefano Zampini     }
2432c8587f34SStefano Zampini   }
2433a57a6d2fSStefano Zampini   /* map indices of local mat to global values */
2434a57a6d2fSStefano Zampini   ierr = PetscMalloc(PetscMax(local_cols,local_rows)*sizeof(*global_indices),&global_indices);CHKERRQ(ierr);
2435a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*local_indices),&local_indices);CHKERRQ(ierr);
2436a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) local_indices[i]=i;
2437a57a6d2fSStefano Zampini   ierr = ISLocalToGlobalMappingApply(matis->mapping,local_rows,local_indices,global_indices);CHKERRQ(ierr);
2438a57a6d2fSStefano Zampini   ierr = PetscFree(local_indices);CHKERRQ(ierr);
2439c8587f34SStefano Zampini 
2440e7931f94SStefano Zampini   /*
2441e7931f94SStefano Zampini      my_dnz and my_onz contains exact contribution to preallocation from each local mat
2442e7931f94SStefano Zampini      then, they will be summed up properly. This way, preallocation is always sufficient
2443e7931f94SStefano Zampini   */
2444a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*my_dnz),&my_dnz);CHKERRQ(ierr);
2445a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*my_onz),&my_onz);CHKERRQ(ierr);
2446a57a6d2fSStefano Zampini   ierr = PetscMemzero(my_dnz,local_rows*sizeof(*my_dnz));CHKERRQ(ierr);
2447a57a6d2fSStefano Zampini   ierr = PetscMemzero(my_onz,local_rows*sizeof(*my_onz));CHKERRQ(ierr);
2448a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) {
2449a57a6d2fSStefano Zampini     index_row = global_indices[i];
2450a57a6d2fSStefano Zampini     for (j=i;j<local_rows;j++) {
2451a57a6d2fSStefano Zampini       owner = row_ownership[index_row];
2452a57a6d2fSStefano Zampini       index_col = global_indices[j];
2453a57a6d2fSStefano Zampini       if (index_col > mat_ranges[owner]-1 && index_col < mat_ranges[owner+1] ) { /* diag block */
2454c8587f34SStefano Zampini         my_dnz[i] += 1.0;
2455a57a6d2fSStefano Zampini       } else { /* offdiag block */
2456c8587f34SStefano Zampini         my_onz[i] += 1.0;
2457c8587f34SStefano Zampini       }
2458a57a6d2fSStefano Zampini       /* same as before, interchanging rows and cols */
2459c8587f34SStefano Zampini       if (i != j) {
2460a57a6d2fSStefano Zampini         owner = row_ownership[index_col];
2461a57a6d2fSStefano Zampini         if (index_row > mat_ranges[owner]-1 && index_row < mat_ranges[owner+1] ) {
2462c8587f34SStefano Zampini           my_dnz[j] += 1.0;
2463c8587f34SStefano Zampini         } else {
2464c8587f34SStefano Zampini           my_onz[j] += 1.0;
2465c8587f34SStefano Zampini         }
2466c8587f34SStefano Zampini       }
2467c8587f34SStefano Zampini     }
2468c8587f34SStefano Zampini   }
2469c8587f34SStefano Zampini   ierr = VecSet(vec_dnz,0.0);CHKERRQ(ierr);
2470c8587f34SStefano Zampini   ierr = VecSet(vec_onz,0.0);CHKERRQ(ierr);
247120a2ab83SStefano Zampini   if (local_rows) { /* multilevel guard */
2472a57a6d2fSStefano Zampini     ierr = VecSetValues(vec_dnz,local_rows,global_indices,my_dnz,ADD_VALUES);CHKERRQ(ierr);
2473a57a6d2fSStefano Zampini     ierr = VecSetValues(vec_onz,local_rows,global_indices,my_onz,ADD_VALUES);CHKERRQ(ierr);
2474c8587f34SStefano Zampini   }
2475c8587f34SStefano Zampini   ierr = VecAssemblyBegin(vec_dnz);CHKERRQ(ierr);
2476c8587f34SStefano Zampini   ierr = VecAssemblyBegin(vec_onz);CHKERRQ(ierr);
2477c8587f34SStefano Zampini   ierr = VecAssemblyEnd(vec_dnz);CHKERRQ(ierr);
2478c8587f34SStefano Zampini   ierr = VecAssemblyEnd(vec_onz);CHKERRQ(ierr);
2479c8587f34SStefano Zampini   ierr = PetscFree(my_dnz);CHKERRQ(ierr);
2480c8587f34SStefano Zampini   ierr = PetscFree(my_onz);CHKERRQ(ierr);
2481c8587f34SStefano Zampini   ierr = PetscFree(row_ownership);CHKERRQ(ierr);
2482a57a6d2fSStefano Zampini 
2483a57a6d2fSStefano Zampini   /* set computed preallocation in dnz and onz */
2484a57a6d2fSStefano Zampini   ierr = VecGetArray(vec_dnz,&array);CHKERRQ(ierr);
2485a57a6d2fSStefano Zampini   for (i=0; i<lrows; i++) dnz[i] = (PetscInt)PetscRealPart(array[i]);
2486a57a6d2fSStefano Zampini   ierr = VecRestoreArray(vec_dnz,&array);CHKERRQ(ierr);
2487a57a6d2fSStefano Zampini   ierr = VecGetArray(vec_onz,&array);CHKERRQ(ierr);
2488a57a6d2fSStefano Zampini   for (i=0;i<lrows;i++) onz[i] = (PetscInt)PetscRealPart(array[i]);
2489a57a6d2fSStefano Zampini   ierr = VecRestoreArray(vec_onz,&array);CHKERRQ(ierr);
2490c8587f34SStefano Zampini   ierr = VecDestroy(&vec_dnz);CHKERRQ(ierr);
2491c8587f34SStefano Zampini   ierr = VecDestroy(&vec_onz);CHKERRQ(ierr);
2492c8587f34SStefano Zampini 
2493e7931f94SStefano Zampini   /* Resize preallocation if overestimated */
2494c8587f34SStefano Zampini   for (i=0;i<lrows;i++) {
2495a57a6d2fSStefano Zampini     dnz[i] = PetscMin(dnz[i],lcols);
2496a57a6d2fSStefano Zampini     onz[i] = PetscMin(onz[i],cols-lcols);
2497c8587f34SStefano Zampini   }
2498a57a6d2fSStefano Zampini   ierr = MatMPIAIJSetPreallocation(new_mat,0,dnz,0,onz);CHKERRQ(ierr);
2499c8587f34SStefano Zampini   ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
2500a57a6d2fSStefano Zampini 
2501a57a6d2fSStefano Zampini   /*
2502e7931f94SStefano Zampini     Set values. Very Basic.
2503a57a6d2fSStefano Zampini   */
2504a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) {
2505a57a6d2fSStefano Zampini     ierr = MatGetRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2506a57a6d2fSStefano Zampini     ierr = ISLocalToGlobalMappingApply(matis->mapping,j,local_indices,global_indices);CHKERRQ(ierr);
2507a57a6d2fSStefano Zampini     ierr = ISLocalToGlobalMappingApply(matis->mapping,1,&i,&index_row);CHKERRQ(ierr);
2508a57a6d2fSStefano Zampini     ierr = MatSetValues(new_mat,1,&index_row,j,global_indices,array,ADD_VALUES);CHKERRQ(ierr);
2509a57a6d2fSStefano Zampini     ierr = MatRestoreRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2510a57a6d2fSStefano Zampini   }
251120a2ab83SStefano Zampini   ierr = MatAssemblyBegin(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2512a57a6d2fSStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
251320a2ab83SStefano Zampini   ierr = MatAssemblyEnd(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2514a57a6d2fSStefano Zampini 
2515a57a6d2fSStefano Zampini   /* get back mat */
2516a57a6d2fSStefano Zampini   *M = new_mat;
2517a57a6d2fSStefano Zampini   PetscFunctionReturn(0);
2518a57a6d2fSStefano Zampini }
2519a57a6d2fSStefano Zampini 
2520e7931f94SStefano Zampini #undef __FUNCT__
2521e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble_Private"
2522e7931f94SStefano Zampini PetscErrorCode MatISSubassemble_Private(Mat mat, PetscInt coarsening_ratio, IS* is_sends)
2523e7931f94SStefano Zampini {
2524e7931f94SStefano Zampini   Mat             subdomain_adj;
2525e7931f94SStefano Zampini   IS              new_ranks,ranks_send_to;
2526e7931f94SStefano Zampini   MatPartitioning partitioner;
2527e7931f94SStefano Zampini   Mat_IS          *matis;
2528e7931f94SStefano Zampini   PetscInt        n_neighs,*neighs,*n_shared,**shared;
2529e7931f94SStefano Zampini   PetscInt        prank;
2530e7931f94SStefano Zampini   PetscMPIInt     size,rank,color;
2531e7931f94SStefano Zampini   PetscInt        *xadj,*adjncy,*oldranks;
2532e7931f94SStefano Zampini   PetscInt        *adjncy_wgt,*v_wgt,*is_indices,*ranks_send_to_idx;
2533e7931f94SStefano Zampini   PetscInt        i,j,n_subdomains,local_size,threshold=0;
2534e7931f94SStefano Zampini   PetscErrorCode  ierr;
25352b510759SStefano Zampini   PetscBool       use_vwgt=PETSC_FALSE,use_square=PETSC_FALSE;
2536e7931f94SStefano Zampini   PetscSubcomm    subcomm;
2537a57a6d2fSStefano Zampini 
2538e7931f94SStefano Zampini   PetscFunctionBegin;
25392b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_square",&use_square,NULL);CHKERRQ(ierr);
25402b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
25412b510759SStefano Zampini   ierr = PetscOptionsGetInt(NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
2542e7931f94SStefano Zampini 
2543e7931f94SStefano Zampini   /* Get info on mapping */
2544e7931f94SStefano Zampini   matis = (Mat_IS*)(mat->data);
2545e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&local_size);CHKERRQ(ierr);
2546e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2547e7931f94SStefano Zampini 
2548e7931f94SStefano Zampini   /* build local CSR graph of subdomains' connectivity */
2549e7931f94SStefano Zampini   ierr = PetscMalloc(2*sizeof(*xadj),&xadj);CHKERRQ(ierr);
2550e7931f94SStefano Zampini   xadj[0] = 0;
2551e7931f94SStefano Zampini   xadj[1] = PetscMax(n_neighs-1,0);
2552e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy),&adjncy);CHKERRQ(ierr);
2553e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy_wgt),&adjncy_wgt);CHKERRQ(ierr);
2554e7931f94SStefano Zampini 
25552b510759SStefano Zampini   if (threshold) {
25562b510759SStefano Zampini     PetscInt* count,min_threshold;
2557e7931f94SStefano Zampini     ierr = PetscMalloc(local_size*sizeof(PetscInt),&count);CHKERRQ(ierr);
2558e7931f94SStefano Zampini     ierr = PetscMemzero(count,local_size*sizeof(PetscInt));CHKERRQ(ierr);
2559e7931f94SStefano Zampini     for (i=1;i<n_neighs;i++) {/* i=1 so I don't count myself -> faces nodes counts to 1 */
2560e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2561e7931f94SStefano Zampini         count[shared[i][j]] += 1;
2562e7931f94SStefano Zampini       }
2563e7931f94SStefano Zampini     }
25642b510759SStefano Zampini     /* adapt threshold since we dont want to lose significant connections */
25652b510759SStefano Zampini     min_threshold = n_neighs;
25662b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
25672b510759SStefano Zampini       for (j=0;j<n_shared[i];j++) {
25682b510759SStefano Zampini         min_threshold = PetscMin(count[shared[i][j]],min_threshold);
25692b510759SStefano Zampini       }
25702b510759SStefano Zampini     }
25712b510759SStefano Zampini     PetscPrintf(PETSC_COMM_SELF,"PASSED THRESHOLD %d\n",threshold);
25722b510759SStefano Zampini     threshold = PetscMax(min_threshold+1,threshold);
25732b510759SStefano Zampini     PetscPrintf(PETSC_COMM_SELF,"USING THRESHOLD %d (min %d)\n",threshold,min_threshold);
2574e7931f94SStefano Zampini     xadj[1] = 0;
25752b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
2576e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2577e7931f94SStefano Zampini         if (count[shared[i][j]] < threshold) {
2578e7931f94SStefano Zampini           adjncy[xadj[1]] = neighs[i];
2579e7931f94SStefano Zampini           adjncy_wgt[xadj[1]] = n_shared[i];
2580e7931f94SStefano Zampini           xadj[1]++;
2581e7931f94SStefano Zampini           break;
2582e7931f94SStefano Zampini         }
2583e7931f94SStefano Zampini       }
2584e7931f94SStefano Zampini     }
2585e7931f94SStefano Zampini     ierr = PetscFree(count);CHKERRQ(ierr);
2586c8587f34SStefano Zampini   } else {
2587e7931f94SStefano Zampini     if (xadj[1]) {
2588e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy,&neighs[1],xadj[1]*sizeof(*adjncy));CHKERRQ(ierr);
2589e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy_wgt,&n_shared[1],xadj[1]*sizeof(*adjncy_wgt));CHKERRQ(ierr);
2590c8587f34SStefano Zampini     }
2591e7931f94SStefano Zampini   }
2592e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingRestoreInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2593e7931f94SStefano Zampini   if (use_square) {
2594e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2595e7931f94SStefano Zampini       adjncy_wgt[i] = adjncy_wgt[i]*adjncy_wgt[i];
2596e7931f94SStefano Zampini     }
2597e7931f94SStefano Zampini   }
2598e7931f94SStefano Zampini   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2599e7931f94SStefano Zampini 
2600e7931f94SStefano Zampini   ierr = PetscMalloc(sizeof(PetscInt),&ranks_send_to_idx);CHKERRQ(ierr);
2601e7931f94SStefano Zampini 
2602e7931f94SStefano Zampini   /*
2603e7931f94SStefano Zampini     Restrict work on active processes only.
2604e7931f94SStefano Zampini   */
2605e7931f94SStefano Zampini   ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&subcomm);CHKERRQ(ierr);
2606e7931f94SStefano Zampini   ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
2607e7931f94SStefano Zampini   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
26082b510759SStefano Zampini   ierr = PetscMPIIntCast(!local_size,&color);CHKERRQ(ierr);
2609d3531aaaSJed Brown   ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
2610e7931f94SStefano Zampini   if (color) {
2611e7931f94SStefano Zampini     ierr = PetscFree(xadj);CHKERRQ(ierr);
2612e7931f94SStefano Zampini     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2613e7931f94SStefano Zampini     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
2614c8587f34SStefano Zampini   } else {
2615e7931f94SStefano Zampini     ierr = MPI_Comm_size(subcomm->comm,&size);CHKERRQ(ierr);
2616e7931f94SStefano Zampini     ierr = PetscMalloc(size*sizeof(*oldranks),&oldranks);CHKERRQ(ierr);
2617e7931f94SStefano Zampini     prank = rank;
2618e7931f94SStefano Zampini     ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm->comm);CHKERRQ(ierr);
2619e7931f94SStefano Zampini     for (i=0;i<size;i++) {
2620e7931f94SStefano Zampini       PetscPrintf(subcomm->comm,"oldranks[%d] = %d\n",i,oldranks[i]);
2621c8587f34SStefano Zampini     }
2622e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2623e7931f94SStefano Zampini       ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
2624c8587f34SStefano Zampini     }
2625e7931f94SStefano Zampini     ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2626e7931f94SStefano Zampini     ierr = MatCreateMPIAdj(subcomm->comm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
2627e7931f94SStefano Zampini     n_subdomains = (PetscInt)size;
2628e7931f94SStefano Zampini     ierr = MatView(subdomain_adj,0);CHKERRQ(ierr);
2629e7931f94SStefano Zampini 
2630e7931f94SStefano Zampini     /* Partition */
2631e7931f94SStefano Zampini     ierr = MatPartitioningCreate(subcomm->comm,&partitioner);CHKERRQ(ierr);
2632e7931f94SStefano Zampini     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
2633e7931f94SStefano Zampini     if (use_vwgt) {
2634e7931f94SStefano Zampini       ierr = PetscMalloc(sizeof(*v_wgt),&v_wgt);CHKERRQ(ierr);
2635e7931f94SStefano Zampini       v_wgt[0] = local_size;
2636e7931f94SStefano Zampini       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
2637c8587f34SStefano Zampini     }
2638e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)partitioner),"NPARTS %d\n",n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2639e7931f94SStefano Zampini     ierr = MatPartitioningSetNParts(partitioner,n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2640e7931f94SStefano Zampini     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
2641e7931f94SStefano Zampini     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
2642e7931f94SStefano Zampini     ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr);
2643e7931f94SStefano Zampini 
2644e7931f94SStefano Zampini     ierr = ISGetIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2645e7931f94SStefano Zampini     ranks_send_to_idx[0] = oldranks[is_indices[0]];
2646e7931f94SStefano Zampini     ierr = ISRestoreIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2647e7931f94SStefano Zampini     /* clean up */
2648e7931f94SStefano Zampini     ierr = PetscFree(oldranks);CHKERRQ(ierr);
2649e7931f94SStefano Zampini     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
2650e7931f94SStefano Zampini     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
2651e7931f94SStefano Zampini     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
2652e7931f94SStefano Zampini   }
2653e7931f94SStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
2654e7931f94SStefano Zampini 
2655e7931f94SStefano Zampini   /* assemble parallel IS for sends */
2656e7931f94SStefano Zampini   i = 1;
2657e7931f94SStefano Zampini   if (color) i=0;
2658e7931f94SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,&ranks_send_to);CHKERRQ(ierr);
2659e7931f94SStefano Zampini   ierr = ISView(ranks_send_to,0);CHKERRQ(ierr);
2660e7931f94SStefano Zampini 
2661e7931f94SStefano Zampini   /* get back IS */
2662e7931f94SStefano Zampini   *is_sends = ranks_send_to;
2663e7931f94SStefano Zampini   PetscFunctionReturn(0);
2664e7931f94SStefano Zampini }
2665e7931f94SStefano Zampini 
2666e7931f94SStefano Zampini typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
2667e7931f94SStefano Zampini 
2668e7931f94SStefano Zampini #undef __FUNCT__
2669e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble"
2670e7931f94SStefano Zampini PetscErrorCode MatISSubassemble(Mat mat, IS is_sends, PetscInt coarsening_ratio, Mat *mat_n)
2671e7931f94SStefano Zampini {
2672e7931f94SStefano Zampini   Mat                    local_mat,new_mat;
2673e7931f94SStefano Zampini   Mat_IS                 *matis;
2674e7931f94SStefano Zampini   IS                     is_sends_internal;
2675e7931f94SStefano Zampini   PetscInt               rows,cols;
2676e7931f94SStefano Zampini   PetscInt               i,bs,buf_size_idxs,buf_size_vals;
2677e7931f94SStefano Zampini   PetscBool              ismatis,isdense;
2678e7931f94SStefano Zampini   ISLocalToGlobalMapping l2gmap;
2679e7931f94SStefano Zampini   PetscInt*              l2gmap_indices;
2680e7931f94SStefano Zampini   const PetscInt*        is_indices;
2681e7931f94SStefano Zampini   MatType                new_local_type;
2682e7931f94SStefano Zampini   MatTypePrivate         new_local_type_private;
2683e7931f94SStefano Zampini   /* buffers */
2684e7931f94SStefano Zampini   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
2685e7931f94SStefano Zampini   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
2686e7931f94SStefano Zampini   /* MPI */
2687e7931f94SStefano Zampini   MPI_Comm               comm;
2688e7931f94SStefano Zampini   PetscMPIInt            n_sends,n_recvs,commsize;
2689e7931f94SStefano Zampini   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals;
2690e7931f94SStefano Zampini   PetscMPIInt            *onodes,*olengths_idxs,*olengths_vals;
2691e7931f94SStefano Zampini   PetscMPIInt            len,tag_idxs,tag_vals,source_dest;
2692e7931f94SStefano Zampini   MPI_Request            *send_req_idxs,*send_req_vals,*recv_req_idxs,*recv_req_vals;
2693e7931f94SStefano Zampini   PetscErrorCode         ierr;
2694e7931f94SStefano Zampini 
2695e7931f94SStefano Zampini   PetscFunctionBegin;
2696e7931f94SStefano Zampini   /* checks */
2697e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
2698e7931f94SStefano Zampini   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on an matrix object which is not of type MATIS",__FUNCT__);
2699e7931f94SStefano Zampini   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2700e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
2701e7931f94SStefano Zampini   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
2702e7931f94SStefano Zampini   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
2703e7931f94SStefano Zampini   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
2704e7931f94SStefano Zampini   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
2705e7931f94SStefano Zampini   PetscValidLogicalCollectiveInt(mat,bs,0);
2706e7931f94SStefano Zampini   /* prepare IS for sending if not provided */
2707e7931f94SStefano Zampini   if (!is_sends) {
2708e7931f94SStefano Zampini     if (!coarsening_ratio) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a coarsening ratio");
2709e7931f94SStefano Zampini     ierr = MatISSubassemble_Private(mat,coarsening_ratio,&is_sends_internal);CHKERRQ(ierr);
2710c8587f34SStefano Zampini   } else {
2711e7931f94SStefano Zampini     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
2712e7931f94SStefano Zampini     is_sends_internal = is_sends;
2713c8587f34SStefano Zampini   }
2714e7931f94SStefano Zampini 
2715e7931f94SStefano Zampini   /* get pointer of MATIS data */
2716e7931f94SStefano Zampini   matis = (Mat_IS*)mat->data;
2717e7931f94SStefano Zampini 
2718e7931f94SStefano Zampini   /* get comm */
2719e7931f94SStefano Zampini   comm = PetscObjectComm((PetscObject)mat);
2720e7931f94SStefano Zampini 
2721e7931f94SStefano Zampini   /* compute number of sends */
2722e7931f94SStefano Zampini   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
2723e7931f94SStefano Zampini   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
2724e7931f94SStefano Zampini 
2725e7931f94SStefano Zampini   /* compute number of receives */
2726e7931f94SStefano Zampini   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
2727e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*iflags),&iflags);CHKERRQ(ierr);
2728e7931f94SStefano Zampini   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
2729e7931f94SStefano Zampini   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2730e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
2731e7931f94SStefano Zampini   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
2732e7931f94SStefano Zampini   ierr = PetscFree(iflags);CHKERRQ(ierr);
2733e7931f94SStefano Zampini 
2734e7931f94SStefano Zampini   /* prepare send/receive buffers */
2735e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_idxs),&ilengths_idxs);CHKERRQ(ierr);
2736e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
2737e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_vals),&ilengths_vals);CHKERRQ(ierr);
2738e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
2739e7931f94SStefano Zampini 
2740e7931f94SStefano Zampini   /* Get data from local mat */
2741e7931f94SStefano Zampini   if (!isdense) {
2742e7931f94SStefano Zampini     /* TODO: See below some guidelines on how to prepare the local buffers */
2743e7931f94SStefano Zampini     /*
2744e7931f94SStefano Zampini        send_buffer_vals should contain the raw values of the local matrix
2745e7931f94SStefano Zampini        send_buffer_idxs should contain:
2746e7931f94SStefano Zampini        - MatType_PRIVATE type
2747e7931f94SStefano Zampini        - PetscInt        size_of_l2gmap
2748e7931f94SStefano Zampini        - PetscInt        global_row_indices[size_of_l2gmap]
2749e7931f94SStefano Zampini        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
2750e7931f94SStefano Zampini     */
2751e7931f94SStefano Zampini   } else {
2752e7931f94SStefano Zampini     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
2753e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&i);CHKERRQ(ierr);
2754e7931f94SStefano Zampini     ierr = PetscMalloc((i+2)*sizeof(PetscInt),&send_buffer_idxs);CHKERRQ(ierr);
2755e7931f94SStefano Zampini     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
2756e7931f94SStefano Zampini     send_buffer_idxs[1] = i;
2757e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2758e7931f94SStefano Zampini     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
2759e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingRestoreIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2760e7931f94SStefano Zampini     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
2761e7931f94SStefano Zampini     for (i=0;i<n_sends;i++) {
2762e7931f94SStefano Zampini       ilengths_vals[is_indices[i]] = len*len;
2763e7931f94SStefano Zampini       ilengths_idxs[is_indices[i]] = len+2;
2764c8587f34SStefano Zampini     }
2765c8587f34SStefano Zampini   }
2766e7931f94SStefano Zampini   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
2767e7931f94SStefano Zampini   buf_size_idxs = 0;
2768e7931f94SStefano Zampini   buf_size_vals = 0;
2769e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2770e7931f94SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
2771e7931f94SStefano Zampini     buf_size_vals += (PetscInt)olengths_vals[i];
2772e7931f94SStefano Zampini   }
2773e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&recv_buffer_idxs);CHKERRQ(ierr);
2774e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_vals*sizeof(PetscScalar),&recv_buffer_vals);CHKERRQ(ierr);
2775e7931f94SStefano Zampini 
2776e7931f94SStefano Zampini   /* get new tags for clean communications */
2777e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
2778e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
2779e7931f94SStefano Zampini 
2780e7931f94SStefano Zampini   /* allocate for requests */
2781e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_idxs);CHKERRQ(ierr);
2782e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_vals);CHKERRQ(ierr);
2783e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_idxs);CHKERRQ(ierr);
2784e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_vals);CHKERRQ(ierr);
2785e7931f94SStefano Zampini 
2786e7931f94SStefano Zampini   /* communications */
2787e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2788e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
2789e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2790e7931f94SStefano Zampini     source_dest = onodes[i];
2791e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
2792e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
2793e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2794e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
2795e7931f94SStefano Zampini   }
2796e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) {
2797e7931f94SStefano Zampini     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
2798e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
2799e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
2800e7931f94SStefano Zampini   }
2801e7931f94SStefano Zampini   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2802e7931f94SStefano Zampini   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
2803e7931f94SStefano Zampini 
2804e7931f94SStefano Zampini   /* assemble new l2g map */
2805e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2806e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2807e7931f94SStefano Zampini   buf_size_idxs = 0;
2808e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2809e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
2810e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2811e7931f94SStefano Zampini   }
2812e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&l2gmap_indices);CHKERRQ(ierr);
2813e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2814e7931f94SStefano Zampini   buf_size_idxs = 0;
2815e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2816e7931f94SStefano Zampini     ierr = PetscMemcpy(&l2gmap_indices[buf_size_idxs],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
2817e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
2818e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2819e7931f94SStefano Zampini   }
2820e7931f94SStefano Zampini   ierr = PetscSortRemoveDupsInt(&buf_size_idxs,l2gmap_indices);CHKERRQ(ierr);
2821e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingCreate(comm,buf_size_idxs,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
2822e7931f94SStefano Zampini   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
2823e7931f94SStefano Zampini 
2824e7931f94SStefano Zampini   /* infer new local matrix type from received local matrices type */
2825e7931f94SStefano Zampini   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
2826e7931f94SStefano 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) */
2827e7931f94SStefano Zampini   new_local_type_private = MATAIJ_PRIVATE;
2828e7931f94SStefano Zampini   new_local_type = MATSEQAIJ;
2829e7931f94SStefano Zampini   if (n_recvs) {
2830be4bc593SStefano Zampini     new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
2831e7931f94SStefano Zampini     ptr_idxs = recv_buffer_idxs;
2832e7931f94SStefano Zampini     for (i=0;i<n_recvs;i++) {
2833e7931f94SStefano Zampini       if ((PetscInt)new_local_type_private != *ptr_idxs) {
2834e7931f94SStefano Zampini         new_local_type_private = MATAIJ_PRIVATE;
2835e7931f94SStefano Zampini         break;
2836e7931f94SStefano Zampini       }
2837e7931f94SStefano Zampini       ptr_idxs += olengths_idxs[i];
2838e7931f94SStefano Zampini     }
2839e7931f94SStefano Zampini     switch (new_local_type_private) {
2840e7931f94SStefano Zampini       case MATDENSE_PRIVATE: /* subassembling of dense matrices does not give a dense matrix! */
2841e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
2842e7931f94SStefano Zampini         bs = 1;
2843e7931f94SStefano Zampini         break;
2844e7931f94SStefano Zampini       case MATAIJ_PRIVATE:
2845e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
2846e7931f94SStefano Zampini         bs = 1;
2847e7931f94SStefano Zampini         break;
2848e7931f94SStefano Zampini       case MATBAIJ_PRIVATE:
2849e7931f94SStefano Zampini         new_local_type = MATSEQBAIJ;
2850e7931f94SStefano Zampini         break;
2851e7931f94SStefano Zampini       case MATSBAIJ_PRIVATE:
2852e7931f94SStefano Zampini         new_local_type = MATSEQSBAIJ;
2853e7931f94SStefano Zampini         break;
2854e7931f94SStefano Zampini       default:
2855e7931f94SStefano Zampini         SETERRQ2(comm,PETSC_ERR_LIB,"Unkwown private type %d in %s",new_local_type_private,__FUNCT__);
2856e7931f94SStefano Zampini         break;
2857e7931f94SStefano Zampini     }
2858e7931f94SStefano Zampini   }
2859e7931f94SStefano Zampini 
2860e7931f94SStefano Zampini   /* create MATIS object */
2861e7931f94SStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
2862e7931f94SStefano Zampini   ierr = MatCreateIS(comm,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,&new_mat);CHKERRQ(ierr);
2863e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
2864e7931f94SStefano Zampini   ierr = MatISGetLocalMat(new_mat,&local_mat);CHKERRQ(ierr);
2865e7931f94SStefano Zampini   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
2866e7931f94SStefano Zampini   ierr = MatSetUp(local_mat);CHKERRQ(ierr); /* WARNING -> no preallocation yet */
2867e7931f94SStefano Zampini 
2868e7931f94SStefano Zampini   /* set values */
2869e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2870e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
2871e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2872e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2873e7931f94SStefano Zampini     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
2874e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
2875e7931f94SStefano Zampini       ierr = MatSetValues(new_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
2876e7931f94SStefano Zampini       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
2877e7931f94SStefano Zampini       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
2878e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
2879e7931f94SStefano Zampini     }
2880e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2881e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
2882e7931f94SStefano Zampini   }
2883e7931f94SStefano Zampini   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2884e7931f94SStefano Zampini   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2885e7931f94SStefano Zampini   ierr = MatAssemblyBegin(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2886e7931f94SStefano Zampini   ierr = MatAssemblyEnd(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2887e7931f94SStefano Zampini 
2888e7931f94SStefano Zampini   { /* check */
2889e7931f94SStefano Zampini     Vec       lvec,rvec;
2890e7931f94SStefano Zampini     PetscReal infty_error;
2891e7931f94SStefano Zampini 
2892e7931f94SStefano Zampini     ierr = MatGetVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
2893e7931f94SStefano Zampini     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
2894e7931f94SStefano Zampini     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
2895e7931f94SStefano Zampini     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
2896e7931f94SStefano Zampini     ierr = MatMultAdd(new_mat,rvec,lvec,lvec);CHKERRQ(ierr);
2897e7931f94SStefano Zampini     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
2898e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
2899e7931f94SStefano Zampini     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
2900e7931f94SStefano Zampini     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
2901e7931f94SStefano Zampini   }
2902e7931f94SStefano Zampini 
2903e7931f94SStefano Zampini   /* free workspace */
2904e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
2905e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
2906e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2907e7931f94SStefano Zampini   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
2908e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2909e7931f94SStefano Zampini   if (isdense) {
2910e7931f94SStefano Zampini     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2911e7931f94SStefano Zampini     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
2912e7931f94SStefano Zampini   } else {
2913e7931f94SStefano Zampini     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
2914e7931f94SStefano Zampini   }
2915e7931f94SStefano Zampini   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
2916e7931f94SStefano Zampini   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
2917e7931f94SStefano Zampini   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
2918e7931f94SStefano Zampini   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
2919e7931f94SStefano Zampini   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
2920e7931f94SStefano Zampini   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
2921e7931f94SStefano Zampini   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
2922e7931f94SStefano Zampini   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
2923e7931f94SStefano Zampini   ierr = PetscFree(onodes);CHKERRQ(ierr);
2924e7931f94SStefano Zampini   /* get back new mat */
2925e7931f94SStefano Zampini   *mat_n = new_mat;
2926e7931f94SStefano Zampini   PetscFunctionReturn(0);
2927e7931f94SStefano Zampini }
2928a57a6d2fSStefano Zampini 
2929c8587f34SStefano Zampini #undef __FUNCT__
2930c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
2931c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
2932c8587f34SStefano Zampini {
2933c8587f34SStefano Zampini   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
2934c8587f34SStefano Zampini   PC_IS                  *pcis = (PC_IS*)pc->data;
293520a2ab83SStefano Zampini   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
29369881197aSStefano Zampini   MatNullSpace           CoarseNullSpace=NULL;
293720a2ab83SStefano Zampini   ISLocalToGlobalMapping coarse_islg;
293820a2ab83SStefano Zampini   IS                     coarse_is;
2939f9eb5b7dSStefano Zampini   PetscInt               max_it,coarse_size,*local_primal_indices=NULL;
2940f9eb5b7dSStefano Zampini   PetscInt               im_active=-1,active_procs=-1;
2941f9eb5b7dSStefano Zampini   PC                     pc_temp;
2942c8587f34SStefano Zampini   PCType                 coarse_pc_type;
2943c8587f34SStefano Zampini   KSPType                coarse_ksp_type;
2944f9eb5b7dSStefano Zampini   PetscBool              multilevel_requested,multilevel_allowed;
2945f9eb5b7dSStefano Zampini   PetscBool              setsym,issym,isbddc,isnn;
2946f9eb5b7dSStefano Zampini   MatStructure           matstruct;
29479881197aSStefano Zampini   PetscErrorCode         ierr;
2948fdc09c96SStefano Zampini 
2949c8587f34SStefano Zampini   PetscFunctionBegin;
2950c8587f34SStefano Zampini   /* Assign global numbering to coarse dofs */
2951f34684f1SStefano Zampini   ierr = PCBDDCComputePrimalNumbering(pc,&coarse_size,&local_primal_indices);CHKERRQ(ierr);
2952c8587f34SStefano Zampini 
2953f9eb5b7dSStefano Zampini   /* infer some info from user */
2954f9eb5b7dSStefano Zampini   issym = PETSC_FALSE;
2955f9eb5b7dSStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
2956f9eb5b7dSStefano Zampini   multilevel_allowed = PETSC_FALSE;
2957f9eb5b7dSStefano Zampini   multilevel_requested = PETSC_FALSE;
2958f9eb5b7dSStefano Zampini   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
2959f9eb5b7dSStefano Zampini   if (multilevel_requested) {
29602b510759SStefano Zampini     /* count "active processes" */
29612b510759SStefano Zampini     im_active = !!(pcis->n);
29622b510759SStefano Zampini     ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
29632b510759SStefano Zampini     if (active_procs/pcbddc->coarsening_ratio < 2) {
2964f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_FALSE;
29652b510759SStefano Zampini     } else {
2966f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_TRUE;
2967c8587f34SStefano Zampini     }
2968c8587f34SStefano Zampini   }
2969e7931f94SStefano Zampini 
2970f9eb5b7dSStefano Zampini   /* set defaults for coarse KSP and PC */
2971f9eb5b7dSStefano Zampini   if (multilevel_allowed) {
2972c8587f34SStefano Zampini     if (issym) {
2973f9eb5b7dSStefano Zampini       coarse_ksp_type = KSPRICHARDSON;
2974f9eb5b7dSStefano Zampini     } else {
2975f9eb5b7dSStefano Zampini       coarse_ksp_type = KSPCHEBYSHEV;
2976c8587f34SStefano Zampini     }
2977f9eb5b7dSStefano Zampini     coarse_pc_type = PCBDDC;
2978f9eb5b7dSStefano Zampini   } else {
2979f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPPREONLY;
2980f9eb5b7dSStefano Zampini     coarse_pc_type = PCREDUNDANT;
2981c8587f34SStefano Zampini   }
2982c8587f34SStefano Zampini 
2983f9eb5b7dSStefano Zampini   /* create the coarse KSP object only once with defaults */
2984f9eb5b7dSStefano Zampini   if (!pcbddc->coarse_ksp) {
2985e604994aSStefano Zampini     char prefix[256],str_level[3];
2986e604994aSStefano Zampini     size_t len;
2987f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_ksp);CHKERRQ(ierr);
2988c8587f34SStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
2989f9eb5b7dSStefano Zampini     ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
2990c8587f34SStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
2991c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
2992c8587f34SStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
2993e604994aSStefano Zampini     /* prefix */
2994e604994aSStefano Zampini     ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
2995e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
2996e604994aSStefano Zampini     if (!pcbddc->current_level) {
2997e604994aSStefano Zampini       ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
2998e604994aSStefano Zampini       ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
2999c8587f34SStefano Zampini     } else {
3000e604994aSStefano Zampini       ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
3001e604994aSStefano Zampini       if (pcbddc->current_level>1) len -= 2;
3002e604994aSStefano Zampini       ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
3003e604994aSStefano Zampini       *(prefix+len)='\0';
3004e604994aSStefano Zampini       sprintf(str_level,"%d_",(int)(pcbddc->current_level));
3005e604994aSStefano Zampini       ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
3006e604994aSStefano Zampini     }
3007e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
3008f9eb5b7dSStefano Zampini   }
3009f9eb5b7dSStefano Zampini   /* allow user customization */
301085c4d303SStefano 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); */
3011f9eb5b7dSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
301285c4d303SStefano 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); */
3013f9eb5b7dSStefano Zampini 
3014f9eb5b7dSStefano Zampini   /* get some info after set from options */
3015f9eb5b7dSStefano Zampini   ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3016f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
3017f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
3018f9eb5b7dSStefano Zampini   if (isbddc && !multilevel_allowed) { /* prevent from infinite loop if user as requested bddc pc for coarse solver */
3019f9eb5b7dSStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
3020f9eb5b7dSStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
3021f9eb5b7dSStefano Zampini     isbddc = PETSC_FALSE;
3022f9eb5b7dSStefano Zampini   }
3023f9eb5b7dSStefano Zampini 
3024f9eb5b7dSStefano Zampini   /* propagate BDDC info to the next level */
3025f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
3026f9eb5b7dSStefano Zampini   ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
3027f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
3028f9eb5b7dSStefano Zampini 
3029f9eb5b7dSStefano Zampini   /* creates temporary MATIS object for coarse matrix */
3030a57a6d2fSStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,local_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
3031a57a6d2fSStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
3032a57a6d2fSStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
3033a57a6d2fSStefano Zampini   ierr = MatCreateIS(PetscObjectComm((PetscObject)pc),1,PETSC_DECIDE,PETSC_DECIDE,coarse_size,coarse_size,coarse_islg,&coarse_mat_is);CHKERRQ(ierr);
3034a57a6d2fSStefano Zampini   ierr = MatISSetLocalMat(coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
3035e7931f94SStefano Zampini   ierr = MatAssemblyBegin(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3036e7931f94SStefano Zampini   ierr = MatAssemblyEnd(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
303720a2ab83SStefano Zampini   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
303820a2ab83SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
303920a2ab83SStefano Zampini   ierr = PetscFree(local_primal_indices);CHKERRQ(ierr);
3040fdc09c96SStefano Zampini 
3041f9eb5b7dSStefano Zampini   /* assemble coarse matrix */
3042f9eb5b7dSStefano Zampini   if (isbddc || isnn) {
3043f9eb5b7dSStefano Zampini     ierr = MatISSubassemble(coarse_mat_is,NULL,pcbddc->coarsening_ratio,&coarse_mat);CHKERRQ(ierr);
3044f9eb5b7dSStefano Zampini   } else {
30452b510759SStefano Zampini     ierr = MatConvert_IS_AIJ(coarse_mat_is,MATAIJ,MAT_INITIAL_MATRIX,&coarse_mat);CHKERRQ(ierr);
3046c8587f34SStefano Zampini   }
30472b510759SStefano Zampini   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
30489881197aSStefano Zampini 
3049f9eb5b7dSStefano Zampini   /* create local to global scatters for coarse problem */
3050f9eb5b7dSStefano Zampini   ierr = MatGetVecs(coarse_mat,&pcbddc->coarse_vec,&pcbddc->coarse_rhs);CHKERRQ(ierr);
3051f9eb5b7dSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3052f9eb5b7dSStefano Zampini   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
3053f9eb5b7dSStefano Zampini 
3054f9eb5b7dSStefano Zampini   /* propagate symmetry info to coarse matrix */
3055f9eb5b7dSStefano Zampini   ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,issym);CHKERRQ(ierr);
3056f9eb5b7dSStefano Zampini 
3057b8ffe317SStefano Zampini   /* Compute coarse null space (special handling by BDDC only) */
3058b8ffe317SStefano Zampini   if (pcbddc->NullSpace) {
3059b8ffe317SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCoarse(pc,coarse_mat,&CoarseNullSpace);CHKERRQ(ierr);
3060b8ffe317SStefano Zampini     if (isbddc) {
3061b8ffe317SStefano Zampini       ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
3062b8ffe317SStefano Zampini     } else {
3063c8587f34SStefano Zampini       ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
3064c8587f34SStefano Zampini     }
3065c8587f34SStefano Zampini   }
3066c8587f34SStefano Zampini 
3067f9eb5b7dSStefano Zampini   /* set operators */
3068f9eb5b7dSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
3069f9eb5b7dSStefano Zampini   ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat,matstruct);CHKERRQ(ierr);
3070f9eb5b7dSStefano Zampini 
3071f9eb5b7dSStefano Zampini   /* additional KSP customization */
3072f9eb5b7dSStefano Zampini   ierr = KSPGetTolerances(pcbddc->coarse_ksp,NULL,NULL,NULL,&max_it);CHKERRQ(ierr);
3073f9eb5b7dSStefano Zampini   if (max_it < 5) {
3074c8587f34SStefano Zampini     ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
3075f9eb5b7dSStefano Zampini   }
3076b8ffe317SStefano Zampini   /* ierr = KSPChebyshevSetEstimateEigenvalues(pcbddc->coarse_ksp,1.0,0.0,0.0,1.1);CHKERRQ(ierr); */
3077f9eb5b7dSStefano Zampini 
3078f9eb5b7dSStefano Zampini 
3079f9eb5b7dSStefano Zampini   /* print some info if requested */
3080f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
3081f9eb5b7dSStefano Zampini     ierr = KSPGetType(pcbddc->coarse_ksp,&coarse_ksp_type);CHKERRQ(ierr);
3082f9eb5b7dSStefano Zampini     ierr = PCGetType(pc_temp,&coarse_pc_type);CHKERRQ(ierr);
3083f9eb5b7dSStefano Zampini     if (!multilevel_allowed) {
3084f9eb5b7dSStefano Zampini       if (multilevel_requested) {
3085f9eb5b7dSStefano 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);
3086f9eb5b7dSStefano Zampini       } else if (pcbddc->max_levels) {
3087f9eb5b7dSStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
3088c8587f34SStefano Zampini       }
3089c8587f34SStefano Zampini     }
3090e604994aSStefano 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);
3091f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3092c8587f34SStefano Zampini   }
3093f9eb5b7dSStefano Zampini 
3094f9eb5b7dSStefano Zampini   /* setup coarse ksp */
3095f9eb5b7dSStefano Zampini   ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
3096f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
3097f9eb5b7dSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
3098f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3099f9eb5b7dSStefano Zampini     ierr = KSPView(pcbddc->coarse_ksp,pcbddc->dbg_viewer);CHKERRQ(ierr);
3100f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3101f9eb5b7dSStefano Zampini   }
3102f9eb5b7dSStefano Zampini 
3103c8587f34SStefano Zampini   /* Check coarse problem if requested */
310420a2ab83SStefano Zampini   if (pcbddc->dbg_flag) {
3105c8587f34SStefano Zampini     KSP       check_ksp;
31062b510759SStefano Zampini     KSPType   check_ksp_type;
3107c8587f34SStefano Zampini     PC        check_pc;
3108c8587f34SStefano Zampini     Vec       check_vec;
3109c8587f34SStefano Zampini     PetscReal abs_infty_error,infty_error,lambda_min,lambda_max;
31102b510759SStefano Zampini     PetscInt  its;
3111f9eb5b7dSStefano Zampini     PetscBool ispreonly,compute;
3112c8587f34SStefano Zampini 
31132b510759SStefano Zampini     /* Create ksp object suitable for estimation of extreme eigenvalues */
3114f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&check_ksp);CHKERRQ(ierr);
3115fdc635d7SStefano Zampini     ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
3116983f5fd7SStefano Zampini     ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,coarse_size);CHKERRQ(ierr);
31172b510759SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
31182b510759SStefano Zampini     if (ispreonly) {
31192b510759SStefano Zampini       check_ksp_type = KSPPREONLY;
3120f9eb5b7dSStefano Zampini       compute = PETSC_FALSE;
31212b510759SStefano Zampini     } else {
3122c8587f34SStefano Zampini       if (issym) check_ksp_type = KSPCG;
3123c8587f34SStefano Zampini       else check_ksp_type = KSPGMRES;
3124f9eb5b7dSStefano Zampini       compute = PETSC_TRUE;
3125c8587f34SStefano Zampini     }
3126c8587f34SStefano Zampini     ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
3127f9eb5b7dSStefano Zampini     ierr = KSPSetComputeSingularValues(check_ksp,compute);CHKERRQ(ierr);
3128c8587f34SStefano Zampini     ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
3129c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
3130c8587f34SStefano Zampini     ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
3131c8587f34SStefano Zampini     /* create random vec */
3132c8587f34SStefano Zampini     ierr = VecDuplicate(pcbddc->coarse_vec,&check_vec);CHKERRQ(ierr);
3133c8587f34SStefano Zampini     ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
3134c8587f34SStefano Zampini     if (CoarseNullSpace) {
3135c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec);CHKERRQ(ierr);
3136c8587f34SStefano Zampini     }
3137fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3138c8587f34SStefano Zampini     /* solve coarse problem */
3139c8587f34SStefano Zampini     ierr = KSPSolve(check_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
3140c8587f34SStefano Zampini     if (CoarseNullSpace) {
3141c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,pcbddc->coarse_vec);CHKERRQ(ierr);
3142c8587f34SStefano Zampini     }
3143c8587f34SStefano Zampini     /* check coarse problem residual error */
3144c8587f34SStefano Zampini     ierr = VecAXPY(check_vec,-1.0,pcbddc->coarse_vec);CHKERRQ(ierr);
3145c8587f34SStefano Zampini     ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3146fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3147c8587f34SStefano Zampini     ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
3148c8587f34SStefano Zampini     ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
3149e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem (%s) details\n",((PetscObject)(pcbddc->coarse_ksp))->prefix);CHKERRQ(ierr);
3150e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
3151e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
3152f9eb5b7dSStefano Zampini     /* get eigenvalue estimation if preonly has not been requested */
31532b510759SStefano Zampini     if (!ispreonly) {
3154c8587f34SStefano Zampini       ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
315520a2ab83SStefano Zampini       ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
3156f9eb5b7dSStefano 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);
3157c8587f34SStefano Zampini     }
31582b510759SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3159c8587f34SStefano Zampini     ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
3160c8587f34SStefano Zampini   }
31612b510759SStefano Zampini   /* free memory */
3162c8587f34SStefano Zampini   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
3163fdc635d7SStefano Zampini   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
3164c8587f34SStefano Zampini   PetscFunctionReturn(0);
3165c8587f34SStefano Zampini }
3166674ae819SStefano Zampini 
3167f34684f1SStefano Zampini #undef __FUNCT__
3168f34684f1SStefano Zampini #define __FUNCT__ "PCBDDCComputePrimalNumbering"
3169f34684f1SStefano Zampini PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
3170f34684f1SStefano Zampini {
3171f34684f1SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3172f34684f1SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
3173f34684f1SStefano Zampini   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
3174f34684f1SStefano Zampini   PetscInt       i,j,coarse_size;
3175f34684f1SStefano Zampini   PetscInt       *local_primal_indices,*auxlocal_primal,*aux_idx;
3176f34684f1SStefano Zampini   PetscErrorCode ierr;
3177f34684f1SStefano Zampini 
3178f34684f1SStefano Zampini   PetscFunctionBegin;
3179f34684f1SStefano Zampini   /* get indices in local ordering for vertices and constraints */
3180f34684f1SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&auxlocal_primal);CHKERRQ(ierr);
3181f34684f1SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&i,&aux_idx);CHKERRQ(ierr);
3182f34684f1SStefano Zampini   ierr = PetscMemcpy(auxlocal_primal,aux_idx,i*sizeof(PetscInt));CHKERRQ(ierr);
3183f34684f1SStefano Zampini   ierr = PetscFree(aux_idx);CHKERRQ(ierr);
3184f34684f1SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&j,&aux_idx);CHKERRQ(ierr);
3185f34684f1SStefano Zampini   ierr = PetscMemcpy(&auxlocal_primal[i],aux_idx,j*sizeof(PetscInt));CHKERRQ(ierr);
3186f34684f1SStefano Zampini   ierr = PetscFree(aux_idx);CHKERRQ(ierr);
3187f34684f1SStefano Zampini 
3188f34684f1SStefano Zampini   /* Compute global number of coarse dofs */
3189f34684f1SStefano Zampini   ierr = PCBDDCSubsetNumbering(PetscObjectComm((PetscObject)(pc->pmat)),matis->mapping,pcbddc->local_primal_size,auxlocal_primal,NULL,&coarse_size,&local_primal_indices);CHKERRQ(ierr);
3190f34684f1SStefano Zampini 
3191f34684f1SStefano Zampini   /* check numbering */
3192f34684f1SStefano Zampini   if (pcbddc->dbg_flag) {
3193f34684f1SStefano Zampini     PetscScalar coarsesum,*array;
3194f34684f1SStefano Zampini 
3195f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3196f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3197f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
3198f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
3199f34684f1SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
3200f34684f1SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,auxlocal_primal[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
3201f34684f1SStefano Zampini     }
3202f34684f1SStefano Zampini     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
3203f34684f1SStefano Zampini     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
3204f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3205f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3206f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3207f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3208f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3209f34684f1SStefano Zampini     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3210f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3211f34684f1SStefano Zampini       if (array[i] == 1.0) {
3212f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %d owned by a single process!\n",PetscGlobalRank,i);CHKERRQ(ierr);
3213f34684f1SStefano Zampini       }
3214f34684f1SStefano Zampini     }
3215f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3216f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3217f34684f1SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
3218f34684f1SStefano Zampini     }
3219f34684f1SStefano Zampini     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3220f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3221f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3222f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3223f34684f1SStefano Zampini     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
3224f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
3225f34684f1SStefano Zampini     if (pcbddc->dbg_flag > 1) {
3226f34684f1SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
3227f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3228f34684f1SStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
3229f34684f1SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
323045a1bb75SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_primal_indices[%d]=%d (%d)\n",i,local_primal_indices[i],auxlocal_primal[i]);
3231f34684f1SStefano Zampini       }
3232f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3233f34684f1SStefano Zampini     }
3234f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3235f34684f1SStefano Zampini   }
3236f34684f1SStefano Zampini   ierr = PetscFree(auxlocal_primal);CHKERRQ(ierr);
3237f34684f1SStefano Zampini   /* get back data */
3238f34684f1SStefano Zampini   *coarse_size_n = coarse_size;
3239f34684f1SStefano Zampini   *local_primal_indices_n = local_primal_indices;
3240674ae819SStefano Zampini   PetscFunctionReturn(0);
3241674ae819SStefano Zampini }
3242674ae819SStefano Zampini 
3243e456f2a8SStefano Zampini #undef __FUNCT__
3244e456f2a8SStefano Zampini #define __FUNCT__ "PCBDDCGlobalToLocal"
3245e456f2a8SStefano Zampini PetscErrorCode PCBDDCGlobalToLocal(PC pc,VecScatter ctx,IS globalis,IS* localis)
3246e456f2a8SStefano Zampini {
3247e456f2a8SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
3248e456f2a8SStefano Zampini   IS             localis_t;
3249e456f2a8SStefano Zampini   PetscInt       i,lsize,*idxs;
3250e456f2a8SStefano Zampini   PetscScalar    *vals;
3251e456f2a8SStefano Zampini   PetscErrorCode ierr;
3252e456f2a8SStefano Zampini 
3253e456f2a8SStefano Zampini   PetscFunctionBegin;
3254e456f2a8SStefano Zampini   /* get dirichlet indices in local ordering exploiting local to global map */
3255e456f2a8SStefano Zampini   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
3256e456f2a8SStefano Zampini   ierr = PetscMalloc(lsize*sizeof(PetscScalar),&vals);CHKERRQ(ierr);
3257e456f2a8SStefano Zampini   for (i=0;i<lsize;i++) vals[i] = 1.0;
3258e456f2a8SStefano Zampini   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
3259e456f2a8SStefano Zampini   ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3260e456f2a8SStefano Zampini   ierr = VecSetValues(pcis->vec1_global,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
3261e456f2a8SStefano Zampini   ierr = VecAssemblyBegin(pcis->vec1_global);CHKERRQ(ierr);
3262e456f2a8SStefano Zampini   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
3263e456f2a8SStefano Zampini   ierr = PetscFree(vals);CHKERRQ(ierr);
3264e456f2a8SStefano Zampini   ierr = VecAssemblyEnd(pcis->vec1_global);CHKERRQ(ierr);
3265e456f2a8SStefano Zampini   /* now compute dirichlet set in local ordering */
3266e456f2a8SStefano Zampini   ierr = VecScatterBegin(ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3267e456f2a8SStefano Zampini   ierr = VecScatterEnd(ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3268e456f2a8SStefano Zampini   ierr = VecGetArrayRead(pcis->vec1_N,(const PetscScalar**)&vals);CHKERRQ(ierr);
3269e456f2a8SStefano Zampini   for (i=0,lsize=0;i<pcis->n;i++) {
3270e456f2a8SStefano Zampini     if (vals[i] == 1.0) {
3271e456f2a8SStefano Zampini       lsize++;
3272e456f2a8SStefano Zampini     }
3273e456f2a8SStefano Zampini   }
3274e456f2a8SStefano Zampini   ierr = PetscMalloc(lsize*sizeof(PetscInt),&idxs);CHKERRQ(ierr);
3275e456f2a8SStefano Zampini   for (i=0,lsize=0;i<pcis->n;i++) {
3276e456f2a8SStefano Zampini     if (vals[i] == 1.0) {
3277e456f2a8SStefano Zampini       idxs[lsize++] = i;
3278e456f2a8SStefano Zampini     }
3279e456f2a8SStefano Zampini   }
3280e456f2a8SStefano Zampini   ierr = VecRestoreArrayRead(pcis->vec1_N,(const PetscScalar**)&vals);CHKERRQ(ierr);
3281e456f2a8SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
3282e456f2a8SStefano Zampini   *localis = localis_t;
3283e456f2a8SStefano Zampini   PetscFunctionReturn(0);
3284e456f2a8SStefano Zampini }
3285