xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 785d12438418abfe1dc590cf0e72c5e5ca69a49b)
1674ae819SStefano Zampini #include "bddc.h"
2674ae819SStefano Zampini #include "bddcprivate.h"
3674ae819SStefano Zampini #include <petscblaslapack.h>
4674ae819SStefano Zampini 
5674ae819SStefano Zampini #undef __FUNCT__
6c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpSolvers"
7c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpSolvers(PC pc)
8c8587f34SStefano Zampini {
9c8587f34SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
108629588bSStefano Zampini   PetscScalar    *coarse_submat_vals;
11c8587f34SStefano Zampini   PetscErrorCode ierr;
12c8587f34SStefano Zampini 
13c8587f34SStefano Zampini   PetscFunctionBegin;
14c8587f34SStefano Zampini   /* Compute matrix after change of basis and extract local submatrices */
15c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalMatrices(pc);CHKERRQ(ierr);
16c8587f34SStefano Zampini 
17c8587f34SStefano Zampini   /* Allocate needed vectors */
18c8587f34SStefano Zampini   ierr = PCBDDCCreateWorkVectors(pc);CHKERRQ(ierr);
19c8587f34SStefano Zampini 
20c8587f34SStefano Zampini   /* Setup local scatters R_to_B and (optionally) R_to_D : PCBDDCCreateWorkVectors should be called first! */
21c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
22c8587f34SStefano Zampini 
23c8587f34SStefano Zampini   /* Setup local solvers ksp_D and ksp_R */
24c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalSolvers(pc);CHKERRQ(ierr);
25c8587f34SStefano Zampini 
26c8587f34SStefano Zampini   /* Change global null space passed in by the user if change of basis has been requested */
27c8587f34SStefano Zampini   if (pcbddc->NullSpace && pcbddc->use_change_of_basis) {
28c8587f34SStefano Zampini     ierr = PCBDDCNullSpaceAdaptGlobal(pc);CHKERRQ(ierr);
29c8587f34SStefano Zampini   }
30c8587f34SStefano Zampini 
318629588bSStefano Zampini   /*
328629588bSStefano Zampini      Setup local correction and local part of coarse basis.
338629588bSStefano Zampini      Gives back the dense local part of the coarse matrix in column major ordering
348629588bSStefano Zampini   */
3547f4ddc3SStefano Zampini   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
368629588bSStefano Zampini 
378629588bSStefano Zampini   /* Compute total number of coarse nodes and setup coarse solver */
388629588bSStefano Zampini   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
398629588bSStefano Zampini 
408629588bSStefano Zampini   /* free */
418629588bSStefano Zampini   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
42c8587f34SStefano Zampini   PetscFunctionReturn(0);
43c8587f34SStefano Zampini }
44c8587f34SStefano Zampini 
45c8587f34SStefano Zampini #undef __FUNCT__
46674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetCustomization"
47674ae819SStefano Zampini PetscErrorCode PCBDDCResetCustomization(PC pc)
48674ae819SStefano Zampini {
49674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
50674ae819SStefano Zampini   PetscInt       i;
51674ae819SStefano Zampini   PetscErrorCode ierr;
52674ae819SStefano Zampini 
53674ae819SStefano Zampini   PetscFunctionBegin;
54674ae819SStefano Zampini   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
55674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
56674ae819SStefano Zampini   ierr = MatNullSpaceDestroy(&pcbddc->NullSpace);CHKERRQ(ierr);
57674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
58*785d1243SStefano Zampini   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
59674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
60*785d1243SStefano Zampini   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
61674ae819SStefano Zampini   for (i=0;i<pcbddc->n_ISForDofs;i++) {
62674ae819SStefano Zampini     ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
63674ae819SStefano Zampini   }
64674ae819SStefano Zampini   ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
659577ea80SStefano Zampini   pcbddc->n_ISForDofs = 0;
66674ae819SStefano Zampini   PetscFunctionReturn(0);
67674ae819SStefano Zampini }
68674ae819SStefano Zampini 
69674ae819SStefano Zampini #undef __FUNCT__
70674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetTopography"
71674ae819SStefano Zampini PetscErrorCode PCBDDCResetTopography(PC pc)
72674ae819SStefano Zampini {
73674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
74674ae819SStefano Zampini   PetscErrorCode ierr;
75674ae819SStefano Zampini 
76674ae819SStefano Zampini   PetscFunctionBegin;
77674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
78674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
79674ae819SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
80674ae819SStefano Zampini   PetscFunctionReturn(0);
81674ae819SStefano Zampini }
82674ae819SStefano Zampini 
83674ae819SStefano Zampini #undef __FUNCT__
84674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetSolvers"
85674ae819SStefano Zampini PetscErrorCode PCBDDCResetSolvers(PC pc)
86674ae819SStefano Zampini {
87674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
88674ae819SStefano Zampini   PetscErrorCode ierr;
89674ae819SStefano Zampini 
90674ae819SStefano Zampini   PetscFunctionBegin;
91674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
92674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_rhs);CHKERRQ(ierr);
93674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
94674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
9515aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
9615aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
97674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
98674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
99674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
100674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
101674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
102674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
103674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec4_D);CHKERRQ(ierr);
1048ce42a96SStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
105674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
106674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
107674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
108674ae819SStefano Zampini   PetscFunctionReturn(0);
109674ae819SStefano Zampini }
110674ae819SStefano Zampini 
111674ae819SStefano Zampini #undef __FUNCT__
1126bfb1811SStefano Zampini #define __FUNCT__ "PCBDDCCreateWorkVectors"
1136bfb1811SStefano Zampini PetscErrorCode PCBDDCCreateWorkVectors(PC pc)
1146bfb1811SStefano Zampini {
1156bfb1811SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1166bfb1811SStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
1176bfb1811SStefano Zampini   VecType        impVecType;
1186bfb1811SStefano Zampini   PetscInt       n_vertices,n_constraints,local_primal_size,n_R;
1196bfb1811SStefano Zampini   PetscErrorCode ierr;
1206bfb1811SStefano Zampini 
1216bfb1811SStefano Zampini   PetscFunctionBegin;
1226bfb1811SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,NULL);CHKERRQ(ierr);
1236bfb1811SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&n_constraints,NULL);CHKERRQ(ierr);
1246bfb1811SStefano Zampini   local_primal_size = n_constraints+n_vertices;
1256bfb1811SStefano Zampini   n_R = pcis->n-n_vertices;
1266bfb1811SStefano Zampini   /* local work vectors */
1276bfb1811SStefano Zampini   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
1286bfb1811SStefano Zampini   ierr = VecDuplicate(pcis->vec1_D,&pcbddc->vec4_D);CHKERRQ(ierr);
1296bfb1811SStefano Zampini   ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
1306bfb1811SStefano Zampini   ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
1316bfb1811SStefano Zampini   ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
1326bfb1811SStefano Zampini   ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
13383b7ccabSStefano Zampini   ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
1346bfb1811SStefano Zampini   ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,local_primal_size);CHKERRQ(ierr);
1356bfb1811SStefano Zampini   ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
13683b7ccabSStefano Zampini   if (n_constraints) {
13783b7ccabSStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
13883b7ccabSStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
13983b7ccabSStefano Zampini     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
14083b7ccabSStefano Zampini   }
1416bfb1811SStefano Zampini   PetscFunctionReturn(0);
1426bfb1811SStefano Zampini }
1436bfb1811SStefano Zampini 
1446bfb1811SStefano Zampini #undef __FUNCT__
14547f4ddc3SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCorrection"
14647f4ddc3SStefano Zampini PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
14788ebb749SStefano Zampini {
14825084f0cSStefano Zampini   PetscErrorCode         ierr;
14925084f0cSStefano Zampini   /* pointers to pcis and pcbddc */
15088ebb749SStefano Zampini   PC_IS*                 pcis = (PC_IS*)pc->data;
15188ebb749SStefano Zampini   PC_BDDC*               pcbddc = (PC_BDDC*)pc->data;
15225084f0cSStefano Zampini   /* submatrices of local problem */
15388ebb749SStefano Zampini   Mat                    A_RV,A_VR,A_VV;
15425084f0cSStefano Zampini   /* working matrices */
15525084f0cSStefano Zampini   Mat                    M1,M2,M3,C_CR;
15625084f0cSStefano Zampini   /* working vectors */
15725084f0cSStefano Zampini   Vec                    vec1_C,vec2_C,vec1_V,vec2_V;
15825084f0cSStefano Zampini   /* additional working stuff */
15925084f0cSStefano Zampini   IS                     is_aux;
16088ebb749SStefano Zampini   ISLocalToGlobalMapping BtoNmap;
16125084f0cSStefano Zampini   PetscScalar            *coarse_submat_vals; /* TODO: use a PETSc matrix */
16225084f0cSStefano Zampini   const PetscScalar      *array,*row_cmat_values;
16325084f0cSStefano Zampini   const PetscInt         *row_cmat_indices,*idx_R_local;
16425084f0cSStefano Zampini   PetscInt               *vertices,*idx_V_B,*auxindices;
16525084f0cSStefano Zampini   PetscInt               n_vertices,n_constraints,size_of_constraint;
16625084f0cSStefano Zampini   PetscInt               i,j,n_R,n_D,n_B;
16788ebb749SStefano Zampini   PetscBool              setsym=PETSC_FALSE,issym=PETSC_FALSE;
16845a1bb75SStefano Zampini   /* matrix type (vector type propagated downstream from vec1_C and local matrix type) */
16988ebb749SStefano Zampini   MatType                impMatType;
17025084f0cSStefano Zampini   /* some shortcuts to scalars */
17125084f0cSStefano Zampini   PetscScalar            zero=0.0,one=1.0,m_one=-1.0;
17225084f0cSStefano Zampini   /* for debugging purposes */
17388ebb749SStefano Zampini   PetscReal              *coarsefunctions_errors,*constraints_errors;
17488ebb749SStefano Zampini 
17588ebb749SStefano Zampini   PetscFunctionBegin;
17625084f0cSStefano Zampini   /* get number of vertices and their local indices */
17725084f0cSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
17888ebb749SStefano Zampini   n_constraints = pcbddc->local_primal_size-n_vertices;
17988ebb749SStefano Zampini   /* Set Non-overlapping dimensions */
18088ebb749SStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
18188ebb749SStefano Zampini   n_R = pcis->n-n_vertices;
18288ebb749SStefano Zampini 
18388ebb749SStefano Zampini   /* Set types for local objects needed by BDDC precondtioner */
18488ebb749SStefano Zampini   impMatType = MATSEQDENSE;
18588ebb749SStefano Zampini 
18688ebb749SStefano Zampini   /* Allocating some extra storage just to be safe */
18788ebb749SStefano Zampini   ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&auxindices);CHKERRQ(ierr);
18888ebb749SStefano Zampini   for (i=0;i<pcis->n;i++) auxindices[i]=i;
18988ebb749SStefano Zampini 
19088ebb749SStefano Zampini   /* vertices in boundary numbering */
19188ebb749SStefano Zampini   ierr = PetscMalloc(n_vertices*sizeof(PetscInt),&idx_V_B);CHKERRQ(ierr);
19288ebb749SStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(pcis->is_B_local,&BtoNmap);CHKERRQ(ierr);
19388ebb749SStefano Zampini   ierr = ISGlobalToLocalMappingApply(BtoNmap,IS_GTOLM_DROP,n_vertices,vertices,&i,idx_V_B);CHKERRQ(ierr);
19488ebb749SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&BtoNmap);CHKERRQ(ierr);
19588ebb749SStefano Zampini   if (i != n_vertices) {
19688ebb749SStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %d != %d\n",n_vertices,i);
19788ebb749SStefano Zampini   }
19888ebb749SStefano Zampini 
19988ebb749SStefano Zampini   /* Precompute stuffs needed for preprocessing and application of BDDC*/
20088ebb749SStefano Zampini   if (n_constraints) {
20145a1bb75SStefano Zampini     /* work vectors */
20245a1bb75SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec1_C);CHKERRQ(ierr);
20345a1bb75SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec2_C);CHKERRQ(ierr);
20445a1bb75SStefano Zampini     /* auxiliary matrices */
20588ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->local_auxmat2);CHKERRQ(ierr);
20625084f0cSStefano Zampini     ierr = MatSetSizes(pcbddc->local_auxmat2,n_R,n_constraints,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
20788ebb749SStefano Zampini     ierr = MatSetType(pcbddc->local_auxmat2,impMatType);CHKERRQ(ierr);
20825084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->local_auxmat2);CHKERRQ(ierr);
20988ebb749SStefano Zampini 
21025084f0cSStefano Zampini     /* Extract constraints on R nodes: C_{CR}  */
21125084f0cSStefano Zampini     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
2128ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
21325084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
21488ebb749SStefano Zampini 
21588ebb749SStefano Zampini     /* Assemble local_auxmat2 = - A_{RR}^{-1} C^T_{CR} needed by BDDC application */
21688ebb749SStefano Zampini     for (i=0;i<n_constraints;i++) {
21788ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
21888ebb749SStefano Zampini       /* Get row of constraint matrix in R numbering */
21925084f0cSStefano Zampini       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
22025084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_R,size_of_constraint,row_cmat_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
22125084f0cSStefano Zampini       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
22225084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_R);CHKERRQ(ierr);
22325084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_R);CHKERRQ(ierr);
22488ebb749SStefano Zampini       /* Solve for row of constraint matrix in R numbering */
22588ebb749SStefano Zampini       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
22625084f0cSStefano Zampini       /* Set values in local_auxmat2 */
22725084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
22888ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->local_auxmat2,n_R,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
22925084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
23088ebb749SStefano Zampini     }
23188ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
23288ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
23325084f0cSStefano Zampini     ierr = MatScale(pcbddc->local_auxmat2,m_one);CHKERRQ(ierr);
23488ebb749SStefano Zampini 
23588ebb749SStefano Zampini     /* Assemble explicitly M1 = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1} needed in preproc  */
23625084f0cSStefano Zampini     ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
23725084f0cSStefano Zampini     ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
23888ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&M1);CHKERRQ(ierr);
23988ebb749SStefano Zampini     ierr = MatSetSizes(M1,n_constraints,n_constraints,n_constraints,n_constraints);CHKERRQ(ierr);
24088ebb749SStefano Zampini     ierr = MatSetType(M1,impMatType);CHKERRQ(ierr);
24125084f0cSStefano Zampini     ierr = MatSetUp(M1);CHKERRQ(ierr);
24225084f0cSStefano Zampini     ierr = MatDuplicate(M1,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
24325084f0cSStefano Zampini     ierr = MatZeroEntries(M2);CHKERRQ(ierr);
24425084f0cSStefano Zampini     ierr = VecSet(vec1_C,m_one);CHKERRQ(ierr);
24525084f0cSStefano Zampini     ierr = MatDiagonalSet(M2,vec1_C,INSERT_VALUES);CHKERRQ(ierr);
24625084f0cSStefano Zampini     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
24725084f0cSStefano Zampini     ierr = MatDestroy(&M2);CHKERRQ(ierr);
24825084f0cSStefano Zampini     ierr = MatDestroy(&M3);CHKERRQ(ierr);
24988ebb749SStefano Zampini     /* Assemble local_auxmat1 = M1*C_{CR} needed by BDDC application in KSP and in preproc */
25088ebb749SStefano Zampini     ierr = MatMatMult(M1,C_CR,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
25188ebb749SStefano Zampini   }
25288ebb749SStefano Zampini 
25388ebb749SStefano Zampini   /* Get submatrices from subdomain matrix */
25488ebb749SStefano Zampini   if (n_vertices) {
2553a50541eSStefano Zampini     PetscInt ibs,mbs;
2563a50541eSStefano Zampini     PetscBool issbaij;
257af732b37SStefano Zampini     Mat newmat;
2583a50541eSStefano Zampini 
2593a50541eSStefano Zampini     ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
2609577ea80SStefano Zampini     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
2619577ea80SStefano Zampini     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
2623a50541eSStefano Zampini     if (ibs != mbs) { /* need to convert to SEQAIJ */
2639577ea80SStefano Zampini       ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
2649577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
2659577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
2669577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
2679577ea80SStefano Zampini       ierr = MatDestroy(&newmat);CHKERRQ(ierr);
2689577ea80SStefano Zampini     } else {
2693a50541eSStefano Zampini       /* this is safe */
2709577ea80SStefano Zampini       ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
2713a50541eSStefano Zampini       ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
2723a50541eSStefano Zampini       if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
2733a50541eSStefano Zampini         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
27445a1bb75SStefano Zampini         /* which of the two approaches is faster? */
2753a50541eSStefano Zampini         /* ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
2763a50541eSStefano Zampini         ierr = MatCreateTranspose(A_RV,&A_VR);CHKERRQ(ierr);*/
2773a50541eSStefano Zampini         ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
2783a50541eSStefano Zampini         ierr = MatCreateTranspose(A_VR,&A_RV);CHKERRQ(ierr);
2793a50541eSStefano Zampini         ierr = MatDestroy(&newmat);CHKERRQ(ierr);
2803a50541eSStefano Zampini       } else {
2819577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
2829577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
2839577ea80SStefano Zampini       }
2843a50541eSStefano Zampini     }
28545a1bb75SStefano Zampini     ierr = MatGetVecs(A_RV,&vec1_V,NULL);CHKERRQ(ierr);
28645a1bb75SStefano Zampini     ierr = VecDuplicate(vec1_V,&vec2_V);CHKERRQ(ierr);
28725084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
28888ebb749SStefano Zampini   }
28988ebb749SStefano Zampini 
29088ebb749SStefano Zampini   /* Matrix of coarse basis functions (local) */
29188ebb749SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
29288ebb749SStefano Zampini   ierr = MatSetSizes(pcbddc->coarse_phi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
29388ebb749SStefano Zampini   ierr = MatSetType(pcbddc->coarse_phi_B,impMatType);CHKERRQ(ierr);
29425084f0cSStefano Zampini   ierr = MatSetUp(pcbddc->coarse_phi_B);CHKERRQ(ierr);
2958eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
29688ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
29788ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_phi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
29888ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_phi_D,impMatType);CHKERRQ(ierr);
29925084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_phi_D);CHKERRQ(ierr);
30088ebb749SStefano Zampini   }
30188ebb749SStefano Zampini 
30225084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
3038ce42a96SStefano Zampini     ierr = ISGetIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
30488ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*coarsefunctions_errors),&coarsefunctions_errors);CHKERRQ(ierr);
30588ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*constraints_errors),&constraints_errors);CHKERRQ(ierr);
30688ebb749SStefano Zampini   }
30788ebb749SStefano Zampini   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
30888ebb749SStefano Zampini   ierr = PetscMalloc((pcbddc->local_primal_size)*(pcbddc->local_primal_size)*sizeof(PetscScalar),&coarse_submat_vals);CHKERRQ(ierr);
30988ebb749SStefano Zampini 
31088ebb749SStefano Zampini   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
31125084f0cSStefano Zampini 
31225084f0cSStefano Zampini   /* vertices */
31388ebb749SStefano Zampini   for (i=0;i<n_vertices;i++) {
31445a1bb75SStefano Zampini     /* this should not be needed, but MatMult_BAIJ is broken when using compressed row routines */
31545a1bb75SStefano Zampini     ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
31688ebb749SStefano Zampini     ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
31788ebb749SStefano Zampini     ierr = VecSetValue(vec1_V,i,one,INSERT_VALUES);CHKERRQ(ierr);
31888ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
31988ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
32025084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on constraints multipliers */
32188ebb749SStefano Zampini     ierr = MatMult(A_RV,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
32288ebb749SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
32388ebb749SStefano Zampini     ierr = VecScale(pcbddc->vec1_R,m_one);CHKERRQ(ierr);
32488ebb749SStefano Zampini     if (n_constraints) {
32588ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec1_R,vec1_C);CHKERRQ(ierr);
32688ebb749SStefano Zampini       ierr = MatMultAdd(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
32788ebb749SStefano Zampini       ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
32888ebb749SStefano Zampini     }
32988ebb749SStefano Zampini     ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
33088ebb749SStefano Zampini     ierr = MatMultAdd(A_VV,vec1_V,vec2_V,vec2_V);CHKERRQ(ierr);
33188ebb749SStefano Zampini 
33288ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
33388ebb749SStefano Zampini     /* coarse basis functions */
33488ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
33588ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
33688ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
33725084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
33888ebb749SStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
33925084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
34088ebb749SStefano Zampini     ierr = MatSetValue(pcbddc->coarse_phi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
3418eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
34288ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
34388ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
34425084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
34588ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
34625084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
34788ebb749SStefano Zampini     }
34825084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
34925084f0cSStefano Zampini     ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
35025084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
35125084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
35288ebb749SStefano Zampini     if (n_constraints) {
35325084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
35425084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
35525084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
35688ebb749SStefano Zampini     }
35788ebb749SStefano Zampini 
35825084f0cSStefano Zampini     /* check */
35925084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
36025084f0cSStefano Zampini       /* assemble subdomain vector on local nodes */
36188ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
36225084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
36325084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
36425084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
36525084f0cSStefano Zampini       ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
36625084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
36725084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
36888ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers (i.e. primal nodes) */
36988ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
37025084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
37125084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
37225084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
37388ebb749SStefano Zampini       if (n_constraints) {
37425084f0cSStefano Zampini         ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
37525084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
37625084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
37788ebb749SStefano Zampini       }
37825084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
37925084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
38088ebb749SStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
38188ebb749SStefano Zampini       /* check saddle point solution */
38288ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
38388ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
38488ebb749SStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i]);CHKERRQ(ierr);
38588ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
38625084f0cSStefano Zampini       /* shift by the identity matrix */
38725084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
38825084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
38925084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
39088ebb749SStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i]);CHKERRQ(ierr);
39188ebb749SStefano Zampini     }
39288ebb749SStefano Zampini   }
39388ebb749SStefano Zampini 
39425084f0cSStefano Zampini   /* constraints */
39588ebb749SStefano Zampini   for (i=0;i<n_constraints;i++) {
39688ebb749SStefano Zampini     ierr = VecSet(vec2_C,zero);CHKERRQ(ierr);
39788ebb749SStefano Zampini     ierr = VecSetValue(vec2_C,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
39888ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec2_C);CHKERRQ(ierr);
39988ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec2_C);CHKERRQ(ierr);
40025084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on vertices multipliers */
40188ebb749SStefano Zampini     ierr = MatMult(M1,vec2_C,vec1_C);CHKERRQ(ierr);
40288ebb749SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
40388ebb749SStefano Zampini     ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
40425084f0cSStefano Zampini     if (n_vertices) {
40525084f0cSStefano Zampini       ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
40625084f0cSStefano Zampini     }
40788ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
40888ebb749SStefano Zampini     /* coarse basis functions */
40925084f0cSStefano Zampini     j = i+n_vertices; /* don't touch this! */
41088ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
41188ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
41288ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
41325084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
41425084f0cSStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
41525084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
4168eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
41788ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
41888ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
41925084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
42025084f0cSStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
42125084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
42288ebb749SStefano Zampini     }
42325084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
42488ebb749SStefano Zampini     if (n_vertices) {
42525084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
42625084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
42725084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
42888ebb749SStefano Zampini     }
42925084f0cSStefano Zampini     ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
43025084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
43125084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
43288ebb749SStefano Zampini 
43325084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
43488ebb749SStefano Zampini       /* assemble subdomain vector on nodes */
43588ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
43625084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
43725084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
43825084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
43925084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
44025084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
44188ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers */
44288ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
44388ebb749SStefano Zampini       if (n_vertices) {
44425084f0cSStefano Zampini         ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
44525084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
44625084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
44788ebb749SStefano Zampini       }
44825084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
44925084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
45025084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
45125084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
45225084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
45325084f0cSStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
45488ebb749SStefano Zampini       /* check saddle point solution */
45588ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
45688ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
45725084f0cSStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[j]);CHKERRQ(ierr);
45888ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
45925084f0cSStefano Zampini       /* shift by the identity matrix */
46025084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,j,m_one,ADD_VALUES);CHKERRQ(ierr);
46125084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
46225084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
46325084f0cSStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[j]);CHKERRQ(ierr);
46488ebb749SStefano Zampini     }
46588ebb749SStefano Zampini   }
46625084f0cSStefano Zampini   /* call assembling routines for local coarse basis */
46788ebb749SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
46888ebb749SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4698eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
47088ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
47188ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
47288ebb749SStefano Zampini   }
47325084f0cSStefano Zampini 
47488ebb749SStefano Zampini   /* compute other basis functions for non-symmetric problems */
47588ebb749SStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
47688ebb749SStefano Zampini   if (!setsym || (setsym && !issym)) {
47788ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
47888ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_psi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
47988ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_psi_B,impMatType);CHKERRQ(ierr);
48025084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_psi_B);CHKERRQ(ierr);
4818eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
48288ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
48388ebb749SStefano Zampini       ierr = MatSetSizes(pcbddc->coarse_psi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
48488ebb749SStefano Zampini       ierr = MatSetType(pcbddc->coarse_psi_D,impMatType);CHKERRQ(ierr);
48525084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->coarse_psi_D);CHKERRQ(ierr);
48688ebb749SStefano Zampini     }
48788ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
48888ebb749SStefano Zampini       if (n_constraints) {
48988ebb749SStefano Zampini         ierr = VecSet(vec1_C,zero);CHKERRQ(ierr);
49088ebb749SStefano Zampini         for (j=0;j<n_constraints;j++) {
49125084f0cSStefano Zampini           ierr = VecSetValue(vec1_C,j,coarse_submat_vals[(j+n_vertices)*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
49288ebb749SStefano Zampini         }
49325084f0cSStefano Zampini         ierr = VecAssemblyBegin(vec1_C);CHKERRQ(ierr);
49425084f0cSStefano Zampini         ierr = VecAssemblyEnd(vec1_C);CHKERRQ(ierr);
49588ebb749SStefano Zampini       }
49688ebb749SStefano Zampini       if (i<n_vertices) {
49788ebb749SStefano Zampini         ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
49888ebb749SStefano Zampini         ierr = VecSetValue(vec1_V,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
49988ebb749SStefano Zampini         ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
50088ebb749SStefano Zampini         ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
50188ebb749SStefano Zampini         ierr = MatMultTranspose(A_VR,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
50288ebb749SStefano Zampini         if (n_constraints) {
50388ebb749SStefano Zampini           ierr = MatMultTransposeAdd(C_CR,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
50488ebb749SStefano Zampini         }
50588ebb749SStefano Zampini       } else {
50688ebb749SStefano Zampini         ierr = MatMultTranspose(C_CR,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
50788ebb749SStefano Zampini       }
50888ebb749SStefano Zampini       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
50988ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
51088ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
51188ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
51225084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
51388ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_psi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
51425084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
51588ebb749SStefano Zampini       if (i<n_vertices) {
51688ebb749SStefano Zampini         ierr = MatSetValue(pcbddc->coarse_psi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
51788ebb749SStefano Zampini       }
5188eeda7d8SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
51988ebb749SStefano Zampini         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
52088ebb749SStefano Zampini         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
52125084f0cSStefano Zampini         ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
52288ebb749SStefano Zampini         ierr = MatSetValues(pcbddc->coarse_psi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
52325084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
52488ebb749SStefano Zampini       }
52588ebb749SStefano Zampini 
52625084f0cSStefano Zampini       if (pcbddc->dbg_flag) {
52788ebb749SStefano Zampini         /* assemble subdomain vector on nodes */
52888ebb749SStefano Zampini         ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
52925084f0cSStefano Zampini         ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
53025084f0cSStefano Zampini         ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
53125084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
53225084f0cSStefano Zampini         if (i<n_vertices) {
53325084f0cSStefano Zampini           ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
53488ebb749SStefano Zampini         }
53525084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
53625084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
53725084f0cSStefano Zampini         /* assemble subdomain vector of lagrange multipliers */
53825084f0cSStefano Zampini         for (j=0;j<pcbddc->local_primal_size;j++) {
53925084f0cSStefano Zampini           ierr = VecSetValue(pcbddc->vec1_P,j,-coarse_submat_vals[j*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
54025084f0cSStefano Zampini         }
54125084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
54225084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
54388ebb749SStefano Zampini         /* check saddle point solution */
54488ebb749SStefano Zampini         ierr = MatMultTranspose(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
54588ebb749SStefano Zampini         ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
54688ebb749SStefano Zampini         ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
54788ebb749SStefano Zampini         ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
54825084f0cSStefano Zampini         /* shift by the identity matrix */
54925084f0cSStefano Zampini         ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
55025084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
55125084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
55288ebb749SStefano Zampini         ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
55388ebb749SStefano Zampini       }
55488ebb749SStefano Zampini     }
55588ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
55688ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5578eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
55888ebb749SStefano Zampini       ierr = MatAssemblyBegin(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
55988ebb749SStefano Zampini       ierr = MatAssemblyEnd(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
56088ebb749SStefano Zampini     }
56188ebb749SStefano Zampini   }
56288ebb749SStefano Zampini   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
56388ebb749SStefano Zampini   /* Checking coarse_sub_mat and coarse basis functios */
56488ebb749SStefano Zampini   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
56588ebb749SStefano Zampini   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
56625084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
56788ebb749SStefano Zampini     Mat         coarse_sub_mat;
56825084f0cSStefano Zampini     Mat         AUXMAT,TM1,TM2,TM3,TM4;
56988ebb749SStefano Zampini     Mat         coarse_phi_D,coarse_phi_B;
57088ebb749SStefano Zampini     Mat         coarse_psi_D,coarse_psi_B;
57188ebb749SStefano Zampini     Mat         A_II,A_BB,A_IB,A_BI;
57288ebb749SStefano Zampini     MatType     checkmattype=MATSEQAIJ;
57388ebb749SStefano Zampini     PetscReal   real_value;
57488ebb749SStefano Zampini 
57588ebb749SStefano Zampini     ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
57688ebb749SStefano Zampini     ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
57788ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
57888ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
57988ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
58088ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
58188ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
58288ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
58388ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
58488ebb749SStefano Zampini     }
58588ebb749SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
58688ebb749SStefano Zampini 
58725084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
58825084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat and local basis functions\n");CHKERRQ(ierr);
58925084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
59088ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
59188ebb749SStefano Zampini       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
59288ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
59388ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
59488ebb749SStefano Zampini       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
59588ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
59688ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
59788ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
59888ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
59988ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
60088ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
60188ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
60288ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
60388ebb749SStefano Zampini     } else {
60488ebb749SStefano Zampini       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
60588ebb749SStefano Zampini       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
60688ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
60788ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
60888ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
60988ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
61088ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
61188ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
61288ebb749SStefano Zampini     }
61388ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
61488ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
61588ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
61688ebb749SStefano Zampini     ierr = MatConvert(TM1,MATSEQDENSE,MAT_REUSE_MATRIX,&TM1);CHKERRQ(ierr);
61788ebb749SStefano Zampini     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
61888ebb749SStefano Zampini     ierr = MatNorm(TM1,NORM_INFINITY,&real_value);CHKERRQ(ierr);
61925084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"----------------------------------\n");CHKERRQ(ierr);
62025084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d \n",PetscGlobalRank);CHKERRQ(ierr);
62125084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"matrix error = % 1.14e\n",real_value);CHKERRQ(ierr);
62225084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (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,coarsefunctions_errors[i]);CHKERRQ(ierr);
62588ebb749SStefano Zampini     }
62625084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (phi) errors\n");CHKERRQ(ierr);
62788ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
62825084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,constraints_errors[i]);CHKERRQ(ierr);
62988ebb749SStefano Zampini     }
63088ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
63125084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (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,coarsefunctions_errors[i]);CHKERRQ(ierr);
63488ebb749SStefano Zampini       }
63525084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (psi) errors\n");CHKERRQ(ierr);
63688ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
63725084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,constraints_errors[i]);CHKERRQ(ierr);
63888ebb749SStefano Zampini       }
63988ebb749SStefano Zampini     }
64025084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
64188ebb749SStefano Zampini     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
64288ebb749SStefano Zampini     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
64388ebb749SStefano Zampini     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
64488ebb749SStefano Zampini     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
64588ebb749SStefano Zampini     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
64688ebb749SStefano Zampini     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
64788ebb749SStefano Zampini     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
64888ebb749SStefano Zampini     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
64988ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
65088ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
65188ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
65288ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
65388ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
65488ebb749SStefano Zampini     }
65588ebb749SStefano Zampini     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
6568ce42a96SStefano Zampini     ierr = ISRestoreIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
65788ebb749SStefano Zampini     ierr = PetscFree(coarsefunctions_errors);CHKERRQ(ierr);
65888ebb749SStefano Zampini     ierr = PetscFree(constraints_errors);CHKERRQ(ierr);
65988ebb749SStefano Zampini   }
66088ebb749SStefano Zampini   /* free memory */
66188ebb749SStefano Zampini   if (n_vertices) {
66288ebb749SStefano Zampini     ierr = PetscFree(vertices);CHKERRQ(ierr);
66388ebb749SStefano Zampini     ierr = VecDestroy(&vec1_V);CHKERRQ(ierr);
66488ebb749SStefano Zampini     ierr = VecDestroy(&vec2_V);CHKERRQ(ierr);
66588ebb749SStefano Zampini     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
66688ebb749SStefano Zampini     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
66788ebb749SStefano Zampini     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
66888ebb749SStefano Zampini   }
66988ebb749SStefano Zampini   if (n_constraints) {
67088ebb749SStefano Zampini     ierr = VecDestroy(&vec1_C);CHKERRQ(ierr);
67188ebb749SStefano Zampini     ierr = VecDestroy(&vec2_C);CHKERRQ(ierr);
67288ebb749SStefano Zampini     ierr = MatDestroy(&M1);CHKERRQ(ierr);
67388ebb749SStefano Zampini     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
67488ebb749SStefano Zampini   }
67588ebb749SStefano Zampini   ierr = PetscFree(auxindices);CHKERRQ(ierr);
6768629588bSStefano Zampini   /* get back data */
6778629588bSStefano Zampini   *coarse_submat_vals_n = coarse_submat_vals;
67888ebb749SStefano Zampini   PetscFunctionReturn(0);
67988ebb749SStefano Zampini }
68088ebb749SStefano Zampini 
68188ebb749SStefano Zampini #undef __FUNCT__
682aa0d41d4SStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalMatrices"
683aa0d41d4SStefano Zampini PetscErrorCode PCBDDCSetUpLocalMatrices(PC pc)
684aa0d41d4SStefano Zampini {
685aa0d41d4SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
686aa0d41d4SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
687aa0d41d4SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
6889577ea80SStefano Zampini   PetscBool         issbaij,isbaij;
689aa0d41d4SStefano Zampini   /* manage repeated solves */
690aa0d41d4SStefano Zampini   MatReuse          reuse;
691aa0d41d4SStefano Zampini   MatStructure      matstruct;
692aa0d41d4SStefano Zampini   PetscErrorCode    ierr;
693aa0d41d4SStefano Zampini 
694aa0d41d4SStefano Zampini   PetscFunctionBegin;
695aa0d41d4SStefano Zampini   /* get mat flags */
696aa0d41d4SStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
697aa0d41d4SStefano Zampini   reuse = MAT_INITIAL_MATRIX;
698aa0d41d4SStefano Zampini   if (pc->setupcalled) {
699aa0d41d4SStefano Zampini     /* when matstruct is SAME_PRECONDITIONER, we shouldn't be here */
700aa0d41d4SStefano Zampini     if (matstruct == SAME_PRECONDITIONER) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen");
701aa0d41d4SStefano Zampini     if (matstruct == SAME_NONZERO_PATTERN) {
702aa0d41d4SStefano Zampini       reuse = MAT_REUSE_MATRIX;
703aa0d41d4SStefano Zampini     } else {
704aa0d41d4SStefano Zampini       reuse = MAT_INITIAL_MATRIX;
705aa0d41d4SStefano Zampini     }
706aa0d41d4SStefano Zampini   }
707aa0d41d4SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
708aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
709aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
710aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
711aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BB);CHKERRQ(ierr);
712aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
713aa0d41d4SStefano Zampini   }
714aa0d41d4SStefano Zampini 
715aa0d41d4SStefano Zampini   /* transform local matrices if needed */
716aa0d41d4SStefano Zampini   if (pcbddc->use_change_of_basis) {
717aa0d41d4SStefano Zampini     Mat         change_mat_all;
718aa0d41d4SStefano Zampini     PetscScalar *row_cmat_values;
719aa0d41d4SStefano Zampini     PetscInt    *row_cmat_indices;
720aa0d41d4SStefano Zampini     PetscInt    *nnz,*is_indices,*temp_indices;
721aa0d41d4SStefano Zampini     PetscInt    i,j,k,n_D,n_B;
722aa0d41d4SStefano Zampini 
723aa0d41d4SStefano Zampini     /* Get Non-overlapping dimensions */
724aa0d41d4SStefano Zampini     n_B = pcis->n_B;
725aa0d41d4SStefano Zampini     n_D = pcis->n-n_B;
726aa0d41d4SStefano Zampini 
727aa0d41d4SStefano Zampini     /* compute nonzero structure of change of basis on all local nodes */
728aa0d41d4SStefano Zampini     ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
729aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
730aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) nnz[is_indices[i]] = 1;
731aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
732aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
733aa0d41d4SStefano Zampini     k=1;
734aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
735aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
736aa0d41d4SStefano Zampini       nnz[is_indices[i]]=j;
737aa0d41d4SStefano Zampini       if (k < j) k = j;
738aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
739aa0d41d4SStefano Zampini     }
740aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
741aa0d41d4SStefano Zampini     /* assemble change of basis matrix on the whole set of local dofs */
742aa0d41d4SStefano Zampini     ierr = PetscMalloc(k*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
743aa0d41d4SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&change_mat_all);CHKERRQ(ierr);
744aa0d41d4SStefano Zampini     ierr = MatSetSizes(change_mat_all,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
745aa0d41d4SStefano Zampini     ierr = MatSetType(change_mat_all,MATSEQAIJ);CHKERRQ(ierr);
746aa0d41d4SStefano Zampini     ierr = MatSeqAIJSetPreallocation(change_mat_all,0,nnz);CHKERRQ(ierr);
747aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
748aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) {
749aa0d41d4SStefano Zampini       ierr = MatSetValue(change_mat_all,is_indices[i],is_indices[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
750aa0d41d4SStefano Zampini     }
751aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
752aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
753aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
754aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
755aa0d41d4SStefano Zampini       for (k=0; k<j; k++) temp_indices[k]=is_indices[row_cmat_indices[k]];
756aa0d41d4SStefano Zampini       ierr = MatSetValues(change_mat_all,1,&is_indices[i],j,temp_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
757aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
758aa0d41d4SStefano Zampini     }
759aa0d41d4SStefano Zampini     ierr = MatAssemblyBegin(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
760aa0d41d4SStefano Zampini     ierr = MatAssemblyEnd(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7619577ea80SStefano Zampini     /* TODO: HOW TO WORK WITH BAIJ and SBAIJ? PtAP not provided */
7629577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
7639577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQBAIJ,&isbaij);CHKERRQ(ierr);
7649577ea80SStefano Zampini     if (!issbaij && !isbaij) {
765aa0d41d4SStefano Zampini       ierr = MatPtAP(matis->A,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
766aa0d41d4SStefano Zampini     } else {
767aa0d41d4SStefano Zampini       Mat work_mat;
768aa0d41d4SStefano Zampini       ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
769aa0d41d4SStefano Zampini       ierr = MatPtAP(work_mat,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
770aa0d41d4SStefano Zampini       ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
771aa0d41d4SStefano Zampini     }
77245a1bb75SStefano Zampini     /*
77345a1bb75SStefano Zampini     ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
77445a1bb75SStefano Zampini     ierr = MatView(change_mat_all,(PetscViewer)0);CHKERRQ(ierr);
77545a1bb75SStefano Zampini     */
776aa0d41d4SStefano Zampini     ierr = MatDestroy(&change_mat_all);CHKERRQ(ierr);
777aa0d41d4SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
778aa0d41d4SStefano Zampini     ierr = PetscFree(temp_indices);CHKERRQ(ierr);
779aa0d41d4SStefano Zampini   } else {
780aa0d41d4SStefano Zampini     /* without change of basis, the local matrix is unchanged */
781aa0d41d4SStefano Zampini     if (!pcbddc->local_mat) {
782aa0d41d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)matis->A);CHKERRQ(ierr);
783aa0d41d4SStefano Zampini       pcbddc->local_mat = matis->A;
784aa0d41d4SStefano Zampini     }
785aa0d41d4SStefano Zampini   }
786aa0d41d4SStefano Zampini 
787aa0d41d4SStefano Zampini   /* get submatrices */
788aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_I_local,reuse,&pcis->A_II);CHKERRQ(ierr);
7899577ea80SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_B_local,reuse,&pcis->A_BB);CHKERRQ(ierr);
7909577ea80SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
7919577ea80SStefano Zampini   if (!issbaij) {
792aa0d41d4SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
793aa0d41d4SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
7949577ea80SStefano Zampini   } else {
7959577ea80SStefano Zampini     Mat newmat;
7969577ea80SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
7979577ea80SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
7989577ea80SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
7999577ea80SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
8009577ea80SStefano Zampini   }
801aa0d41d4SStefano Zampini   PetscFunctionReturn(0);
802aa0d41d4SStefano Zampini }
803aa0d41d4SStefano Zampini 
804aa0d41d4SStefano Zampini #undef __FUNCT__
805a64d13efSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalScatters"
8068ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
807a64d13efSStefano Zampini {
808a64d13efSStefano Zampini   PC_IS*         pcis = (PC_IS*)(pc->data);
809a64d13efSStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8108ce42a96SStefano Zampini   IS             is_aux1,is_aux2;
811a64d13efSStefano Zampini   PetscInt       *vertices,*aux_array1,*aux_array2,*is_indices,*idx_R_local;
8123a50541eSStefano Zampini   PetscInt       n_vertices,i,j,n_R,n_D,n_B;
8133a50541eSStefano Zampini   PetscInt       vbs,bs;
8144641a718SStefano Zampini   PetscBT        bitmask;
815a64d13efSStefano Zampini   PetscErrorCode ierr;
816a64d13efSStefano Zampini 
817a64d13efSStefano Zampini   PetscFunctionBegin;
818a64d13efSStefano Zampini   /* Set Non-overlapping dimensions */
819a64d13efSStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
820a64d13efSStefano Zampini   /* get vertex indices from constraint matrix */
821a64d13efSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
8223a50541eSStefano Zampini 
8234641a718SStefano Zampini   /* create auxiliary bitmask */
8244641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
8254641a718SStefano Zampini   for (i=0;i<n_vertices;i++) {
8264641a718SStefano Zampini     ierr = PetscBTSet(bitmask,vertices[i]);CHKERRQ(ierr);
8274641a718SStefano Zampini   }
8283a50541eSStefano Zampini 
829a64d13efSStefano Zampini   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
830a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n-n_vertices)*sizeof(PetscInt),&idx_R_local);CHKERRQ(ierr);
831a64d13efSStefano Zampini   for (i=0, n_R=0; i<pcis->n; i++) {
8324641a718SStefano Zampini     if (!PetscBTLookup(bitmask,i)) {
833a64d13efSStefano Zampini       idx_R_local[n_R] = i;
834a64d13efSStefano Zampini       n_R++;
835a64d13efSStefano Zampini     }
836a64d13efSStefano Zampini   }
8373a50541eSStefano Zampini 
8383a50541eSStefano Zampini   /* Block code */
8393a50541eSStefano Zampini   vbs = 1;
8403a50541eSStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
8413a50541eSStefano Zampini   if (bs>1 && !(n_vertices%bs)) {
8423a50541eSStefano Zampini     PetscBool is_blocked = PETSC_TRUE;
8433a50541eSStefano Zampini     PetscInt  *vary;
8443a50541eSStefano Zampini     /* Verify if the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
8453a50541eSStefano Zampini     ierr = PetscMalloc(pcis->n/bs*sizeof(PetscInt),&vary);CHKERRQ(ierr);
8463a50541eSStefano Zampini     ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
8473a50541eSStefano Zampini     for (i=0; i<n_vertices; i++) vary[vertices[i]/bs]++;
8483a50541eSStefano Zampini     for (i=0; i<n_vertices; i++) {
8493a50541eSStefano Zampini       if (vary[i]!=0 && vary[i]!=bs) {
8503a50541eSStefano Zampini         is_blocked = PETSC_FALSE;
8513a50541eSStefano Zampini         break;
8523a50541eSStefano Zampini       }
8533a50541eSStefano Zampini     }
8543a50541eSStefano Zampini     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
8553a50541eSStefano Zampini       vbs = bs;
8563a50541eSStefano Zampini       for (i=0;i<n_R/vbs;i++) {
8573a50541eSStefano Zampini         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
8583a50541eSStefano Zampini       }
8593a50541eSStefano Zampini     }
8603a50541eSStefano Zampini     ierr = PetscFree(vary);CHKERRQ(ierr);
8613a50541eSStefano Zampini   }
862a64d13efSStefano Zampini   ierr = PetscFree(vertices);CHKERRQ(ierr);
8633a50541eSStefano Zampini   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
8643a50541eSStefano Zampini   ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
865a64d13efSStefano Zampini 
866a64d13efSStefano Zampini   /* print some info if requested */
867a64d13efSStefano Zampini   if (pcbddc->dbg_flag) {
868a64d13efSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
869a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
870a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
871a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
8723a50541eSStefano 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);
873a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr);
874a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
875a64d13efSStefano Zampini   }
876a64d13efSStefano Zampini 
877a64d13efSStefano Zampini   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
8783a50541eSStefano Zampini   ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
879a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
880a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array2);CHKERRQ(ierr);
881a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
8824641a718SStefano Zampini   for (i=0; i<n_D; i++) {
8834641a718SStefano Zampini     ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
8844641a718SStefano Zampini   }
885a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
886a64d13efSStefano Zampini   for (i=0, j=0; i<n_R; i++) {
8874641a718SStefano Zampini     if (!PetscBTLookup(bitmask,idx_R_local[i])) {
8884641a718SStefano Zampini       aux_array1[j++] = i;
889a64d13efSStefano Zampini     }
890a64d13efSStefano Zampini   }
891a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
892a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
893a64d13efSStefano Zampini   for (i=0, j=0; i<n_B; i++) {
8944641a718SStefano Zampini     if (!PetscBTLookup(bitmask,is_indices[i])) {
8954641a718SStefano Zampini       aux_array2[j++] = i;
896a64d13efSStefano Zampini     }
897a64d13efSStefano Zampini   }
898a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
899a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
900a64d13efSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
901a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
902a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
903a64d13efSStefano Zampini 
9048eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
905a64d13efSStefano Zampini     ierr = PetscMalloc(n_D*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
906a64d13efSStefano Zampini     for (i=0, j=0; i<n_R; i++) {
9074641a718SStefano Zampini       if (PetscBTLookup(bitmask,idx_R_local[i])) {
9084641a718SStefano Zampini         aux_array1[j++] = i;
909a64d13efSStefano Zampini       }
910a64d13efSStefano Zampini     }
911a64d13efSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
912a64d13efSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
913a64d13efSStefano Zampini     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
914a64d13efSStefano Zampini   }
9154641a718SStefano Zampini   ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
9163a50541eSStefano Zampini   ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
917a64d13efSStefano Zampini   PetscFunctionReturn(0);
918a64d13efSStefano Zampini }
919a64d13efSStefano Zampini 
920304d26faSStefano Zampini 
921304d26faSStefano Zampini #undef __FUNCT__
922304d26faSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
9238ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc)
924304d26faSStefano Zampini {
925304d26faSStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
926304d26faSStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
927304d26faSStefano Zampini   PC             pc_temp;
928304d26faSStefano Zampini   Mat            A_RR;
929304d26faSStefano Zampini   Vec            vec1,vec2,vec3;
930304d26faSStefano Zampini   MatStructure   matstruct;
931304d26faSStefano Zampini   PetscScalar    m_one = -1.0;
932304d26faSStefano Zampini   PetscReal      value;
933af732b37SStefano Zampini   PetscInt       n_D,n_R,ibs,mbs;
9349577ea80SStefano Zampini   PetscBool      use_exact,use_exact_reduced,issbaij;
935304d26faSStefano Zampini   PetscErrorCode ierr;
936e604994aSStefano Zampini   /* prefixes stuff */
937e604994aSStefano Zampini   char           dir_prefix[256],neu_prefix[256],str_level[3];
938e604994aSStefano Zampini   size_t         len;
939304d26faSStefano Zampini 
940304d26faSStefano Zampini   PetscFunctionBegin;
941304d26faSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
942304d26faSStefano Zampini 
943e604994aSStefano Zampini   /* compute prefixes */
944e604994aSStefano Zampini   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
945e604994aSStefano Zampini   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
946e604994aSStefano Zampini   if (!pcbddc->current_level) {
947e604994aSStefano Zampini     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
948e604994aSStefano Zampini     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
949e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
950e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
951e604994aSStefano Zampini   } else {
952e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
953e604994aSStefano Zampini     sprintf(str_level,"%d_",(int)(pcbddc->current_level));
954e604994aSStefano Zampini     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
955e604994aSStefano Zampini     len -= 15; /* remove "pc_bddc_coarse_" */
956e604994aSStefano Zampini     if (pcbddc->current_level>1) len -= 2; /* remove "X_" with X level number (works with 9 levels max) */
957e604994aSStefano Zampini     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
958e604994aSStefano Zampini     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
959e604994aSStefano Zampini     *(dir_prefix+len)='\0';
960e604994aSStefano Zampini     *(neu_prefix+len)='\0';
961e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
962e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
963e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
964e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
965e604994aSStefano Zampini   }
966e604994aSStefano Zampini 
967304d26faSStefano Zampini   /* DIRICHLET PROBLEM */
968ac78edfcSStefano Zampini   /* Matrix for Dirichlet problem is pcis->A_II */
9698ce42a96SStefano Zampini   ierr = ISGetSize(pcis->is_I_local,&n_D);CHKERRQ(ierr);
970304d26faSStefano Zampini   if (!pcbddc->ksp_D) { /* create object if not yet build */
971304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
972304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
973304d26faSStefano Zampini     /* default */
974304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
975e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
9769577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
977304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
9789577ea80SStefano Zampini     if (issbaij) {
9799577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
9809577ea80SStefano Zampini     } else {
981304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
9829577ea80SStefano Zampini     }
983304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
984304d26faSStefano Zampini   }
985304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II,matstruct);CHKERRQ(ierr);
986304d26faSStefano Zampini   /* Allow user's customization */
987304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
988304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
989304d26faSStefano Zampini   if (!n_D) {
990304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
991304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
992304d26faSStefano Zampini   }
993304d26faSStefano Zampini   /* Set Up KSP for Dirichlet problem of BDDC */
994304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
995304d26faSStefano Zampini   /* set ksp_D into pcis data */
996304d26faSStefano Zampini   ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
997304d26faSStefano Zampini   ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
998304d26faSStefano Zampini   pcis->ksp_D = pcbddc->ksp_D;
999304d26faSStefano Zampini 
1000304d26faSStefano Zampini   /* NEUMANN PROBLEM */
1001304d26faSStefano Zampini   /* Matrix for Neumann problem is A_RR -> we need to create it */
10028ce42a96SStefano Zampini   ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
1003af732b37SStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
1004af732b37SStefano Zampini   ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
10053a50541eSStefano Zampini   if (ibs != mbs) {
1006af732b37SStefano Zampini     Mat newmat;
1007af732b37SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
1008af732b37SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
1009af732b37SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
1010af732b37SStefano Zampini   } else {
10118ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
1012af732b37SStefano Zampini   }
1013304d26faSStefano Zampini   if (!pcbddc->ksp_R) { /* create object if not yet build */
1014304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
1015304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
1016304d26faSStefano Zampini     /* default */
1017304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
1018e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
1019304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
10209577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
10219577ea80SStefano Zampini     if (issbaij) {
10229577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
10239577ea80SStefano Zampini     } else {
1024304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
10259577ea80SStefano Zampini     }
1026304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1027304d26faSStefano Zampini   }
1028304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR,matstruct);CHKERRQ(ierr);
1029304d26faSStefano Zampini   /* Allow user's customization */
1030304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
1031304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1032304d26faSStefano Zampini   if (!n_R) {
1033304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
1034304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1035304d26faSStefano Zampini   }
1036304d26faSStefano Zampini   /* Set Up KSP for Neumann problem of BDDC */
1037304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
1038304d26faSStefano Zampini 
1039304d26faSStefano Zampini   /* check Dirichlet and Neumann solvers and adapt them if a nullspace correction is needed */
1040304d26faSStefano Zampini 
1041304d26faSStefano Zampini   /* Dirichlet */
1042304d26faSStefano Zampini   ierr = MatGetVecs(pcis->A_II,&vec1,&vec2);CHKERRQ(ierr);
1043304d26faSStefano Zampini   ierr = VecDuplicate(vec1,&vec3);CHKERRQ(ierr);
1044304d26faSStefano Zampini   ierr = VecSetRandom(vec1,NULL);CHKERRQ(ierr);
1045304d26faSStefano Zampini   ierr = MatMult(pcis->A_II,vec1,vec2);CHKERRQ(ierr);
1046304d26faSStefano Zampini   ierr = KSPSolve(pcbddc->ksp_D,vec2,vec3);CHKERRQ(ierr);
1047304d26faSStefano Zampini   ierr = VecAXPY(vec3,m_one,vec1);CHKERRQ(ierr);
1048304d26faSStefano Zampini   ierr = VecNorm(vec3,NORM_INFINITY,&value);CHKERRQ(ierr);
1049304d26faSStefano Zampini   ierr = VecDestroy(&vec1);CHKERRQ(ierr);
1050304d26faSStefano Zampini   ierr = VecDestroy(&vec2);CHKERRQ(ierr);
1051304d26faSStefano Zampini   ierr = VecDestroy(&vec3);CHKERRQ(ierr);
1052304d26faSStefano Zampini   /* need to be adapted? */
1053b8ffe317SStefano Zampini   use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1054b8ffe317SStefano Zampini   ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1055b8ffe317SStefano Zampini   ierr = PCBDDCSetUseExactDirichlet(pc,use_exact_reduced);CHKERRQ(ierr);
1056304d26faSStefano Zampini   /* print info */
1057304d26faSStefano Zampini   if (pcbddc->dbg_flag) {
1058304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1059304d26faSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
1060304d26faSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Checking solution of Dirichlet and Neumann problems\n");CHKERRQ(ierr);
1061e604994aSStefano 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);
1062304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1063304d26faSStefano Zampini   }
1064b8ffe317SStefano Zampini   if (pcbddc->NullSpace && !use_exact_reduced && !pcbddc->switch_static) {
10658ce42a96SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcis->is_I_local);CHKERRQ(ierr);
1066304d26faSStefano Zampini   }
1067304d26faSStefano Zampini 
1068304d26faSStefano Zampini   /* Neumann */
1069304d26faSStefano Zampini   ierr = MatGetVecs(A_RR,&vec1,&vec2);CHKERRQ(ierr);
1070304d26faSStefano Zampini   ierr = VecDuplicate(vec1,&vec3);CHKERRQ(ierr);
1071304d26faSStefano Zampini   ierr = VecSetRandom(vec1,NULL);CHKERRQ(ierr);
1072304d26faSStefano Zampini   ierr = MatMult(A_RR,vec1,vec2);CHKERRQ(ierr);
1073304d26faSStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,vec2,vec3);CHKERRQ(ierr);
1074304d26faSStefano Zampini   ierr = VecAXPY(vec3,m_one,vec1);CHKERRQ(ierr);
1075304d26faSStefano Zampini   ierr = VecNorm(vec3,NORM_INFINITY,&value);CHKERRQ(ierr);
1076304d26faSStefano Zampini   ierr = VecDestroy(&vec1);CHKERRQ(ierr);
1077304d26faSStefano Zampini   ierr = VecDestroy(&vec2);CHKERRQ(ierr);
1078304d26faSStefano Zampini   ierr = VecDestroy(&vec3);CHKERRQ(ierr);
1079304d26faSStefano Zampini   /* need to be adapted? */
1080b8ffe317SStefano Zampini   use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1081b8ffe317SStefano Zampini   ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1082304d26faSStefano Zampini   /* print info */
1083304d26faSStefano Zampini   if (pcbddc->dbg_flag) {
1084e604994aSStefano 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);
1085304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1086304d26faSStefano Zampini   }
1087b8ffe317SStefano Zampini   if (pcbddc->NullSpace && !use_exact_reduced) { /* is it the right logic? */
10888ce42a96SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcbddc->is_R_local);CHKERRQ(ierr);
1089304d26faSStefano Zampini   }
1090304d26faSStefano Zampini   /* free Neumann problem's matrix */
1091304d26faSStefano Zampini   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1092304d26faSStefano Zampini   PetscFunctionReturn(0);
1093304d26faSStefano Zampini }
1094304d26faSStefano Zampini 
1095304d26faSStefano Zampini #undef __FUNCT__
1096674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSolveSaddlePoint"
1097674ae819SStefano Zampini static PetscErrorCode  PCBDDCSolveSaddlePoint(PC pc)
1098674ae819SStefano Zampini {
1099674ae819SStefano Zampini   PetscErrorCode ierr;
1100674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1101674ae819SStefano Zampini 
1102674ae819SStefano Zampini   PetscFunctionBegin;
1103674ae819SStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
1104674ae819SStefano Zampini   if (pcbddc->local_auxmat1) {
1105674ae819SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec2_R,pcbddc->vec1_C);CHKERRQ(ierr);
1106674ae819SStefano Zampini     ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
1107674ae819SStefano Zampini   }
1108674ae819SStefano Zampini   PetscFunctionReturn(0);
1109674ae819SStefano Zampini }
1110674ae819SStefano Zampini 
1111674ae819SStefano Zampini #undef __FUNCT__
1112674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
1113674ae819SStefano Zampini PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc)
1114674ae819SStefano Zampini {
1115674ae819SStefano Zampini   PetscErrorCode ierr;
1116674ae819SStefano Zampini   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
1117674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)  (pc->data);
1118674ae819SStefano Zampini   const PetscScalar zero = 0.0;
1119674ae819SStefano Zampini 
1120674ae819SStefano Zampini   PetscFunctionBegin;
112115aaf578SStefano Zampini   /* Application of PHI^T (or PSI^T)  */
112215aaf578SStefano Zampini   if (pcbddc->coarse_psi_B) {
112315aaf578SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
11248eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
112515aaf578SStefano Zampini   } else {
1126674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
11278eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
112815aaf578SStefano Zampini   }
1129674ae819SStefano Zampini   /* Scatter data of coarse_rhs */
1130674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { ierr = VecSet(pcbddc->coarse_rhs,zero);CHKERRQ(ierr); }
1131674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1132674ae819SStefano Zampini 
1133674ae819SStefano Zampini   /* Local solution on R nodes */
1134674ae819SStefano Zampini   ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
1135674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1136674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
11378eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1138674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1139674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1140674ae819SStefano Zampini   }
1141674ae819SStefano Zampini   ierr = PCBDDCSolveSaddlePoint(pc);CHKERRQ(ierr);
1142674ae819SStefano Zampini   ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1143674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1144674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
11458eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1146674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1147674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1148674ae819SStefano Zampini   }
1149674ae819SStefano Zampini 
1150674ae819SStefano Zampini   /* Coarse solution */
1151674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1152674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { /* TODO remove null space when doing multilevel */
1153674ae819SStefano Zampini     ierr = KSPSolve(pcbddc->coarse_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
1154674ae819SStefano Zampini   }
1155674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1156674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd  (pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1157674ae819SStefano Zampini 
1158674ae819SStefano Zampini   /* Sum contributions from two levels */
1159674ae819SStefano Zampini   ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
11608eeda7d8SStefano Zampini   if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1161674ae819SStefano Zampini   PetscFunctionReturn(0);
1162674ae819SStefano Zampini }
1163674ae819SStefano Zampini 
1164674ae819SStefano Zampini #undef __FUNCT__
1165674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
1166674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1167674ae819SStefano Zampini {
1168674ae819SStefano Zampini   PetscErrorCode ierr;
1169674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1170674ae819SStefano Zampini 
1171674ae819SStefano Zampini   PetscFunctionBegin;
1172674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1173674ae819SStefano Zampini   PetscFunctionReturn(0);
1174674ae819SStefano Zampini }
1175674ae819SStefano Zampini 
1176674ae819SStefano Zampini #undef __FUNCT__
1177674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
1178674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1179674ae819SStefano Zampini {
1180674ae819SStefano Zampini   PetscErrorCode ierr;
1181674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1182674ae819SStefano Zampini 
1183674ae819SStefano Zampini   PetscFunctionBegin;
1184674ae819SStefano Zampini   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1185674ae819SStefano Zampini   PetscFunctionReturn(0);
1186674ae819SStefano Zampini }
1187674ae819SStefano Zampini 
1188984c4197SStefano Zampini /* uncomment for testing purposes */
1189984c4197SStefano Zampini /* #define PETSC_MISSING_LAPACK_GESVD 1 */
1190674ae819SStefano Zampini #undef __FUNCT__
1191674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp"
1192674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
1193674ae819SStefano Zampini {
1194674ae819SStefano Zampini   PetscErrorCode    ierr;
1195674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
1196674ae819SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
1197674ae819SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
1198984c4197SStefano Zampini   /* constraint and (optionally) change of basis matrix implemented as SeqAIJ */
1199674ae819SStefano Zampini   MatType           impMatType=MATSEQAIJ;
1200984c4197SStefano Zampini   /* one and zero */
1201984c4197SStefano Zampini   PetscScalar       one=1.0,zero=0.0;
1202984c4197SStefano Zampini   /* space to store constraints and their local indices */
1203984c4197SStefano Zampini   PetscScalar       *temp_quadrature_constraint;
1204984c4197SStefano Zampini   PetscInt          *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B;
1205984c4197SStefano Zampini   /* iterators */
1206984c4197SStefano Zampini   PetscInt          i,j,k,total_counts,temp_start_ptr;
1207984c4197SStefano Zampini   /* stuff to store connected components stored in pcbddc->mat_graph */
1208984c4197SStefano Zampini   IS                ISForVertices,*ISForFaces,*ISForEdges,*used_IS;
1209984c4197SStefano Zampini   PetscInt          n_ISForFaces,n_ISForEdges;
1210984c4197SStefano Zampini   /* near null space stuff */
1211674ae819SStefano Zampini   MatNullSpace      nearnullsp;
1212674ae819SStefano Zampini   const Vec         *nearnullvecs;
1213674ae819SStefano Zampini   Vec               *localnearnullsp;
1214984c4197SStefano Zampini   PetscBool         nnsp_has_cnst;
1215984c4197SStefano Zampini   PetscInt          nnsp_size;
1216984c4197SStefano Zampini   PetscScalar       *array;
1217984c4197SStefano Zampini   /* BLAS integers */
1218e310c8b4SStefano Zampini   PetscBLASInt      lwork,lierr;
1219e310c8b4SStefano Zampini   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
1220c4303822SStefano Zampini   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
1221984c4197SStefano Zampini   /* LAPACK working arrays for SVD or POD */
1222242a89d7SStefano Zampini   PetscBool         skip_lapack;
1223984c4197SStefano Zampini   PetscScalar       *work;
1224984c4197SStefano Zampini   PetscReal         *singular_vals;
1225984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1226984c4197SStefano Zampini   PetscReal         *rwork;
1227674ae819SStefano Zampini #endif
1228984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1229e310c8b4SStefano Zampini   PetscBLASInt      Blas_one_2=1;
1230984c4197SStefano Zampini   PetscScalar       *temp_basis,*correlation_mat;
1231b7d8b9f8SStefano Zampini #else
1232b7d8b9f8SStefano Zampini   PetscBLASInt      dummy_int_1=1,dummy_int_2=1;
1233b7d8b9f8SStefano Zampini   PetscScalar       dummy_scalar_1=0.0,dummy_scalar_2=0.0;
1234984c4197SStefano Zampini #endif
1235984c4197SStefano Zampini   /* change of basis */
1236984c4197SStefano Zampini   PetscInt          *aux_primal_numbering,*aux_primal_minloc,*global_indices;
1237a717540cSStefano Zampini   PetscBool         boolforchange,qr_needed;
1238a717540cSStefano Zampini   PetscBT           touched,change_basis,qr_needed_idx;
1239984c4197SStefano Zampini   /* auxiliary stuff */
1240984c4197SStefano Zampini   PetscInt          *nnz,*is_indices,*local_to_B;
1241984c4197SStefano Zampini   /* some quantities */
124245a1bb75SStefano Zampini   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
1243984c4197SStefano Zampini   PetscInt          size_of_constraint,max_size_of_constraint,max_constraints,temp_constraints;
1244984c4197SStefano Zampini 
1245674ae819SStefano Zampini 
1246674ae819SStefano Zampini   PetscFunctionBegin;
1247674ae819SStefano Zampini   /* Get index sets for faces, edges and vertices from graph */
12488eeda7d8SStefano Zampini   if (!pcbddc->use_faces && !pcbddc->use_edges && !pcbddc->use_vertices) {
12498eeda7d8SStefano Zampini     pcbddc->use_vertices = PETSC_TRUE;
1250674ae819SStefano Zampini   }
12518eeda7d8SStefano Zampini   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,pcbddc->use_faces,pcbddc->use_edges,pcbddc->use_vertices,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);
1252b8ffe317SStefano Zampini   /* HACK: provide functions to set change of basis */
1253b8ffe317SStefano Zampini   if (!ISForVertices && pcbddc->NullSpace) {
1254b8ffe317SStefano Zampini     pcbddc->use_change_of_basis = PETSC_TRUE;
1255b8ffe317SStefano Zampini     pcbddc->use_change_on_faces = PETSC_FALSE;
1256b8ffe317SStefano Zampini   }
1257984c4197SStefano Zampini   /* print some info */
1258674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
1259674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1260674ae819SStefano Zampini     i = 0;
1261674ae819SStefano Zampini     if (ISForVertices) {
1262674ae819SStefano Zampini       ierr = ISGetSize(ISForVertices,&i);CHKERRQ(ierr);
1263674ae819SStefano Zampini     }
1264674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices\n",PetscGlobalRank,i);CHKERRQ(ierr);
1265674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges\n",PetscGlobalRank,n_ISForEdges);CHKERRQ(ierr);
126615aaf578SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces\n",PetscGlobalRank,n_ISForFaces);CHKERRQ(ierr);
1267674ae819SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1268674ae819SStefano Zampini   }
1269674ae819SStefano Zampini   /* check if near null space is attached to global mat */
1270674ae819SStefano Zampini   ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
1271674ae819SStefano Zampini   if (nearnullsp) {
1272674ae819SStefano Zampini     ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
1273984c4197SStefano Zampini   } else { /* if near null space is not provided BDDC uses constants by default */
1274984c4197SStefano Zampini     nnsp_size = 0;
1275674ae819SStefano Zampini     nnsp_has_cnst = PETSC_TRUE;
1276674ae819SStefano Zampini   }
1277984c4197SStefano Zampini   /* get max number of constraints on a single cc */
1278984c4197SStefano Zampini   max_constraints = nnsp_size;
1279984c4197SStefano Zampini   if (nnsp_has_cnst) max_constraints++;
1280984c4197SStefano Zampini 
1281674ae819SStefano Zampini   /*
1282674ae819SStefano Zampini        Evaluate maximum storage size needed by the procedure
1283674ae819SStefano Zampini        - temp_indices will contain start index of each constraint stored as follows
1284674ae819SStefano 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
1285674ae819SStefano 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
1286674ae819SStefano Zampini        - temp_quadrature_constraint  [temp_indices[i],...,temp[indices[i+1]-1] will contain the scalars representing the constraint itself
1287674ae819SStefano Zampini                                                                                                                                                          */
1288674ae819SStefano Zampini   total_counts = n_ISForFaces+n_ISForEdges;
1289984c4197SStefano Zampini   total_counts *= max_constraints;
1290674ae819SStefano Zampini   n_vertices = 0;
1291674ae819SStefano Zampini   if (ISForVertices) {
1292674ae819SStefano Zampini     ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
1293674ae819SStefano Zampini   }
1294674ae819SStefano Zampini   total_counts += n_vertices;
1295674ae819SStefano Zampini   ierr = PetscMalloc((total_counts+1)*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
12964641a718SStefano Zampini   ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
1297674ae819SStefano Zampini   total_counts = 0;
1298674ae819SStefano Zampini   max_size_of_constraint = 0;
1299674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1300674ae819SStefano Zampini     if (i<n_ISForEdges) {
1301674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1302674ae819SStefano Zampini     } else {
1303674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1304674ae819SStefano Zampini     }
1305674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
1306674ae819SStefano Zampini     total_counts += j;
1307674ae819SStefano Zampini     max_size_of_constraint = PetscMax(j,max_size_of_constraint);
1308674ae819SStefano Zampini   }
1309984c4197SStefano Zampini   total_counts *= max_constraints;
1310674ae819SStefano Zampini   total_counts += n_vertices;
1311674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&temp_quadrature_constraint);CHKERRQ(ierr);
1312674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint);CHKERRQ(ierr);
1313674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint_B);CHKERRQ(ierr);
1314984c4197SStefano Zampini   /* local to boundary numbering */
1315674ae819SStefano Zampini   ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&local_to_B);CHKERRQ(ierr);
1316674ae819SStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1317984c4197SStefano Zampini   for (i=0;i<pcis->n;i++) local_to_B[i]=-1;
1318984c4197SStefano Zampini   for (i=0;i<pcis->n_B;i++) local_to_B[is_indices[i]]=i;
1319674ae819SStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1320984c4197SStefano Zampini   /* get local part of global near null space vectors */
1321984c4197SStefano Zampini   ierr = PetscMalloc(nnsp_size*sizeof(Vec),&localnearnullsp);CHKERRQ(ierr);
1322984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1323984c4197SStefano Zampini     ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
1324984c4197SStefano Zampini     ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1325984c4197SStefano Zampini     ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1326984c4197SStefano Zampini   }
1327674ae819SStefano Zampini 
1328242a89d7SStefano Zampini   /* whether or not to skip lapack calls */
1329242a89d7SStefano Zampini   skip_lapack = PETSC_TRUE;
1330242a89d7SStefano Zampini   if (n_ISForFaces+n_ISForEdges) skip_lapack = PETSC_FALSE;
1331242a89d7SStefano Zampini 
1332984c4197SStefano Zampini   /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
1333242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1334674ae819SStefano Zampini     PetscScalar temp_work;
1335674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1336984c4197SStefano Zampini     /* Proper Orthogonal Decomposition (POD) using the snapshot method */
1337984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*max_constraints*sizeof(PetscScalar),&correlation_mat);CHKERRQ(ierr);
1338984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1339984c4197SStefano Zampini     ierr = PetscMalloc(max_size_of_constraint*max_constraints*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr);
1340674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1341984c4197SStefano Zampini     ierr = PetscMalloc(3*max_constraints*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1342674ae819SStefano Zampini #endif
1343674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1344c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
1345c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
1346674ae819SStefano Zampini     lwork = -1;
1347674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1348674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1349c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
1350674ae819SStefano Zampini #else
1351c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
1352674ae819SStefano Zampini #endif
1353674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1354984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
1355674ae819SStefano Zampini #else /* on missing GESVD */
1356674ae819SStefano Zampini     /* SVD */
1357674ae819SStefano Zampini     PetscInt max_n,min_n;
1358674ae819SStefano Zampini     max_n = max_size_of_constraint;
1359984c4197SStefano Zampini     min_n = max_constraints;
1360984c4197SStefano Zampini     if (max_size_of_constraint < max_constraints) {
1361674ae819SStefano Zampini       min_n = max_size_of_constraint;
1362984c4197SStefano Zampini       max_n = max_constraints;
1363674ae819SStefano Zampini     }
1364674ae819SStefano Zampini     ierr = PetscMalloc(min_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1365674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1366674ae819SStefano Zampini     ierr = PetscMalloc(5*min_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1367674ae819SStefano Zampini #endif
1368674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1369674ae819SStefano Zampini     lwork = -1;
1370e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
1371e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
1372b7d8b9f8SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
1373674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1374674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1375e310c8b4SStefano 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));
1376674ae819SStefano Zampini #else
1377e310c8b4SStefano 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));
1378674ae819SStefano Zampini #endif
1379674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1380984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
1381984c4197SStefano Zampini #endif /* on missing GESVD */
1382674ae819SStefano Zampini     /* Allocate optimal workspace */
1383674ae819SStefano Zampini     ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
1384984c4197SStefano Zampini     ierr = PetscMalloc((PetscInt)lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
1385674ae819SStefano Zampini   }
1386674ae819SStefano Zampini   /* Now we can loop on constraining sets */
1387674ae819SStefano Zampini   total_counts = 0;
1388674ae819SStefano Zampini   temp_indices[0] = 0;
1389674ae819SStefano Zampini   /* vertices */
1390674ae819SStefano Zampini   if (ISForVertices) {
1391674ae819SStefano Zampini     ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1392674ae819SStefano Zampini     if (nnsp_has_cnst) { /* consider all vertices */
1393674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1394674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1395674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
1396674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1397674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1398674ae819SStefano Zampini         total_counts++;
1399674ae819SStefano Zampini       }
1400674ae819SStefano Zampini     } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
1401984c4197SStefano Zampini       PetscBool used_vertex;
1402674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1403674ae819SStefano Zampini         used_vertex = PETSC_FALSE;
1404674ae819SStefano Zampini         k = 0;
1405674ae819SStefano Zampini         while (!used_vertex && k<nnsp_size) {
1406984c4197SStefano Zampini           ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1407984c4197SStefano Zampini           if (PetscAbsScalar(array[is_indices[i]])>0.0) {
1408674ae819SStefano Zampini             temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1409674ae819SStefano Zampini             temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
1410674ae819SStefano Zampini             temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1411674ae819SStefano Zampini             temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1412674ae819SStefano Zampini             total_counts++;
1413674ae819SStefano Zampini             used_vertex = PETSC_TRUE;
1414674ae819SStefano Zampini           }
1415984c4197SStefano Zampini           ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1416674ae819SStefano Zampini           k++;
1417674ae819SStefano Zampini         }
1418674ae819SStefano Zampini       }
1419674ae819SStefano Zampini     }
1420674ae819SStefano Zampini     ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1421674ae819SStefano Zampini     n_vertices = total_counts;
1422674ae819SStefano Zampini   }
1423984c4197SStefano Zampini 
1424674ae819SStefano Zampini   /* edges and faces */
1425674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1426674ae819SStefano Zampini     if (i<n_ISForEdges) {
1427674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1428984c4197SStefano Zampini       boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
1429674ae819SStefano Zampini     } else {
1430674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1431984c4197SStefano Zampini       boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
1432674ae819SStefano Zampini     }
1433674ae819SStefano Zampini     temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
1434674ae819SStefano Zampini     temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
1435674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
1436674ae819SStefano Zampini     ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1437984c4197SStefano Zampini     /* change of basis should not be performed on local periodic nodes */
1438984c4197SStefano Zampini     if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
1439674ae819SStefano Zampini     if (nnsp_has_cnst) {
14405b08dc53SStefano Zampini       PetscScalar quad_value;
1441674ae819SStefano Zampini       temp_constraints++;
1442674ae819SStefano Zampini       quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
1443674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1444674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
1445674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
1446674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
1447674ae819SStefano Zampini       }
1448674ae819SStefano Zampini       temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
1449674ae819SStefano Zampini       total_counts++;
1450674ae819SStefano Zampini     }
1451674ae819SStefano Zampini     for (k=0;k<nnsp_size;k++) {
1452984c4197SStefano Zampini       PetscReal real_value;
1453984c4197SStefano Zampini       ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1454674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1455674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
1456674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
1457984c4197SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=array[is_indices[j]];
1458674ae819SStefano Zampini       }
1459984c4197SStefano Zampini       ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1460984c4197SStefano Zampini       /* check if array is null on the connected component */
1461e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1462e310c8b4SStefano Zampini       PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_one));
14635b08dc53SStefano Zampini       if (real_value > 0.0) { /* keep indices and values */
1464674ae819SStefano Zampini         temp_constraints++;
1465674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
1466674ae819SStefano Zampini         total_counts++;
1467674ae819SStefano Zampini       }
1468674ae819SStefano Zampini     }
1469674ae819SStefano Zampini     ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
147045a1bb75SStefano Zampini     valid_constraints = temp_constraints;
1471eb97c9d2SStefano 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 */
1472eb97c9d2SStefano Zampini     if (!pcbddc->use_nnsp_true && temp_constraints) {
1473984c4197SStefano Zampini       PetscReal tol = 1.0e-8; /* tolerance for retaining eigenmodes */
1474674ae819SStefano Zampini 
1475674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1476984c4197SStefano Zampini       /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
1477984c4197SStefano Zampini          POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
1478984c4197SStefano Zampini          -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
1479984c4197SStefano Zampini             the constraints basis will differ (by a complex factor with absolute value equal to 1)
1480984c4197SStefano Zampini             from that computed using LAPACKgesvd
1481984c4197SStefano Zampini          -> This is due to a different computation of eigenvectors in LAPACKheev
1482984c4197SStefano Zampini          -> The quality of the POD-computed basis will be the same */
1483984c4197SStefano Zampini       ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
1484674ae819SStefano Zampini       /* Store upper triangular part of correlation matrix */
1485e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1486984c4197SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1487674ae819SStefano Zampini       for (j=0;j<temp_constraints;j++) {
1488674ae819SStefano Zampini         for (k=0;k<j+1;k++) {
1489e310c8b4SStefano 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));
1490674ae819SStefano Zampini         }
1491674ae819SStefano Zampini       }
1492e310c8b4SStefano Zampini       /* compute eigenvalues and eigenvectors of correlation matrix */
1493e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1494e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
1495674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1496c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
1497674ae819SStefano Zampini #else
1498c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
1499674ae819SStefano Zampini #endif
1500674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1501984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
1502984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
1503674ae819SStefano Zampini       j=0;
1504984c4197SStefano Zampini       while (j < temp_constraints && singular_vals[j] < tol) j++;
1505674ae819SStefano Zampini       total_counts=total_counts-j;
150645a1bb75SStefano Zampini       valid_constraints = temp_constraints-j;
1507e310c8b4SStefano Zampini       /* scale and copy POD basis into used quadrature memory */
1508c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1509c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1510c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
1511c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1512c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
1513c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1514674ae819SStefano Zampini       if (j<temp_constraints) {
1515984c4197SStefano Zampini         PetscInt ii;
1516984c4197SStefano Zampini         for (k=j;k<temp_constraints;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]);
1517674ae819SStefano Zampini         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1518c4303822SStefano 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));
1519674ae819SStefano Zampini         ierr = PetscFPTrapPop();CHKERRQ(ierr);
1520984c4197SStefano Zampini         for (k=0;k<temp_constraints-j;k++) {
1521674ae819SStefano Zampini           for (ii=0;ii<size_of_constraint;ii++) {
1522984c4197SStefano 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];
1523674ae819SStefano Zampini           }
1524674ae819SStefano Zampini         }
1525674ae819SStefano Zampini       }
1526674ae819SStefano Zampini #else  /* on missing GESVD */
1527e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1528e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1529b7d8b9f8SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1530674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1531674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1532e310c8b4SStefano 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));
1533674ae819SStefano Zampini #else
1534e310c8b4SStefano 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));
1535674ae819SStefano Zampini #endif
1536984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
1537674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1538984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
1539e310c8b4SStefano Zampini       k = temp_constraints;
1540e310c8b4SStefano Zampini       if (k > size_of_constraint) k = size_of_constraint;
1541674ae819SStefano Zampini       j = 0;
1542e310c8b4SStefano Zampini       while (j < k && singular_vals[k-j-1] < tol) j++;
1543e310c8b4SStefano Zampini       total_counts = total_counts-temp_constraints+k-j;
154445a1bb75SStefano Zampini       valid_constraints = k-j;
1545984c4197SStefano Zampini #endif /* on missing GESVD */
1546674ae819SStefano Zampini     }
154745a1bb75SStefano Zampini     /* setting change_of_basis flag is safe now */
154845a1bb75SStefano Zampini     if (boolforchange) {
154945a1bb75SStefano Zampini       for (j=0;j<valid_constraints;j++) {
155045a1bb75SStefano Zampini         PetscBTSet(change_basis,total_counts-j-1);
155145a1bb75SStefano Zampini       }
155245a1bb75SStefano Zampini     }
1553674ae819SStefano Zampini   }
1554674ae819SStefano Zampini   /* free index sets of faces, edges and vertices */
1555674ae819SStefano Zampini   for (i=0;i<n_ISForFaces;i++) {
1556674ae819SStefano Zampini     ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
1557674ae819SStefano Zampini   }
1558674ae819SStefano Zampini   ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
1559674ae819SStefano Zampini   for (i=0;i<n_ISForEdges;i++) {
1560674ae819SStefano Zampini     ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
1561674ae819SStefano Zampini   }
1562674ae819SStefano Zampini   ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
1563674ae819SStefano Zampini   ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
1564674ae819SStefano Zampini 
1565984c4197SStefano Zampini   /* free workspace */
1566242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1567984c4197SStefano Zampini     ierr = PetscFree(work);CHKERRQ(ierr);
1568984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1569984c4197SStefano Zampini     ierr = PetscFree(rwork);CHKERRQ(ierr);
1570984c4197SStefano Zampini #endif
1571984c4197SStefano Zampini     ierr = PetscFree(singular_vals);CHKERRQ(ierr);
1572984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1573984c4197SStefano Zampini     ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
1574984c4197SStefano Zampini     ierr = PetscFree(temp_basis);CHKERRQ(ierr);
1575984c4197SStefano Zampini #endif
1576984c4197SStefano Zampini   }
1577984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1578984c4197SStefano Zampini     ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
1579984c4197SStefano Zampini   }
1580984c4197SStefano Zampini   ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
1581984c4197SStefano Zampini 
1582674ae819SStefano Zampini   /* set quantities in pcbddc data structure */
1583984c4197SStefano Zampini   /* n_vertices defines the number of subdomain corners in the primal space */
1584674ae819SStefano Zampini   /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */
1585984c4197SStefano Zampini   pcbddc->local_primal_size = total_counts;
1586674ae819SStefano Zampini   pcbddc->n_vertices = n_vertices;
1587984c4197SStefano Zampini   pcbddc->n_constraints = pcbddc->local_primal_size-pcbddc->n_vertices;
1588674ae819SStefano Zampini 
1589674ae819SStefano Zampini   /* Create constraint matrix */
1590674ae819SStefano Zampini   /* The constraint matrix is used to compute the l2g map of primal dofs */
1591674ae819SStefano Zampini   /* so we need to set it up properly either with or without change of basis */
1592674ae819SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1593674ae819SStefano Zampini   ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr);
1594984c4197SStefano Zampini   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
1595984c4197SStefano Zampini   /* array to compute a local numbering of constraints : vertices first then constraints */
1596984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_numbering);CHKERRQ(ierr);
1597984c4197SStefano Zampini   /* array to select the proper local node (of minimum index with respect to global ordering) when changing the basis */
1598984c4197SStefano 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 */
1599984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_minloc);CHKERRQ(ierr);
1600984c4197SStefano Zampini   /* auxiliary stuff for basis change */
1601984c4197SStefano Zampini   ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&global_indices);CHKERRQ(ierr);
16024641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n_B,&touched);CHKERRQ(ierr);
1603984c4197SStefano Zampini 
1604984c4197SStefano Zampini   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
1605984c4197SStefano Zampini   total_primal_vertices=0;
1606984c4197SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
1607674ae819SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
1608984c4197SStefano Zampini     if (size_of_constraint == 1) {
16094641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]]);CHKERRQ(ierr);
1610984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]];
1611984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=0;
1612984c4197SStefano Zampini       total_primal_vertices++;
16134641a718SStefano Zampini     } else if (PetscBTLookup(change_basis,i)) { /* Same procedure used in PCBDDCGetPrimalConstraintsLocalIdx */
1614984c4197SStefano Zampini       PetscInt min_loc,min_index;
1615984c4197SStefano Zampini       ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],global_indices);CHKERRQ(ierr);
1616984c4197SStefano Zampini       /* find first untouched local node */
1617674ae819SStefano Zampini       k = 0;
16184641a718SStefano Zampini       while (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) k++;
1619984c4197SStefano Zampini       min_index = global_indices[k];
1620984c4197SStefano Zampini       min_loc = k;
1621984c4197SStefano Zampini       /* search the minimum among global nodes already untouched on the cc */
1622984c4197SStefano Zampini       for (k=1;k<size_of_constraint;k++) {
1623984c4197SStefano Zampini         /* there can be more than one constraint on a single connected component */
16244641a718SStefano Zampini         if (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k]) && min_index > global_indices[k]) {
1625984c4197SStefano Zampini           min_index = global_indices[k];
1626984c4197SStefano Zampini           min_loc = k;
1627674ae819SStefano Zampini         }
1628674ae819SStefano Zampini       }
16294641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]+min_loc]);CHKERRQ(ierr);
1630984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]+min_loc];
1631984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=min_loc;
1632984c4197SStefano Zampini       total_primal_vertices++;
1633984c4197SStefano Zampini     }
1634984c4197SStefano Zampini   }
1635a717540cSStefano Zampini   /* determine if a QR strategy is needed for change of basis */
1636a717540cSStefano Zampini   qr_needed = PETSC_FALSE;
1637a717540cSStefano Zampini   ierr = PetscBTCreate(pcbddc->local_primal_size,&qr_needed_idx);CHKERRQ(ierr);
1638a717540cSStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1639a717540cSStefano Zampini     if (PetscBTLookup(change_basis,i)) {
1640a717540cSStefano Zampini       size_of_constraint = temp_indices[i+1]-temp_indices[i];
1641a717540cSStefano Zampini       j = 0;
1642a717540cSStefano Zampini       for (k=0;k<size_of_constraint;k++) {
1643a717540cSStefano Zampini         if (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) {
1644a717540cSStefano Zampini           j++;
1645a717540cSStefano Zampini         }
1646a717540cSStefano Zampini       }
1647a717540cSStefano Zampini       /* found more than one primal dof on the cc */
1648a717540cSStefano Zampini       if (j > 1) {
1649a717540cSStefano Zampini         PetscBTSet(qr_needed_idx,i);
1650a717540cSStefano Zampini         qr_needed = PETSC_TRUE;
1651a717540cSStefano Zampini       }
1652a717540cSStefano Zampini     }
1653a717540cSStefano Zampini   }
1654984c4197SStefano Zampini   /* free workspace */
1655984c4197SStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
165645a1bb75SStefano Zampini 
1657674ae819SStefano Zampini   /* permute indices in order to have a sorted set of vertices */
1658a717540cSStefano Zampini   ierr = PetscSortInt(total_primal_vertices,aux_primal_numbering);CHKERRQ(ierr);
1659984c4197SStefano Zampini 
1660984c4197SStefano Zampini   /* nonzero structure of constraint matrix */
1661984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1662984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) nnz[i]=1;
1663984c4197SStefano Zampini   j=total_primal_vertices;
1664984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
16654641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1666674ae819SStefano Zampini       nnz[j]=temp_indices[i+1]-temp_indices[i];
1667674ae819SStefano Zampini       j++;
1668674ae819SStefano Zampini     }
1669674ae819SStefano Zampini   }
1670674ae819SStefano Zampini   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
1671674ae819SStefano Zampini   ierr = PetscFree(nnz);CHKERRQ(ierr);
1672674ae819SStefano Zampini   /* set values in constraint matrix */
1673984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) {
1674984c4197SStefano Zampini     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,aux_primal_numbering[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
1675674ae819SStefano Zampini   }
1676984c4197SStefano Zampini   total_counts = total_primal_vertices;
1677984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
16784641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1679674ae819SStefano Zampini       size_of_constraint=temp_indices[i+1]-temp_indices[i];
1680674ae819SStefano 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);
1681674ae819SStefano Zampini       total_counts++;
1682674ae819SStefano Zampini     }
1683674ae819SStefano Zampini   }
1684674ae819SStefano Zampini   /* assembling */
1685674ae819SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1686674ae819SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1687984c4197SStefano Zampini   /*
168845a1bb75SStefano Zampini   ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
1689984c4197SStefano Zampini   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
1690984c4197SStefano Zampini   */
1691674ae819SStefano Zampini   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
1692674ae819SStefano Zampini   if (pcbddc->use_change_of_basis) {
1693026de310SStefano Zampini     /* dual and primal dofs on a single cc */
1694984c4197SStefano Zampini     PetscInt     dual_dofs,primal_dofs;
1695026de310SStefano Zampini     /* iterator on aux_primal_minloc (ordered as read from nearnullspace: vertices, edges and then constraints) */
1696026de310SStefano Zampini     PetscInt     primal_counter;
1697984c4197SStefano Zampini     /* working stuff for GEQRF */
1698984c4197SStefano Zampini     PetscScalar  *qr_basis,*qr_tau,*qr_work,lqr_work_t;
1699984c4197SStefano Zampini     PetscBLASInt lqr_work;
1700984c4197SStefano Zampini     /* working stuff for UNGQR */
1701984c4197SStefano Zampini     PetscScalar  *gqr_work,lgqr_work_t;
1702984c4197SStefano Zampini     PetscBLASInt lgqr_work;
1703984c4197SStefano Zampini     /* working stuff for TRTRS */
1704984c4197SStefano Zampini     PetscScalar  *trs_rhs;
17053f08241aSStefano Zampini     PetscBLASInt Blas_NRHS;
1706984c4197SStefano Zampini     /* pointers for values insertion into change of basis matrix */
1707984c4197SStefano Zampini     PetscInt     *start_rows,*start_cols;
1708984c4197SStefano Zampini     PetscScalar  *start_vals;
1709984c4197SStefano Zampini     /* working stuff for values insertion */
17104641a718SStefano Zampini     PetscBT      is_primal;
1711984c4197SStefano Zampini 
1712a717540cSStefano Zampini     /* change of basis acts on local interfaces -> dimension is n_B x n_B */
1713a717540cSStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
1714a717540cSStefano Zampini     ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr);
1715a717540cSStefano Zampini     ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr);
1716a717540cSStefano Zampini     /* work arrays */
1717a717540cSStefano Zampini     ierr = PetscMalloc(pcis->n_B*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1718a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) nnz[i]=1;
1719a717540cSStefano Zampini     /* nonzeros per row */
1720a717540cSStefano Zampini     for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1721a717540cSStefano Zampini       if (PetscBTLookup(change_basis,i)) {
1722a717540cSStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
1723a717540cSStefano Zampini         if (PetscBTLookup(qr_needed_idx,i)) {
1724a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1725a717540cSStefano Zampini         } else {
1726a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = 2;
1727a717540cSStefano Zampini           /* get local primal index on the cc */
1728a717540cSStefano Zampini           j = 0;
1729a717540cSStefano Zampini           while (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+j])) j++;
1730a717540cSStefano Zampini           nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1731a717540cSStefano Zampini         }
1732a717540cSStefano Zampini       }
1733a717540cSStefano Zampini     }
1734a717540cSStefano Zampini     ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
1735a717540cSStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
1736a717540cSStefano Zampini     /* Set initial identity in the matrix */
1737a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) {
1738a717540cSStefano Zampini       ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
1739a717540cSStefano Zampini     }
1740a717540cSStefano Zampini 
1741a717540cSStefano Zampini     if (pcbddc->dbg_flag) {
1742a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1743a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
1744a717540cSStefano Zampini     }
1745a717540cSStefano Zampini 
1746a717540cSStefano Zampini 
1747a717540cSStefano Zampini     /* Now we loop on the constraints which need a change of basis */
1748a717540cSStefano Zampini     /*
1749a717540cSStefano Zampini        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
1750a717540cSStefano Zampini        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
1751a717540cSStefano Zampini 
1752a717540cSStefano Zampini        Basic blocks of change of basis matrix T computed
1753a717540cSStefano Zampini 
1754a717540cSStefano Zampini           - Using the following block transformation if there is only a primal dof on the cc
1755a717540cSStefano Zampini             (in the example, primal dof is the last one of the edge in LOCAL ordering
1756a717540cSStefano Zampini              in this code, primal dof is the first one of the edge in GLOBAL ordering)
1757a717540cSStefano Zampini             | 1        0   ...        0     1 |
1758a717540cSStefano Zampini             | 0        1   ...        0     1 |
1759a717540cSStefano Zampini             |              ...                |
1760a717540cSStefano Zampini             | 0        ...            1     1 |
1761a717540cSStefano Zampini             | -s_1/s_n ...    -s_{n-1}/-s_n 1 |
1762a717540cSStefano Zampini 
1763a717540cSStefano Zampini           - via QR decomposition of constraints otherwise
1764a717540cSStefano Zampini     */
1765a717540cSStefano Zampini     if (qr_needed) {
1766984c4197SStefano Zampini       /* space to store Q */
1767984c4197SStefano Zampini       ierr = PetscMalloc((max_size_of_constraint)*(max_size_of_constraint)*sizeof(PetscScalar),&qr_basis);CHKERRQ(ierr);
1768984c4197SStefano Zampini       /* first we issue queries for optimal work */
17693f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
17703f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
17713f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1772984c4197SStefano Zampini       lqr_work = -1;
17733f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
1774984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
1775984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
1776984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lqr_work_t)*sizeof(*qr_work),&qr_work);CHKERRQ(ierr);
1777984c4197SStefano Zampini       lgqr_work = -1;
17783f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
17793f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
17803f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
17813f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
17823f08241aSStefano Zampini       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
17833f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
1784984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
1785984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
1786984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lgqr_work_t)*sizeof(*gqr_work),&gqr_work);CHKERRQ(ierr);
1787984c4197SStefano Zampini       /* array to store scaling factors for reflectors */
1788984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*sizeof(*qr_tau),&qr_tau);CHKERRQ(ierr);
1789984c4197SStefano Zampini       /* array to store rhs and solution of triangular solver */
1790984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*max_constraints*sizeof(*trs_rhs),&trs_rhs);CHKERRQ(ierr);
1791a717540cSStefano Zampini       /* allocating workspace for check */
1792a717540cSStefano Zampini       if (pcbddc->dbg_flag) {
1793a717540cSStefano Zampini         ierr = PetscMalloc(max_size_of_constraint*(max_constraints+max_size_of_constraint)*sizeof(*work),&work);CHKERRQ(ierr);
1794a717540cSStefano Zampini       }
1795a717540cSStefano Zampini     }
1796984c4197SStefano Zampini     /* array to store whether a node is primal or not */
17974641a718SStefano Zampini     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
17984641a718SStefano Zampini     for (i=0;i<total_primal_vertices;i++) {
17994641a718SStefano Zampini       ierr = PetscBTSet(is_primal,local_to_B[aux_primal_numbering[i]]);CHKERRQ(ierr);
18004641a718SStefano Zampini     }
1801984c4197SStefano Zampini 
1802a717540cSStefano Zampini     /* loop on constraints and see whether or not they need a change of basis and compute it */
1803026de310SStefano Zampini     /* -> using implicit ordering contained in temp_indices data */
1804026de310SStefano Zampini     total_counts = pcbddc->n_vertices;
1805026de310SStefano Zampini     primal_counter = total_counts;
1806026de310SStefano Zampini     while (total_counts<pcbddc->local_primal_size) {
1807026de310SStefano Zampini       primal_dofs = 1;
18084641a718SStefano Zampini       if (PetscBTLookup(change_basis,total_counts)) {
1809026de310SStefano Zampini         /* get all constraints with same support: if more then one constraint is present on the cc then surely indices are stored contiguosly */
1810026de310SStefano 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]]) {
1811026de310SStefano Zampini           primal_dofs++;
1812674ae819SStefano Zampini         }
1813984c4197SStefano Zampini         /* get constraint info */
1814026de310SStefano Zampini         size_of_constraint = temp_indices[total_counts+1]-temp_indices[total_counts];
1815984c4197SStefano Zampini         dual_dofs = size_of_constraint-primal_dofs;
1816984c4197SStefano Zampini 
1817984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
1818a717540cSStefano 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);
1819674ae819SStefano Zampini         }
1820984c4197SStefano Zampini 
1821a717540cSStefano Zampini         if (primal_dofs > 1) { /* QR */
1822a717540cSStefano Zampini 
1823a717540cSStefano Zampini           /* copy quadrature constraints for change of basis check */
1824a717540cSStefano Zampini           if (pcbddc->dbg_flag) {
1825a717540cSStefano Zampini             ierr = PetscMemcpy(work,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1826a717540cSStefano Zampini           }
1827984c4197SStefano Zampini           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
1828026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1829984c4197SStefano Zampini 
1830984c4197SStefano Zampini           /* compute QR decomposition of constraints */
18313f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
18323f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
18333f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1834674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
18353f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
1836984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
1837674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1838984c4197SStefano Zampini 
1839984c4197SStefano Zampini           /* explictly compute R^-T */
1840984c4197SStefano Zampini           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
1841984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
18423f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
18433f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
18443f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
18453f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
1846984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
18473f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
1848984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
1849984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1850984c4197SStefano Zampini 
1851a717540cSStefano Zampini           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
18523f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
18533f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
18543f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
18553f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1856984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
18573f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
1858984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
1859984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1860984c4197SStefano Zampini 
1861984c4197SStefano Zampini           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
1862984c4197SStefano Zampini              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
1863984c4197SStefano Zampini              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
18643f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
18653f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
18663f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
18673f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
18683f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
18693f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1870984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1871c4303822SStefano 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));
1872984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1873026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1874984c4197SStefano Zampini 
1875984c4197SStefano Zampini           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
1876026de310SStefano Zampini           start_rows = &temp_indices_to_constraint_B[temp_indices[total_counts]];
1877984c4197SStefano Zampini           /* insert cols for primal dofs */
1878984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) {
1879984c4197SStefano Zampini             start_vals = &qr_basis[j*size_of_constraint];
1880026de310SStefano Zampini             start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter+j]];
1881984c4197SStefano Zampini             ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1882984c4197SStefano Zampini           }
1883984c4197SStefano Zampini           /* insert cols for dual dofs */
1884984c4197SStefano Zampini           for (j=0,k=0;j<dual_dofs;k++) {
18854641a718SStefano Zampini             if (!PetscBTLookup(is_primal,temp_indices_to_constraint_B[temp_indices[total_counts]+k])) {
1886984c4197SStefano Zampini               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
1887026de310SStefano Zampini               start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+k];
1888984c4197SStefano Zampini               ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1889984c4197SStefano Zampini               j++;
1890674ae819SStefano Zampini             }
1891674ae819SStefano Zampini           }
1892984c4197SStefano Zampini 
1893984c4197SStefano Zampini           /* check change of basis */
1894984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
1895984c4197SStefano Zampini             PetscInt   ii,jj;
1896984c4197SStefano Zampini             PetscBool valid_qr=PETSC_TRUE;
1897c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
1898c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1899c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
1900c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1901c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
1902c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
1903984c4197SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1904c4303822SStefano 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));
1905984c4197SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
1906984c4197SStefano Zampini             for (jj=0;jj<size_of_constraint;jj++) {
1907984c4197SStefano Zampini               for (ii=0;ii<primal_dofs;ii++) {
1908984c4197SStefano Zampini                 if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
1909984c4197SStefano Zampini                 if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
1910674ae819SStefano Zampini               }
1911674ae819SStefano Zampini             }
1912984c4197SStefano Zampini             if (!valid_qr) {
1913984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
1914984c4197SStefano Zampini               for (jj=0;jj<size_of_constraint;jj++) {
1915984c4197SStefano Zampini                 for (ii=0;ii<primal_dofs;ii++) {
1916984c4197SStefano Zampini                   if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
1917984c4197SStefano 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]));
1918674ae819SStefano Zampini                   }
1919984c4197SStefano Zampini                   if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
1920984c4197SStefano 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]));
1921984c4197SStefano Zampini                   }
1922984c4197SStefano Zampini                 }
1923984c4197SStefano Zampini               }
1924674ae819SStefano Zampini             } else {
1925984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
1926674ae819SStefano Zampini             }
1927674ae819SStefano Zampini           }
1928a717540cSStefano Zampini         } else { /* simple transformation block */
1929a717540cSStefano Zampini           PetscInt row,col;
1930a717540cSStefano Zampini           PetscScalar val;
1931a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) {
1932a717540cSStefano Zampini             row = temp_indices_to_constraint_B[temp_indices[total_counts]+j];
1933a717540cSStefano Zampini             if (!PetscBTLookup(is_primal,row)) {
1934a717540cSStefano Zampini               col = temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
1935a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
1936a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,1.0,INSERT_VALUES);CHKERRQ(ierr);
1937a717540cSStefano Zampini             } else {
1938a717540cSStefano Zampini               for (k=0;k<size_of_constraint;k++) {
1939a717540cSStefano Zampini                 col = temp_indices_to_constraint_B[temp_indices[total_counts]+k];
1940a717540cSStefano Zampini                 if (row != col) {
1941a717540cSStefano Zampini                   val = -temp_quadrature_constraint[temp_indices[total_counts]+k]/temp_quadrature_constraint[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
1942a717540cSStefano Zampini                 } else {
1943a717540cSStefano Zampini                   val = 1.0;
1944a717540cSStefano Zampini                 }
1945a717540cSStefano Zampini                 ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
1946a717540cSStefano Zampini               }
1947a717540cSStefano Zampini             }
1948a717540cSStefano Zampini           }
1949a717540cSStefano Zampini         }
1950026de310SStefano Zampini         /* increment primal counter */
1951026de310SStefano Zampini         primal_counter += primal_dofs;
1952984c4197SStefano Zampini       } else {
1953984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
1954026de310SStefano 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);
1955674ae819SStefano Zampini         }
1956674ae819SStefano Zampini       }
1957026de310SStefano Zampini       /* increment constraint counter total_counts */
1958026de310SStefano Zampini       total_counts += primal_dofs;
1959674ae819SStefano Zampini     }
1960a717540cSStefano Zampini 
1961a717540cSStefano Zampini     /* free workspace */
1962a717540cSStefano Zampini     if (qr_needed) {
1963984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
1964984c4197SStefano Zampini         ierr = PetscFree(work);CHKERRQ(ierr);
1965984c4197SStefano Zampini       }
1966984c4197SStefano Zampini       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
1967984c4197SStefano Zampini       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
1968984c4197SStefano Zampini       ierr = PetscFree(qr_work);CHKERRQ(ierr);
1969984c4197SStefano Zampini       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
1970984c4197SStefano Zampini       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
1971674ae819SStefano Zampini     }
1972a717540cSStefano Zampini     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
1973674ae819SStefano Zampini     /* assembling */
1974674ae819SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1975674ae819SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1976984c4197SStefano Zampini     /*
197745a1bb75SStefano Zampini     ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
1978984c4197SStefano Zampini     ierr = MatView(pcbddc->ChangeOfBasisMatrix,(PetscViewer)0);CHKERRQ(ierr);
1979984c4197SStefano Zampini     */
1980674ae819SStefano Zampini   }
1981a717540cSStefano Zampini 
1982a717540cSStefano Zampini   /* flush dbg viewer */
1983b8ffe317SStefano Zampini   if (pcbddc->dbg_flag) {
1984b8ffe317SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1985b8ffe317SStefano Zampini   }
1986a717540cSStefano Zampini 
1987e310c8b4SStefano Zampini   /* free workspace */
1988a717540cSStefano Zampini   ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
1989a717540cSStefano Zampini   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
1990984c4197SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
1991984c4197SStefano Zampini   ierr = PetscFree(aux_primal_minloc);CHKERRQ(ierr);
1992674ae819SStefano Zampini   ierr = PetscFree(temp_indices);CHKERRQ(ierr);
19934641a718SStefano Zampini   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
1994674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr);
1995674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
1996674ae819SStefano Zampini   ierr = PetscFree(local_to_B);CHKERRQ(ierr);
1997674ae819SStefano Zampini   ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr);
1998674ae819SStefano Zampini   PetscFunctionReturn(0);
1999674ae819SStefano Zampini }
2000674ae819SStefano Zampini 
2001674ae819SStefano Zampini #undef __FUNCT__
2002674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
2003674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
2004674ae819SStefano Zampini {
2005674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
2006674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
2007674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
2008674ae819SStefano Zampini   PetscInt    bs,ierr,i,vertex_size;
2009674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
2010674ae819SStefano Zampini 
2011674ae819SStefano Zampini   PetscFunctionBegin;
2012674ae819SStefano Zampini   /* Init local Graph struct */
2013674ae819SStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr);
2014674ae819SStefano Zampini 
2015575ad6abSStefano Zampini   /* Check validity of the csr graph passed in by the user */
2016575ad6abSStefano Zampini   if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) {
2017575ad6abSStefano Zampini     ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
2018575ad6abSStefano Zampini   }
20199577ea80SStefano Zampini 
2020674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
2021674ae819SStefano Zampini   if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) {
2022674ae819SStefano Zampini     Mat mat_adj;
2023674ae819SStefano Zampini     const PetscInt *xadj,*adjncy;
2024674ae819SStefano Zampini     PetscBool flg_row=PETSC_TRUE;
2025674ae819SStefano Zampini 
2026674ae819SStefano Zampini     ierr = MatConvert(matis->A,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr);
2027674ae819SStefano Zampini     ierr = MatGetRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2028674ae819SStefano Zampini     if (!flg_row) {
2029674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ called in %s\n",__FUNCT__);
2030674ae819SStefano Zampini     }
2031674ae819SStefano Zampini     ierr = PCBDDCSetLocalAdjacencyGraph(pc,i,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
2032674ae819SStefano Zampini     ierr = MatRestoreRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2033674ae819SStefano Zampini     if (!flg_row) {
2034674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__);
2035674ae819SStefano Zampini     }
2036674ae819SStefano Zampini     ierr = MatDestroy(&mat_adj);CHKERRQ(ierr);
2037674ae819SStefano Zampini   }
2038674ae819SStefano Zampini 
2039674ae819SStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting */
2040674ae819SStefano Zampini   vertex_size = 1;
20419577ea80SStefano Zampini   if (!pcbddc->user_provided_isfordofs) {
2042674ae819SStefano Zampini     if (!pcbddc->n_ISForDofs) {
2043674ae819SStefano Zampini       IS *custom_ISForDofs;
2044674ae819SStefano Zampini 
2045674ae819SStefano Zampini       ierr = MatGetBlockSize(matis->A,&bs);CHKERRQ(ierr);
2046674ae819SStefano Zampini       ierr = PetscMalloc(bs*sizeof(IS),&custom_ISForDofs);CHKERRQ(ierr);
2047674ae819SStefano Zampini       for (i=0;i<bs;i++) {
2048674ae819SStefano Zampini         ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n/bs,i,bs,&custom_ISForDofs[i]);CHKERRQ(ierr);
2049674ae819SStefano Zampini       }
2050674ae819SStefano Zampini       ierr = PCBDDCSetDofsSplitting(pc,bs,custom_ISForDofs);CHKERRQ(ierr);
20519577ea80SStefano Zampini       pcbddc->user_provided_isfordofs = PETSC_FALSE;
2052674ae819SStefano Zampini       /* remove my references to IS objects */
2053674ae819SStefano Zampini       for (i=0;i<bs;i++) {
2054674ae819SStefano Zampini         ierr = ISDestroy(&custom_ISForDofs[i]);CHKERRQ(ierr);
2055674ae819SStefano Zampini       }
2056674ae819SStefano Zampini       ierr = PetscFree(custom_ISForDofs);CHKERRQ(ierr);
20579577ea80SStefano Zampini     }
20589577ea80SStefano Zampini   } else { /* mat block size as vertex size (used for elasticity with rigid body modes as nearnullspace) */
2059674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
2060674ae819SStefano Zampini   }
2061674ae819SStefano Zampini 
2062674ae819SStefano Zampini   /* Setup of Graph */
2063*785d1243SStefano Zampini   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) { /* need to convert from global to local */
2064*785d1243SStefano Zampini     PetscInt    i,lsize,*idxs;
2065*785d1243SStefano Zampini     PetscScalar *vals;
2066*785d1243SStefano Zampini 
2067*785d1243SStefano Zampini     /* get dirichlet indices in local ordering exploiting local to global map */
2068*785d1243SStefano Zampini     ierr = ISGetLocalSize(pcbddc->DirichletBoundaries,&lsize);CHKERRQ(ierr);
2069*785d1243SStefano Zampini     ierr = PetscMalloc(lsize*sizeof(PetscScalar),&vals);CHKERRQ(ierr);
2070*785d1243SStefano Zampini     for (i=0;i<lsize;i++) vals[i] = 1.0;
2071*785d1243SStefano Zampini     ierr = ISGetIndices(pcbddc->DirichletBoundaries,(const PetscInt**)&idxs);CHKERRQ(ierr);
2072*785d1243SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
2073*785d1243SStefano Zampini     ierr = VecSetValues(pcis->vec1_global,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2074*785d1243SStefano Zampini     ierr = VecAssemblyBegin(pcis->vec1_global);CHKERRQ(ierr);
2075*785d1243SStefano Zampini     ierr = ISRestoreIndices(pcbddc->DirichletBoundaries,(const PetscInt**)&idxs);CHKERRQ(ierr);
2076*785d1243SStefano Zampini     ierr = PetscFree(vals);CHKERRQ(ierr);
2077*785d1243SStefano Zampini     ierr = VecAssemblyEnd(pcis->vec1_global);CHKERRQ(ierr);
2078*785d1243SStefano Zampini     /* now compute dirichlet set in local ordering */
2079*785d1243SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2080*785d1243SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2081*785d1243SStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_N,(const PetscScalar**)&vals);CHKERRQ(ierr);
2082*785d1243SStefano Zampini     for (i=0,lsize=0;i<pcis->n;i++) {
2083*785d1243SStefano Zampini       if (vals[i] == 1.0) {
2084*785d1243SStefano Zampini         lsize++;
2085*785d1243SStefano Zampini       }
2086*785d1243SStefano Zampini     }
2087*785d1243SStefano Zampini     ierr = PetscMalloc(lsize*sizeof(PetscInt),&idxs);CHKERRQ(ierr);
2088*785d1243SStefano Zampini     for (i=0,lsize=0;i<pcis->n;i++) {
2089*785d1243SStefano Zampini       if (vals[i] == 1.0) {
2090*785d1243SStefano Zampini         idxs[lsize++] = i;
2091*785d1243SStefano Zampini       }
2092*785d1243SStefano Zampini     }
2093*785d1243SStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_N,(const PetscScalar**)&vals);CHKERRQ(ierr);
2094*785d1243SStefano Zampini     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),lsize,idxs,PETSC_OWN_POINTER,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
2095*785d1243SStefano Zampini   }
2096*785d1243SStefano Zampini   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) { /* need to convert from global to local */
2097*785d1243SStefano Zampini     PetscInt    i,lsize,*idxs;
2098*785d1243SStefano Zampini     PetscScalar *vals;
2099*785d1243SStefano Zampini 
2100*785d1243SStefano Zampini     /* get dirichlet indices in local ordering exploiting local to global map */
2101*785d1243SStefano Zampini     ierr = ISGetLocalSize(pcbddc->NeumannBoundaries,&lsize);CHKERRQ(ierr);
2102*785d1243SStefano Zampini     ierr = PetscMalloc(lsize*sizeof(PetscScalar),&vals);CHKERRQ(ierr);
2103*785d1243SStefano Zampini     for (i=0;i<lsize;i++) vals[i] = 1.0;
2104*785d1243SStefano Zampini     ierr = ISGetIndices(pcbddc->NeumannBoundaries,(const PetscInt**)&idxs);CHKERRQ(ierr);
2105*785d1243SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
2106*785d1243SStefano Zampini     ierr = VecSetValues(pcis->vec1_global,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2107*785d1243SStefano Zampini     ierr = VecAssemblyBegin(pcis->vec1_global);CHKERRQ(ierr);
2108*785d1243SStefano Zampini     ierr = ISRestoreIndices(pcbddc->NeumannBoundaries,(const PetscInt**)&idxs);CHKERRQ(ierr);
2109*785d1243SStefano Zampini     ierr = PetscFree(vals);CHKERRQ(ierr);
2110*785d1243SStefano Zampini     ierr = VecAssemblyEnd(pcis->vec1_global);CHKERRQ(ierr);
2111*785d1243SStefano Zampini     /* now compute dirichlet set in local ordering */
2112*785d1243SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2113*785d1243SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2114*785d1243SStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_N,(const PetscScalar**)&vals);CHKERRQ(ierr);
2115*785d1243SStefano Zampini     for (i=0,lsize=0;i<pcis->n;i++) {
2116*785d1243SStefano Zampini       if (vals[i] == 1.0) {
2117*785d1243SStefano Zampini         lsize++;
2118*785d1243SStefano Zampini       }
2119*785d1243SStefano Zampini     }
2120*785d1243SStefano Zampini     ierr = PetscMalloc(lsize*sizeof(PetscInt),&idxs);CHKERRQ(ierr);
2121*785d1243SStefano Zampini     for (i=0,lsize=0;i<pcis->n;i++) {
2122*785d1243SStefano Zampini       if (vals[i] == 1.0) {
2123*785d1243SStefano Zampini         idxs[lsize++] = i;
2124*785d1243SStefano Zampini       }
2125*785d1243SStefano Zampini     }
2126*785d1243SStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_N,(const PetscScalar**)&vals);CHKERRQ(ierr);
2127*785d1243SStefano Zampini     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),lsize,idxs,PETSC_OWN_POINTER,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
2128*785d1243SStefano Zampini   }
2129*785d1243SStefano Zampini   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofs,pcbddc->ISForDofs,pcbddc->user_primal_vertices);
2130674ae819SStefano Zampini 
2131674ae819SStefano Zampini   /* Graph's connected components analysis */
2132674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
2133674ae819SStefano Zampini 
2134674ae819SStefano Zampini   /* print some info to stdout */
2135674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
2136e49050b4SStefano Zampini     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer);
2137674ae819SStefano Zampini   }
2138674ae819SStefano Zampini   PetscFunctionReturn(0);
2139674ae819SStefano Zampini }
2140674ae819SStefano Zampini 
2141674ae819SStefano Zampini #undef __FUNCT__
2142674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx"
2143f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt **vertices_idx)
2144674ae819SStefano Zampini {
2145674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2146674ae819SStefano Zampini   PetscInt       *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size;
2147674ae819SStefano Zampini   PetscErrorCode ierr;
2148674ae819SStefano Zampini 
2149674ae819SStefano Zampini   PetscFunctionBegin;
2150674ae819SStefano Zampini   n = 0;
2151674ae819SStefano Zampini   vertices = 0;
2152674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2153674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr);
2154b120a5c6SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2155b120a5c6SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2156b120a5c6SStefano Zampini       if (size_of_constraint == 1) n++;
2157b120a5c6SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2158b120a5c6SStefano Zampini     }
2159811e8ca2SStefano Zampini     if (vertices_idx) {
2160b120a5c6SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&vertices);CHKERRQ(ierr);
2161b120a5c6SStefano Zampini       n = 0;
2162674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2163674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2164674ae819SStefano Zampini         if (size_of_constraint == 1) {
2165674ae819SStefano Zampini           vertices[n++]=row_cmat_indices[0];
2166674ae819SStefano Zampini         }
2167674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2168674ae819SStefano Zampini       }
2169674ae819SStefano Zampini     }
2170811e8ca2SStefano Zampini   }
2171674ae819SStefano Zampini   *n_vertices = n;
2172811e8ca2SStefano Zampini   if (vertices_idx) *vertices_idx = vertices;
2173674ae819SStefano Zampini   PetscFunctionReturn(0);
2174674ae819SStefano Zampini }
2175674ae819SStefano Zampini 
2176674ae819SStefano Zampini #undef __FUNCT__
2177674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx"
2178f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt **constraints_idx)
2179674ae819SStefano Zampini {
2180674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2181674ae819SStefano Zampini   PetscInt       *constraints_index,*row_cmat_indices,*row_cmat_global_indices;
2182674ae819SStefano Zampini   PetscInt       n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc;
21834641a718SStefano Zampini   PetscBT        touched;
2184674ae819SStefano Zampini   PetscErrorCode ierr;
2185674ae819SStefano Zampini 
2186f34684f1SStefano Zampini     /* This function assumes that the number of local constraints per connected component
2187f34684f1SStefano Zampini        is not greater than the number of nodes defined for the connected component
2188f34684f1SStefano Zampini        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
2189674ae819SStefano Zampini   PetscFunctionBegin;
2190674ae819SStefano Zampini   n = 0;
2191674ae819SStefano Zampini   constraints_index = 0;
2192674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2193674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr);
2194674ae819SStefano Zampini     max_size_of_constraint = 0;
2195674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2196674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2197674ae819SStefano Zampini       if (size_of_constraint > 1) {
2198674ae819SStefano Zampini         n++;
2199674ae819SStefano Zampini       }
2200674ae819SStefano Zampini       max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint);
2201674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2202674ae819SStefano Zampini     }
2203811e8ca2SStefano Zampini     if (constraints_idx) {
2204674ae819SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&constraints_index);CHKERRQ(ierr);
2205674ae819SStefano Zampini       ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&row_cmat_global_indices);CHKERRQ(ierr);
22064641a718SStefano Zampini       ierr = PetscBTCreate(local_size,&touched);CHKERRQ(ierr);
2207674ae819SStefano Zampini       n = 0;
2208674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2209674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2210674ae819SStefano Zampini         if (size_of_constraint > 1) {
2211674ae819SStefano Zampini           ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr);
221282d3d8afSStefano Zampini           /* find first untouched local node */
221382d3d8afSStefano Zampini           j = 0;
22144641a718SStefano Zampini           while (PetscBTLookup(touched,row_cmat_indices[j])) j++;
221582d3d8afSStefano Zampini           min_index = row_cmat_global_indices[j];
221682d3d8afSStefano Zampini           min_loc = j;
221782d3d8afSStefano Zampini           /* search the minimum among nodes not yet touched on the connected component
221882d3d8afSStefano Zampini              since there can be more than one constraint on a single cc */
2219674ae819SStefano Zampini           for (j=1;j<size_of_constraint;j++) {
22204641a718SStefano Zampini             if (!PetscBTLookup(touched,row_cmat_indices[j]) && min_index > row_cmat_global_indices[j]) {
2221674ae819SStefano Zampini               min_index = row_cmat_global_indices[j];
2222674ae819SStefano Zampini               min_loc = j;
2223674ae819SStefano Zampini             }
2224674ae819SStefano Zampini           }
22254641a718SStefano Zampini           ierr = PetscBTSet(touched,row_cmat_indices[min_loc]);CHKERRQ(ierr);
2226674ae819SStefano Zampini           constraints_index[n++] = row_cmat_indices[min_loc];
2227674ae819SStefano Zampini         }
2228674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2229674ae819SStefano Zampini       }
22304641a718SStefano Zampini       ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2231674ae819SStefano Zampini       ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr);
2232811e8ca2SStefano Zampini     }
2233811e8ca2SStefano Zampini   }
2234674ae819SStefano Zampini   *n_constraints = n;
2235811e8ca2SStefano Zampini   if (constraints_idx) *constraints_idx = constraints_index;
2236674ae819SStefano Zampini   PetscFunctionReturn(0);
2237674ae819SStefano Zampini }
2238674ae819SStefano Zampini 
2239674ae819SStefano Zampini /* the next two functions has been adapted from pcis.c */
2240674ae819SStefano Zampini #undef __FUNCT__
2241674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchur"
2242674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchur(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2243674ae819SStefano Zampini {
2244674ae819SStefano Zampini   PetscErrorCode ierr;
2245674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2246674ae819SStefano Zampini 
2247674ae819SStefano Zampini   PetscFunctionBegin;
2248674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2249674ae819SStefano Zampini   ierr = MatMult(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2250674ae819SStefano Zampini   ierr = MatMult(pcis->A_IB,v,vec1_D);CHKERRQ(ierr);
2251674ae819SStefano Zampini   ierr = KSPSolve(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2252674ae819SStefano Zampini   ierr = MatMult(pcis->A_BI,vec2_D,vec2_B);CHKERRQ(ierr);
2253674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2254674ae819SStefano Zampini   PetscFunctionReturn(0);
2255674ae819SStefano Zampini }
2256674ae819SStefano Zampini 
2257674ae819SStefano Zampini #undef __FUNCT__
2258674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchurTranspose"
2259674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchurTranspose(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2260674ae819SStefano Zampini {
2261674ae819SStefano Zampini   PetscErrorCode ierr;
2262674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2263674ae819SStefano Zampini 
2264674ae819SStefano Zampini   PetscFunctionBegin;
2265674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2266674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2267674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BI,v,vec1_D);CHKERRQ(ierr);
2268674ae819SStefano Zampini   ierr = KSPSolveTranspose(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2269674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_IB,vec2_D,vec2_B);CHKERRQ(ierr);
2270674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2271674ae819SStefano Zampini   PetscFunctionReturn(0);
2272674ae819SStefano Zampini }
2273674ae819SStefano Zampini 
2274674ae819SStefano Zampini #undef __FUNCT__
2275674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
2276674ae819SStefano 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[])
2277674ae819SStefano Zampini {
2278674ae819SStefano Zampini   Vec            local_vec,global_vec;
2279674ae819SStefano Zampini   IS             seqis,paris;
2280674ae819SStefano Zampini   VecScatter     scatter_ctx;
2281674ae819SStefano Zampini   PetscScalar    *array;
2282674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
2283674ae819SStefano Zampini   PetscScalar    globalsum;
2284674ae819SStefano Zampini   PetscInt       i,j,s;
2285674ae819SStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local;
2286674ae819SStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm,max_global;
2287674ae819SStefano Zampini   PetscMPIInt    *dof_sizes,*dof_displs;
2288674ae819SStefano Zampini   PetscBool      first_found;
2289674ae819SStefano Zampini   PetscErrorCode ierr;
2290674ae819SStefano Zampini 
2291674ae819SStefano Zampini   PetscFunctionBegin;
2292674ae819SStefano Zampini   /* mpi buffers */
2293674ae819SStefano Zampini   MPI_Comm_size(comm,&size_prec_comm);
2294674ae819SStefano Zampini   MPI_Comm_rank(comm,&rank_prec_comm);
2295674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
2296674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_sizes),&dof_sizes);CHKERRQ(ierr);
2297674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_displs),&dof_displs);CHKERRQ(ierr);
2298674ae819SStefano Zampini   /* get maximum size of subset */
2299674ae819SStefano Zampini   ierr = PetscMalloc(n_local_dofs*sizeof(PetscInt),&temp_global_dofs);CHKERRQ(ierr);
2300674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
2301674ae819SStefano Zampini   max_local = 0;
2302674ae819SStefano Zampini   if (n_local_dofs) {
2303674ae819SStefano Zampini     max_local = temp_global_dofs[0];
2304674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2305674ae819SStefano Zampini       if (max_local < temp_global_dofs[i] ) {
2306674ae819SStefano Zampini         max_local = temp_global_dofs[i];
2307674ae819SStefano Zampini       }
2308674ae819SStefano Zampini     }
2309674ae819SStefano Zampini   }
2310674ae819SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);
2311674ae819SStefano Zampini   max_global++;
2312674ae819SStefano Zampini   max_local = 0;
2313674ae819SStefano Zampini   if (n_local_dofs) {
2314674ae819SStefano Zampini     max_local = local_dofs[0];
2315674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2316674ae819SStefano Zampini       if (max_local < local_dofs[i] ) {
2317674ae819SStefano Zampini         max_local = local_dofs[i];
2318674ae819SStefano Zampini       }
2319674ae819SStefano Zampini     }
2320674ae819SStefano Zampini   }
2321674ae819SStefano Zampini   max_local++;
2322674ae819SStefano Zampini   /* allocate workspace */
2323674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
2324674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
2325674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
2326674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
2327674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
2328674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
2329674ae819SStefano Zampini   /* create scatter */
2330674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
2331674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
2332674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
2333674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
2334674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
2335674ae819SStefano Zampini   /* init array */
2336674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
2337674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2338674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2339674ae819SStefano Zampini   if (local_dofs_mult) {
2340674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2341674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
2342674ae819SStefano Zampini     }
2343674ae819SStefano Zampini   } else {
2344674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2345674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
2346674ae819SStefano Zampini     }
2347674ae819SStefano Zampini   }
2348674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2349674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
2350674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2351674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2352674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
23535b08dc53SStefano Zampini   *n_global_subset = (PetscInt)PetscRealPart(globalsum);
2354674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
2355674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
2356674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
2357674ae819SStefano Zampini   nlocals = 0;
2358674ae819SStefano Zampini   first_index = -1;
2359674ae819SStefano Zampini   first_found = PETSC_FALSE;
2360674ae819SStefano Zampini   for (i=0;i<s;i++) {
23615b08dc53SStefano Zampini     if (!first_found && PetscRealPart(array[i]) > 0.0) {
2362674ae819SStefano Zampini       first_found = PETSC_TRUE;
2363674ae819SStefano Zampini       first_index = i;
2364674ae819SStefano Zampini     }
23655b08dc53SStefano Zampini     nlocals += (PetscInt)PetscRealPart(array[i]);
2366674ae819SStefano Zampini   }
2367674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2368674ae819SStefano Zampini   if (!rank_prec_comm) {
2369674ae819SStefano Zampini     dof_displs[0]=0;
2370674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
2371674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
2372674ae819SStefano Zampini     }
2373674ae819SStefano Zampini   }
2374674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2375674ae819SStefano Zampini   if (first_found) {
2376674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
2377674ae819SStefano Zampini     old_index = first_index;
2378674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
23795b08dc53SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) {
2380674ae819SStefano Zampini         array[i] += array[old_index];
2381674ae819SStefano Zampini         old_index = i;
2382674ae819SStefano Zampini       }
2383674ae819SStefano Zampini     }
2384674ae819SStefano Zampini   }
2385674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
2386674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2387674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2388674ae819SStefano Zampini   ierr = VecScatterEnd  (scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2389674ae819SStefano Zampini   /* get global ordering of local dofs */
2390674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2391674ae819SStefano Zampini   if (local_dofs_mult) {
2392674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
23935b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i];
2394674ae819SStefano Zampini     }
2395674ae819SStefano Zampini   } else {
2396674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
23975b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1;
2398674ae819SStefano Zampini     }
2399674ae819SStefano Zampini   }
2400674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2401674ae819SStefano Zampini   /* free workspace */
2402674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
2403674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
2404674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
2405674ae819SStefano Zampini   ierr = PetscFree(dof_sizes);CHKERRQ(ierr);
2406674ae819SStefano Zampini   ierr = PetscFree(dof_displs);CHKERRQ(ierr);
2407674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
2408674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
2409674ae819SStefano Zampini   PetscFunctionReturn(0);
2410674ae819SStefano Zampini }
24119a7d3425SStefano Zampini 
24129a7d3425SStefano Zampini #undef __FUNCT__
24139a7d3425SStefano Zampini #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
24149a7d3425SStefano Zampini PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
24159a7d3425SStefano Zampini {
24169a7d3425SStefano Zampini   PetscInt       i,j;
24179a7d3425SStefano Zampini   PetscScalar    *alphas;
24189a7d3425SStefano Zampini   PetscErrorCode ierr;
24199a7d3425SStefano Zampini 
24209a7d3425SStefano Zampini   PetscFunctionBegin;
24219a7d3425SStefano Zampini   /* this implements stabilized Gram-Schmidt */
24229a7d3425SStefano Zampini   ierr = PetscMalloc(n*sizeof(PetscScalar),&alphas);CHKERRQ(ierr);
24239a7d3425SStefano Zampini   for (i=0;i<n;i++) {
24249a7d3425SStefano Zampini     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
24259a7d3425SStefano Zampini     if (i<n) { ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],&alphas[i+1]);CHKERRQ(ierr); }
24269a7d3425SStefano Zampini     for (j=i+1;j<n;j++) { ierr = VecAXPY(vecs[j],PetscConj(-alphas[j]),vecs[i]);CHKERRQ(ierr); }
24279a7d3425SStefano Zampini   }
24289a7d3425SStefano Zampini   ierr = PetscFree(alphas);CHKERRQ(ierr);
24299a7d3425SStefano Zampini   PetscFunctionReturn(0);
24309a7d3425SStefano Zampini }
24319a7d3425SStefano Zampini 
2432a57a6d2fSStefano Zampini /* Currently support MAT_INITIAL_MATRIX only, with partial support to block matrices */
2433c8587f34SStefano Zampini #undef __FUNCT__
2434a57a6d2fSStefano Zampini #define __FUNCT__ "MatConvert_IS_AIJ"
2435a57a6d2fSStefano Zampini static PetscErrorCode MatConvert_IS_AIJ(Mat mat, MatType newtype,MatReuse reuse,Mat *M)
2436c8587f34SStefano Zampini {
2437a57a6d2fSStefano Zampini   Mat new_mat;
2438a57a6d2fSStefano Zampini   Mat_IS *matis = (Mat_IS*)(mat->data);
2439a57a6d2fSStefano Zampini   /* info on mat */
2440a57a6d2fSStefano Zampini   PetscInt bs,rows,cols;
2441a57a6d2fSStefano Zampini   PetscInt lrows,lcols;
2442a57a6d2fSStefano Zampini   PetscInt local_rows,local_cols;
2443e7931f94SStefano Zampini   PetscMPIInt nsubdomains;
2444c8587f34SStefano Zampini   /* preallocation */
2445c8587f34SStefano Zampini   Vec vec_dnz,vec_onz;
2446c8587f34SStefano Zampini   PetscScalar *my_dnz,*my_onz,*array;
2447a57a6d2fSStefano Zampini   PetscInt *dnz,*onz,*mat_ranges,*row_ownership;
2448a57a6d2fSStefano Zampini   PetscInt  index_row,index_col,owner;
2449a57a6d2fSStefano Zampini   PetscInt  *local_indices,*global_indices;
2450a57a6d2fSStefano Zampini   /* work */
2451a57a6d2fSStefano Zampini   PetscInt i,j;
2452a57a6d2fSStefano Zampini   PetscErrorCode ierr;
2453c8587f34SStefano Zampini 
2454a57a6d2fSStefano Zampini   PetscFunctionBegin;
2455a57a6d2fSStefano Zampini   /* CHECKS */
2456a57a6d2fSStefano Zampini   /* get info from mat */
2457a57a6d2fSStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
2458a57a6d2fSStefano Zampini   ierr = MatGetBlockSize(mat,&bs);CHKERRQ(ierr);
2459a57a6d2fSStefano Zampini   ierr = MatGetSize(matis->A,&local_rows,&local_cols);CHKERRQ(ierr);
2460a57a6d2fSStefano Zampini   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&nsubdomains);CHKERRQ(ierr);
2461a57a6d2fSStefano Zampini 
2462a57a6d2fSStefano Zampini   /* MAT_INITIAL_MATRIX */
2463a57a6d2fSStefano Zampini   ierr = MatCreate(PetscObjectComm((PetscObject)mat),&new_mat);CHKERRQ(ierr);
2464a57a6d2fSStefano Zampini   ierr = MatSetSizes(new_mat,PETSC_DECIDE,PETSC_DECIDE,rows,cols);CHKERRQ(ierr);
2465a57a6d2fSStefano Zampini   ierr = MatSetBlockSize(new_mat,bs);CHKERRQ(ierr);
2466a57a6d2fSStefano Zampini   ierr = MatSetType(new_mat,newtype);CHKERRQ(ierr);
2467a57a6d2fSStefano Zampini   ierr = MatSetUp(new_mat);CHKERRQ(ierr);
2468a57a6d2fSStefano Zampini   ierr = MatGetLocalSize(new_mat,&lrows,&lcols);CHKERRQ(ierr);
2469a57a6d2fSStefano Zampini 
2470a57a6d2fSStefano Zampini   /*
2471a57a6d2fSStefano Zampini     preallocation
2472a57a6d2fSStefano Zampini   */
2473a57a6d2fSStefano Zampini 
2474a57a6d2fSStefano Zampini   ierr = MatPreallocateInitialize(PetscObjectComm((PetscObject)new_mat),lrows,lcols,dnz,onz);CHKERRQ(ierr);
2475a57a6d2fSStefano Zampini   /*
2476a57a6d2fSStefano Zampini      Some vectors are needed to sum up properly on shared interface dofs.
2477a57a6d2fSStefano Zampini      Note that preallocation is not exact, since it overestimates nonzeros
2478a57a6d2fSStefano Zampini   */
2479a57a6d2fSStefano Zampini /*
2480a57a6d2fSStefano Zampini   ierr = VecCreate(PetscObjectComm((PetscObject)mat),&vec_dnz);CHKERRQ(ierr);
2481c8587f34SStefano Zampini   ierr = VecSetBlockSize(vec_dnz,bs);CHKERRQ(ierr);
2482a57a6d2fSStefano Zampini   ierr = VecSetSizes(vec_dnz,PETSC_DECIDE,rows);CHKERRQ(ierr);
2483a57a6d2fSStefano Zampini   ierr = VecSetType(vec_dnz,VECSTANDARD);CHKERRQ(ierr);
2484a57a6d2fSStefano Zampini */
2485a57a6d2fSStefano Zampini   ierr = MatGetVecs(new_mat,NULL,&vec_dnz);CHKERRQ(ierr);
2486c8587f34SStefano Zampini   ierr = VecDuplicate(vec_dnz,&vec_onz);CHKERRQ(ierr);
2487e7931f94SStefano Zampini   /* All processes need to compute entire row ownership */
2488a57a6d2fSStefano Zampini   ierr = PetscMalloc(rows*sizeof(*row_ownership),&row_ownership);CHKERRQ(ierr);
2489a57a6d2fSStefano Zampini   ierr = MatGetOwnershipRanges(new_mat,(const PetscInt**)&mat_ranges);CHKERRQ(ierr);
2490a57a6d2fSStefano Zampini   for (i=0;i<nsubdomains;i++) {
2491c8587f34SStefano Zampini     for (j=mat_ranges[i];j<mat_ranges[i+1];j++) {
2492c8587f34SStefano Zampini       row_ownership[j]=i;
2493c8587f34SStefano Zampini     }
2494c8587f34SStefano Zampini   }
2495a57a6d2fSStefano Zampini   /* map indices of local mat to global values */
2496a57a6d2fSStefano Zampini   ierr = PetscMalloc(PetscMax(local_cols,local_rows)*sizeof(*global_indices),&global_indices);CHKERRQ(ierr);
2497a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*local_indices),&local_indices);CHKERRQ(ierr);
2498a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) local_indices[i]=i;
2499a57a6d2fSStefano Zampini   ierr = ISLocalToGlobalMappingApply(matis->mapping,local_rows,local_indices,global_indices);CHKERRQ(ierr);
2500a57a6d2fSStefano Zampini   ierr = PetscFree(local_indices);CHKERRQ(ierr);
2501c8587f34SStefano Zampini 
2502e7931f94SStefano Zampini   /*
2503e7931f94SStefano Zampini      my_dnz and my_onz contains exact contribution to preallocation from each local mat
2504e7931f94SStefano Zampini      then, they will be summed up properly. This way, preallocation is always sufficient
2505e7931f94SStefano Zampini   */
2506a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*my_dnz),&my_dnz);CHKERRQ(ierr);
2507a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*my_onz),&my_onz);CHKERRQ(ierr);
2508a57a6d2fSStefano Zampini   ierr = PetscMemzero(my_dnz,local_rows*sizeof(*my_dnz));CHKERRQ(ierr);
2509a57a6d2fSStefano Zampini   ierr = PetscMemzero(my_onz,local_rows*sizeof(*my_onz));CHKERRQ(ierr);
2510a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) {
2511a57a6d2fSStefano Zampini     index_row = global_indices[i];
2512a57a6d2fSStefano Zampini     for (j=i;j<local_rows;j++) {
2513a57a6d2fSStefano Zampini       owner = row_ownership[index_row];
2514a57a6d2fSStefano Zampini       index_col = global_indices[j];
2515a57a6d2fSStefano Zampini       if (index_col > mat_ranges[owner]-1 && index_col < mat_ranges[owner+1] ) { /* diag block */
2516c8587f34SStefano Zampini         my_dnz[i] += 1.0;
2517a57a6d2fSStefano Zampini       } else { /* offdiag block */
2518c8587f34SStefano Zampini         my_onz[i] += 1.0;
2519c8587f34SStefano Zampini       }
2520a57a6d2fSStefano Zampini       /* same as before, interchanging rows and cols */
2521c8587f34SStefano Zampini       if (i != j) {
2522a57a6d2fSStefano Zampini         owner = row_ownership[index_col];
2523a57a6d2fSStefano Zampini         if (index_row > mat_ranges[owner]-1 && index_row < mat_ranges[owner+1] ) {
2524c8587f34SStefano Zampini           my_dnz[j] += 1.0;
2525c8587f34SStefano Zampini         } else {
2526c8587f34SStefano Zampini           my_onz[j] += 1.0;
2527c8587f34SStefano Zampini         }
2528c8587f34SStefano Zampini       }
2529c8587f34SStefano Zampini     }
2530c8587f34SStefano Zampini   }
2531c8587f34SStefano Zampini   ierr = VecSet(vec_dnz,0.0);CHKERRQ(ierr);
2532c8587f34SStefano Zampini   ierr = VecSet(vec_onz,0.0);CHKERRQ(ierr);
253320a2ab83SStefano Zampini   if (local_rows) { /* multilevel guard */
2534a57a6d2fSStefano Zampini     ierr = VecSetValues(vec_dnz,local_rows,global_indices,my_dnz,ADD_VALUES);CHKERRQ(ierr);
2535a57a6d2fSStefano Zampini     ierr = VecSetValues(vec_onz,local_rows,global_indices,my_onz,ADD_VALUES);CHKERRQ(ierr);
2536c8587f34SStefano Zampini   }
2537c8587f34SStefano Zampini   ierr = VecAssemblyBegin(vec_dnz);CHKERRQ(ierr);
2538c8587f34SStefano Zampini   ierr = VecAssemblyBegin(vec_onz);CHKERRQ(ierr);
2539c8587f34SStefano Zampini   ierr = VecAssemblyEnd(vec_dnz);CHKERRQ(ierr);
2540c8587f34SStefano Zampini   ierr = VecAssemblyEnd(vec_onz);CHKERRQ(ierr);
2541c8587f34SStefano Zampini   ierr = PetscFree(my_dnz);CHKERRQ(ierr);
2542c8587f34SStefano Zampini   ierr = PetscFree(my_onz);CHKERRQ(ierr);
2543c8587f34SStefano Zampini   ierr = PetscFree(row_ownership);CHKERRQ(ierr);
2544a57a6d2fSStefano Zampini 
2545a57a6d2fSStefano Zampini   /* set computed preallocation in dnz and onz */
2546a57a6d2fSStefano Zampini   ierr = VecGetArray(vec_dnz,&array);CHKERRQ(ierr);
2547a57a6d2fSStefano Zampini   for (i=0; i<lrows; i++) dnz[i] = (PetscInt)PetscRealPart(array[i]);
2548a57a6d2fSStefano Zampini   ierr = VecRestoreArray(vec_dnz,&array);CHKERRQ(ierr);
2549a57a6d2fSStefano Zampini   ierr = VecGetArray(vec_onz,&array);CHKERRQ(ierr);
2550a57a6d2fSStefano Zampini   for (i=0;i<lrows;i++) onz[i] = (PetscInt)PetscRealPart(array[i]);
2551a57a6d2fSStefano Zampini   ierr = VecRestoreArray(vec_onz,&array);CHKERRQ(ierr);
2552c8587f34SStefano Zampini   ierr = VecDestroy(&vec_dnz);CHKERRQ(ierr);
2553c8587f34SStefano Zampini   ierr = VecDestroy(&vec_onz);CHKERRQ(ierr);
2554c8587f34SStefano Zampini 
2555e7931f94SStefano Zampini   /* Resize preallocation if overestimated */
2556c8587f34SStefano Zampini   for (i=0;i<lrows;i++) {
2557a57a6d2fSStefano Zampini     dnz[i] = PetscMin(dnz[i],lcols);
2558a57a6d2fSStefano Zampini     onz[i] = PetscMin(onz[i],cols-lcols);
2559c8587f34SStefano Zampini   }
2560a57a6d2fSStefano Zampini   ierr = MatMPIAIJSetPreallocation(new_mat,0,dnz,0,onz);CHKERRQ(ierr);
2561c8587f34SStefano Zampini   ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
2562a57a6d2fSStefano Zampini 
2563a57a6d2fSStefano Zampini   /*
2564e7931f94SStefano Zampini     Set values. Very Basic.
2565a57a6d2fSStefano Zampini   */
2566a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) {
2567a57a6d2fSStefano Zampini     ierr = MatGetRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2568a57a6d2fSStefano Zampini     ierr = ISLocalToGlobalMappingApply(matis->mapping,j,local_indices,global_indices);CHKERRQ(ierr);
2569a57a6d2fSStefano Zampini     ierr = ISLocalToGlobalMappingApply(matis->mapping,1,&i,&index_row);CHKERRQ(ierr);
2570a57a6d2fSStefano Zampini     ierr = MatSetValues(new_mat,1,&index_row,j,global_indices,array,ADD_VALUES);CHKERRQ(ierr);
2571a57a6d2fSStefano Zampini     ierr = MatRestoreRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2572a57a6d2fSStefano Zampini   }
257320a2ab83SStefano Zampini   ierr = MatAssemblyBegin(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2574a57a6d2fSStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
257520a2ab83SStefano Zampini   ierr = MatAssemblyEnd(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2576a57a6d2fSStefano Zampini 
2577a57a6d2fSStefano Zampini   /* get back mat */
2578a57a6d2fSStefano Zampini   *M = new_mat;
2579a57a6d2fSStefano Zampini   PetscFunctionReturn(0);
2580a57a6d2fSStefano Zampini }
2581a57a6d2fSStefano Zampini 
2582e7931f94SStefano Zampini #undef __FUNCT__
2583e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble_Private"
2584e7931f94SStefano Zampini PetscErrorCode MatISSubassemble_Private(Mat mat, PetscInt coarsening_ratio, IS* is_sends)
2585e7931f94SStefano Zampini {
2586e7931f94SStefano Zampini   Mat             subdomain_adj;
2587e7931f94SStefano Zampini   IS              new_ranks,ranks_send_to;
2588e7931f94SStefano Zampini   MatPartitioning partitioner;
2589e7931f94SStefano Zampini   Mat_IS          *matis;
2590e7931f94SStefano Zampini   PetscInt        n_neighs,*neighs,*n_shared,**shared;
2591e7931f94SStefano Zampini   PetscInt        prank;
2592e7931f94SStefano Zampini   PetscMPIInt     size,rank,color;
2593e7931f94SStefano Zampini   PetscInt        *xadj,*adjncy,*oldranks;
2594e7931f94SStefano Zampini   PetscInt        *adjncy_wgt,*v_wgt,*is_indices,*ranks_send_to_idx;
2595e7931f94SStefano Zampini   PetscInt        i,j,n_subdomains,local_size,threshold=0;
2596e7931f94SStefano Zampini   PetscErrorCode  ierr;
25972b510759SStefano Zampini   PetscBool       use_vwgt=PETSC_FALSE,use_square=PETSC_FALSE;
2598e7931f94SStefano Zampini   PetscSubcomm    subcomm;
2599a57a6d2fSStefano Zampini 
2600e7931f94SStefano Zampini   PetscFunctionBegin;
26012b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_square",&use_square,NULL);CHKERRQ(ierr);
26022b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
26032b510759SStefano Zampini   ierr = PetscOptionsGetInt(NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
2604e7931f94SStefano Zampini 
2605e7931f94SStefano Zampini   /* Get info on mapping */
2606e7931f94SStefano Zampini   matis = (Mat_IS*)(mat->data);
2607e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&local_size);CHKERRQ(ierr);
2608e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2609e7931f94SStefano Zampini 
2610e7931f94SStefano Zampini   /* build local CSR graph of subdomains' connectivity */
2611e7931f94SStefano Zampini   ierr = PetscMalloc(2*sizeof(*xadj),&xadj);CHKERRQ(ierr);
2612e7931f94SStefano Zampini   xadj[0] = 0;
2613e7931f94SStefano Zampini   xadj[1] = PetscMax(n_neighs-1,0);
2614e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy),&adjncy);CHKERRQ(ierr);
2615e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy_wgt),&adjncy_wgt);CHKERRQ(ierr);
2616e7931f94SStefano Zampini 
26172b510759SStefano Zampini   if (threshold) {
26182b510759SStefano Zampini     PetscInt* count,min_threshold;
2619e7931f94SStefano Zampini     ierr = PetscMalloc(local_size*sizeof(PetscInt),&count);CHKERRQ(ierr);
2620e7931f94SStefano Zampini     ierr = PetscMemzero(count,local_size*sizeof(PetscInt));CHKERRQ(ierr);
2621e7931f94SStefano Zampini     for (i=1;i<n_neighs;i++) {/* i=1 so I don't count myself -> faces nodes counts to 1 */
2622e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2623e7931f94SStefano Zampini         count[shared[i][j]] += 1;
2624e7931f94SStefano Zampini       }
2625e7931f94SStefano Zampini     }
26262b510759SStefano Zampini     /* adapt threshold since we dont want to lose significant connections */
26272b510759SStefano Zampini     min_threshold = n_neighs;
26282b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
26292b510759SStefano Zampini       for (j=0;j<n_shared[i];j++) {
26302b510759SStefano Zampini         min_threshold = PetscMin(count[shared[i][j]],min_threshold);
26312b510759SStefano Zampini       }
26322b510759SStefano Zampini     }
26332b510759SStefano Zampini     PetscPrintf(PETSC_COMM_SELF,"PASSED THRESHOLD %d\n",threshold);
26342b510759SStefano Zampini     threshold = PetscMax(min_threshold+1,threshold);
26352b510759SStefano Zampini     PetscPrintf(PETSC_COMM_SELF,"USING THRESHOLD %d (min %d)\n",threshold,min_threshold);
2636e7931f94SStefano Zampini     xadj[1] = 0;
26372b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
2638e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2639e7931f94SStefano Zampini         if (count[shared[i][j]] < threshold) {
2640e7931f94SStefano Zampini           adjncy[xadj[1]] = neighs[i];
2641e7931f94SStefano Zampini           adjncy_wgt[xadj[1]] = n_shared[i];
2642e7931f94SStefano Zampini           xadj[1]++;
2643e7931f94SStefano Zampini           break;
2644e7931f94SStefano Zampini         }
2645e7931f94SStefano Zampini       }
2646e7931f94SStefano Zampini     }
2647e7931f94SStefano Zampini     ierr = PetscFree(count);CHKERRQ(ierr);
2648c8587f34SStefano Zampini   } else {
2649e7931f94SStefano Zampini     if (xadj[1]) {
2650e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy,&neighs[1],xadj[1]*sizeof(*adjncy));CHKERRQ(ierr);
2651e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy_wgt,&n_shared[1],xadj[1]*sizeof(*adjncy_wgt));CHKERRQ(ierr);
2652c8587f34SStefano Zampini     }
2653e7931f94SStefano Zampini   }
2654e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingRestoreInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2655e7931f94SStefano Zampini   if (use_square) {
2656e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2657e7931f94SStefano Zampini       adjncy_wgt[i] = adjncy_wgt[i]*adjncy_wgt[i];
2658e7931f94SStefano Zampini     }
2659e7931f94SStefano Zampini   }
2660e7931f94SStefano Zampini   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2661e7931f94SStefano Zampini 
2662e7931f94SStefano Zampini   ierr = PetscMalloc(sizeof(PetscInt),&ranks_send_to_idx);CHKERRQ(ierr);
2663e7931f94SStefano Zampini 
2664e7931f94SStefano Zampini   /*
2665e7931f94SStefano Zampini     Restrict work on active processes only.
2666e7931f94SStefano Zampini   */
2667e7931f94SStefano Zampini   ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&subcomm);CHKERRQ(ierr);
2668e7931f94SStefano Zampini   ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
2669e7931f94SStefano Zampini   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
26702b510759SStefano Zampini   ierr = PetscMPIIntCast(!local_size,&color);CHKERRQ(ierr);
2671d3531aaaSJed Brown   ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
2672e7931f94SStefano Zampini   if (color) {
2673e7931f94SStefano Zampini     ierr = PetscFree(xadj);CHKERRQ(ierr);
2674e7931f94SStefano Zampini     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2675e7931f94SStefano Zampini     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
2676c8587f34SStefano Zampini   } else {
2677e7931f94SStefano Zampini     ierr = MPI_Comm_size(subcomm->comm,&size);CHKERRQ(ierr);
2678e7931f94SStefano Zampini     ierr = PetscMalloc(size*sizeof(*oldranks),&oldranks);CHKERRQ(ierr);
2679e7931f94SStefano Zampini     prank = rank;
2680e7931f94SStefano Zampini     ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm->comm);CHKERRQ(ierr);
2681e7931f94SStefano Zampini     for (i=0;i<size;i++) {
2682e7931f94SStefano Zampini       PetscPrintf(subcomm->comm,"oldranks[%d] = %d\n",i,oldranks[i]);
2683c8587f34SStefano Zampini     }
2684e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2685e7931f94SStefano Zampini       ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
2686c8587f34SStefano Zampini     }
2687e7931f94SStefano Zampini     ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2688e7931f94SStefano Zampini     ierr = MatCreateMPIAdj(subcomm->comm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
2689e7931f94SStefano Zampini     n_subdomains = (PetscInt)size;
2690e7931f94SStefano Zampini     ierr = MatView(subdomain_adj,0);CHKERRQ(ierr);
2691e7931f94SStefano Zampini 
2692e7931f94SStefano Zampini     /* Partition */
2693e7931f94SStefano Zampini     ierr = MatPartitioningCreate(subcomm->comm,&partitioner);CHKERRQ(ierr);
2694e7931f94SStefano Zampini     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
2695e7931f94SStefano Zampini     if (use_vwgt) {
2696e7931f94SStefano Zampini       ierr = PetscMalloc(sizeof(*v_wgt),&v_wgt);CHKERRQ(ierr);
2697e7931f94SStefano Zampini       v_wgt[0] = local_size;
2698e7931f94SStefano Zampini       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
2699c8587f34SStefano Zampini     }
2700e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)partitioner),"NPARTS %d\n",n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2701e7931f94SStefano Zampini     ierr = MatPartitioningSetNParts(partitioner,n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2702e7931f94SStefano Zampini     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
2703e7931f94SStefano Zampini     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
2704e7931f94SStefano Zampini     ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr);
2705e7931f94SStefano Zampini 
2706e7931f94SStefano Zampini     ierr = ISGetIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2707e7931f94SStefano Zampini     ranks_send_to_idx[0] = oldranks[is_indices[0]];
2708e7931f94SStefano Zampini     ierr = ISRestoreIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2709e7931f94SStefano Zampini     /* clean up */
2710e7931f94SStefano Zampini     ierr = PetscFree(oldranks);CHKERRQ(ierr);
2711e7931f94SStefano Zampini     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
2712e7931f94SStefano Zampini     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
2713e7931f94SStefano Zampini     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
2714e7931f94SStefano Zampini   }
2715e7931f94SStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
2716e7931f94SStefano Zampini 
2717e7931f94SStefano Zampini   /* assemble parallel IS for sends */
2718e7931f94SStefano Zampini   i = 1;
2719e7931f94SStefano Zampini   if (color) i=0;
2720e7931f94SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,&ranks_send_to);CHKERRQ(ierr);
2721e7931f94SStefano Zampini   ierr = ISView(ranks_send_to,0);CHKERRQ(ierr);
2722e7931f94SStefano Zampini 
2723e7931f94SStefano Zampini   /* get back IS */
2724e7931f94SStefano Zampini   *is_sends = ranks_send_to;
2725e7931f94SStefano Zampini   PetscFunctionReturn(0);
2726e7931f94SStefano Zampini }
2727e7931f94SStefano Zampini 
2728e7931f94SStefano Zampini typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
2729e7931f94SStefano Zampini 
2730e7931f94SStefano Zampini #undef __FUNCT__
2731e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble"
2732e7931f94SStefano Zampini PetscErrorCode MatISSubassemble(Mat mat, IS is_sends, PetscInt coarsening_ratio, Mat *mat_n)
2733e7931f94SStefano Zampini {
2734e7931f94SStefano Zampini   Mat                    local_mat,new_mat;
2735e7931f94SStefano Zampini   Mat_IS                 *matis;
2736e7931f94SStefano Zampini   IS                     is_sends_internal;
2737e7931f94SStefano Zampini   PetscInt               rows,cols;
2738e7931f94SStefano Zampini   PetscInt               i,bs,buf_size_idxs,buf_size_vals;
2739e7931f94SStefano Zampini   PetscBool              ismatis,isdense;
2740e7931f94SStefano Zampini   ISLocalToGlobalMapping l2gmap;
2741e7931f94SStefano Zampini   PetscInt*              l2gmap_indices;
2742e7931f94SStefano Zampini   const PetscInt*        is_indices;
2743e7931f94SStefano Zampini   MatType                new_local_type;
2744e7931f94SStefano Zampini   MatTypePrivate         new_local_type_private;
2745e7931f94SStefano Zampini   /* buffers */
2746e7931f94SStefano Zampini   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
2747e7931f94SStefano Zampini   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
2748e7931f94SStefano Zampini   /* MPI */
2749e7931f94SStefano Zampini   MPI_Comm               comm;
2750e7931f94SStefano Zampini   PetscMPIInt            n_sends,n_recvs,commsize;
2751e7931f94SStefano Zampini   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals;
2752e7931f94SStefano Zampini   PetscMPIInt            *onodes,*olengths_idxs,*olengths_vals;
2753e7931f94SStefano Zampini   PetscMPIInt            len,tag_idxs,tag_vals,source_dest;
2754e7931f94SStefano Zampini   MPI_Request            *send_req_idxs,*send_req_vals,*recv_req_idxs,*recv_req_vals;
2755e7931f94SStefano Zampini   PetscErrorCode         ierr;
2756e7931f94SStefano Zampini 
2757e7931f94SStefano Zampini   PetscFunctionBegin;
2758e7931f94SStefano Zampini   /* checks */
2759e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
2760e7931f94SStefano Zampini   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on an matrix object which is not of type MATIS",__FUNCT__);
2761e7931f94SStefano Zampini   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2762e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
2763e7931f94SStefano Zampini   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
2764e7931f94SStefano Zampini   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
2765e7931f94SStefano Zampini   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
2766e7931f94SStefano Zampini   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
2767e7931f94SStefano Zampini   PetscValidLogicalCollectiveInt(mat,bs,0);
2768e7931f94SStefano Zampini   /* prepare IS for sending if not provided */
2769e7931f94SStefano Zampini   if (!is_sends) {
2770e7931f94SStefano Zampini     if (!coarsening_ratio) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a coarsening ratio");
2771e7931f94SStefano Zampini     ierr = MatISSubassemble_Private(mat,coarsening_ratio,&is_sends_internal);CHKERRQ(ierr);
2772c8587f34SStefano Zampini   } else {
2773e7931f94SStefano Zampini     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
2774e7931f94SStefano Zampini     is_sends_internal = is_sends;
2775c8587f34SStefano Zampini   }
2776e7931f94SStefano Zampini 
2777e7931f94SStefano Zampini   /* get pointer of MATIS data */
2778e7931f94SStefano Zampini   matis = (Mat_IS*)mat->data;
2779e7931f94SStefano Zampini 
2780e7931f94SStefano Zampini   /* get comm */
2781e7931f94SStefano Zampini   comm = PetscObjectComm((PetscObject)mat);
2782e7931f94SStefano Zampini 
2783e7931f94SStefano Zampini   /* compute number of sends */
2784e7931f94SStefano Zampini   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
2785e7931f94SStefano Zampini   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
2786e7931f94SStefano Zampini 
2787e7931f94SStefano Zampini   /* compute number of receives */
2788e7931f94SStefano Zampini   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
2789e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*iflags),&iflags);CHKERRQ(ierr);
2790e7931f94SStefano Zampini   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
2791e7931f94SStefano Zampini   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2792e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
2793e7931f94SStefano Zampini   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
2794e7931f94SStefano Zampini   ierr = PetscFree(iflags);CHKERRQ(ierr);
2795e7931f94SStefano Zampini 
2796e7931f94SStefano Zampini   /* prepare send/receive buffers */
2797e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_idxs),&ilengths_idxs);CHKERRQ(ierr);
2798e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
2799e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_vals),&ilengths_vals);CHKERRQ(ierr);
2800e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
2801e7931f94SStefano Zampini 
2802e7931f94SStefano Zampini   /* Get data from local mat */
2803e7931f94SStefano Zampini   if (!isdense) {
2804e7931f94SStefano Zampini     /* TODO: See below some guidelines on how to prepare the local buffers */
2805e7931f94SStefano Zampini     /*
2806e7931f94SStefano Zampini        send_buffer_vals should contain the raw values of the local matrix
2807e7931f94SStefano Zampini        send_buffer_idxs should contain:
2808e7931f94SStefano Zampini        - MatType_PRIVATE type
2809e7931f94SStefano Zampini        - PetscInt        size_of_l2gmap
2810e7931f94SStefano Zampini        - PetscInt        global_row_indices[size_of_l2gmap]
2811e7931f94SStefano Zampini        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
2812e7931f94SStefano Zampini     */
2813e7931f94SStefano Zampini   } else {
2814e7931f94SStefano Zampini     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
2815e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&i);CHKERRQ(ierr);
2816e7931f94SStefano Zampini     ierr = PetscMalloc((i+2)*sizeof(PetscInt),&send_buffer_idxs);CHKERRQ(ierr);
2817e7931f94SStefano Zampini     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
2818e7931f94SStefano Zampini     send_buffer_idxs[1] = i;
2819e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2820e7931f94SStefano Zampini     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
2821e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingRestoreIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2822e7931f94SStefano Zampini     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
2823e7931f94SStefano Zampini     for (i=0;i<n_sends;i++) {
2824e7931f94SStefano Zampini       ilengths_vals[is_indices[i]] = len*len;
2825e7931f94SStefano Zampini       ilengths_idxs[is_indices[i]] = len+2;
2826c8587f34SStefano Zampini     }
2827c8587f34SStefano Zampini   }
2828e7931f94SStefano Zampini   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
2829e7931f94SStefano Zampini   buf_size_idxs = 0;
2830e7931f94SStefano Zampini   buf_size_vals = 0;
2831e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2832e7931f94SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
2833e7931f94SStefano Zampini     buf_size_vals += (PetscInt)olengths_vals[i];
2834e7931f94SStefano Zampini   }
2835e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&recv_buffer_idxs);CHKERRQ(ierr);
2836e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_vals*sizeof(PetscScalar),&recv_buffer_vals);CHKERRQ(ierr);
2837e7931f94SStefano Zampini 
2838e7931f94SStefano Zampini   /* get new tags for clean communications */
2839e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
2840e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
2841e7931f94SStefano Zampini 
2842e7931f94SStefano Zampini   /* allocate for requests */
2843e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_idxs);CHKERRQ(ierr);
2844e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_vals);CHKERRQ(ierr);
2845e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_idxs);CHKERRQ(ierr);
2846e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_vals);CHKERRQ(ierr);
2847e7931f94SStefano Zampini 
2848e7931f94SStefano Zampini   /* communications */
2849e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2850e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
2851e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2852e7931f94SStefano Zampini     source_dest = onodes[i];
2853e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
2854e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
2855e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2856e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
2857e7931f94SStefano Zampini   }
2858e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) {
2859e7931f94SStefano Zampini     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
2860e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
2861e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
2862e7931f94SStefano Zampini   }
2863e7931f94SStefano Zampini   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2864e7931f94SStefano Zampini   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
2865e7931f94SStefano Zampini 
2866e7931f94SStefano Zampini   /* assemble new l2g map */
2867e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2868e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2869e7931f94SStefano Zampini   buf_size_idxs = 0;
2870e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2871e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
2872e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2873e7931f94SStefano Zampini   }
2874e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&l2gmap_indices);CHKERRQ(ierr);
2875e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2876e7931f94SStefano Zampini   buf_size_idxs = 0;
2877e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2878e7931f94SStefano Zampini     ierr = PetscMemcpy(&l2gmap_indices[buf_size_idxs],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
2879e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
2880e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2881e7931f94SStefano Zampini   }
2882e7931f94SStefano Zampini   ierr = PetscSortRemoveDupsInt(&buf_size_idxs,l2gmap_indices);CHKERRQ(ierr);
2883e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingCreate(comm,buf_size_idxs,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
2884e7931f94SStefano Zampini   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
2885e7931f94SStefano Zampini 
2886e7931f94SStefano Zampini   /* infer new local matrix type from received local matrices type */
2887e7931f94SStefano Zampini   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
2888e7931f94SStefano 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) */
2889e7931f94SStefano Zampini   new_local_type_private = MATAIJ_PRIVATE;
2890e7931f94SStefano Zampini   new_local_type = MATSEQAIJ;
2891e7931f94SStefano Zampini   if (n_recvs) {
2892be4bc593SStefano Zampini     new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
2893e7931f94SStefano Zampini     ptr_idxs = recv_buffer_idxs;
2894e7931f94SStefano Zampini     for (i=0;i<n_recvs;i++) {
2895e7931f94SStefano Zampini       if ((PetscInt)new_local_type_private != *ptr_idxs) {
2896e7931f94SStefano Zampini         new_local_type_private = MATAIJ_PRIVATE;
2897e7931f94SStefano Zampini         break;
2898e7931f94SStefano Zampini       }
2899e7931f94SStefano Zampini       ptr_idxs += olengths_idxs[i];
2900e7931f94SStefano Zampini     }
2901e7931f94SStefano Zampini     switch (new_local_type_private) {
2902e7931f94SStefano Zampini       case MATDENSE_PRIVATE: /* subassembling of dense matrices does not give a dense matrix! */
2903e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
2904e7931f94SStefano Zampini         bs = 1;
2905e7931f94SStefano Zampini         break;
2906e7931f94SStefano Zampini       case MATAIJ_PRIVATE:
2907e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
2908e7931f94SStefano Zampini         bs = 1;
2909e7931f94SStefano Zampini         break;
2910e7931f94SStefano Zampini       case MATBAIJ_PRIVATE:
2911e7931f94SStefano Zampini         new_local_type = MATSEQBAIJ;
2912e7931f94SStefano Zampini         break;
2913e7931f94SStefano Zampini       case MATSBAIJ_PRIVATE:
2914e7931f94SStefano Zampini         new_local_type = MATSEQSBAIJ;
2915e7931f94SStefano Zampini         break;
2916e7931f94SStefano Zampini       default:
2917e7931f94SStefano Zampini         SETERRQ2(comm,PETSC_ERR_LIB,"Unkwown private type %d in %s",new_local_type_private,__FUNCT__);
2918e7931f94SStefano Zampini         break;
2919e7931f94SStefano Zampini     }
2920e7931f94SStefano Zampini   }
2921e7931f94SStefano Zampini 
2922e7931f94SStefano Zampini   /* create MATIS object */
2923e7931f94SStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
2924e7931f94SStefano Zampini   ierr = MatCreateIS(comm,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,&new_mat);CHKERRQ(ierr);
2925e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
2926e7931f94SStefano Zampini   ierr = MatISGetLocalMat(new_mat,&local_mat);CHKERRQ(ierr);
2927e7931f94SStefano Zampini   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
2928e7931f94SStefano Zampini   ierr = MatSetUp(local_mat);CHKERRQ(ierr); /* WARNING -> no preallocation yet */
2929e7931f94SStefano Zampini 
2930e7931f94SStefano Zampini   /* set values */
2931e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2932e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
2933e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2934e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2935e7931f94SStefano Zampini     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
2936e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
2937e7931f94SStefano Zampini       ierr = MatSetValues(new_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
2938e7931f94SStefano Zampini       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
2939e7931f94SStefano Zampini       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
2940e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
2941e7931f94SStefano Zampini     }
2942e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2943e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
2944e7931f94SStefano Zampini   }
2945e7931f94SStefano Zampini   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2946e7931f94SStefano Zampini   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2947e7931f94SStefano Zampini   ierr = MatAssemblyBegin(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2948e7931f94SStefano Zampini   ierr = MatAssemblyEnd(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2949e7931f94SStefano Zampini 
2950e7931f94SStefano Zampini   { /* check */
2951e7931f94SStefano Zampini     Vec       lvec,rvec;
2952e7931f94SStefano Zampini     PetscReal infty_error;
2953e7931f94SStefano Zampini 
2954e7931f94SStefano Zampini     ierr = MatGetVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
2955e7931f94SStefano Zampini     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
2956e7931f94SStefano Zampini     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
2957e7931f94SStefano Zampini     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
2958e7931f94SStefano Zampini     ierr = MatMultAdd(new_mat,rvec,lvec,lvec);CHKERRQ(ierr);
2959e7931f94SStefano Zampini     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
2960e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
2961e7931f94SStefano Zampini     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
2962e7931f94SStefano Zampini     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
2963e7931f94SStefano Zampini   }
2964e7931f94SStefano Zampini 
2965e7931f94SStefano Zampini   /* free workspace */
2966e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
2967e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
2968e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2969e7931f94SStefano Zampini   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
2970e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2971e7931f94SStefano Zampini   if (isdense) {
2972e7931f94SStefano Zampini     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2973e7931f94SStefano Zampini     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
2974e7931f94SStefano Zampini   } else {
2975e7931f94SStefano Zampini     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
2976e7931f94SStefano Zampini   }
2977e7931f94SStefano Zampini   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
2978e7931f94SStefano Zampini   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
2979e7931f94SStefano Zampini   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
2980e7931f94SStefano Zampini   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
2981e7931f94SStefano Zampini   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
2982e7931f94SStefano Zampini   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
2983e7931f94SStefano Zampini   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
2984e7931f94SStefano Zampini   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
2985e7931f94SStefano Zampini   ierr = PetscFree(onodes);CHKERRQ(ierr);
2986e7931f94SStefano Zampini   /* get back new mat */
2987e7931f94SStefano Zampini   *mat_n = new_mat;
2988e7931f94SStefano Zampini   PetscFunctionReturn(0);
2989e7931f94SStefano Zampini }
2990a57a6d2fSStefano Zampini 
2991c8587f34SStefano Zampini #undef __FUNCT__
2992c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
2993c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
2994c8587f34SStefano Zampini {
2995c8587f34SStefano Zampini   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
2996c8587f34SStefano Zampini   PC_IS                  *pcis = (PC_IS*)pc->data;
299720a2ab83SStefano Zampini   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
29989881197aSStefano Zampini   MatNullSpace           CoarseNullSpace=NULL;
299920a2ab83SStefano Zampini   ISLocalToGlobalMapping coarse_islg;
300020a2ab83SStefano Zampini   IS                     coarse_is;
3001f9eb5b7dSStefano Zampini   PetscInt               max_it,coarse_size,*local_primal_indices=NULL;
3002f9eb5b7dSStefano Zampini   PetscInt               im_active=-1,active_procs=-1;
3003f9eb5b7dSStefano Zampini   PC                     pc_temp;
3004c8587f34SStefano Zampini   PCType                 coarse_pc_type;
3005c8587f34SStefano Zampini   KSPType                coarse_ksp_type;
3006f9eb5b7dSStefano Zampini   PetscBool              multilevel_requested,multilevel_allowed;
3007f9eb5b7dSStefano Zampini   PetscBool              setsym,issym,isbddc,isnn;
3008f9eb5b7dSStefano Zampini   MatStructure           matstruct;
30099881197aSStefano Zampini   PetscErrorCode         ierr;
3010fdc09c96SStefano Zampini 
3011c8587f34SStefano Zampini   PetscFunctionBegin;
3012c8587f34SStefano Zampini   /* Assign global numbering to coarse dofs */
3013f34684f1SStefano Zampini   ierr = PCBDDCComputePrimalNumbering(pc,&coarse_size,&local_primal_indices);CHKERRQ(ierr);
3014c8587f34SStefano Zampini 
3015f9eb5b7dSStefano Zampini   /* infer some info from user */
3016f9eb5b7dSStefano Zampini   issym = PETSC_FALSE;
3017f9eb5b7dSStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
3018f9eb5b7dSStefano Zampini   multilevel_allowed = PETSC_FALSE;
3019f9eb5b7dSStefano Zampini   multilevel_requested = PETSC_FALSE;
3020f9eb5b7dSStefano Zampini   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
3021f9eb5b7dSStefano Zampini   if (multilevel_requested) {
30222b510759SStefano Zampini     /* count "active processes" */
30232b510759SStefano Zampini     im_active = !!(pcis->n);
30242b510759SStefano Zampini     ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
30252b510759SStefano Zampini     if (active_procs/pcbddc->coarsening_ratio < 2) {
3026f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_FALSE;
30272b510759SStefano Zampini     } else {
3028f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_TRUE;
3029c8587f34SStefano Zampini     }
3030c8587f34SStefano Zampini   }
3031e7931f94SStefano Zampini 
3032f9eb5b7dSStefano Zampini   /* set defaults for coarse KSP and PC */
3033f9eb5b7dSStefano Zampini   if (multilevel_allowed) {
3034c8587f34SStefano Zampini     if (issym) {
3035f9eb5b7dSStefano Zampini       coarse_ksp_type = KSPRICHARDSON;
3036f9eb5b7dSStefano Zampini     } else {
3037f9eb5b7dSStefano Zampini       coarse_ksp_type = KSPCHEBYSHEV;
3038c8587f34SStefano Zampini     }
3039f9eb5b7dSStefano Zampini     coarse_pc_type = PCBDDC;
3040f9eb5b7dSStefano Zampini   } else {
3041f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPPREONLY;
3042f9eb5b7dSStefano Zampini     coarse_pc_type = PCREDUNDANT;
3043c8587f34SStefano Zampini   }
3044c8587f34SStefano Zampini 
3045f9eb5b7dSStefano Zampini   /* create the coarse KSP object only once with defaults */
3046f9eb5b7dSStefano Zampini   if (!pcbddc->coarse_ksp) {
3047e604994aSStefano Zampini     char prefix[256],str_level[3];
3048e604994aSStefano Zampini     size_t len;
3049f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_ksp);CHKERRQ(ierr);
3050c8587f34SStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
3051f9eb5b7dSStefano Zampini     ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
3052c8587f34SStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
3053c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3054c8587f34SStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
3055e604994aSStefano Zampini     /* prefix */
3056e604994aSStefano Zampini     ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
3057e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
3058e604994aSStefano Zampini     if (!pcbddc->current_level) {
3059e604994aSStefano Zampini       ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
3060e604994aSStefano Zampini       ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
3061c8587f34SStefano Zampini     } else {
3062e604994aSStefano Zampini       ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
3063e604994aSStefano Zampini       if (pcbddc->current_level>1) len -= 2;
3064e604994aSStefano Zampini       ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
3065e604994aSStefano Zampini       *(prefix+len)='\0';
3066e604994aSStefano Zampini       sprintf(str_level,"%d_",(int)(pcbddc->current_level));
3067e604994aSStefano Zampini       ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
3068e604994aSStefano Zampini     }
3069e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
3070f9eb5b7dSStefano Zampini   }
3071f9eb5b7dSStefano Zampini   /* allow user customization */
307285c4d303SStefano 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); */
3073f9eb5b7dSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
307485c4d303SStefano 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); */
3075f9eb5b7dSStefano Zampini 
3076f9eb5b7dSStefano Zampini   /* get some info after set from options */
3077f9eb5b7dSStefano Zampini   ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3078f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
3079f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
3080f9eb5b7dSStefano Zampini   if (isbddc && !multilevel_allowed) { /* prevent from infinite loop if user as requested bddc pc for coarse solver */
3081f9eb5b7dSStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
3082f9eb5b7dSStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
3083f9eb5b7dSStefano Zampini     isbddc = PETSC_FALSE;
3084f9eb5b7dSStefano Zampini   }
3085f9eb5b7dSStefano Zampini 
3086f9eb5b7dSStefano Zampini   /* propagate BDDC info to the next level */
3087f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
3088f9eb5b7dSStefano Zampini   ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
3089f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
3090f9eb5b7dSStefano Zampini 
3091f9eb5b7dSStefano Zampini   /* creates temporary MATIS object for coarse matrix */
3092a57a6d2fSStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,local_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
3093a57a6d2fSStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
3094a57a6d2fSStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
3095a57a6d2fSStefano Zampini   ierr = MatCreateIS(PetscObjectComm((PetscObject)pc),1,PETSC_DECIDE,PETSC_DECIDE,coarse_size,coarse_size,coarse_islg,&coarse_mat_is);CHKERRQ(ierr);
3096a57a6d2fSStefano Zampini   ierr = MatISSetLocalMat(coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
3097e7931f94SStefano Zampini   ierr = MatAssemblyBegin(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3098e7931f94SStefano Zampini   ierr = MatAssemblyEnd(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
309920a2ab83SStefano Zampini   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
310020a2ab83SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
310120a2ab83SStefano Zampini   ierr = PetscFree(local_primal_indices);CHKERRQ(ierr);
3102fdc09c96SStefano Zampini 
3103f9eb5b7dSStefano Zampini   /* assemble coarse matrix */
3104f9eb5b7dSStefano Zampini   if (isbddc || isnn) {
3105f9eb5b7dSStefano Zampini     ierr = MatISSubassemble(coarse_mat_is,NULL,pcbddc->coarsening_ratio,&coarse_mat);CHKERRQ(ierr);
3106f9eb5b7dSStefano Zampini   } else {
31072b510759SStefano Zampini     ierr = MatConvert_IS_AIJ(coarse_mat_is,MATAIJ,MAT_INITIAL_MATRIX,&coarse_mat);CHKERRQ(ierr);
3108c8587f34SStefano Zampini   }
31092b510759SStefano Zampini   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
31109881197aSStefano Zampini 
3111f9eb5b7dSStefano Zampini   /* create local to global scatters for coarse problem */
3112f9eb5b7dSStefano Zampini   ierr = MatGetVecs(coarse_mat,&pcbddc->coarse_vec,&pcbddc->coarse_rhs);CHKERRQ(ierr);
3113f9eb5b7dSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3114f9eb5b7dSStefano Zampini   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
3115f9eb5b7dSStefano Zampini 
3116f9eb5b7dSStefano Zampini   /* propagate symmetry info to coarse matrix */
3117f9eb5b7dSStefano Zampini   ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,issym);CHKERRQ(ierr);
3118f9eb5b7dSStefano Zampini 
3119b8ffe317SStefano Zampini   /* Compute coarse null space (special handling by BDDC only) */
3120b8ffe317SStefano Zampini   if (pcbddc->NullSpace) {
3121b8ffe317SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCoarse(pc,coarse_mat,&CoarseNullSpace);CHKERRQ(ierr);
3122b8ffe317SStefano Zampini     if (isbddc) {
3123b8ffe317SStefano Zampini       ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
3124b8ffe317SStefano Zampini     } else {
3125c8587f34SStefano Zampini       ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
3126c8587f34SStefano Zampini     }
3127c8587f34SStefano Zampini   }
3128c8587f34SStefano Zampini 
3129f9eb5b7dSStefano Zampini   /* set operators */
3130f9eb5b7dSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
3131f9eb5b7dSStefano Zampini   ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat,matstruct);CHKERRQ(ierr);
3132f9eb5b7dSStefano Zampini 
3133f9eb5b7dSStefano Zampini   /* additional KSP customization */
3134f9eb5b7dSStefano Zampini   ierr = KSPGetTolerances(pcbddc->coarse_ksp,NULL,NULL,NULL,&max_it);CHKERRQ(ierr);
3135f9eb5b7dSStefano Zampini   if (max_it < 5) {
3136c8587f34SStefano Zampini     ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
3137f9eb5b7dSStefano Zampini   }
3138b8ffe317SStefano Zampini   /* ierr = KSPChebyshevSetEstimateEigenvalues(pcbddc->coarse_ksp,1.0,0.0,0.0,1.1);CHKERRQ(ierr); */
3139f9eb5b7dSStefano Zampini 
3140f9eb5b7dSStefano Zampini 
3141f9eb5b7dSStefano Zampini   /* print some info if requested */
3142f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
3143f9eb5b7dSStefano Zampini     ierr = KSPGetType(pcbddc->coarse_ksp,&coarse_ksp_type);CHKERRQ(ierr);
3144f9eb5b7dSStefano Zampini     ierr = PCGetType(pc_temp,&coarse_pc_type);CHKERRQ(ierr);
3145f9eb5b7dSStefano Zampini     if (!multilevel_allowed) {
3146f9eb5b7dSStefano Zampini       if (multilevel_requested) {
3147f9eb5b7dSStefano 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);
3148f9eb5b7dSStefano Zampini       } else if (pcbddc->max_levels) {
3149f9eb5b7dSStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
3150c8587f34SStefano Zampini       }
3151c8587f34SStefano Zampini     }
3152e604994aSStefano 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);
3153f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3154c8587f34SStefano Zampini   }
3155f9eb5b7dSStefano Zampini 
3156f9eb5b7dSStefano Zampini   /* setup coarse ksp */
3157f9eb5b7dSStefano Zampini   ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
3158f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
3159f9eb5b7dSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
3160f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3161f9eb5b7dSStefano Zampini     ierr = KSPView(pcbddc->coarse_ksp,pcbddc->dbg_viewer);CHKERRQ(ierr);
3162f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3163f9eb5b7dSStefano Zampini   }
3164f9eb5b7dSStefano Zampini 
3165c8587f34SStefano Zampini   /* Check coarse problem if requested */
316620a2ab83SStefano Zampini   if (pcbddc->dbg_flag) {
3167c8587f34SStefano Zampini     KSP       check_ksp;
31682b510759SStefano Zampini     KSPType   check_ksp_type;
3169c8587f34SStefano Zampini     PC        check_pc;
3170c8587f34SStefano Zampini     Vec       check_vec;
3171c8587f34SStefano Zampini     PetscReal abs_infty_error,infty_error,lambda_min,lambda_max;
31722b510759SStefano Zampini     PetscInt  its;
3173f9eb5b7dSStefano Zampini     PetscBool ispreonly,compute;
3174c8587f34SStefano Zampini 
31752b510759SStefano Zampini     /* Create ksp object suitable for estimation of extreme eigenvalues */
3176f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&check_ksp);CHKERRQ(ierr);
3177fdc635d7SStefano Zampini     ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
3178983f5fd7SStefano Zampini     ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,coarse_size);CHKERRQ(ierr);
31792b510759SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
31802b510759SStefano Zampini     if (ispreonly) {
31812b510759SStefano Zampini       check_ksp_type = KSPPREONLY;
3182f9eb5b7dSStefano Zampini       compute = PETSC_FALSE;
31832b510759SStefano Zampini     } else {
3184c8587f34SStefano Zampini       if (issym) check_ksp_type = KSPCG;
3185c8587f34SStefano Zampini       else check_ksp_type = KSPGMRES;
3186f9eb5b7dSStefano Zampini       compute = PETSC_TRUE;
3187c8587f34SStefano Zampini     }
3188c8587f34SStefano Zampini     ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
3189f9eb5b7dSStefano Zampini     ierr = KSPSetComputeSingularValues(check_ksp,compute);CHKERRQ(ierr);
3190c8587f34SStefano Zampini     ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
3191c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
3192c8587f34SStefano Zampini     ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
3193c8587f34SStefano Zampini     /* create random vec */
3194c8587f34SStefano Zampini     ierr = VecDuplicate(pcbddc->coarse_vec,&check_vec);CHKERRQ(ierr);
3195c8587f34SStefano Zampini     ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
3196c8587f34SStefano Zampini     if (CoarseNullSpace) {
3197c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec);CHKERRQ(ierr);
3198c8587f34SStefano Zampini     }
3199fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3200c8587f34SStefano Zampini     /* solve coarse problem */
3201c8587f34SStefano Zampini     ierr = KSPSolve(check_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
3202c8587f34SStefano Zampini     if (CoarseNullSpace) {
3203c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,pcbddc->coarse_vec);CHKERRQ(ierr);
3204c8587f34SStefano Zampini     }
3205c8587f34SStefano Zampini     /* check coarse problem residual error */
3206c8587f34SStefano Zampini     ierr = VecAXPY(check_vec,-1.0,pcbddc->coarse_vec);CHKERRQ(ierr);
3207c8587f34SStefano Zampini     ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3208fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3209c8587f34SStefano Zampini     ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
3210c8587f34SStefano Zampini     ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
3211e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem (%s) details\n",((PetscObject)(pcbddc->coarse_ksp))->prefix);CHKERRQ(ierr);
3212e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
3213e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
3214f9eb5b7dSStefano Zampini     /* get eigenvalue estimation if preonly has not been requested */
32152b510759SStefano Zampini     if (!ispreonly) {
3216c8587f34SStefano Zampini       ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
321720a2ab83SStefano Zampini       ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
3218f9eb5b7dSStefano 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);
3219c8587f34SStefano Zampini     }
32202b510759SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3221c8587f34SStefano Zampini     ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
3222c8587f34SStefano Zampini   }
32232b510759SStefano Zampini   /* free memory */
3224c8587f34SStefano Zampini   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
3225fdc635d7SStefano Zampini   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
3226c8587f34SStefano Zampini   PetscFunctionReturn(0);
3227c8587f34SStefano Zampini }
3228674ae819SStefano Zampini 
3229f34684f1SStefano Zampini #undef __FUNCT__
3230f34684f1SStefano Zampini #define __FUNCT__ "PCBDDCComputePrimalNumbering"
3231f34684f1SStefano Zampini PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
3232f34684f1SStefano Zampini {
3233f34684f1SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3234f34684f1SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
3235f34684f1SStefano Zampini   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
3236f34684f1SStefano Zampini   PetscInt       i,j,coarse_size;
3237f34684f1SStefano Zampini   PetscInt       *local_primal_indices,*auxlocal_primal,*aux_idx;
3238f34684f1SStefano Zampini   PetscErrorCode ierr;
3239f34684f1SStefano Zampini 
3240f34684f1SStefano Zampini   PetscFunctionBegin;
3241f34684f1SStefano Zampini   /* get indices in local ordering for vertices and constraints */
3242f34684f1SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&auxlocal_primal);CHKERRQ(ierr);
3243f34684f1SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&i,&aux_idx);CHKERRQ(ierr);
3244f34684f1SStefano Zampini   ierr = PetscMemcpy(auxlocal_primal,aux_idx,i*sizeof(PetscInt));CHKERRQ(ierr);
3245f34684f1SStefano Zampini   ierr = PetscFree(aux_idx);CHKERRQ(ierr);
3246f34684f1SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&j,&aux_idx);CHKERRQ(ierr);
3247f34684f1SStefano Zampini   ierr = PetscMemcpy(&auxlocal_primal[i],aux_idx,j*sizeof(PetscInt));CHKERRQ(ierr);
3248f34684f1SStefano Zampini   ierr = PetscFree(aux_idx);CHKERRQ(ierr);
3249f34684f1SStefano Zampini 
3250f34684f1SStefano Zampini   /* Compute global number of coarse dofs */
3251f34684f1SStefano Zampini   ierr = PCBDDCSubsetNumbering(PetscObjectComm((PetscObject)(pc->pmat)),matis->mapping,pcbddc->local_primal_size,auxlocal_primal,NULL,&coarse_size,&local_primal_indices);CHKERRQ(ierr);
3252f34684f1SStefano Zampini 
3253f34684f1SStefano Zampini   /* check numbering */
3254f34684f1SStefano Zampini   if (pcbddc->dbg_flag) {
3255f34684f1SStefano Zampini     PetscScalar coarsesum,*array;
3256f34684f1SStefano Zampini 
3257f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3258f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3259f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
3260f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
3261f34684f1SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
3262f34684f1SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,auxlocal_primal[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
3263f34684f1SStefano Zampini     }
3264f34684f1SStefano Zampini     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
3265f34684f1SStefano Zampini     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
3266f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3267f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3268f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3269f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3270f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3271f34684f1SStefano Zampini     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3272f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3273f34684f1SStefano Zampini       if (array[i] == 1.0) {
3274f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %d owned by a single process!\n",PetscGlobalRank,i);CHKERRQ(ierr);
3275f34684f1SStefano Zampini       }
3276f34684f1SStefano Zampini     }
3277f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3278f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3279f34684f1SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
3280f34684f1SStefano Zampini     }
3281f34684f1SStefano Zampini     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3282f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3283f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3284f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3285f34684f1SStefano Zampini     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
3286f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
3287f34684f1SStefano Zampini     if (pcbddc->dbg_flag > 1) {
3288f34684f1SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
3289f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3290f34684f1SStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
3291f34684f1SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
329245a1bb75SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_primal_indices[%d]=%d (%d)\n",i,local_primal_indices[i],auxlocal_primal[i]);
3293f34684f1SStefano Zampini       }
3294f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3295f34684f1SStefano Zampini     }
3296f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3297f34684f1SStefano Zampini   }
3298f34684f1SStefano Zampini   ierr = PetscFree(auxlocal_primal);CHKERRQ(ierr);
3299f34684f1SStefano Zampini   /* get back data */
3300f34684f1SStefano Zampini   *coarse_size_n = coarse_size;
3301f34684f1SStefano Zampini   *local_primal_indices_n = local_primal_indices;
3302674ae819SStefano Zampini   PetscFunctionReturn(0);
3303674ae819SStefano Zampini }
3304674ae819SStefano Zampini 
3305