xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 9881197aa671a785a78c2af771fc6e38049d9b71)
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   */
358629588bSStefano Zampini   ierr = PCBDDCSetUpCoarseLocal(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__
46a401a8b6SStefano Zampini #define __FUNCT__ "PCBDDCSetLevel"
47a401a8b6SStefano Zampini PetscErrorCode PCBDDCSetLevel(PC pc,PetscInt level)
48a401a8b6SStefano Zampini {
49a401a8b6SStefano Zampini   PC_BDDC  *pcbddc = (PC_BDDC*)pc->data;
50a401a8b6SStefano Zampini 
51a401a8b6SStefano Zampini   PetscFunctionBegin;
52a401a8b6SStefano Zampini   pcbddc->current_level=level;
53a401a8b6SStefano Zampini   PetscFunctionReturn(0);
54a401a8b6SStefano Zampini }
55a401a8b6SStefano Zampini 
56a401a8b6SStefano Zampini #undef __FUNCT__
57674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetCustomization"
58674ae819SStefano Zampini PetscErrorCode PCBDDCResetCustomization(PC pc)
59674ae819SStefano Zampini {
60674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
61674ae819SStefano Zampini   PetscInt       i;
62674ae819SStefano Zampini   PetscErrorCode ierr;
63674ae819SStefano Zampini 
64674ae819SStefano Zampini   PetscFunctionBegin;
65674ae819SStefano Zampini   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
66674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
67674ae819SStefano Zampini   ierr = MatNullSpaceDestroy(&pcbddc->NullSpace);CHKERRQ(ierr);
68674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
69674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
70674ae819SStefano Zampini   for (i=0;i<pcbddc->n_ISForDofs;i++) {
71674ae819SStefano Zampini     ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
72674ae819SStefano Zampini   }
73674ae819SStefano Zampini   ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
74674ae819SStefano Zampini   PetscFunctionReturn(0);
75674ae819SStefano Zampini }
76674ae819SStefano Zampini 
77674ae819SStefano Zampini #undef __FUNCT__
78674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetTopography"
79674ae819SStefano Zampini PetscErrorCode PCBDDCResetTopography(PC pc)
80674ae819SStefano Zampini {
81674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
82674ae819SStefano Zampini   PetscErrorCode ierr;
83674ae819SStefano Zampini 
84674ae819SStefano Zampini   PetscFunctionBegin;
85674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
86674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
87674ae819SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
88674ae819SStefano Zampini   PetscFunctionReturn(0);
89674ae819SStefano Zampini }
90674ae819SStefano Zampini 
91674ae819SStefano Zampini #undef __FUNCT__
92674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetSolvers"
93674ae819SStefano Zampini PetscErrorCode PCBDDCResetSolvers(PC pc)
94674ae819SStefano Zampini {
95674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
96674ae819SStefano Zampini   PetscErrorCode ierr;
97674ae819SStefano Zampini 
98674ae819SStefano Zampini   PetscFunctionBegin;
99674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
100674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_rhs);CHKERRQ(ierr);
101674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
102674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
10315aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
10415aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
105674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
106674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
107674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
108674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
109674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
110674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
111674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec4_D);CHKERRQ(ierr);
1128ce42a96SStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
113674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
114674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
115674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
116674ae819SStefano Zampini   PetscFunctionReturn(0);
117674ae819SStefano Zampini }
118674ae819SStefano Zampini 
119674ae819SStefano Zampini #undef __FUNCT__
1206bfb1811SStefano Zampini #define __FUNCT__ "PCBDDCCreateWorkVectors"
1216bfb1811SStefano Zampini PetscErrorCode PCBDDCCreateWorkVectors(PC pc)
1226bfb1811SStefano Zampini {
1236bfb1811SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1246bfb1811SStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
1256bfb1811SStefano Zampini   VecType        impVecType;
1266bfb1811SStefano Zampini   PetscInt       n_vertices,n_constraints,local_primal_size,n_R;
1276bfb1811SStefano Zampini   PetscErrorCode ierr;
1286bfb1811SStefano Zampini 
1296bfb1811SStefano Zampini   PetscFunctionBegin;
1306bfb1811SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,NULL);CHKERRQ(ierr);
1316bfb1811SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&n_constraints,NULL);CHKERRQ(ierr);
1326bfb1811SStefano Zampini   local_primal_size = n_constraints+n_vertices;
1336bfb1811SStefano Zampini   n_R = pcis->n-n_vertices;
1346bfb1811SStefano Zampini   /* local work vectors */
1356bfb1811SStefano Zampini   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
1366bfb1811SStefano Zampini   ierr = VecDuplicate(pcis->vec1_D,&pcbddc->vec4_D);CHKERRQ(ierr);
1376bfb1811SStefano Zampini   ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
1386bfb1811SStefano Zampini   ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
1396bfb1811SStefano Zampini   ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
1406bfb1811SStefano Zampini   ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
14183b7ccabSStefano Zampini   ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
1426bfb1811SStefano Zampini   ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,local_primal_size);CHKERRQ(ierr);
1436bfb1811SStefano Zampini   ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
14483b7ccabSStefano Zampini   if (n_constraints) {
14583b7ccabSStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
14683b7ccabSStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
14783b7ccabSStefano Zampini     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
14883b7ccabSStefano Zampini   }
1496bfb1811SStefano Zampini   PetscFunctionReturn(0);
1506bfb1811SStefano Zampini }
1516bfb1811SStefano Zampini 
1526bfb1811SStefano Zampini #undef __FUNCT__
1534a78082cSStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseLocal"
1548629588bSStefano Zampini PetscErrorCode PCBDDCSetUpCoarseLocal(PC pc, PetscScalar **coarse_submat_vals_n)
15588ebb749SStefano Zampini {
15625084f0cSStefano Zampini   PetscErrorCode         ierr;
15725084f0cSStefano Zampini   /* pointers to pcis and pcbddc */
15888ebb749SStefano Zampini   PC_IS*                 pcis = (PC_IS*)pc->data;
15988ebb749SStefano Zampini   PC_BDDC*               pcbddc = (PC_BDDC*)pc->data;
16025084f0cSStefano Zampini   /* submatrices of local problem */
16188ebb749SStefano Zampini   Mat                    A_RV,A_VR,A_VV;
16225084f0cSStefano Zampini   /* working matrices */
16325084f0cSStefano Zampini   Mat                    M1,M2,M3,C_CR;
16425084f0cSStefano Zampini   /* working vectors */
16525084f0cSStefano Zampini   Vec                    vec1_C,vec2_C,vec1_V,vec2_V;
16625084f0cSStefano Zampini   /* additional working stuff */
16725084f0cSStefano Zampini   IS                     is_aux;
16888ebb749SStefano Zampini   ISLocalToGlobalMapping BtoNmap;
16925084f0cSStefano Zampini   PetscScalar            *coarse_submat_vals; /* TODO: use a PETSc matrix */
17025084f0cSStefano Zampini   const PetscScalar      *array,*row_cmat_values;
17125084f0cSStefano Zampini   const PetscInt         *row_cmat_indices,*idx_R_local;
17225084f0cSStefano Zampini   PetscInt               *vertices,*idx_V_B,*auxindices;
17325084f0cSStefano Zampini   PetscInt               n_vertices,n_constraints,size_of_constraint;
17425084f0cSStefano Zampini   PetscInt               i,j,n_R,n_D,n_B;
17588ebb749SStefano Zampini   PetscBool              setsym=PETSC_FALSE,issym=PETSC_FALSE;
17625084f0cSStefano Zampini   /* Vector and matrix types */
17788ebb749SStefano Zampini   VecType                impVecType;
17888ebb749SStefano Zampini   MatType                impMatType;
17925084f0cSStefano Zampini   /* some shortcuts to scalars */
18025084f0cSStefano Zampini   PetscScalar            zero=0.0,one=1.0,m_one=-1.0;
18125084f0cSStefano Zampini   /* for debugging purposes */
18288ebb749SStefano Zampini   PetscReal              *coarsefunctions_errors,*constraints_errors;
18388ebb749SStefano Zampini 
18488ebb749SStefano Zampini   PetscFunctionBegin;
18525084f0cSStefano Zampini   /* get number of vertices and their local indices */
18625084f0cSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
18788ebb749SStefano Zampini   n_constraints = pcbddc->local_primal_size-n_vertices;
18888ebb749SStefano Zampini   /* Set Non-overlapping dimensions */
18988ebb749SStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
19088ebb749SStefano Zampini   n_R = pcis->n-n_vertices;
19188ebb749SStefano Zampini 
19288ebb749SStefano Zampini   /* Set types for local objects needed by BDDC precondtioner */
19388ebb749SStefano Zampini   impMatType = MATSEQDENSE;
19425084f0cSStefano Zampini   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
19588ebb749SStefano Zampini 
19688ebb749SStefano Zampini   /* Allocating some extra storage just to be safe */
19788ebb749SStefano Zampini   ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&auxindices);CHKERRQ(ierr);
19888ebb749SStefano Zampini   for (i=0;i<pcis->n;i++) auxindices[i]=i;
19988ebb749SStefano Zampini 
20088ebb749SStefano Zampini   /* vertices in boundary numbering */
20188ebb749SStefano Zampini   ierr = PetscMalloc(n_vertices*sizeof(PetscInt),&idx_V_B);CHKERRQ(ierr);
20288ebb749SStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(pcis->is_B_local,&BtoNmap);CHKERRQ(ierr);
20388ebb749SStefano Zampini   ierr = ISGlobalToLocalMappingApply(BtoNmap,IS_GTOLM_DROP,n_vertices,vertices,&i,idx_V_B);CHKERRQ(ierr);
20488ebb749SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&BtoNmap);CHKERRQ(ierr);
20588ebb749SStefano Zampini   if (i != n_vertices) {
20688ebb749SStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %d != %d\n",n_vertices,i);
20788ebb749SStefano Zampini   }
20888ebb749SStefano Zampini 
20988ebb749SStefano Zampini   /* some work vectors on vertices and/or constraints */
21088ebb749SStefano Zampini   if (n_vertices) {
21188ebb749SStefano Zampini     ierr = VecCreate(PETSC_COMM_SELF,&vec1_V);CHKERRQ(ierr);
21288ebb749SStefano Zampini     ierr = VecSetSizes(vec1_V,n_vertices,n_vertices);CHKERRQ(ierr);
21388ebb749SStefano Zampini     ierr = VecSetType(vec1_V,impVecType);CHKERRQ(ierr);
21488ebb749SStefano Zampini     ierr = VecDuplicate(vec1_V,&vec2_V);CHKERRQ(ierr);
21588ebb749SStefano Zampini   }
21688ebb749SStefano Zampini   if (n_constraints) {
21788ebb749SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec1_C);CHKERRQ(ierr);
21888ebb749SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec2_C);CHKERRQ(ierr);
21988ebb749SStefano Zampini   }
22025084f0cSStefano Zampini 
22188ebb749SStefano Zampini   /* Precompute stuffs needed for preprocessing and application of BDDC*/
22288ebb749SStefano Zampini   if (n_constraints) {
22388ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->local_auxmat2);CHKERRQ(ierr);
22425084f0cSStefano Zampini     ierr = MatSetSizes(pcbddc->local_auxmat2,n_R,n_constraints,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
22588ebb749SStefano Zampini     ierr = MatSetType(pcbddc->local_auxmat2,impMatType);CHKERRQ(ierr);
22625084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->local_auxmat2);CHKERRQ(ierr);
22788ebb749SStefano Zampini 
22825084f0cSStefano Zampini     /* Extract constraints on R nodes: C_{CR}  */
22925084f0cSStefano Zampini     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
2308ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
23125084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
23288ebb749SStefano Zampini 
23388ebb749SStefano Zampini     /* Assemble local_auxmat2 = - A_{RR}^{-1} C^T_{CR} needed by BDDC application */
23488ebb749SStefano Zampini     for (i=0;i<n_constraints;i++) {
23588ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
23688ebb749SStefano Zampini       /* Get row of constraint matrix in R numbering */
23725084f0cSStefano Zampini       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
23825084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_R,size_of_constraint,row_cmat_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
23925084f0cSStefano Zampini       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
24025084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_R);CHKERRQ(ierr);
24125084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_R);CHKERRQ(ierr);
24288ebb749SStefano Zampini       /* Solve for row of constraint matrix in R numbering */
24388ebb749SStefano Zampini       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
24425084f0cSStefano Zampini       /* Set values in local_auxmat2 */
24525084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
24688ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->local_auxmat2,n_R,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
24725084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
24888ebb749SStefano Zampini     }
24988ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
25088ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
25125084f0cSStefano Zampini     ierr = MatScale(pcbddc->local_auxmat2,m_one);CHKERRQ(ierr);
25288ebb749SStefano Zampini 
25388ebb749SStefano Zampini     /* Assemble explicitly M1 = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1} needed in preproc  */
25425084f0cSStefano Zampini     ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
25525084f0cSStefano Zampini     ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
25688ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&M1);CHKERRQ(ierr);
25788ebb749SStefano Zampini     ierr = MatSetSizes(M1,n_constraints,n_constraints,n_constraints,n_constraints);CHKERRQ(ierr);
25888ebb749SStefano Zampini     ierr = MatSetType(M1,impMatType);CHKERRQ(ierr);
25925084f0cSStefano Zampini     ierr = MatSetUp(M1);CHKERRQ(ierr);
26025084f0cSStefano Zampini     ierr = MatDuplicate(M1,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
26125084f0cSStefano Zampini     ierr = MatZeroEntries(M2);CHKERRQ(ierr);
26225084f0cSStefano Zampini     ierr = VecSet(vec1_C,m_one);CHKERRQ(ierr);
26325084f0cSStefano Zampini     ierr = MatDiagonalSet(M2,vec1_C,INSERT_VALUES);CHKERRQ(ierr);
26425084f0cSStefano Zampini     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
26525084f0cSStefano Zampini     ierr = MatDestroy(&M2);CHKERRQ(ierr);
26625084f0cSStefano Zampini     ierr = MatDestroy(&M3);CHKERRQ(ierr);
26788ebb749SStefano Zampini     /* Assemble local_auxmat1 = M1*C_{CR} needed by BDDC application in KSP and in preproc */
26888ebb749SStefano Zampini     ierr = MatMatMult(M1,C_CR,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
26988ebb749SStefano Zampini   }
27088ebb749SStefano Zampini 
27188ebb749SStefano Zampini   /* Get submatrices from subdomain matrix */
27288ebb749SStefano Zampini   if (n_vertices) {
27325084f0cSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,n_vertices,vertices,PETSC_COPY_VALUES,&is_aux);CHKERRQ(ierr);
2748ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
2758ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
27625084f0cSStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
27725084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
27888ebb749SStefano Zampini   }
27988ebb749SStefano Zampini 
28088ebb749SStefano Zampini   /* Matrix of coarse basis functions (local) */
28188ebb749SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
28288ebb749SStefano Zampini   ierr = MatSetSizes(pcbddc->coarse_phi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
28388ebb749SStefano Zampini   ierr = MatSetType(pcbddc->coarse_phi_B,impMatType);CHKERRQ(ierr);
28425084f0cSStefano Zampini   ierr = MatSetUp(pcbddc->coarse_phi_B);CHKERRQ(ierr);
2858eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
28688ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
28788ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_phi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
28888ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_phi_D,impMatType);CHKERRQ(ierr);
28925084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_phi_D);CHKERRQ(ierr);
29088ebb749SStefano Zampini   }
29188ebb749SStefano Zampini 
29225084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
2938ce42a96SStefano Zampini     ierr = ISGetIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
29488ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*coarsefunctions_errors),&coarsefunctions_errors);CHKERRQ(ierr);
29588ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*constraints_errors),&constraints_errors);CHKERRQ(ierr);
29688ebb749SStefano Zampini   }
29788ebb749SStefano Zampini   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
29888ebb749SStefano Zampini   ierr = PetscMalloc((pcbddc->local_primal_size)*(pcbddc->local_primal_size)*sizeof(PetscScalar),&coarse_submat_vals);CHKERRQ(ierr);
29988ebb749SStefano Zampini 
30088ebb749SStefano Zampini   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
30125084f0cSStefano Zampini 
30225084f0cSStefano Zampini   /* vertices */
30388ebb749SStefano Zampini   for (i=0;i<n_vertices;i++) {
30488ebb749SStefano Zampini     ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
30588ebb749SStefano Zampini     ierr = VecSetValue(vec1_V,i,one,INSERT_VALUES);CHKERRQ(ierr);
30688ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
30788ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
30825084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on constraints multipliers */
30988ebb749SStefano Zampini     ierr = MatMult(A_RV,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
31088ebb749SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
31188ebb749SStefano Zampini     ierr = VecScale(pcbddc->vec1_R,m_one);CHKERRQ(ierr);
31288ebb749SStefano Zampini     if (n_constraints) {
31388ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec1_R,vec1_C);CHKERRQ(ierr);
31488ebb749SStefano Zampini       ierr = MatMultAdd(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
31588ebb749SStefano Zampini       ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
31688ebb749SStefano Zampini     }
31788ebb749SStefano Zampini     ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
31888ebb749SStefano Zampini     ierr = MatMultAdd(A_VV,vec1_V,vec2_V,vec2_V);CHKERRQ(ierr);
31988ebb749SStefano Zampini 
32088ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
32188ebb749SStefano Zampini     /* coarse basis functions */
32288ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
32388ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
32488ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
32525084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
32688ebb749SStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
32725084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
32888ebb749SStefano Zampini     ierr = MatSetValue(pcbddc->coarse_phi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
3298eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
33088ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
33188ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
33225084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
33388ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
33425084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
33588ebb749SStefano Zampini     }
33625084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
33725084f0cSStefano Zampini     ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
33825084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
33925084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
34088ebb749SStefano Zampini     if (n_constraints) {
34125084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
34225084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
34325084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
34488ebb749SStefano Zampini     }
34588ebb749SStefano Zampini 
34625084f0cSStefano Zampini     /* check */
34725084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
34825084f0cSStefano Zampini       /* assemble subdomain vector on local nodes */
34988ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
35025084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
35125084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
35225084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
35325084f0cSStefano Zampini       ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
35425084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
35525084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
35688ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers (i.e. primal nodes) */
35788ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
35825084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
35925084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
36025084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
36188ebb749SStefano Zampini       if (n_constraints) {
36225084f0cSStefano Zampini         ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
36325084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
36425084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
36588ebb749SStefano Zampini       }
36625084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
36725084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
36888ebb749SStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
36988ebb749SStefano Zampini       /* check saddle point solution */
37088ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
37188ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
37288ebb749SStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i]);CHKERRQ(ierr);
37388ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
37425084f0cSStefano Zampini       /* shift by the identity matrix */
37525084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
37625084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
37725084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
37888ebb749SStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i]);CHKERRQ(ierr);
37988ebb749SStefano Zampini     }
38088ebb749SStefano Zampini   }
38188ebb749SStefano Zampini 
38225084f0cSStefano Zampini   /* constraints */
38388ebb749SStefano Zampini   for (i=0;i<n_constraints;i++) {
38488ebb749SStefano Zampini     ierr = VecSet(vec2_C,zero);CHKERRQ(ierr);
38588ebb749SStefano Zampini     ierr = VecSetValue(vec2_C,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
38688ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec2_C);CHKERRQ(ierr);
38788ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec2_C);CHKERRQ(ierr);
38825084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on vertices multipliers */
38988ebb749SStefano Zampini     ierr = MatMult(M1,vec2_C,vec1_C);CHKERRQ(ierr);
39088ebb749SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
39188ebb749SStefano Zampini     ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
39225084f0cSStefano Zampini     if (n_vertices) {
39325084f0cSStefano Zampini       ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
39425084f0cSStefano Zampini     }
39588ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
39688ebb749SStefano Zampini     /* coarse basis functions */
39725084f0cSStefano Zampini     j = i+n_vertices; /* don't touch this! */
39888ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
39988ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40088ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40125084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
40225084f0cSStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
40325084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
4048eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
40588ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40688ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40725084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
40825084f0cSStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
40925084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
41088ebb749SStefano Zampini     }
41125084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
41288ebb749SStefano Zampini     if (n_vertices) {
41325084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
41425084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
41525084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
41688ebb749SStefano Zampini     }
41725084f0cSStefano Zampini     ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
41825084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
41925084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
42088ebb749SStefano Zampini 
42125084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
42288ebb749SStefano Zampini       /* assemble subdomain vector on nodes */
42388ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
42425084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
42525084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
42625084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
42725084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
42825084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
42988ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers */
43088ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
43188ebb749SStefano Zampini       if (n_vertices) {
43225084f0cSStefano Zampini         ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
43325084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
43425084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
43588ebb749SStefano Zampini       }
43625084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
43725084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
43825084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
43925084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
44025084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
44125084f0cSStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
44288ebb749SStefano Zampini       /* check saddle point solution */
44388ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
44488ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
44525084f0cSStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[j]);CHKERRQ(ierr);
44688ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
44725084f0cSStefano Zampini       /* shift by the identity matrix */
44825084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,j,m_one,ADD_VALUES);CHKERRQ(ierr);
44925084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
45025084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
45125084f0cSStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[j]);CHKERRQ(ierr);
45288ebb749SStefano Zampini     }
45388ebb749SStefano Zampini   }
45425084f0cSStefano Zampini   /* call assembling routines for local coarse basis */
45588ebb749SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
45688ebb749SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4578eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
45888ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
45988ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
46088ebb749SStefano Zampini   }
46125084f0cSStefano Zampini 
46288ebb749SStefano Zampini   /* compute other basis functions for non-symmetric problems */
46388ebb749SStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
46488ebb749SStefano Zampini   if (!setsym || (setsym && !issym)) {
46588ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
46688ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_psi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
46788ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_psi_B,impMatType);CHKERRQ(ierr);
46825084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_psi_B);CHKERRQ(ierr);
4698eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
47088ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
47188ebb749SStefano Zampini       ierr = MatSetSizes(pcbddc->coarse_psi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
47288ebb749SStefano Zampini       ierr = MatSetType(pcbddc->coarse_psi_D,impMatType);CHKERRQ(ierr);
47325084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->coarse_psi_D);CHKERRQ(ierr);
47488ebb749SStefano Zampini     }
47588ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
47688ebb749SStefano Zampini       if (n_constraints) {
47788ebb749SStefano Zampini         ierr = VecSet(vec1_C,zero);CHKERRQ(ierr);
47888ebb749SStefano Zampini         for (j=0;j<n_constraints;j++) {
47925084f0cSStefano Zampini           ierr = VecSetValue(vec1_C,j,coarse_submat_vals[(j+n_vertices)*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
48088ebb749SStefano Zampini         }
48125084f0cSStefano Zampini         ierr = VecAssemblyBegin(vec1_C);CHKERRQ(ierr);
48225084f0cSStefano Zampini         ierr = VecAssemblyEnd(vec1_C);CHKERRQ(ierr);
48388ebb749SStefano Zampini       }
48488ebb749SStefano Zampini       if (i<n_vertices) {
48588ebb749SStefano Zampini         ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
48688ebb749SStefano Zampini         ierr = VecSetValue(vec1_V,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
48788ebb749SStefano Zampini         ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
48888ebb749SStefano Zampini         ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
48988ebb749SStefano Zampini         ierr = MatMultTranspose(A_VR,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
49088ebb749SStefano Zampini         if (n_constraints) {
49188ebb749SStefano Zampini           ierr = MatMultTransposeAdd(C_CR,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
49288ebb749SStefano Zampini         }
49388ebb749SStefano Zampini       } else {
49488ebb749SStefano Zampini         ierr = MatMultTranspose(C_CR,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
49588ebb749SStefano Zampini       }
49688ebb749SStefano Zampini       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
49788ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
49888ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
49988ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
50025084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
50188ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_psi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
50225084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
50388ebb749SStefano Zampini       if (i<n_vertices) {
50488ebb749SStefano Zampini         ierr = MatSetValue(pcbddc->coarse_psi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
50588ebb749SStefano Zampini       }
5068eeda7d8SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
50788ebb749SStefano Zampini         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
50888ebb749SStefano Zampini         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
50925084f0cSStefano Zampini         ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
51088ebb749SStefano Zampini         ierr = MatSetValues(pcbddc->coarse_psi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
51125084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
51288ebb749SStefano Zampini       }
51388ebb749SStefano Zampini 
51425084f0cSStefano Zampini       if (pcbddc->dbg_flag) {
51588ebb749SStefano Zampini         /* assemble subdomain vector on nodes */
51688ebb749SStefano Zampini         ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
51725084f0cSStefano Zampini         ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
51825084f0cSStefano Zampini         ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
51925084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
52025084f0cSStefano Zampini         if (i<n_vertices) {
52125084f0cSStefano Zampini           ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
52288ebb749SStefano Zampini         }
52325084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
52425084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
52525084f0cSStefano Zampini         /* assemble subdomain vector of lagrange multipliers */
52625084f0cSStefano Zampini         for (j=0;j<pcbddc->local_primal_size;j++) {
52725084f0cSStefano Zampini           ierr = VecSetValue(pcbddc->vec1_P,j,-coarse_submat_vals[j*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
52825084f0cSStefano Zampini         }
52925084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
53025084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
53188ebb749SStefano Zampini         /* check saddle point solution */
53288ebb749SStefano Zampini         ierr = MatMultTranspose(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
53388ebb749SStefano Zampini         ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
53488ebb749SStefano Zampini         ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
53588ebb749SStefano Zampini         ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
53625084f0cSStefano Zampini         /* shift by the identity matrix */
53725084f0cSStefano Zampini         ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
53825084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
53925084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
54088ebb749SStefano Zampini         ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
54188ebb749SStefano Zampini       }
54288ebb749SStefano Zampini     }
54388ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
54488ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5458eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
54688ebb749SStefano Zampini       ierr = MatAssemblyBegin(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
54788ebb749SStefano Zampini       ierr = MatAssemblyEnd(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
54888ebb749SStefano Zampini     }
54988ebb749SStefano Zampini   }
55088ebb749SStefano Zampini   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
55188ebb749SStefano Zampini   /* Checking coarse_sub_mat and coarse basis functios */
55288ebb749SStefano Zampini   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
55388ebb749SStefano Zampini   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
55425084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
55588ebb749SStefano Zampini     Mat         coarse_sub_mat;
55625084f0cSStefano Zampini     Mat         AUXMAT,TM1,TM2,TM3,TM4;
55788ebb749SStefano Zampini     Mat         coarse_phi_D,coarse_phi_B;
55888ebb749SStefano Zampini     Mat         coarse_psi_D,coarse_psi_B;
55988ebb749SStefano Zampini     Mat         A_II,A_BB,A_IB,A_BI;
56088ebb749SStefano Zampini     MatType     checkmattype=MATSEQAIJ;
56188ebb749SStefano Zampini     PetscReal   real_value;
56288ebb749SStefano Zampini 
56388ebb749SStefano Zampini     ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
56488ebb749SStefano Zampini     ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
56588ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
56688ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
56788ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
56888ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
56988ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
57088ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
57188ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
57288ebb749SStefano Zampini     }
57388ebb749SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
57488ebb749SStefano Zampini 
57525084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
57625084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat and local basis functions\n");CHKERRQ(ierr);
57725084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
57888ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
57988ebb749SStefano Zampini       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
58088ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
58188ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
58288ebb749SStefano Zampini       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
58388ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
58488ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
58588ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
58688ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
58788ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
58888ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
58988ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
59088ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
59188ebb749SStefano Zampini     } else {
59288ebb749SStefano Zampini       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
59388ebb749SStefano Zampini       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
59488ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
59588ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
59688ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
59788ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
59888ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
59988ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
60088ebb749SStefano Zampini     }
60188ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
60288ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
60388ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
60488ebb749SStefano Zampini     ierr = MatConvert(TM1,MATSEQDENSE,MAT_REUSE_MATRIX,&TM1);CHKERRQ(ierr);
60588ebb749SStefano Zampini     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
60688ebb749SStefano Zampini     ierr = MatNorm(TM1,NORM_INFINITY,&real_value);CHKERRQ(ierr);
60725084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"----------------------------------\n");CHKERRQ(ierr);
60825084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d \n",PetscGlobalRank);CHKERRQ(ierr);
60925084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"matrix error = % 1.14e\n",real_value);CHKERRQ(ierr);
61025084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (phi) errors\n");CHKERRQ(ierr);
61188ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
61225084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,coarsefunctions_errors[i]);CHKERRQ(ierr);
61388ebb749SStefano Zampini     }
61425084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (phi) errors\n");CHKERRQ(ierr);
61588ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
61625084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,constraints_errors[i]);CHKERRQ(ierr);
61788ebb749SStefano Zampini     }
61888ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
61925084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (psi) errors\n");CHKERRQ(ierr);
62088ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
62125084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,coarsefunctions_errors[i]);CHKERRQ(ierr);
62288ebb749SStefano Zampini       }
62325084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (psi) errors\n");CHKERRQ(ierr);
62488ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
62525084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,constraints_errors[i]);CHKERRQ(ierr);
62688ebb749SStefano Zampini       }
62788ebb749SStefano Zampini     }
62825084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
62988ebb749SStefano Zampini     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
63088ebb749SStefano Zampini     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
63188ebb749SStefano Zampini     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
63288ebb749SStefano Zampini     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
63388ebb749SStefano Zampini     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
63488ebb749SStefano Zampini     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
63588ebb749SStefano Zampini     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
63688ebb749SStefano Zampini     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
63788ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
63888ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
63988ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
64088ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
64188ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
64288ebb749SStefano Zampini     }
64388ebb749SStefano Zampini     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
6448ce42a96SStefano Zampini     ierr = ISRestoreIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
64588ebb749SStefano Zampini     ierr = PetscFree(coarsefunctions_errors);CHKERRQ(ierr);
64688ebb749SStefano Zampini     ierr = PetscFree(constraints_errors);CHKERRQ(ierr);
64788ebb749SStefano Zampini   }
64888ebb749SStefano Zampini   /* free memory */
64988ebb749SStefano Zampini   if (n_vertices) {
65088ebb749SStefano Zampini     ierr = PetscFree(vertices);CHKERRQ(ierr);
65188ebb749SStefano Zampini     ierr = VecDestroy(&vec1_V);CHKERRQ(ierr);
65288ebb749SStefano Zampini     ierr = VecDestroy(&vec2_V);CHKERRQ(ierr);
65388ebb749SStefano Zampini     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
65488ebb749SStefano Zampini     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
65588ebb749SStefano Zampini     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
65688ebb749SStefano Zampini   }
65788ebb749SStefano Zampini   if (n_constraints) {
65888ebb749SStefano Zampini     ierr = VecDestroy(&vec1_C);CHKERRQ(ierr);
65988ebb749SStefano Zampini     ierr = VecDestroy(&vec2_C);CHKERRQ(ierr);
66088ebb749SStefano Zampini     ierr = MatDestroy(&M1);CHKERRQ(ierr);
66188ebb749SStefano Zampini     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
66288ebb749SStefano Zampini   }
66388ebb749SStefano Zampini   ierr = PetscFree(auxindices);CHKERRQ(ierr);
6648629588bSStefano Zampini   /* get back data */
6658629588bSStefano Zampini   *coarse_submat_vals_n = coarse_submat_vals;
66688ebb749SStefano Zampini   PetscFunctionReturn(0);
66788ebb749SStefano Zampini }
66888ebb749SStefano Zampini 
66988ebb749SStefano Zampini #undef __FUNCT__
670aa0d41d4SStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalMatrices"
671aa0d41d4SStefano Zampini PetscErrorCode PCBDDCSetUpLocalMatrices(PC pc)
672aa0d41d4SStefano Zampini {
673aa0d41d4SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
674aa0d41d4SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
675aa0d41d4SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
676aa0d41d4SStefano Zampini   /* manage repeated solves */
677aa0d41d4SStefano Zampini   MatReuse          reuse;
678aa0d41d4SStefano Zampini   MatStructure      matstruct;
679aa0d41d4SStefano Zampini   PetscErrorCode    ierr;
680aa0d41d4SStefano Zampini 
681aa0d41d4SStefano Zampini   PetscFunctionBegin;
682aa0d41d4SStefano Zampini   /* get mat flags */
683aa0d41d4SStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
684aa0d41d4SStefano Zampini   reuse = MAT_INITIAL_MATRIX;
685aa0d41d4SStefano Zampini   if (pc->setupcalled) {
686aa0d41d4SStefano Zampini     /* when matstruct is SAME_PRECONDITIONER, we shouldn't be here */
687aa0d41d4SStefano Zampini     if (matstruct == SAME_PRECONDITIONER) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen");
688aa0d41d4SStefano Zampini     if (matstruct == SAME_NONZERO_PATTERN) {
689aa0d41d4SStefano Zampini       reuse = MAT_REUSE_MATRIX;
690aa0d41d4SStefano Zampini     } else {
691aa0d41d4SStefano Zampini       reuse = MAT_INITIAL_MATRIX;
692aa0d41d4SStefano Zampini     }
693aa0d41d4SStefano Zampini   }
694aa0d41d4SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
695aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
696aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
697aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
698aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BB);CHKERRQ(ierr);
699aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
700aa0d41d4SStefano Zampini   }
701aa0d41d4SStefano Zampini 
702aa0d41d4SStefano Zampini   /* transform local matrices if needed */
703aa0d41d4SStefano Zampini   if (pcbddc->use_change_of_basis) {
704aa0d41d4SStefano Zampini     Mat         change_mat_all;
705aa0d41d4SStefano Zampini     PetscScalar *row_cmat_values;
706aa0d41d4SStefano Zampini     PetscInt    *row_cmat_indices;
707aa0d41d4SStefano Zampini     PetscInt    *nnz,*is_indices,*temp_indices;
708aa0d41d4SStefano Zampini     PetscInt    i,j,k,n_D,n_B;
709aa0d41d4SStefano Zampini 
710aa0d41d4SStefano Zampini     /* Get Non-overlapping dimensions */
711aa0d41d4SStefano Zampini     n_B = pcis->n_B;
712aa0d41d4SStefano Zampini     n_D = pcis->n-n_B;
713aa0d41d4SStefano Zampini 
714aa0d41d4SStefano Zampini     /* compute nonzero structure of change of basis on all local nodes */
715aa0d41d4SStefano Zampini     ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
716aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
717aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) nnz[is_indices[i]] = 1;
718aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
719aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
720aa0d41d4SStefano Zampini     k=1;
721aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
722aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
723aa0d41d4SStefano Zampini       nnz[is_indices[i]]=j;
724aa0d41d4SStefano Zampini       if (k < j) k = j;
725aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
726aa0d41d4SStefano Zampini     }
727aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
728aa0d41d4SStefano Zampini     /* assemble change of basis matrix on the whole set of local dofs */
729aa0d41d4SStefano Zampini     ierr = PetscMalloc(k*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
730aa0d41d4SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&change_mat_all);CHKERRQ(ierr);
731aa0d41d4SStefano Zampini     ierr = MatSetSizes(change_mat_all,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
732aa0d41d4SStefano Zampini     ierr = MatSetType(change_mat_all,MATSEQAIJ);CHKERRQ(ierr);
733aa0d41d4SStefano Zampini     ierr = MatSeqAIJSetPreallocation(change_mat_all,0,nnz);CHKERRQ(ierr);
734aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
735aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) {
736aa0d41d4SStefano Zampini       ierr = MatSetValue(change_mat_all,is_indices[i],is_indices[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
737aa0d41d4SStefano Zampini     }
738aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
739aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
740aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
741aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
742aa0d41d4SStefano Zampini       for (k=0; k<j; k++) temp_indices[k]=is_indices[row_cmat_indices[k]];
743aa0d41d4SStefano Zampini       ierr = MatSetValues(change_mat_all,1,&is_indices[i],j,temp_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
744aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
745aa0d41d4SStefano Zampini     }
746aa0d41d4SStefano Zampini     ierr = MatAssemblyBegin(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
747aa0d41d4SStefano Zampini     ierr = MatAssemblyEnd(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
748aa0d41d4SStefano Zampini     /* TODO: HOW TO WORK WITH BAIJ? PtAP not provided */
749aa0d41d4SStefano Zampini     ierr = MatGetBlockSize(matis->A,&i);CHKERRQ(ierr);
750aa0d41d4SStefano Zampini     if (i==1) {
751aa0d41d4SStefano Zampini       ierr = MatPtAP(matis->A,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
752aa0d41d4SStefano Zampini     } else {
753aa0d41d4SStefano Zampini       Mat work_mat;
754aa0d41d4SStefano Zampini       ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
755aa0d41d4SStefano Zampini       ierr = MatPtAP(work_mat,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
756aa0d41d4SStefano Zampini       ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
757aa0d41d4SStefano Zampini     }
758aa0d41d4SStefano Zampini     ierr = MatDestroy(&change_mat_all);CHKERRQ(ierr);
759aa0d41d4SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
760aa0d41d4SStefano Zampini     ierr = PetscFree(temp_indices);CHKERRQ(ierr);
761aa0d41d4SStefano Zampini   } else {
762aa0d41d4SStefano Zampini     /* without change of basis, the local matrix is unchanged */
763aa0d41d4SStefano Zampini     if (!pcbddc->local_mat) {
764aa0d41d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)matis->A);CHKERRQ(ierr);
765aa0d41d4SStefano Zampini       pcbddc->local_mat = matis->A;
766aa0d41d4SStefano Zampini     }
767aa0d41d4SStefano Zampini   }
768aa0d41d4SStefano Zampini 
769aa0d41d4SStefano Zampini   /* get submatrices */
770aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_I_local,reuse,&pcis->A_II);CHKERRQ(ierr);
771aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
772aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
773aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_B_local,reuse,&pcis->A_BB);CHKERRQ(ierr);
774aa0d41d4SStefano Zampini   PetscFunctionReturn(0);
775aa0d41d4SStefano Zampini }
776aa0d41d4SStefano Zampini 
777aa0d41d4SStefano Zampini #undef __FUNCT__
778a64d13efSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalScatters"
7798ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
780a64d13efSStefano Zampini {
781a64d13efSStefano Zampini   PC_IS*         pcis = (PC_IS*)(pc->data);
782a64d13efSStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
7838ce42a96SStefano Zampini   IS             is_aux1,is_aux2;
784a64d13efSStefano Zampini   PetscInt       *vertices,*aux_array1,*aux_array2,*is_indices,*idx_R_local;
785a64d13efSStefano Zampini   PetscInt       n_vertices,n_constraints,i,j,n_R,n_D,n_B;
7864641a718SStefano Zampini   PetscBT        bitmask;
787a64d13efSStefano Zampini   PetscErrorCode ierr;
788a64d13efSStefano Zampini 
789a64d13efSStefano Zampini   PetscFunctionBegin;
790a64d13efSStefano Zampini   /* Set Non-overlapping dimensions */
791a64d13efSStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
792a64d13efSStefano Zampini   /* get vertex indices from constraint matrix */
793a64d13efSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
794a64d13efSStefano Zampini   /* Set number of constraints */
795a64d13efSStefano Zampini   n_constraints = pcbddc->local_primal_size-n_vertices;
7964641a718SStefano Zampini   /* create auxiliary bitmask */
7974641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
7984641a718SStefano Zampini   for (i=0;i<n_vertices;i++) {
7994641a718SStefano Zampini     ierr = PetscBTSet(bitmask,vertices[i]);CHKERRQ(ierr);
8004641a718SStefano Zampini   }
801a64d13efSStefano Zampini   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
802a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n-n_vertices)*sizeof(PetscInt),&idx_R_local);CHKERRQ(ierr);
803a64d13efSStefano Zampini   for (i=0, n_R=0; i<pcis->n; i++) {
8044641a718SStefano Zampini     if (!PetscBTLookup(bitmask,i)) {
805a64d13efSStefano Zampini       idx_R_local[n_R] = i;
806a64d13efSStefano Zampini       n_R++;
807a64d13efSStefano Zampini     }
808a64d13efSStefano Zampini   }
809a64d13efSStefano Zampini   ierr = PetscFree(vertices);CHKERRQ(ierr);
8108ce42a96SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_R,idx_R_local,PETSC_OWN_POINTER,&pcbddc->is_R_local);CHKERRQ(ierr);
811a64d13efSStefano Zampini 
812a64d13efSStefano Zampini   /* print some info if requested */
813a64d13efSStefano Zampini   if (pcbddc->dbg_flag) {
814a64d13efSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
815a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
816a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
817a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
818a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"r_size = %d, v_size = %d, constraints = %d, local_primal_size = %d\n",n_R,n_vertices,n_constraints,pcbddc->local_primal_size);CHKERRQ(ierr);
819a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr);
820a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
821a64d13efSStefano Zampini   }
822a64d13efSStefano Zampini 
823a64d13efSStefano Zampini   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
824a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
825a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array2);CHKERRQ(ierr);
826a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
8274641a718SStefano Zampini   for (i=0; i<n_D; i++) {
8284641a718SStefano Zampini     ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
8294641a718SStefano Zampini   }
830a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
831a64d13efSStefano Zampini   for (i=0, j=0; i<n_R; i++) {
8324641a718SStefano Zampini     if (!PetscBTLookup(bitmask,idx_R_local[i])) {
8334641a718SStefano Zampini       aux_array1[j++] = i;
834a64d13efSStefano Zampini     }
835a64d13efSStefano Zampini   }
836a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
837a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
838a64d13efSStefano Zampini   for (i=0, j=0; i<n_B; i++) {
8394641a718SStefano Zampini     if (!PetscBTLookup(bitmask,is_indices[i])) {
8404641a718SStefano Zampini       aux_array2[j++] = i;
841a64d13efSStefano Zampini     }
842a64d13efSStefano Zampini   }
843a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
844a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
845a64d13efSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
846a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
847a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
848a64d13efSStefano Zampini 
8498eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
850a64d13efSStefano Zampini     ierr = PetscMalloc(n_D*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
851a64d13efSStefano Zampini     for (i=0, j=0; i<n_R; i++) {
8524641a718SStefano Zampini       if (PetscBTLookup(bitmask,idx_R_local[i])) {
8534641a718SStefano Zampini         aux_array1[j++] = i;
854a64d13efSStefano Zampini       }
855a64d13efSStefano Zampini     }
856a64d13efSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
857a64d13efSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
858a64d13efSStefano Zampini     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
859a64d13efSStefano Zampini   }
8604641a718SStefano Zampini   ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
861a64d13efSStefano Zampini   PetscFunctionReturn(0);
862a64d13efSStefano Zampini }
863a64d13efSStefano Zampini 
864a64d13efSStefano Zampini #undef __FUNCT__
865304d26faSStefano Zampini #define __FUNCT__ "PCBDDCSetUseExactDirichlet"
866304d26faSStefano Zampini PetscErrorCode PCBDDCSetUseExactDirichlet(PC pc,PetscBool use)
867304d26faSStefano Zampini {
868304d26faSStefano Zampini   PC_BDDC  *pcbddc = (PC_BDDC*)pc->data;
869304d26faSStefano Zampini 
870304d26faSStefano Zampini   PetscFunctionBegin;
871304d26faSStefano Zampini   pcbddc->use_exact_dirichlet=use;
872304d26faSStefano Zampini   PetscFunctionReturn(0);
873304d26faSStefano Zampini }
874304d26faSStefano Zampini 
875304d26faSStefano Zampini #undef __FUNCT__
876304d26faSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
8778ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc)
878304d26faSStefano Zampini {
879304d26faSStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
880304d26faSStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
881304d26faSStefano Zampini   PC             pc_temp;
882304d26faSStefano Zampini   Mat            A_RR;
883304d26faSStefano Zampini   Vec            vec1,vec2,vec3;
884304d26faSStefano Zampini   MatStructure   matstruct;
885304d26faSStefano Zampini   PetscScalar    m_one = -1.0;
886304d26faSStefano Zampini   PetscReal      value;
887304d26faSStefano Zampini   PetscInt       n_D,n_R,use_exact,use_exact_reduced;
888304d26faSStefano Zampini   PetscErrorCode ierr;
889304d26faSStefano Zampini 
890304d26faSStefano Zampini   PetscFunctionBegin;
891304d26faSStefano Zampini   /* Creating PC contexts for local Dirichlet and Neumann problems */
892304d26faSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
893304d26faSStefano Zampini 
894304d26faSStefano Zampini   /* DIRICHLET PROBLEM */
895ac78edfcSStefano Zampini   /* Matrix for Dirichlet problem is pcis->A_II */
8968ce42a96SStefano Zampini   ierr = ISGetSize(pcis->is_I_local,&n_D);CHKERRQ(ierr);
897304d26faSStefano Zampini   if (!pcbddc->ksp_D) { /* create object if not yet build */
898304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
899304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
900304d26faSStefano Zampini     /* default */
901304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
902304d26faSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,"dirichlet_");CHKERRQ(ierr);
903304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
904304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
905304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
906304d26faSStefano Zampini   }
907304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II,matstruct);CHKERRQ(ierr);
908304d26faSStefano Zampini   /* Allow user's customization */
909304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
910304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
911304d26faSStefano Zampini   if (!n_D) {
912304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
913304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
914304d26faSStefano Zampini   }
915304d26faSStefano Zampini   /* Set Up KSP for Dirichlet problem of BDDC */
916304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
917304d26faSStefano Zampini   /* set ksp_D into pcis data */
918304d26faSStefano Zampini   ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
919304d26faSStefano Zampini   ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
920304d26faSStefano Zampini   pcis->ksp_D = pcbddc->ksp_D;
921304d26faSStefano Zampini 
922304d26faSStefano Zampini   /* NEUMANN PROBLEM */
923304d26faSStefano Zampini   /* Matrix for Neumann problem is A_RR -> we need to create it */
9248ce42a96SStefano Zampini   ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
9258ce42a96SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
926304d26faSStefano Zampini   if (!pcbddc->ksp_R) { /* create object if not yet build */
927304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
928304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
929304d26faSStefano Zampini     /* default */
930304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
931304d26faSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,"neumann_");CHKERRQ(ierr);
932304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
933304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
934304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
935304d26faSStefano Zampini   }
936304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR,matstruct);CHKERRQ(ierr);
937304d26faSStefano Zampini   /* Allow user's customization */
938304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
939304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
940304d26faSStefano Zampini   if (!n_R) {
941304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
942304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
943304d26faSStefano Zampini   }
944304d26faSStefano Zampini   /* Set Up KSP for Neumann problem of BDDC */
945304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
946304d26faSStefano Zampini 
947304d26faSStefano Zampini   /* check Dirichlet and Neumann solvers and adapt them if a nullspace correction is needed */
948304d26faSStefano Zampini 
949304d26faSStefano Zampini   /* Dirichlet */
950304d26faSStefano Zampini   ierr = MatGetVecs(pcis->A_II,&vec1,&vec2);CHKERRQ(ierr);
951304d26faSStefano Zampini   ierr = VecDuplicate(vec1,&vec3);CHKERRQ(ierr);
952304d26faSStefano Zampini   ierr = VecSetRandom(vec1,NULL);CHKERRQ(ierr);
953304d26faSStefano Zampini   ierr = MatMult(pcis->A_II,vec1,vec2);CHKERRQ(ierr);
954304d26faSStefano Zampini   ierr = KSPSolve(pcbddc->ksp_D,vec2,vec3);CHKERRQ(ierr);
955304d26faSStefano Zampini   ierr = VecAXPY(vec3,m_one,vec1);CHKERRQ(ierr);
956304d26faSStefano Zampini   ierr = VecNorm(vec3,NORM_INFINITY,&value);CHKERRQ(ierr);
957304d26faSStefano Zampini   ierr = VecDestroy(&vec1);CHKERRQ(ierr);
958304d26faSStefano Zampini   ierr = VecDestroy(&vec2);CHKERRQ(ierr);
959304d26faSStefano Zampini   ierr = VecDestroy(&vec3);CHKERRQ(ierr);
960304d26faSStefano Zampini   /* need to be adapted? */
961304d26faSStefano Zampini   use_exact = (PetscAbsReal(value) > 1.e-4 ? 0 : 1);
962304d26faSStefano Zampini   ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_INT,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
963304d26faSStefano Zampini   ierr = PCBDDCSetUseExactDirichlet(pc,(PetscBool)use_exact_reduced);CHKERRQ(ierr);
964304d26faSStefano Zampini   /* print info */
965304d26faSStefano Zampini   if (pcbddc->dbg_flag) {
966304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
967304d26faSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
968304d26faSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Checking solution of Dirichlet and Neumann problems\n");CHKERRQ(ierr);
969304d26faSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Dirichlet solve = % 1.14e \n",PetscGlobalRank,value);CHKERRQ(ierr);
970304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
971304d26faSStefano Zampini   }
9728eeda7d8SStefano Zampini   if (n_D && pcbddc->NullSpace && !use_exact_reduced && !pcbddc->switch_static) {
9738ce42a96SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcis->is_I_local);CHKERRQ(ierr);
974304d26faSStefano Zampini   }
975304d26faSStefano Zampini 
976304d26faSStefano Zampini   /* Neumann */
977304d26faSStefano Zampini   ierr = MatGetVecs(A_RR,&vec1,&vec2);CHKERRQ(ierr);
978304d26faSStefano Zampini   ierr = VecDuplicate(vec1,&vec3);CHKERRQ(ierr);
979304d26faSStefano Zampini   ierr = VecSetRandom(vec1,NULL);CHKERRQ(ierr);
980304d26faSStefano Zampini   ierr = MatMult(A_RR,vec1,vec2);CHKERRQ(ierr);
981304d26faSStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,vec2,vec3);CHKERRQ(ierr);
982304d26faSStefano Zampini   ierr = VecAXPY(vec3,m_one,vec1);CHKERRQ(ierr);
983304d26faSStefano Zampini   ierr = VecNorm(vec3,NORM_INFINITY,&value);CHKERRQ(ierr);
984304d26faSStefano Zampini   ierr = VecDestroy(&vec1);CHKERRQ(ierr);
985304d26faSStefano Zampini   ierr = VecDestroy(&vec2);CHKERRQ(ierr);
986304d26faSStefano Zampini   ierr = VecDestroy(&vec3);CHKERRQ(ierr);
987304d26faSStefano Zampini   /* need to be adapted? */
988304d26faSStefano Zampini   use_exact = (PetscAbsReal(value) > 1.e-4 ? 0 : 1);
989304d26faSStefano Zampini   if (PetscAbsReal(value) > 1.e-4) use_exact = 0;
990304d26faSStefano Zampini   ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_INT,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
991304d26faSStefano Zampini   /* print info */
992304d26faSStefano Zampini   if (pcbddc->dbg_flag) {
993304d26faSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for  Neumann  solve = % 1.14e \n",PetscGlobalRank,value);CHKERRQ(ierr);
994304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
995304d26faSStefano Zampini   }
996304d26faSStefano Zampini   if (n_R && pcbddc->NullSpace && !use_exact_reduced) { /* is it the right logic? */
9978ce42a96SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcbddc->is_R_local);CHKERRQ(ierr);
998304d26faSStefano Zampini   }
999304d26faSStefano Zampini 
1000304d26faSStefano Zampini   /* free Neumann problem's matrix */
1001304d26faSStefano Zampini   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1002304d26faSStefano Zampini   PetscFunctionReturn(0);
1003304d26faSStefano Zampini }
1004304d26faSStefano Zampini 
1005304d26faSStefano Zampini #undef __FUNCT__
1006674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSolveSaddlePoint"
1007674ae819SStefano Zampini static PetscErrorCode  PCBDDCSolveSaddlePoint(PC pc)
1008674ae819SStefano Zampini {
1009674ae819SStefano Zampini   PetscErrorCode ierr;
1010674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1011674ae819SStefano Zampini 
1012674ae819SStefano Zampini   PetscFunctionBegin;
1013674ae819SStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
1014674ae819SStefano Zampini   if (pcbddc->local_auxmat1) {
1015674ae819SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec2_R,pcbddc->vec1_C);CHKERRQ(ierr);
1016674ae819SStefano Zampini     ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
1017674ae819SStefano Zampini   }
1018674ae819SStefano Zampini   PetscFunctionReturn(0);
1019674ae819SStefano Zampini }
1020674ae819SStefano Zampini 
1021674ae819SStefano Zampini #undef __FUNCT__
1022674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
1023674ae819SStefano Zampini PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc)
1024674ae819SStefano Zampini {
1025674ae819SStefano Zampini   PetscErrorCode ierr;
1026674ae819SStefano Zampini   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
1027674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)  (pc->data);
1028674ae819SStefano Zampini   const PetscScalar zero = 0.0;
1029674ae819SStefano Zampini 
1030674ae819SStefano Zampini   PetscFunctionBegin;
103115aaf578SStefano Zampini   /* Application of PHI^T (or PSI^T)  */
103215aaf578SStefano Zampini   if (pcbddc->coarse_psi_B) {
103315aaf578SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
10348eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
103515aaf578SStefano Zampini   } else {
1036674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
10378eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
103815aaf578SStefano Zampini   }
1039674ae819SStefano Zampini   /* Scatter data of coarse_rhs */
1040674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { ierr = VecSet(pcbddc->coarse_rhs,zero);CHKERRQ(ierr); }
1041674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1042674ae819SStefano Zampini 
1043674ae819SStefano Zampini   /* Local solution on R nodes */
1044674ae819SStefano Zampini   ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
1045674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1046674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
10478eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1048674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1049674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1050674ae819SStefano Zampini   }
1051674ae819SStefano Zampini   ierr = PCBDDCSolveSaddlePoint(pc);CHKERRQ(ierr);
1052674ae819SStefano Zampini   ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1053674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1054674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
10558eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1056674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1057674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1058674ae819SStefano Zampini   }
1059674ae819SStefano Zampini 
1060674ae819SStefano Zampini   /* Coarse solution */
1061674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1062674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { /* TODO remove null space when doing multilevel */
1063674ae819SStefano Zampini     ierr = KSPSolve(pcbddc->coarse_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
1064674ae819SStefano Zampini   }
1065674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1066674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd  (pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1067674ae819SStefano Zampini 
1068674ae819SStefano Zampini   /* Sum contributions from two levels */
1069674ae819SStefano Zampini   ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
10708eeda7d8SStefano Zampini   if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1071674ae819SStefano Zampini   PetscFunctionReturn(0);
1072674ae819SStefano Zampini }
1073674ae819SStefano Zampini 
1074674ae819SStefano Zampini #undef __FUNCT__
1075674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
1076674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1077674ae819SStefano Zampini {
1078674ae819SStefano Zampini   PetscErrorCode ierr;
1079674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1080674ae819SStefano Zampini 
1081674ae819SStefano Zampini   PetscFunctionBegin;
1082674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1083674ae819SStefano Zampini   PetscFunctionReturn(0);
1084674ae819SStefano Zampini }
1085674ae819SStefano Zampini 
1086674ae819SStefano Zampini #undef __FUNCT__
1087674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
1088674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1089674ae819SStefano Zampini {
1090674ae819SStefano Zampini   PetscErrorCode ierr;
1091674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1092674ae819SStefano Zampini 
1093674ae819SStefano Zampini   PetscFunctionBegin;
1094674ae819SStefano Zampini   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1095674ae819SStefano Zampini   PetscFunctionReturn(0);
1096674ae819SStefano Zampini }
1097674ae819SStefano Zampini 
1098984c4197SStefano Zampini /* uncomment for testing purposes */
1099984c4197SStefano Zampini /* #define PETSC_MISSING_LAPACK_GESVD 1 */
1100674ae819SStefano Zampini #undef __FUNCT__
1101674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp"
1102674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
1103674ae819SStefano Zampini {
1104674ae819SStefano Zampini   PetscErrorCode    ierr;
1105674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
1106674ae819SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
1107674ae819SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
1108984c4197SStefano Zampini   /* constraint and (optionally) change of basis matrix implemented as SeqAIJ */
1109674ae819SStefano Zampini   MatType           impMatType=MATSEQAIJ;
1110984c4197SStefano Zampini   /* one and zero */
1111984c4197SStefano Zampini   PetscScalar       one=1.0,zero=0.0;
1112984c4197SStefano Zampini   /* space to store constraints and their local indices */
1113984c4197SStefano Zampini   PetscScalar       *temp_quadrature_constraint;
1114984c4197SStefano Zampini   PetscInt          *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B;
1115984c4197SStefano Zampini   /* iterators */
1116984c4197SStefano Zampini   PetscInt          i,j,k,total_counts,temp_start_ptr;
1117984c4197SStefano Zampini   /* stuff to store connected components stored in pcbddc->mat_graph */
1118984c4197SStefano Zampini   IS                ISForVertices,*ISForFaces,*ISForEdges,*used_IS;
1119984c4197SStefano Zampini   PetscInt          n_ISForFaces,n_ISForEdges;
1120984c4197SStefano Zampini   /* near null space stuff */
1121674ae819SStefano Zampini   MatNullSpace      nearnullsp;
1122674ae819SStefano Zampini   const Vec         *nearnullvecs;
1123674ae819SStefano Zampini   Vec               *localnearnullsp;
1124984c4197SStefano Zampini   PetscBool         nnsp_has_cnst;
1125984c4197SStefano Zampini   PetscInt          nnsp_size;
1126984c4197SStefano Zampini   PetscScalar       *array;
1127984c4197SStefano Zampini   /* BLAS integers */
1128e310c8b4SStefano Zampini   PetscBLASInt      lwork,lierr;
1129e310c8b4SStefano Zampini   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
1130c4303822SStefano Zampini   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
1131984c4197SStefano Zampini   /* LAPACK working arrays for SVD or POD */
1132242a89d7SStefano Zampini   PetscBool         skip_lapack;
1133984c4197SStefano Zampini   PetscScalar       *work;
1134984c4197SStefano Zampini   PetscReal         *singular_vals;
1135984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1136984c4197SStefano Zampini   PetscReal         *rwork;
1137674ae819SStefano Zampini #endif
1138984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1139e310c8b4SStefano Zampini   PetscBLASInt      Blas_one_2=1;
1140984c4197SStefano Zampini   PetscScalar       *temp_basis,*correlation_mat;
1141b7d8b9f8SStefano Zampini #else
1142b7d8b9f8SStefano Zampini   PetscBLASInt      dummy_int_1=1,dummy_int_2=1;
1143b7d8b9f8SStefano Zampini   PetscScalar       dummy_scalar_1=0.0,dummy_scalar_2=0.0;
1144984c4197SStefano Zampini #endif
1145984c4197SStefano Zampini   /* change of basis */
1146984c4197SStefano Zampini   PetscInt          *aux_primal_numbering,*aux_primal_minloc,*global_indices;
11474641a718SStefano Zampini   PetscBool         boolforchange;
11484641a718SStefano Zampini   PetscBT           touched,change_basis;
1149984c4197SStefano Zampini   /* auxiliary stuff */
1150984c4197SStefano Zampini   PetscInt          *nnz,*is_indices,*local_to_B;
1151984c4197SStefano Zampini   /* some quantities */
1152984c4197SStefano Zampini   PetscInt          n_vertices,total_primal_vertices;
1153984c4197SStefano Zampini   PetscInt          size_of_constraint,max_size_of_constraint,max_constraints,temp_constraints;
1154984c4197SStefano Zampini 
1155674ae819SStefano Zampini 
1156674ae819SStefano Zampini   PetscFunctionBegin;
1157674ae819SStefano Zampini   /* Get index sets for faces, edges and vertices from graph */
11588eeda7d8SStefano Zampini   if (!pcbddc->use_faces && !pcbddc->use_edges && !pcbddc->use_vertices) {
11598eeda7d8SStefano Zampini     pcbddc->use_vertices = PETSC_TRUE;
1160674ae819SStefano Zampini   }
11618eeda7d8SStefano Zampini   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,pcbddc->use_faces,pcbddc->use_edges,pcbddc->use_vertices,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);
1162984c4197SStefano Zampini   /* print some info */
1163674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
1164674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1165674ae819SStefano Zampini     i = 0;
1166674ae819SStefano Zampini     if (ISForVertices) {
1167674ae819SStefano Zampini       ierr = ISGetSize(ISForVertices,&i);CHKERRQ(ierr);
1168674ae819SStefano Zampini     }
1169674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices\n",PetscGlobalRank,i);CHKERRQ(ierr);
1170674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges\n",PetscGlobalRank,n_ISForEdges);CHKERRQ(ierr);
117115aaf578SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces\n",PetscGlobalRank,n_ISForFaces);CHKERRQ(ierr);
1172674ae819SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1173674ae819SStefano Zampini   }
1174674ae819SStefano Zampini   /* check if near null space is attached to global mat */
1175674ae819SStefano Zampini   ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
1176674ae819SStefano Zampini   if (nearnullsp) {
1177674ae819SStefano Zampini     ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
1178984c4197SStefano Zampini   } else { /* if near null space is not provided BDDC uses constants by default */
1179984c4197SStefano Zampini     nnsp_size = 0;
1180674ae819SStefano Zampini     nnsp_has_cnst = PETSC_TRUE;
1181674ae819SStefano Zampini   }
1182984c4197SStefano Zampini   /* get max number of constraints on a single cc */
1183984c4197SStefano Zampini   max_constraints = nnsp_size;
1184984c4197SStefano Zampini   if (nnsp_has_cnst) max_constraints++;
1185984c4197SStefano Zampini 
1186674ae819SStefano Zampini   /*
1187674ae819SStefano Zampini        Evaluate maximum storage size needed by the procedure
1188674ae819SStefano Zampini        - temp_indices will contain start index of each constraint stored as follows
1189674ae819SStefano 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
1190674ae819SStefano 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
1191674ae819SStefano Zampini        - temp_quadrature_constraint  [temp_indices[i],...,temp[indices[i+1]-1] will contain the scalars representing the constraint itself
1192674ae819SStefano Zampini                                                                                                                                                          */
1193674ae819SStefano Zampini   total_counts = n_ISForFaces+n_ISForEdges;
1194984c4197SStefano Zampini   total_counts *= max_constraints;
1195674ae819SStefano Zampini   n_vertices = 0;
1196674ae819SStefano Zampini   if (ISForVertices) {
1197674ae819SStefano Zampini     ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
1198674ae819SStefano Zampini   }
1199674ae819SStefano Zampini   total_counts += n_vertices;
1200674ae819SStefano Zampini   ierr = PetscMalloc((total_counts+1)*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
12014641a718SStefano Zampini   ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
1202674ae819SStefano Zampini   total_counts = 0;
1203674ae819SStefano Zampini   max_size_of_constraint = 0;
1204674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1205674ae819SStefano Zampini     if (i<n_ISForEdges) {
1206674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1207674ae819SStefano Zampini     } else {
1208674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1209674ae819SStefano Zampini     }
1210674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
1211674ae819SStefano Zampini     total_counts += j;
1212674ae819SStefano Zampini     max_size_of_constraint = PetscMax(j,max_size_of_constraint);
1213674ae819SStefano Zampini   }
1214984c4197SStefano Zampini   total_counts *= max_constraints;
1215674ae819SStefano Zampini   total_counts += n_vertices;
1216674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&temp_quadrature_constraint);CHKERRQ(ierr);
1217674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint);CHKERRQ(ierr);
1218674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint_B);CHKERRQ(ierr);
1219984c4197SStefano Zampini   /* local to boundary numbering */
1220674ae819SStefano Zampini   ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&local_to_B);CHKERRQ(ierr);
1221674ae819SStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1222984c4197SStefano Zampini   for (i=0;i<pcis->n;i++) local_to_B[i]=-1;
1223984c4197SStefano Zampini   for (i=0;i<pcis->n_B;i++) local_to_B[is_indices[i]]=i;
1224674ae819SStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1225984c4197SStefano Zampini   /* get local part of global near null space vectors */
1226984c4197SStefano Zampini   ierr = PetscMalloc(nnsp_size*sizeof(Vec),&localnearnullsp);CHKERRQ(ierr);
1227984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1228984c4197SStefano Zampini     ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
1229984c4197SStefano Zampini     ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1230984c4197SStefano Zampini     ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1231984c4197SStefano Zampini   }
1232674ae819SStefano Zampini 
1233242a89d7SStefano Zampini   /* whether or not to skip lapack calls */
1234242a89d7SStefano Zampini   skip_lapack = PETSC_TRUE;
1235242a89d7SStefano Zampini   if (n_ISForFaces+n_ISForEdges) skip_lapack = PETSC_FALSE;
1236242a89d7SStefano Zampini 
1237984c4197SStefano Zampini   /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
1238242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1239674ae819SStefano Zampini     PetscScalar temp_work;
1240674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1241984c4197SStefano Zampini     /* Proper Orthogonal Decomposition (POD) using the snapshot method */
1242984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*max_constraints*sizeof(PetscScalar),&correlation_mat);CHKERRQ(ierr);
1243984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1244984c4197SStefano Zampini     ierr = PetscMalloc(max_size_of_constraint*max_constraints*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr);
1245674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1246984c4197SStefano Zampini     ierr = PetscMalloc(3*max_constraints*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1247674ae819SStefano Zampini #endif
1248674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1249c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
1250c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
1251674ae819SStefano Zampini     lwork = -1;
1252674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1253674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1254c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
1255674ae819SStefano Zampini #else
1256c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
1257674ae819SStefano Zampini #endif
1258674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1259984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
1260674ae819SStefano Zampini #else /* on missing GESVD */
1261674ae819SStefano Zampini     /* SVD */
1262674ae819SStefano Zampini     PetscInt max_n,min_n;
1263674ae819SStefano Zampini     max_n = max_size_of_constraint;
1264984c4197SStefano Zampini     min_n = max_constraints;
1265984c4197SStefano Zampini     if (max_size_of_constraint < max_constraints) {
1266674ae819SStefano Zampini       min_n = max_size_of_constraint;
1267984c4197SStefano Zampini       max_n = max_constraints;
1268674ae819SStefano Zampini     }
1269674ae819SStefano Zampini     ierr = PetscMalloc(min_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1270674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1271674ae819SStefano Zampini     ierr = PetscMalloc(5*min_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1272674ae819SStefano Zampini #endif
1273674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1274674ae819SStefano Zampini     lwork = -1;
1275e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
1276e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
1277b7d8b9f8SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
1278674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1279674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1280e310c8b4SStefano 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));
1281674ae819SStefano Zampini #else
1282e310c8b4SStefano 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));
1283674ae819SStefano Zampini #endif
1284674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1285984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
1286984c4197SStefano Zampini #endif /* on missing GESVD */
1287674ae819SStefano Zampini     /* Allocate optimal workspace */
1288674ae819SStefano Zampini     ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
1289984c4197SStefano Zampini     ierr = PetscMalloc((PetscInt)lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
1290674ae819SStefano Zampini   }
1291674ae819SStefano Zampini   /* Now we can loop on constraining sets */
1292674ae819SStefano Zampini   total_counts = 0;
1293674ae819SStefano Zampini   temp_indices[0] = 0;
1294674ae819SStefano Zampini   /* vertices */
1295674ae819SStefano Zampini   if (ISForVertices) {
1296674ae819SStefano Zampini     ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1297674ae819SStefano Zampini     if (nnsp_has_cnst) { /* consider all vertices */
1298674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1299674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1300674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
1301674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1302674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1303674ae819SStefano Zampini         total_counts++;
1304674ae819SStefano Zampini       }
1305674ae819SStefano Zampini     } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
1306984c4197SStefano Zampini       PetscBool used_vertex;
1307674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1308674ae819SStefano Zampini         used_vertex = PETSC_FALSE;
1309674ae819SStefano Zampini         k = 0;
1310674ae819SStefano Zampini         while (!used_vertex && k<nnsp_size) {
1311984c4197SStefano Zampini           ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1312984c4197SStefano Zampini           if (PetscAbsScalar(array[is_indices[i]])>0.0) {
1313674ae819SStefano Zampini             temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1314674ae819SStefano Zampini             temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
1315674ae819SStefano Zampini             temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1316674ae819SStefano Zampini             temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1317674ae819SStefano Zampini             total_counts++;
1318674ae819SStefano Zampini             used_vertex = PETSC_TRUE;
1319674ae819SStefano Zampini           }
1320984c4197SStefano Zampini           ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1321674ae819SStefano Zampini           k++;
1322674ae819SStefano Zampini         }
1323674ae819SStefano Zampini       }
1324674ae819SStefano Zampini     }
1325674ae819SStefano Zampini     ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1326674ae819SStefano Zampini     n_vertices = total_counts;
1327674ae819SStefano Zampini   }
1328984c4197SStefano Zampini 
1329674ae819SStefano Zampini   /* edges and faces */
1330674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1331674ae819SStefano Zampini     if (i<n_ISForEdges) {
1332674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1333984c4197SStefano Zampini       boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
1334674ae819SStefano Zampini     } else {
1335674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1336984c4197SStefano Zampini       boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
1337674ae819SStefano Zampini     }
1338674ae819SStefano Zampini     temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
1339674ae819SStefano Zampini     temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
1340674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
1341674ae819SStefano Zampini     ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1342984c4197SStefano Zampini     /* change of basis should not be performed on local periodic nodes */
1343984c4197SStefano Zampini     if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
1344674ae819SStefano Zampini     if (nnsp_has_cnst) {
13455b08dc53SStefano Zampini       PetscScalar quad_value;
1346674ae819SStefano Zampini       temp_constraints++;
1347674ae819SStefano Zampini       quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
1348674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1349674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
1350674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
1351674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
1352674ae819SStefano Zampini       }
1353674ae819SStefano Zampini       temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
13544641a718SStefano Zampini       if (boolforchange) {
13554641a718SStefano Zampini         ierr = PetscBTSet(change_basis,total_counts);CHKERRQ(ierr);
13564641a718SStefano Zampini       }
1357674ae819SStefano Zampini       total_counts++;
1358674ae819SStefano Zampini     }
1359674ae819SStefano Zampini     for (k=0;k<nnsp_size;k++) {
1360984c4197SStefano Zampini       PetscReal real_value;
1361984c4197SStefano Zampini       ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1362674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1363674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
1364674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
1365984c4197SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=array[is_indices[j]];
1366674ae819SStefano Zampini       }
1367984c4197SStefano Zampini       ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1368984c4197SStefano Zampini       /* check if array is null on the connected component */
1369e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1370e310c8b4SStefano Zampini       PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_one));
13715b08dc53SStefano Zampini       if (real_value > 0.0) { /* keep indices and values */
1372674ae819SStefano Zampini         temp_constraints++;
1373674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
13744641a718SStefano Zampini         if (boolforchange) {
13754641a718SStefano Zampini           ierr = PetscBTSet(change_basis,total_counts);CHKERRQ(ierr);
13764641a718SStefano Zampini         }
1377674ae819SStefano Zampini         total_counts++;
1378674ae819SStefano Zampini       }
1379674ae819SStefano Zampini     }
1380674ae819SStefano Zampini     ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1381984c4197SStefano Zampini     /* perform SVD on the constraints if use_nnsp_true has not be requested by the user */
1382984c4197SStefano Zampini     if (!pcbddc->use_nnsp_true) {
1383984c4197SStefano Zampini       PetscReal tol = 1.0e-8; /* tolerance for retaining eigenmodes */
1384674ae819SStefano Zampini 
1385674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1386984c4197SStefano Zampini       /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
1387984c4197SStefano Zampini          POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
1388984c4197SStefano Zampini          -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
1389984c4197SStefano Zampini             the constraints basis will differ (by a complex factor with absolute value equal to 1)
1390984c4197SStefano Zampini             from that computed using LAPACKgesvd
1391984c4197SStefano Zampini          -> This is due to a different computation of eigenvectors in LAPACKheev
1392984c4197SStefano Zampini          -> The quality of the POD-computed basis will be the same */
1393984c4197SStefano Zampini       ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
1394674ae819SStefano Zampini       /* Store upper triangular part of correlation matrix */
1395e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1396984c4197SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1397674ae819SStefano Zampini       for (j=0;j<temp_constraints;j++) {
1398674ae819SStefano Zampini         for (k=0;k<j+1;k++) {
1399e310c8b4SStefano 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));
1400674ae819SStefano Zampini         }
1401674ae819SStefano Zampini       }
1402e310c8b4SStefano Zampini       /* compute eigenvalues and eigenvectors of correlation matrix */
1403e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1404e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
1405674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1406c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
1407674ae819SStefano Zampini #else
1408c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
1409674ae819SStefano Zampini #endif
1410674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1411984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
1412984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
1413674ae819SStefano Zampini       j=0;
1414984c4197SStefano Zampini       while (j < temp_constraints && singular_vals[j] < tol) j++;
1415674ae819SStefano Zampini       total_counts=total_counts-j;
1416e310c8b4SStefano Zampini       /* scale and copy POD basis into used quadrature memory */
1417c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1418c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1419c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
1420c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1421c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
1422c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1423674ae819SStefano Zampini       if (j<temp_constraints) {
1424984c4197SStefano Zampini         PetscInt ii;
1425984c4197SStefano Zampini         for (k=j;k<temp_constraints;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]);
1426674ae819SStefano Zampini         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1427c4303822SStefano 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));
1428674ae819SStefano Zampini         ierr = PetscFPTrapPop();CHKERRQ(ierr);
1429984c4197SStefano Zampini         for (k=0;k<temp_constraints-j;k++) {
1430674ae819SStefano Zampini           for (ii=0;ii<size_of_constraint;ii++) {
1431984c4197SStefano 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];
1432674ae819SStefano Zampini           }
1433674ae819SStefano Zampini         }
1434674ae819SStefano Zampini       }
1435674ae819SStefano Zampini #else  /* on missing GESVD */
1436e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1437e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1438b7d8b9f8SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1439674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1440674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1441e310c8b4SStefano 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));
1442674ae819SStefano Zampini #else
1443e310c8b4SStefano 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));
1444674ae819SStefano Zampini #endif
1445984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
1446674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1447984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
1448e310c8b4SStefano Zampini       k = temp_constraints;
1449e310c8b4SStefano Zampini       if (k > size_of_constraint) k = size_of_constraint;
1450674ae819SStefano Zampini       j = 0;
1451e310c8b4SStefano Zampini       while (j < k && singular_vals[k-j-1] < tol) j++;
1452e310c8b4SStefano Zampini       total_counts = total_counts-temp_constraints+k-j;
1453984c4197SStefano Zampini #endif /* on missing GESVD */
1454674ae819SStefano Zampini     }
1455674ae819SStefano Zampini   }
1456674ae819SStefano Zampini   /* free index sets of faces, edges and vertices */
1457674ae819SStefano Zampini   for (i=0;i<n_ISForFaces;i++) {
1458674ae819SStefano Zampini     ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
1459674ae819SStefano Zampini   }
1460674ae819SStefano Zampini   ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
1461674ae819SStefano Zampini   for (i=0;i<n_ISForEdges;i++) {
1462674ae819SStefano Zampini     ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
1463674ae819SStefano Zampini   }
1464674ae819SStefano Zampini   ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
1465674ae819SStefano Zampini   ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
1466674ae819SStefano Zampini 
1467984c4197SStefano Zampini   /* free workspace */
1468242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1469984c4197SStefano Zampini     ierr = PetscFree(work);CHKERRQ(ierr);
1470984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1471984c4197SStefano Zampini     ierr = PetscFree(rwork);CHKERRQ(ierr);
1472984c4197SStefano Zampini #endif
1473984c4197SStefano Zampini     ierr = PetscFree(singular_vals);CHKERRQ(ierr);
1474984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1475984c4197SStefano Zampini     ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
1476984c4197SStefano Zampini     ierr = PetscFree(temp_basis);CHKERRQ(ierr);
1477984c4197SStefano Zampini #endif
1478984c4197SStefano Zampini   }
1479984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1480984c4197SStefano Zampini     ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
1481984c4197SStefano Zampini   }
1482984c4197SStefano Zampini   ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
1483984c4197SStefano Zampini 
1484674ae819SStefano Zampini   /* set quantities in pcbddc data structure */
1485984c4197SStefano Zampini   /* n_vertices defines the number of subdomain corners in the primal space */
1486674ae819SStefano Zampini   /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */
1487984c4197SStefano Zampini   pcbddc->local_primal_size = total_counts;
1488674ae819SStefano Zampini   pcbddc->n_vertices = n_vertices;
1489984c4197SStefano Zampini   pcbddc->n_constraints = pcbddc->local_primal_size-pcbddc->n_vertices;
1490674ae819SStefano Zampini 
1491674ae819SStefano Zampini   /* Create constraint matrix */
1492674ae819SStefano Zampini   /* The constraint matrix is used to compute the l2g map of primal dofs */
1493674ae819SStefano Zampini   /* so we need to set it up properly either with or without change of basis */
1494674ae819SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1495674ae819SStefano Zampini   ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr);
1496984c4197SStefano Zampini   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
1497984c4197SStefano Zampini   /* array to compute a local numbering of constraints : vertices first then constraints */
1498984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_numbering);CHKERRQ(ierr);
1499984c4197SStefano Zampini   /* array to select the proper local node (of minimum index with respect to global ordering) when changing the basis */
1500984c4197SStefano 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 */
1501984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_minloc);CHKERRQ(ierr);
1502984c4197SStefano Zampini   /* auxiliary stuff for basis change */
1503984c4197SStefano Zampini   ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&global_indices);CHKERRQ(ierr);
15044641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n_B,&touched);CHKERRQ(ierr);
1505984c4197SStefano Zampini 
1506984c4197SStefano Zampini   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
1507984c4197SStefano Zampini   total_primal_vertices=0;
1508984c4197SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
1509674ae819SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
1510984c4197SStefano Zampini     if (size_of_constraint == 1) {
15114641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]]);CHKERRQ(ierr);
1512984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]];
1513984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=0;
1514984c4197SStefano Zampini       total_primal_vertices++;
15154641a718SStefano Zampini     } else if (PetscBTLookup(change_basis,i)) { /* Same procedure used in PCBDDCGetPrimalConstraintsLocalIdx */
1516984c4197SStefano Zampini       PetscInt min_loc,min_index;
1517984c4197SStefano Zampini       ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],global_indices);CHKERRQ(ierr);
1518984c4197SStefano Zampini       /* find first untouched local node */
1519674ae819SStefano Zampini       k = 0;
15204641a718SStefano Zampini       while (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) k++;
1521984c4197SStefano Zampini       min_index = global_indices[k];
1522984c4197SStefano Zampini       min_loc = k;
1523984c4197SStefano Zampini       /* search the minimum among global nodes already untouched on the cc */
1524984c4197SStefano Zampini       for (k=1;k<size_of_constraint;k++) {
1525984c4197SStefano Zampini         /* there can be more than one constraint on a single connected component */
15264641a718SStefano Zampini         if (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k]) && min_index > global_indices[k]) {
1527984c4197SStefano Zampini           min_index = global_indices[k];
1528984c4197SStefano Zampini           min_loc = k;
1529674ae819SStefano Zampini         }
1530674ae819SStefano Zampini       }
15314641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]+min_loc]);CHKERRQ(ierr);
1532984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]+min_loc];
1533984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=min_loc;
1534984c4197SStefano Zampini       total_primal_vertices++;
1535984c4197SStefano Zampini     }
1536984c4197SStefano Zampini   }
1537984c4197SStefano Zampini   /* free workspace */
1538984c4197SStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
15394641a718SStefano Zampini   ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
1540674ae819SStefano Zampini   /* permute indices in order to have a sorted set of vertices */
1541984c4197SStefano Zampini   ierr = PetscSortInt(total_primal_vertices,aux_primal_numbering);
1542984c4197SStefano Zampini 
1543984c4197SStefano Zampini   /* nonzero structure of constraint matrix */
1544984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1545984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) nnz[i]=1;
1546984c4197SStefano Zampini   j=total_primal_vertices;
1547984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
15484641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1549674ae819SStefano Zampini       nnz[j]=temp_indices[i+1]-temp_indices[i];
1550674ae819SStefano Zampini       j++;
1551674ae819SStefano Zampini     }
1552674ae819SStefano Zampini   }
1553674ae819SStefano Zampini   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
1554674ae819SStefano Zampini   ierr = PetscFree(nnz);CHKERRQ(ierr);
1555674ae819SStefano Zampini   /* set values in constraint matrix */
1556984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) {
1557984c4197SStefano Zampini     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,aux_primal_numbering[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
1558674ae819SStefano Zampini   }
1559984c4197SStefano Zampini   total_counts = total_primal_vertices;
1560984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
15614641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1562674ae819SStefano Zampini       size_of_constraint=temp_indices[i+1]-temp_indices[i];
1563674ae819SStefano 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);
1564674ae819SStefano Zampini       total_counts++;
1565674ae819SStefano Zampini     }
1566674ae819SStefano Zampini   }
1567674ae819SStefano Zampini   /* assembling */
1568674ae819SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1569674ae819SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1570984c4197SStefano Zampini   /*
1571984c4197SStefano Zampini   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
1572984c4197SStefano Zampini   */
1573674ae819SStefano Zampini   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
1574674ae819SStefano Zampini   if (pcbddc->use_change_of_basis) {
1575984c4197SStefano Zampini     PetscBool qr_needed = PETSC_FALSE;
1576984c4197SStefano Zampini     /* change of basis acts on local interfaces -> dimension is n_B x n_B */
1577674ae819SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
1578674ae819SStefano Zampini     ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr);
1579674ae819SStefano Zampini     ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr);
1580674ae819SStefano Zampini     /* work arrays */
1581674ae819SStefano Zampini     ierr = PetscMalloc(pcis->n_B*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1582984c4197SStefano Zampini     for (i=0;i<pcis->n_B;i++) nnz[i]=1;
1583984c4197SStefano Zampini     /* nonzeros per row */
1584984c4197SStefano Zampini     for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
15854641a718SStefano Zampini       if (PetscBTLookup(change_basis,i)) {
1586984c4197SStefano Zampini         qr_needed = PETSC_TRUE;
1587674ae819SStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
1588984c4197SStefano Zampini         for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1589674ae819SStefano Zampini       }
1590674ae819SStefano Zampini     }
1591674ae819SStefano Zampini     ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
1592674ae819SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
1593674ae819SStefano Zampini     /* Set initial identity in the matrix */
1594674ae819SStefano Zampini     for (i=0;i<pcis->n_B;i++) {
1595674ae819SStefano Zampini       ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
1596674ae819SStefano Zampini     }
1597984c4197SStefano Zampini 
1598674ae819SStefano Zampini     /* Now we loop on the constraints which need a change of basis */
1599674ae819SStefano Zampini     /* Change of basis matrix is evaluated as the FIRST APPROACH in */
1600984c4197SStefano Zampini     /* Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1) */
1601984c4197SStefano Zampini     /* Change of basis matrix T computed via QR decomposition of constraints */
1602984c4197SStefano Zampini     if (qr_needed) {
1603026de310SStefano Zampini       /* dual and primal dofs on a single cc */
1604984c4197SStefano Zampini       PetscInt     dual_dofs,primal_dofs;
1605026de310SStefano Zampini       /* iterator on aux_primal_minloc (ordered as read from nearnullspace: vertices, edges and then constraints) */
1606026de310SStefano Zampini       PetscInt     primal_counter;
1607984c4197SStefano Zampini       /* working stuff for GEQRF */
1608984c4197SStefano Zampini       PetscScalar  *qr_basis,*qr_tau,*qr_work,lqr_work_t;
1609984c4197SStefano Zampini       PetscBLASInt lqr_work;
1610984c4197SStefano Zampini       /* working stuff for UNGQR */
1611984c4197SStefano Zampini       PetscScalar  *gqr_work,lgqr_work_t;
1612984c4197SStefano Zampini       PetscBLASInt lgqr_work;
1613984c4197SStefano Zampini       /* working stuff for TRTRS */
1614984c4197SStefano Zampini       PetscScalar  *trs_rhs;
16153f08241aSStefano Zampini       PetscBLASInt Blas_NRHS;
1616984c4197SStefano Zampini       /* pointers for values insertion into change of basis matrix */
1617984c4197SStefano Zampini       PetscInt     *start_rows,*start_cols;
1618984c4197SStefano Zampini       PetscScalar  *start_vals;
1619984c4197SStefano Zampini       /* working stuff for values insertion */
16204641a718SStefano Zampini       PetscBT      is_primal;
1621984c4197SStefano Zampini 
1622984c4197SStefano Zampini       /* space to store Q */
1623984c4197SStefano Zampini       ierr = PetscMalloc((max_size_of_constraint)*(max_size_of_constraint)*sizeof(PetscScalar),&qr_basis);CHKERRQ(ierr);
1624984c4197SStefano Zampini       /* first we issue queries for optimal work */
16253f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
16263f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
16273f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1628984c4197SStefano Zampini       lqr_work = -1;
16293f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
1630984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
1631984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
1632984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lqr_work_t)*sizeof(*qr_work),&qr_work);CHKERRQ(ierr);
1633984c4197SStefano Zampini       lgqr_work = -1;
16343f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
16353f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
16363f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
16373f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
16383f08241aSStefano Zampini       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
16393f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
1640984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
1641984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
1642984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lgqr_work_t)*sizeof(*gqr_work),&gqr_work);CHKERRQ(ierr);
1643984c4197SStefano Zampini       /* array to store scaling factors for reflectors */
1644984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*sizeof(*qr_tau),&qr_tau);CHKERRQ(ierr);
1645984c4197SStefano Zampini       /* array to store rhs and solution of triangular solver */
1646984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*max_constraints*sizeof(*trs_rhs),&trs_rhs);CHKERRQ(ierr);
1647984c4197SStefano Zampini       /* array to store whether a node is primal or not */
16484641a718SStefano Zampini       ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
16494641a718SStefano Zampini       for (i=0;i<total_primal_vertices;i++) {
16504641a718SStefano Zampini         ierr = PetscBTSet(is_primal,local_to_B[aux_primal_numbering[i]]);CHKERRQ(ierr);
16514641a718SStefano Zampini       }
1652984c4197SStefano Zampini 
1653984c4197SStefano Zampini       /* allocating workspace for check */
1654984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
1655984c4197SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1656984c4197SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
1657984c4197SStefano Zampini         ierr = PetscMalloc(max_size_of_constraint*(max_constraints+max_size_of_constraint)*sizeof(*work),&work);CHKERRQ(ierr);
1658674ae819SStefano Zampini       }
1659984c4197SStefano Zampini 
1660026de310SStefano Zampini       /* loop on constraints and see whether or not they need a change of basis */
1661026de310SStefano Zampini       /* -> using implicit ordering contained in temp_indices data */
1662026de310SStefano Zampini       total_counts = pcbddc->n_vertices;
1663026de310SStefano Zampini       primal_counter = total_counts;
1664026de310SStefano Zampini       while (total_counts<pcbddc->local_primal_size) {
1665026de310SStefano Zampini         primal_dofs = 1;
16664641a718SStefano Zampini         if (PetscBTLookup(change_basis,total_counts)) {
1667026de310SStefano Zampini           /* get all constraints with same support: if more then one constraint is present on the cc then surely indices are stored contiguosly */
1668026de310SStefano 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]]) {
1669026de310SStefano Zampini             primal_dofs++;
1670674ae819SStefano Zampini           }
1671984c4197SStefano Zampini           /* get constraint info */
1672026de310SStefano Zampini           size_of_constraint = temp_indices[total_counts+1]-temp_indices[total_counts];
1673984c4197SStefano Zampini           dual_dofs = size_of_constraint-primal_dofs;
1674984c4197SStefano Zampini 
1675984c4197SStefano Zampini           /* copy quadrature constraints for change of basis check */
1676984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
1677026de310SStefano Zampini             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d to %d need a change of basis (size %d)\n",total_counts,total_counts+primal_dofs,size_of_constraint);CHKERRQ(ierr);
1678026de310SStefano Zampini             ierr = PetscMemcpy(work,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1679674ae819SStefano Zampini           }
1680984c4197SStefano Zampini 
1681984c4197SStefano Zampini           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
1682026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1683984c4197SStefano Zampini 
1684984c4197SStefano Zampini           /* compute QR decomposition of constraints */
16853f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
16863f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
16873f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1688674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
16893f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
1690984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
1691674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1692984c4197SStefano Zampini 
1693984c4197SStefano Zampini           /* explictly compute R^-T */
1694984c4197SStefano Zampini           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
1695984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
16963f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
16973f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
16983f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
16993f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
1700984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
17013f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
1702984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
1703984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1704984c4197SStefano Zampini 
1705984c4197SStefano Zampini           /* explcitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
17063f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
17073f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
17083f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
17093f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1710984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
17113f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
1712984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
1713984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1714984c4197SStefano Zampini 
1715984c4197SStefano Zampini           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
1716984c4197SStefano Zampini              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
1717984c4197SStefano Zampini              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
17183f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
17193f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
17203f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
17213f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
17223f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
17233f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1724984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1725c4303822SStefano 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));
1726984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1727026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1728984c4197SStefano Zampini 
1729984c4197SStefano Zampini           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
1730026de310SStefano Zampini           start_rows = &temp_indices_to_constraint_B[temp_indices[total_counts]];
1731984c4197SStefano Zampini           /* insert cols for primal dofs */
1732984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) {
1733984c4197SStefano Zampini             start_vals = &qr_basis[j*size_of_constraint];
1734026de310SStefano Zampini             start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter+j]];
1735984c4197SStefano Zampini             ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1736984c4197SStefano Zampini           }
1737984c4197SStefano Zampini           /* insert cols for dual dofs */
1738984c4197SStefano Zampini           for (j=0,k=0;j<dual_dofs;k++) {
17394641a718SStefano Zampini             if (!PetscBTLookup(is_primal,temp_indices_to_constraint_B[temp_indices[total_counts]+k])) {
1740984c4197SStefano Zampini               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
1741026de310SStefano Zampini               start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+k];
1742984c4197SStefano Zampini               ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1743984c4197SStefano Zampini               j++;
1744674ae819SStefano Zampini             }
1745674ae819SStefano Zampini           }
1746984c4197SStefano Zampini 
1747984c4197SStefano Zampini           /* check change of basis */
1748984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
1749984c4197SStefano Zampini             PetscInt   ii,jj;
1750984c4197SStefano Zampini             PetscBool valid_qr=PETSC_TRUE;
1751c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
1752c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1753c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
1754c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1755c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
1756c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
1757984c4197SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1758c4303822SStefano 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));
1759984c4197SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
1760984c4197SStefano Zampini             for (jj=0;jj<size_of_constraint;jj++) {
1761984c4197SStefano Zampini               for (ii=0;ii<primal_dofs;ii++) {
1762984c4197SStefano Zampini                 if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
1763984c4197SStefano Zampini                 if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
1764674ae819SStefano Zampini               }
1765674ae819SStefano Zampini             }
1766984c4197SStefano Zampini             if (!valid_qr) {
1767984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
1768984c4197SStefano Zampini               for (jj=0;jj<size_of_constraint;jj++) {
1769984c4197SStefano Zampini                 for (ii=0;ii<primal_dofs;ii++) {
1770984c4197SStefano Zampini                   if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
1771984c4197SStefano 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]));
1772674ae819SStefano Zampini                   }
1773984c4197SStefano Zampini                   if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
1774984c4197SStefano 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]));
1775984c4197SStefano Zampini                   }
1776984c4197SStefano Zampini                 }
1777984c4197SStefano Zampini               }
1778674ae819SStefano Zampini             } else {
1779984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
1780674ae819SStefano Zampini             }
1781674ae819SStefano Zampini           }
1782026de310SStefano Zampini           /* increment primal counter */
1783026de310SStefano Zampini           primal_counter += primal_dofs;
1784984c4197SStefano Zampini         } else {
1785984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
1786026de310SStefano 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);
1787674ae819SStefano Zampini           }
1788674ae819SStefano Zampini         }
1789026de310SStefano Zampini         /* increment constraint counter total_counts */
1790026de310SStefano Zampini         total_counts += primal_dofs;
1791674ae819SStefano Zampini       }
1792984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
1793984c4197SStefano Zampini         ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1794984c4197SStefano Zampini         ierr = PetscFree(work);CHKERRQ(ierr);
1795984c4197SStefano Zampini       }
1796984c4197SStefano Zampini       /* free workspace */
1797984c4197SStefano Zampini       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
1798984c4197SStefano Zampini       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
1799984c4197SStefano Zampini       ierr = PetscFree(qr_work);CHKERRQ(ierr);
1800984c4197SStefano Zampini       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
18014641a718SStefano Zampini       ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
1802984c4197SStefano Zampini       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
1803674ae819SStefano Zampini     }
1804674ae819SStefano Zampini     /* assembling */
1805674ae819SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1806674ae819SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1807984c4197SStefano Zampini     /*
1808984c4197SStefano Zampini     ierr = MatView(pcbddc->ChangeOfBasisMatrix,(PetscViewer)0);CHKERRQ(ierr);
1809984c4197SStefano Zampini     */
1810674ae819SStefano Zampini   }
1811e310c8b4SStefano Zampini   /* free workspace */
1812984c4197SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
1813984c4197SStefano Zampini   ierr = PetscFree(aux_primal_minloc);CHKERRQ(ierr);
1814674ae819SStefano Zampini   ierr = PetscFree(temp_indices);CHKERRQ(ierr);
18154641a718SStefano Zampini   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
1816674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr);
1817674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
1818674ae819SStefano Zampini   ierr = PetscFree(local_to_B);CHKERRQ(ierr);
1819674ae819SStefano Zampini   ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr);
1820674ae819SStefano Zampini   PetscFunctionReturn(0);
1821674ae819SStefano Zampini }
1822674ae819SStefano Zampini 
1823674ae819SStefano Zampini #undef __FUNCT__
1824674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
1825674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
1826674ae819SStefano Zampini {
1827674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
1828674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
1829674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
1830674ae819SStefano Zampini   PetscInt    bs,ierr,i,vertex_size;
1831674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
1832674ae819SStefano Zampini 
1833674ae819SStefano Zampini   PetscFunctionBegin;
1834674ae819SStefano Zampini   /* Init local Graph struct */
1835674ae819SStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr);
1836674ae819SStefano Zampini 
1837575ad6abSStefano Zampini   /* Check validity of the csr graph passed in by the user */
1838575ad6abSStefano Zampini   if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) {
1839575ad6abSStefano Zampini     ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1840575ad6abSStefano Zampini   }
1841674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
1842674ae819SStefano Zampini   if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) {
1843674ae819SStefano Zampini     Mat mat_adj;
1844674ae819SStefano Zampini     const PetscInt *xadj,*adjncy;
1845674ae819SStefano Zampini     PetscBool flg_row=PETSC_TRUE;
1846674ae819SStefano Zampini 
1847674ae819SStefano Zampini     ierr = MatConvert(matis->A,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr);
1848674ae819SStefano Zampini     ierr = MatGetRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
1849674ae819SStefano Zampini     if (!flg_row) {
1850674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ called in %s\n",__FUNCT__);
1851674ae819SStefano Zampini     }
1852674ae819SStefano Zampini     ierr = PCBDDCSetLocalAdjacencyGraph(pc,i,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
1853674ae819SStefano Zampini     ierr = MatRestoreRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
1854674ae819SStefano Zampini     if (!flg_row) {
1855674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__);
1856674ae819SStefano Zampini     }
1857674ae819SStefano Zampini     ierr = MatDestroy(&mat_adj);CHKERRQ(ierr);
1858674ae819SStefano Zampini   }
1859674ae819SStefano Zampini 
1860674ae819SStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting */
1861674ae819SStefano Zampini   vertex_size = 1;
1862674ae819SStefano Zampini   if (!pcbddc->n_ISForDofs) {
1863674ae819SStefano Zampini     IS *custom_ISForDofs;
1864674ae819SStefano Zampini 
1865674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&bs);CHKERRQ(ierr);
1866674ae819SStefano Zampini     ierr = PetscMalloc(bs*sizeof(IS),&custom_ISForDofs);CHKERRQ(ierr);
1867674ae819SStefano Zampini     for (i=0;i<bs;i++) {
1868674ae819SStefano Zampini       ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n/bs,i,bs,&custom_ISForDofs[i]);CHKERRQ(ierr);
1869674ae819SStefano Zampini     }
1870674ae819SStefano Zampini     ierr = PCBDDCSetDofsSplitting(pc,bs,custom_ISForDofs);CHKERRQ(ierr);
1871674ae819SStefano Zampini     /* remove my references to IS objects */
1872674ae819SStefano Zampini     for (i=0;i<bs;i++) {
1873674ae819SStefano Zampini       ierr = ISDestroy(&custom_ISForDofs[i]);CHKERRQ(ierr);
1874674ae819SStefano Zampini     }
1875674ae819SStefano Zampini     ierr = PetscFree(custom_ISForDofs);CHKERRQ(ierr);
1876674ae819SStefano Zampini   } else { /* mat block size as vertex size (used for elasticity) */
1877674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
1878674ae819SStefano Zampini   }
1879674ae819SStefano Zampini 
1880674ae819SStefano Zampini   /* Setup of Graph */
1881674ae819SStefano Zampini   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundaries,pcbddc->DirichletBoundaries,pcbddc->n_ISForDofs,pcbddc->ISForDofs,pcbddc->user_primal_vertices);
1882674ae819SStefano Zampini 
1883674ae819SStefano Zampini   /* Graph's connected components analysis */
1884674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
1885674ae819SStefano Zampini 
1886674ae819SStefano Zampini   /* print some info to stdout */
1887674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
1888e49050b4SStefano Zampini     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer);
1889674ae819SStefano Zampini   }
1890674ae819SStefano Zampini   PetscFunctionReturn(0);
1891674ae819SStefano Zampini }
1892674ae819SStefano Zampini 
1893674ae819SStefano Zampini #undef __FUNCT__
1894674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx"
1895f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt **vertices_idx)
1896674ae819SStefano Zampini {
1897674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
1898674ae819SStefano Zampini   PetscInt       *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size;
1899674ae819SStefano Zampini   PetscErrorCode ierr;
1900674ae819SStefano Zampini 
1901674ae819SStefano Zampini   PetscFunctionBegin;
1902674ae819SStefano Zampini   n = 0;
1903674ae819SStefano Zampini   vertices = 0;
1904674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
1905674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr);
1906b120a5c6SStefano Zampini     for (i=0;i<local_primal_size;i++) {
1907b120a5c6SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
1908b120a5c6SStefano Zampini       if (size_of_constraint == 1) n++;
1909b120a5c6SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
1910b120a5c6SStefano Zampini     }
1911811e8ca2SStefano Zampini     if (vertices_idx) {
1912b120a5c6SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&vertices);CHKERRQ(ierr);
1913b120a5c6SStefano Zampini       n = 0;
1914674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
1915674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
1916674ae819SStefano Zampini         if (size_of_constraint == 1) {
1917674ae819SStefano Zampini           vertices[n++]=row_cmat_indices[0];
1918674ae819SStefano Zampini         }
1919674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
1920674ae819SStefano Zampini       }
1921674ae819SStefano Zampini     }
1922811e8ca2SStefano Zampini   }
1923674ae819SStefano Zampini   *n_vertices = n;
1924811e8ca2SStefano Zampini   if (vertices_idx) *vertices_idx = vertices;
1925674ae819SStefano Zampini   PetscFunctionReturn(0);
1926674ae819SStefano Zampini }
1927674ae819SStefano Zampini 
1928674ae819SStefano Zampini #undef __FUNCT__
1929674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx"
1930f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt **constraints_idx)
1931674ae819SStefano Zampini {
1932674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
1933674ae819SStefano Zampini   PetscInt       *constraints_index,*row_cmat_indices,*row_cmat_global_indices;
1934674ae819SStefano Zampini   PetscInt       n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc;
19354641a718SStefano Zampini   PetscBT        touched;
1936674ae819SStefano Zampini   PetscErrorCode ierr;
1937674ae819SStefano Zampini 
1938f34684f1SStefano Zampini     /* This function assumes that the number of local constraints per connected component
1939f34684f1SStefano Zampini        is not greater than the number of nodes defined for the connected component
1940f34684f1SStefano Zampini        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
1941674ae819SStefano Zampini   PetscFunctionBegin;
1942674ae819SStefano Zampini   n = 0;
1943674ae819SStefano Zampini   constraints_index = 0;
1944674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
1945674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr);
1946674ae819SStefano Zampini     max_size_of_constraint = 0;
1947674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
1948674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
1949674ae819SStefano Zampini       if (size_of_constraint > 1) {
1950674ae819SStefano Zampini         n++;
1951674ae819SStefano Zampini       }
1952674ae819SStefano Zampini       max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint);
1953674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
1954674ae819SStefano Zampini     }
1955811e8ca2SStefano Zampini     if (constraints_idx) {
1956674ae819SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&constraints_index);CHKERRQ(ierr);
1957674ae819SStefano Zampini       ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&row_cmat_global_indices);CHKERRQ(ierr);
19584641a718SStefano Zampini       ierr = PetscBTCreate(local_size,&touched);CHKERRQ(ierr);
1959674ae819SStefano Zampini       n = 0;
1960674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
1961674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
1962674ae819SStefano Zampini         if (size_of_constraint > 1) {
1963674ae819SStefano Zampini           ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr);
196482d3d8afSStefano Zampini           /* find first untouched local node */
196582d3d8afSStefano Zampini           j = 0;
19664641a718SStefano Zampini           while (PetscBTLookup(touched,row_cmat_indices[j])) j++;
196782d3d8afSStefano Zampini           min_index = row_cmat_global_indices[j];
196882d3d8afSStefano Zampini           min_loc = j;
196982d3d8afSStefano Zampini           /* search the minimum among nodes not yet touched on the connected component
197082d3d8afSStefano Zampini              since there can be more than one constraint on a single cc */
1971674ae819SStefano Zampini           for (j=1;j<size_of_constraint;j++) {
19724641a718SStefano Zampini             if (!PetscBTLookup(touched,row_cmat_indices[j]) && min_index > row_cmat_global_indices[j]) {
1973674ae819SStefano Zampini               min_index = row_cmat_global_indices[j];
1974674ae819SStefano Zampini               min_loc = j;
1975674ae819SStefano Zampini             }
1976674ae819SStefano Zampini           }
19774641a718SStefano Zampini           ierr = PetscBTSet(touched,row_cmat_indices[min_loc]);CHKERRQ(ierr);
1978674ae819SStefano Zampini           constraints_index[n++] = row_cmat_indices[min_loc];
1979674ae819SStefano Zampini         }
1980674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
1981674ae819SStefano Zampini       }
19824641a718SStefano Zampini       ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
1983674ae819SStefano Zampini       ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr);
1984811e8ca2SStefano Zampini     }
1985811e8ca2SStefano Zampini   }
1986674ae819SStefano Zampini   *n_constraints = n;
1987811e8ca2SStefano Zampini   if (constraints_idx) *constraints_idx = constraints_index;
1988674ae819SStefano Zampini   PetscFunctionReturn(0);
1989674ae819SStefano Zampini }
1990674ae819SStefano Zampini 
1991674ae819SStefano Zampini /* the next two functions has been adapted from pcis.c */
1992674ae819SStefano Zampini #undef __FUNCT__
1993674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchur"
1994674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchur(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
1995674ae819SStefano Zampini {
1996674ae819SStefano Zampini   PetscErrorCode ierr;
1997674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
1998674ae819SStefano Zampini 
1999674ae819SStefano Zampini   PetscFunctionBegin;
2000674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2001674ae819SStefano Zampini   ierr = MatMult(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2002674ae819SStefano Zampini   ierr = MatMult(pcis->A_IB,v,vec1_D);CHKERRQ(ierr);
2003674ae819SStefano Zampini   ierr = KSPSolve(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2004674ae819SStefano Zampini   ierr = MatMult(pcis->A_BI,vec2_D,vec2_B);CHKERRQ(ierr);
2005674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2006674ae819SStefano Zampini   PetscFunctionReturn(0);
2007674ae819SStefano Zampini }
2008674ae819SStefano Zampini 
2009674ae819SStefano Zampini #undef __FUNCT__
2010674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchurTranspose"
2011674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchurTranspose(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2012674ae819SStefano Zampini {
2013674ae819SStefano Zampini   PetscErrorCode ierr;
2014674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2015674ae819SStefano Zampini 
2016674ae819SStefano Zampini   PetscFunctionBegin;
2017674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2018674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2019674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BI,v,vec1_D);CHKERRQ(ierr);
2020674ae819SStefano Zampini   ierr = KSPSolveTranspose(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2021674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_IB,vec2_D,vec2_B);CHKERRQ(ierr);
2022674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2023674ae819SStefano Zampini   PetscFunctionReturn(0);
2024674ae819SStefano Zampini }
2025674ae819SStefano Zampini 
2026674ae819SStefano Zampini #undef __FUNCT__
2027674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
2028674ae819SStefano 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[])
2029674ae819SStefano Zampini {
2030674ae819SStefano Zampini   Vec            local_vec,global_vec;
2031674ae819SStefano Zampini   IS             seqis,paris;
2032674ae819SStefano Zampini   VecScatter     scatter_ctx;
2033674ae819SStefano Zampini   PetscScalar    *array;
2034674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
2035674ae819SStefano Zampini   PetscScalar    globalsum;
2036674ae819SStefano Zampini   PetscInt       i,j,s;
2037674ae819SStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local;
2038674ae819SStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm,max_global;
2039674ae819SStefano Zampini   PetscMPIInt    *dof_sizes,*dof_displs;
2040674ae819SStefano Zampini   PetscBool      first_found;
2041674ae819SStefano Zampini   PetscErrorCode ierr;
2042674ae819SStefano Zampini 
2043674ae819SStefano Zampini   PetscFunctionBegin;
2044674ae819SStefano Zampini   /* mpi buffers */
2045674ae819SStefano Zampini   MPI_Comm_size(comm,&size_prec_comm);
2046674ae819SStefano Zampini   MPI_Comm_rank(comm,&rank_prec_comm);
2047674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
2048674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_sizes),&dof_sizes);CHKERRQ(ierr);
2049674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_displs),&dof_displs);CHKERRQ(ierr);
2050674ae819SStefano Zampini   /* get maximum size of subset */
2051674ae819SStefano Zampini   ierr = PetscMalloc(n_local_dofs*sizeof(PetscInt),&temp_global_dofs);CHKERRQ(ierr);
2052674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
2053674ae819SStefano Zampini   max_local = 0;
2054674ae819SStefano Zampini   if (n_local_dofs) {
2055674ae819SStefano Zampini     max_local = temp_global_dofs[0];
2056674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2057674ae819SStefano Zampini       if (max_local < temp_global_dofs[i] ) {
2058674ae819SStefano Zampini         max_local = temp_global_dofs[i];
2059674ae819SStefano Zampini       }
2060674ae819SStefano Zampini     }
2061674ae819SStefano Zampini   }
2062674ae819SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);
2063674ae819SStefano Zampini   max_global++;
2064674ae819SStefano Zampini   max_local = 0;
2065674ae819SStefano Zampini   if (n_local_dofs) {
2066674ae819SStefano Zampini     max_local = local_dofs[0];
2067674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2068674ae819SStefano Zampini       if (max_local < local_dofs[i] ) {
2069674ae819SStefano Zampini         max_local = local_dofs[i];
2070674ae819SStefano Zampini       }
2071674ae819SStefano Zampini     }
2072674ae819SStefano Zampini   }
2073674ae819SStefano Zampini   max_local++;
2074674ae819SStefano Zampini   /* allocate workspace */
2075674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
2076674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
2077674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
2078674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
2079674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
2080674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
2081674ae819SStefano Zampini   /* create scatter */
2082674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
2083674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
2084674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
2085674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
2086674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
2087674ae819SStefano Zampini   /* init array */
2088674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
2089674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2090674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2091674ae819SStefano Zampini   if (local_dofs_mult) {
2092674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2093674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
2094674ae819SStefano Zampini     }
2095674ae819SStefano Zampini   } else {
2096674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2097674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
2098674ae819SStefano Zampini     }
2099674ae819SStefano Zampini   }
2100674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2101674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
2102674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2103674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2104674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
21055b08dc53SStefano Zampini   *n_global_subset = (PetscInt)PetscRealPart(globalsum);
2106674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
2107674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
2108674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
2109674ae819SStefano Zampini   nlocals = 0;
2110674ae819SStefano Zampini   first_index = -1;
2111674ae819SStefano Zampini   first_found = PETSC_FALSE;
2112674ae819SStefano Zampini   for (i=0;i<s;i++) {
21135b08dc53SStefano Zampini     if (!first_found && PetscRealPart(array[i]) > 0.0) {
2114674ae819SStefano Zampini       first_found = PETSC_TRUE;
2115674ae819SStefano Zampini       first_index = i;
2116674ae819SStefano Zampini     }
21175b08dc53SStefano Zampini     nlocals += (PetscInt)PetscRealPart(array[i]);
2118674ae819SStefano Zampini   }
2119674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2120674ae819SStefano Zampini   if (!rank_prec_comm) {
2121674ae819SStefano Zampini     dof_displs[0]=0;
2122674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
2123674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
2124674ae819SStefano Zampini     }
2125674ae819SStefano Zampini   }
2126674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2127674ae819SStefano Zampini   if (first_found) {
2128674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
2129674ae819SStefano Zampini     old_index = first_index;
2130674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
21315b08dc53SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) {
2132674ae819SStefano Zampini         array[i] += array[old_index];
2133674ae819SStefano Zampini         old_index = i;
2134674ae819SStefano Zampini       }
2135674ae819SStefano Zampini     }
2136674ae819SStefano Zampini   }
2137674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
2138674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2139674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2140674ae819SStefano Zampini   ierr = VecScatterEnd  (scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2141674ae819SStefano Zampini   /* get global ordering of local dofs */
2142674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2143674ae819SStefano Zampini   if (local_dofs_mult) {
2144674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
21455b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i];
2146674ae819SStefano Zampini     }
2147674ae819SStefano Zampini   } else {
2148674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
21495b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1;
2150674ae819SStefano Zampini     }
2151674ae819SStefano Zampini   }
2152674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2153674ae819SStefano Zampini   /* free workspace */
2154674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
2155674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
2156674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
2157674ae819SStefano Zampini   ierr = PetscFree(dof_sizes);CHKERRQ(ierr);
2158674ae819SStefano Zampini   ierr = PetscFree(dof_displs);CHKERRQ(ierr);
2159674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
2160674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
2161674ae819SStefano Zampini   PetscFunctionReturn(0);
2162674ae819SStefano Zampini }
21639a7d3425SStefano Zampini 
21649a7d3425SStefano Zampini #undef __FUNCT__
21659a7d3425SStefano Zampini #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
21669a7d3425SStefano Zampini PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
21679a7d3425SStefano Zampini {
21689a7d3425SStefano Zampini   PetscInt       i,j;
21699a7d3425SStefano Zampini   PetscScalar    *alphas;
21709a7d3425SStefano Zampini   PetscErrorCode ierr;
21719a7d3425SStefano Zampini 
21729a7d3425SStefano Zampini   PetscFunctionBegin;
21739a7d3425SStefano Zampini   /* this implements stabilized Gram-Schmidt */
21749a7d3425SStefano Zampini   ierr = PetscMalloc(n*sizeof(PetscScalar),&alphas);CHKERRQ(ierr);
21759a7d3425SStefano Zampini   for (i=0;i<n;i++) {
21769a7d3425SStefano Zampini     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
21779a7d3425SStefano Zampini     if (i<n) { ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],&alphas[i+1]);CHKERRQ(ierr); }
21789a7d3425SStefano Zampini     for (j=i+1;j<n;j++) { ierr = VecAXPY(vecs[j],PetscConj(-alphas[j]),vecs[i]);CHKERRQ(ierr); }
21799a7d3425SStefano Zampini   }
21809a7d3425SStefano Zampini   ierr = PetscFree(alphas);CHKERRQ(ierr);
21819a7d3425SStefano Zampini   PetscFunctionReturn(0);
21829a7d3425SStefano Zampini }
21839a7d3425SStefano Zampini 
2184a57a6d2fSStefano Zampini /* Currently support MAT_INITIAL_MATRIX only, with partial support to block matrices */
2185a57a6d2fSStefano Zampini #undef __FUNCT__
2186a57a6d2fSStefano Zampini #define __FUNCT__ "MatConvert_IS_AIJ"
2187a57a6d2fSStefano Zampini static PetscErrorCode MatConvert_IS_AIJ(Mat mat, MatType newtype,MatReuse reuse,Mat *M)
2188a57a6d2fSStefano Zampini {
2189a57a6d2fSStefano Zampini   Mat new_mat;
2190a57a6d2fSStefano Zampini   Mat_IS *matis = (Mat_IS*)(mat->data);
2191a57a6d2fSStefano Zampini   /* info on mat */
2192a57a6d2fSStefano Zampini   PetscInt bs,rows,cols;
2193a57a6d2fSStefano Zampini   PetscInt lrows,lcols;
2194a57a6d2fSStefano Zampini   PetscInt local_rows,local_cols;
2195e7931f94SStefano Zampini   PetscMPIInt nsubdomains;
2196a57a6d2fSStefano Zampini   /* preallocation */
2197a57a6d2fSStefano Zampini   Vec vec_dnz,vec_onz;
2198a57a6d2fSStefano Zampini   PetscScalar *my_dnz,*my_onz,*array;
2199a57a6d2fSStefano Zampini   PetscInt *dnz,*onz,*mat_ranges,*row_ownership;
2200a57a6d2fSStefano Zampini   PetscInt  index_row,index_col,owner;
2201a57a6d2fSStefano Zampini   PetscInt  *local_indices,*global_indices;
2202a57a6d2fSStefano Zampini   /* work */
2203a57a6d2fSStefano Zampini   PetscInt i,j;
2204a57a6d2fSStefano Zampini   PetscErrorCode ierr;
2205a57a6d2fSStefano Zampini 
2206a57a6d2fSStefano Zampini   PetscFunctionBegin;
2207a57a6d2fSStefano Zampini   /* CHECKS */
2208a57a6d2fSStefano Zampini   /* get info from mat */
2209a57a6d2fSStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
2210a57a6d2fSStefano Zampini   ierr = MatGetBlockSize(mat,&bs);CHKERRQ(ierr);
2211a57a6d2fSStefano Zampini   ierr = MatGetSize(matis->A,&local_rows,&local_cols);CHKERRQ(ierr);
2212a57a6d2fSStefano Zampini   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&nsubdomains);CHKERRQ(ierr);
2213a57a6d2fSStefano Zampini 
2214a57a6d2fSStefano Zampini   /* MAT_INITIAL_MATRIX */
2215a57a6d2fSStefano Zampini   ierr = MatCreate(PetscObjectComm((PetscObject)mat),&new_mat);CHKERRQ(ierr);
2216a57a6d2fSStefano Zampini   ierr = MatSetSizes(new_mat,PETSC_DECIDE,PETSC_DECIDE,rows,cols);CHKERRQ(ierr);
2217a57a6d2fSStefano Zampini   ierr = MatSetBlockSize(new_mat,bs);CHKERRQ(ierr);
2218a57a6d2fSStefano Zampini   ierr = MatSetType(new_mat,newtype);CHKERRQ(ierr);
2219a57a6d2fSStefano Zampini   ierr = MatSetUp(new_mat);CHKERRQ(ierr);
2220a57a6d2fSStefano Zampini   ierr = MatGetLocalSize(new_mat,&lrows,&lcols);CHKERRQ(ierr);
2221a57a6d2fSStefano Zampini 
2222a57a6d2fSStefano Zampini   /*
2223a57a6d2fSStefano Zampini     preallocation
2224a57a6d2fSStefano Zampini   */
2225a57a6d2fSStefano Zampini 
2226a57a6d2fSStefano Zampini   ierr = MatPreallocateInitialize(PetscObjectComm((PetscObject)new_mat),lrows,lcols,dnz,onz);CHKERRQ(ierr);
2227a57a6d2fSStefano Zampini   /*
2228a57a6d2fSStefano Zampini      Some vectors are needed to sum up properly on shared interface dofs.
2229a57a6d2fSStefano Zampini      Note that preallocation is not exact, since it overestimates nonzeros
2230a57a6d2fSStefano Zampini   */
2231a57a6d2fSStefano Zampini /*
2232a57a6d2fSStefano Zampini   ierr = VecCreate(PetscObjectComm((PetscObject)mat),&vec_dnz);CHKERRQ(ierr);
2233a57a6d2fSStefano Zampini   ierr = VecSetBlockSize(vec_dnz,bs);CHKERRQ(ierr);
2234a57a6d2fSStefano Zampini   ierr = VecSetSizes(vec_dnz,PETSC_DECIDE,rows);CHKERRQ(ierr);
2235a57a6d2fSStefano Zampini   ierr = VecSetType(vec_dnz,VECSTANDARD);CHKERRQ(ierr);
2236a57a6d2fSStefano Zampini */
2237a57a6d2fSStefano Zampini   ierr = MatGetVecs(new_mat,NULL,&vec_dnz);CHKERRQ(ierr);
2238a57a6d2fSStefano Zampini   ierr = VecDuplicate(vec_dnz,&vec_onz);CHKERRQ(ierr);
2239e7931f94SStefano Zampini   /* All processes need to compute entire row ownership */
2240a57a6d2fSStefano Zampini   ierr = PetscMalloc(rows*sizeof(*row_ownership),&row_ownership);CHKERRQ(ierr);
2241a57a6d2fSStefano Zampini   ierr = MatGetOwnershipRanges(new_mat,(const PetscInt**)&mat_ranges);CHKERRQ(ierr);
2242a57a6d2fSStefano Zampini   for (i=0;i<nsubdomains;i++) {
2243a57a6d2fSStefano Zampini     for (j=mat_ranges[i];j<mat_ranges[i+1];j++) {
2244a57a6d2fSStefano Zampini       row_ownership[j]=i;
2245a57a6d2fSStefano Zampini     }
2246a57a6d2fSStefano Zampini   }
2247a57a6d2fSStefano Zampini   /* map indices of local mat to global values */
2248a57a6d2fSStefano Zampini   ierr = PetscMalloc(PetscMax(local_cols,local_rows)*sizeof(*global_indices),&global_indices);CHKERRQ(ierr);
2249a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*local_indices),&local_indices);CHKERRQ(ierr);
2250a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) local_indices[i]=i;
2251a57a6d2fSStefano Zampini   ierr = ISLocalToGlobalMappingApply(matis->mapping,local_rows,local_indices,global_indices);CHKERRQ(ierr);
2252a57a6d2fSStefano Zampini   ierr = PetscFree(local_indices);CHKERRQ(ierr);
2253a57a6d2fSStefano Zampini 
2254e7931f94SStefano Zampini   /*
2255e7931f94SStefano Zampini      my_dnz and my_onz contains exact contribution to preallocation from each local mat
2256e7931f94SStefano Zampini      then, they will be summed up properly. This way, preallocation is always sufficient
2257e7931f94SStefano Zampini   */
2258a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*my_dnz),&my_dnz);CHKERRQ(ierr);
2259a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*my_onz),&my_onz);CHKERRQ(ierr);
2260a57a6d2fSStefano Zampini   ierr = PetscMemzero(my_dnz,local_rows*sizeof(*my_dnz));CHKERRQ(ierr);
2261a57a6d2fSStefano Zampini   ierr = PetscMemzero(my_onz,local_rows*sizeof(*my_onz));CHKERRQ(ierr);
2262a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) {
2263a57a6d2fSStefano Zampini     index_row = global_indices[i];
2264a57a6d2fSStefano Zampini     for (j=i;j<local_rows;j++) {
2265a57a6d2fSStefano Zampini       owner = row_ownership[index_row];
2266a57a6d2fSStefano Zampini       index_col = global_indices[j];
2267a57a6d2fSStefano Zampini       if (index_col > mat_ranges[owner]-1 && index_col < mat_ranges[owner+1] ) { /* diag block */
2268a57a6d2fSStefano Zampini         my_dnz[i] += 1.0;
2269a57a6d2fSStefano Zampini       } else { /* offdiag block */
2270a57a6d2fSStefano Zampini         my_onz[i] += 1.0;
2271a57a6d2fSStefano Zampini       }
2272a57a6d2fSStefano Zampini       /* same as before, interchanging rows and cols */
2273a57a6d2fSStefano Zampini       if (i != j) {
2274a57a6d2fSStefano Zampini         owner = row_ownership[index_col];
2275a57a6d2fSStefano Zampini         if (index_row > mat_ranges[owner]-1 && index_row < mat_ranges[owner+1] ) {
2276a57a6d2fSStefano Zampini           my_dnz[j] += 1.0;
2277a57a6d2fSStefano Zampini         } else {
2278a57a6d2fSStefano Zampini           my_onz[j] += 1.0;
2279a57a6d2fSStefano Zampini         }
2280a57a6d2fSStefano Zampini       }
2281a57a6d2fSStefano Zampini     }
2282a57a6d2fSStefano Zampini   }
2283a57a6d2fSStefano Zampini   ierr = VecSet(vec_dnz,0.0);CHKERRQ(ierr);
2284a57a6d2fSStefano Zampini   ierr = VecSet(vec_onz,0.0);CHKERRQ(ierr);
228520a2ab83SStefano Zampini   if (local_rows) { /* multilevel guard */
2286a57a6d2fSStefano Zampini     ierr = VecSetValues(vec_dnz,local_rows,global_indices,my_dnz,ADD_VALUES);CHKERRQ(ierr);
2287a57a6d2fSStefano Zampini     ierr = VecSetValues(vec_onz,local_rows,global_indices,my_onz,ADD_VALUES);CHKERRQ(ierr);
2288a57a6d2fSStefano Zampini   }
2289a57a6d2fSStefano Zampini   ierr = VecAssemblyBegin(vec_dnz);CHKERRQ(ierr);
2290a57a6d2fSStefano Zampini   ierr = VecAssemblyBegin(vec_onz);CHKERRQ(ierr);
2291a57a6d2fSStefano Zampini   ierr = VecAssemblyEnd(vec_dnz);CHKERRQ(ierr);
2292a57a6d2fSStefano Zampini   ierr = VecAssemblyEnd(vec_onz);CHKERRQ(ierr);
2293a57a6d2fSStefano Zampini   ierr = PetscFree(my_dnz);CHKERRQ(ierr);
2294a57a6d2fSStefano Zampini   ierr = PetscFree(my_onz);CHKERRQ(ierr);
2295a57a6d2fSStefano Zampini   ierr = PetscFree(row_ownership);CHKERRQ(ierr);
2296a57a6d2fSStefano Zampini 
2297a57a6d2fSStefano Zampini   /* set computed preallocation in dnz and onz */
2298a57a6d2fSStefano Zampini   ierr = VecGetArray(vec_dnz,&array);CHKERRQ(ierr);
2299a57a6d2fSStefano Zampini   for (i=0; i<lrows; i++) dnz[i] = (PetscInt)PetscRealPart(array[i]);
2300a57a6d2fSStefano Zampini   ierr = VecRestoreArray(vec_dnz,&array);CHKERRQ(ierr);
2301a57a6d2fSStefano Zampini   ierr = VecGetArray(vec_onz,&array);CHKERRQ(ierr);
2302a57a6d2fSStefano Zampini   for (i=0;i<lrows;i++) onz[i] = (PetscInt)PetscRealPart(array[i]);
2303a57a6d2fSStefano Zampini   ierr = VecRestoreArray(vec_onz,&array);CHKERRQ(ierr);
2304a57a6d2fSStefano Zampini   ierr = VecDestroy(&vec_dnz);CHKERRQ(ierr);
2305a57a6d2fSStefano Zampini   ierr = VecDestroy(&vec_onz);CHKERRQ(ierr);
2306a57a6d2fSStefano Zampini 
2307e7931f94SStefano Zampini   /* Resize preallocation if overestimated */
2308a57a6d2fSStefano Zampini   for (i=0;i<lrows;i++) {
2309a57a6d2fSStefano Zampini     dnz[i] = PetscMin(dnz[i],lcols);
2310a57a6d2fSStefano Zampini     onz[i] = PetscMin(onz[i],cols-lcols);
2311a57a6d2fSStefano Zampini   }
2312a57a6d2fSStefano Zampini   ierr = MatMPIAIJSetPreallocation(new_mat,0,dnz,0,onz);CHKERRQ(ierr);
2313a57a6d2fSStefano Zampini   ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
2314a57a6d2fSStefano Zampini 
2315a57a6d2fSStefano Zampini   /*
2316e7931f94SStefano Zampini     Set values. Very Basic.
2317a57a6d2fSStefano Zampini   */
2318a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) {
2319a57a6d2fSStefano Zampini     ierr = MatGetRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2320a57a6d2fSStefano Zampini     ierr = ISLocalToGlobalMappingApply(matis->mapping,j,local_indices,global_indices);CHKERRQ(ierr);
2321a57a6d2fSStefano Zampini     ierr = ISLocalToGlobalMappingApply(matis->mapping,1,&i,&index_row);CHKERRQ(ierr);
2322a57a6d2fSStefano Zampini     ierr = MatSetValues(new_mat,1,&index_row,j,global_indices,array,ADD_VALUES);CHKERRQ(ierr);
2323a57a6d2fSStefano Zampini     ierr = MatRestoreRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2324a57a6d2fSStefano Zampini   }
232520a2ab83SStefano Zampini   ierr = MatAssemblyBegin(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2326a57a6d2fSStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
232720a2ab83SStefano Zampini   ierr = MatAssemblyEnd(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2328a57a6d2fSStefano Zampini 
2329a57a6d2fSStefano Zampini   /* get back mat */
2330a57a6d2fSStefano Zampini   *M = new_mat;
2331a57a6d2fSStefano Zampini   PetscFunctionReturn(0);
2332a57a6d2fSStefano Zampini }
2333a57a6d2fSStefano Zampini 
2334e7931f94SStefano Zampini #undef __FUNCT__
2335e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble_Private"
2336e7931f94SStefano Zampini PetscErrorCode MatISSubassemble_Private(Mat mat, PetscInt coarsening_ratio, IS* is_sends)
2337e7931f94SStefano Zampini {
2338e7931f94SStefano Zampini   Mat             subdomain_adj;
2339e7931f94SStefano Zampini   IS              new_ranks,ranks_send_to;
2340e7931f94SStefano Zampini   MatPartitioning partitioner;
2341e7931f94SStefano Zampini   Mat_IS          *matis;
2342e7931f94SStefano Zampini   PetscInt        n_neighs,*neighs,*n_shared,**shared;
2343e7931f94SStefano Zampini   PetscInt        prank;
2344e7931f94SStefano Zampini   PetscMPIInt     size,rank,color;
2345e7931f94SStefano Zampini   PetscInt        *xadj,*adjncy,*oldranks;
2346e7931f94SStefano Zampini   PetscInt        *adjncy_wgt,*v_wgt,*is_indices,*ranks_send_to_idx;
2347e7931f94SStefano Zampini   PetscInt        i,j,n_subdomains,local_size,threshold=0;
2348e7931f94SStefano Zampini   PetscErrorCode  ierr;
2349e7931f94SStefano Zampini   PetscBool       use_vwgt=PETSC_FALSE,use_square=PETSC_FALSE,use_threshold=PETSC_FALSE;
2350e7931f94SStefano Zampini   PetscSubcomm    subcomm;
2351a57a6d2fSStefano Zampini 
2352e7931f94SStefano Zampini   PetscFunctionBegin;
2353e7931f94SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matisc_use_square",&use_square,NULL);CHKERRQ(ierr);
2354e7931f94SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matisc_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
2355e7931f94SStefano Zampini   ierr = PetscOptionsGetInt(NULL,"-matisc_threshold",&threshold,&use_threshold);CHKERRQ(ierr);
2356e7931f94SStefano Zampini 
2357e7931f94SStefano Zampini   /* Get info on mapping */
2358e7931f94SStefano Zampini   matis = (Mat_IS*)(mat->data);
2359e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&local_size);CHKERRQ(ierr);
2360e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2361e7931f94SStefano Zampini 
2362e7931f94SStefano Zampini   /* build local CSR graph of subdomains' connectivity */
2363e7931f94SStefano Zampini   ierr = PetscMalloc(2*sizeof(*xadj),&xadj);CHKERRQ(ierr);
2364e7931f94SStefano Zampini   xadj[0] = 0;
2365e7931f94SStefano Zampini   xadj[1] = PetscMax(n_neighs-1,0);
2366e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy),&adjncy);CHKERRQ(ierr);
2367e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy_wgt),&adjncy_wgt);CHKERRQ(ierr);
2368e7931f94SStefano Zampini 
2369e7931f94SStefano Zampini   if (use_threshold) {
2370e7931f94SStefano Zampini     PetscInt* count;
2371e7931f94SStefano Zampini     ierr = PetscMalloc(local_size*sizeof(PetscInt),&count);CHKERRQ(ierr);
2372e7931f94SStefano Zampini     ierr = PetscMemzero(count,local_size*sizeof(PetscInt));CHKERRQ(ierr);
2373e7931f94SStefano Zampini     for (i=1;i<n_neighs;i++) {/* i=1 so I don't count myself -> faces nodes counts to 1 */
2374e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2375e7931f94SStefano Zampini         count[shared[i][j]] += 1;
2376e7931f94SStefano Zampini       }
2377e7931f94SStefano Zampini     }
2378e7931f94SStefano Zampini     xadj[1] = 0;
2379e7931f94SStefano Zampini     for (i=1;i<n_neighs;i++) {/* i=1 so I don't count myself -> faces nodes counts to 1 */
2380e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2381e7931f94SStefano Zampini         if (count[shared[i][j]] < threshold) {
2382e7931f94SStefano Zampini           adjncy[xadj[1]] = neighs[i];
2383e7931f94SStefano Zampini           adjncy_wgt[xadj[1]] = n_shared[i];
2384e7931f94SStefano Zampini           xadj[1]++;
2385e7931f94SStefano Zampini           break;
2386e7931f94SStefano Zampini         }
2387e7931f94SStefano Zampini       }
2388e7931f94SStefano Zampini     }
2389e7931f94SStefano Zampini     ierr = PetscFree(count);CHKERRQ(ierr);
2390e7931f94SStefano Zampini   } else {
2391e7931f94SStefano Zampini     if (xadj[1]) {
2392e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy,&neighs[1],xadj[1]*sizeof(*adjncy));CHKERRQ(ierr);
2393e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy_wgt,&n_shared[1],xadj[1]*sizeof(*adjncy_wgt));CHKERRQ(ierr);
2394e7931f94SStefano Zampini     }
2395e7931f94SStefano Zampini   }
2396e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingRestoreInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2397e7931f94SStefano Zampini   if (use_square) {
2398e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2399e7931f94SStefano Zampini       adjncy_wgt[i] = adjncy_wgt[i]*adjncy_wgt[i];
2400e7931f94SStefano Zampini     }
2401e7931f94SStefano Zampini   }
2402e7931f94SStefano Zampini   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2403e7931f94SStefano Zampini 
2404e7931f94SStefano Zampini   ierr = PetscMalloc(sizeof(PetscInt),&ranks_send_to_idx);CHKERRQ(ierr);
2405e7931f94SStefano Zampini 
2406e7931f94SStefano Zampini   /*
2407e7931f94SStefano Zampini     Restrict work on active processes only.
2408e7931f94SStefano Zampini   */
2409e7931f94SStefano Zampini   ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&subcomm);CHKERRQ(ierr);
2410e7931f94SStefano Zampini   ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
2411e7931f94SStefano Zampini   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
2412e7931f94SStefano Zampini   ierr = PetscMPIIntCast(!n_neighs,&color);CHKERRQ(ierr);
2413e7931f94SStefano Zampini   ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank,rank);CHKERRQ(ierr);
2414e7931f94SStefano Zampini   if (color) {
2415e7931f94SStefano Zampini     ierr = PetscFree(xadj);CHKERRQ(ierr);
2416e7931f94SStefano Zampini     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2417e7931f94SStefano Zampini     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
2418e7931f94SStefano Zampini   } else {
2419e7931f94SStefano Zampini     ierr = MPI_Comm_size(subcomm->comm,&size);CHKERRQ(ierr);
2420e7931f94SStefano Zampini     ierr = PetscMalloc(size*sizeof(*oldranks),&oldranks);CHKERRQ(ierr);
2421e7931f94SStefano Zampini     prank = rank;
2422e7931f94SStefano Zampini     ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm->comm);CHKERRQ(ierr);
2423e7931f94SStefano Zampini     for (i=0;i<size;i++) {
2424e7931f94SStefano Zampini       PetscPrintf(subcomm->comm,"oldranks[%d] = %d\n",i,oldranks[i]);
2425e7931f94SStefano Zampini     }
2426e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2427e7931f94SStefano Zampini       ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
2428e7931f94SStefano Zampini     }
2429e7931f94SStefano Zampini     ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2430e7931f94SStefano Zampini     ierr = MatCreateMPIAdj(subcomm->comm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
2431e7931f94SStefano Zampini     n_subdomains = (PetscInt)size;
2432e7931f94SStefano Zampini     ierr = MatView(subdomain_adj,0);CHKERRQ(ierr);
2433e7931f94SStefano Zampini 
2434e7931f94SStefano Zampini     /* Partition */
2435e7931f94SStefano Zampini     ierr = MatPartitioningCreate(subcomm->comm,&partitioner);CHKERRQ(ierr);
2436e7931f94SStefano Zampini     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
2437e7931f94SStefano Zampini     if (use_vwgt) {
2438e7931f94SStefano Zampini       ierr = PetscMalloc(sizeof(*v_wgt),&v_wgt);CHKERRQ(ierr);
2439e7931f94SStefano Zampini       v_wgt[0] = local_size;
2440e7931f94SStefano Zampini       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
2441e7931f94SStefano Zampini     }
2442e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)partitioner),"NPARTS %d\n",n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2443e7931f94SStefano Zampini     ierr = MatPartitioningSetNParts(partitioner,n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2444e7931f94SStefano Zampini     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
2445e7931f94SStefano Zampini     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
2446e7931f94SStefano Zampini     ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr);
2447e7931f94SStefano Zampini     ierr = ISView(new_ranks,0);CHKERRQ(ierr);
2448e7931f94SStefano Zampini 
2449e7931f94SStefano Zampini     ierr = ISGetIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2450e7931f94SStefano Zampini     ranks_send_to_idx[0] = oldranks[is_indices[0]];
2451e7931f94SStefano Zampini     ierr = ISRestoreIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2452e7931f94SStefano Zampini     /* clean up */
2453e7931f94SStefano Zampini     ierr = PetscFree(oldranks);CHKERRQ(ierr);
2454e7931f94SStefano Zampini     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
2455e7931f94SStefano Zampini     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
2456e7931f94SStefano Zampini     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
2457e7931f94SStefano Zampini   }
2458e7931f94SStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
2459e7931f94SStefano Zampini 
2460e7931f94SStefano Zampini   /* assemble parallel IS for sends */
2461e7931f94SStefano Zampini   i = 1;
2462e7931f94SStefano Zampini   if (color) i=0;
2463e7931f94SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,&ranks_send_to);CHKERRQ(ierr);
2464e7931f94SStefano Zampini   ierr = ISView(ranks_send_to,0);CHKERRQ(ierr);
2465e7931f94SStefano Zampini 
2466e7931f94SStefano Zampini   /* get back IS */
2467e7931f94SStefano Zampini   *is_sends = ranks_send_to;
2468e7931f94SStefano Zampini   PetscFunctionReturn(0);
2469e7931f94SStefano Zampini }
2470e7931f94SStefano Zampini 
2471e7931f94SStefano Zampini typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
2472e7931f94SStefano Zampini 
2473e7931f94SStefano Zampini #undef __FUNCT__
2474e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble"
2475e7931f94SStefano Zampini PetscErrorCode MatISSubassemble(Mat mat, IS is_sends, PetscInt coarsening_ratio, Mat *mat_n)
2476e7931f94SStefano Zampini {
2477e7931f94SStefano Zampini   Mat                    local_mat,new_mat;
2478e7931f94SStefano Zampini   Mat_IS                 *matis;
2479e7931f94SStefano Zampini   IS                     is_sends_internal;
2480e7931f94SStefano Zampini   PetscInt               rows,cols;
2481e7931f94SStefano Zampini   PetscInt               i,bs,buf_size_idxs,buf_size_vals;
2482e7931f94SStefano Zampini   PetscBool              ismatis,isdense;
2483e7931f94SStefano Zampini   ISLocalToGlobalMapping l2gmap;
2484e7931f94SStefano Zampini   PetscInt*              l2gmap_indices;
2485e7931f94SStefano Zampini   const PetscInt*        is_indices;
2486e7931f94SStefano Zampini   MatType                new_local_type;
2487e7931f94SStefano Zampini   MatTypePrivate         new_local_type_private;
2488e7931f94SStefano Zampini   /* buffers */
2489e7931f94SStefano Zampini   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
2490e7931f94SStefano Zampini   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
2491e7931f94SStefano Zampini   /* MPI */
2492e7931f94SStefano Zampini   MPI_Comm               comm;
2493e7931f94SStefano Zampini   PetscMPIInt            n_sends,n_recvs,commsize;
2494e7931f94SStefano Zampini   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals;
2495e7931f94SStefano Zampini   PetscMPIInt            *onodes,*olengths_idxs,*olengths_vals;
2496e7931f94SStefano Zampini   PetscMPIInt            len,tag_idxs,tag_vals,source_dest;
2497e7931f94SStefano Zampini   MPI_Request            *send_req_idxs,*send_req_vals,*recv_req_idxs,*recv_req_vals;
2498e7931f94SStefano Zampini   PetscErrorCode         ierr;
2499e7931f94SStefano Zampini 
2500e7931f94SStefano Zampini   PetscFunctionBegin;
2501e7931f94SStefano Zampini   /* checks */
2502e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
2503e7931f94SStefano Zampini   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on an matrix object which is not of type MATIS",__FUNCT__);
2504e7931f94SStefano Zampini   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2505e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
2506e7931f94SStefano Zampini   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
2507e7931f94SStefano Zampini   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
2508e7931f94SStefano Zampini   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
2509e7931f94SStefano Zampini   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
2510e7931f94SStefano Zampini   PetscValidLogicalCollectiveInt(mat,bs,0);
2511e7931f94SStefano Zampini   /* prepare IS for sending if not provided */
2512e7931f94SStefano Zampini   if (!is_sends) {
2513e7931f94SStefano Zampini     if (!coarsening_ratio) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a coarsening ratio");
2514e7931f94SStefano Zampini     ierr = MatISSubassemble_Private(mat,coarsening_ratio,&is_sends_internal);CHKERRQ(ierr);
2515e7931f94SStefano Zampini   } else {
2516e7931f94SStefano Zampini     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
2517e7931f94SStefano Zampini     is_sends_internal = is_sends;
2518e7931f94SStefano Zampini   }
2519e7931f94SStefano Zampini 
2520e7931f94SStefano Zampini   /* get pointer of MATIS data */
2521e7931f94SStefano Zampini   matis = (Mat_IS*)mat->data;
2522e7931f94SStefano Zampini 
2523e7931f94SStefano Zampini   /* get comm */
2524e7931f94SStefano Zampini   comm = PetscObjectComm((PetscObject)mat);
2525e7931f94SStefano Zampini 
2526e7931f94SStefano Zampini   /* compute number of sends */
2527e7931f94SStefano Zampini   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
2528e7931f94SStefano Zampini   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
2529e7931f94SStefano Zampini 
2530e7931f94SStefano Zampini   /* compute number of receives */
2531e7931f94SStefano Zampini   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
2532e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*iflags),&iflags);CHKERRQ(ierr);
2533e7931f94SStefano Zampini   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
2534e7931f94SStefano Zampini   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2535e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
2536e7931f94SStefano Zampini   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
2537e7931f94SStefano Zampini   ierr = PetscFree(iflags);CHKERRQ(ierr);
2538e7931f94SStefano Zampini 
2539e7931f94SStefano Zampini   /* prepare send/receive buffers */
2540e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_idxs),&ilengths_idxs);CHKERRQ(ierr);
2541e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
2542e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_vals),&ilengths_vals);CHKERRQ(ierr);
2543e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
2544e7931f94SStefano Zampini 
2545e7931f94SStefano Zampini   /* Get data from local mat */
2546e7931f94SStefano Zampini   if (!isdense) {
2547e7931f94SStefano Zampini     /* TODO: See below some guidelines on how to prepare the local buffers */
2548e7931f94SStefano Zampini     /*
2549e7931f94SStefano Zampini        send_buffer_vals should contain the raw values of the local matrix
2550e7931f94SStefano Zampini        send_buffer_idxs should contain:
2551e7931f94SStefano Zampini        - MatType_PRIVATE type
2552e7931f94SStefano Zampini        - PetscInt        size_of_l2gmap
2553e7931f94SStefano Zampini        - PetscInt        global_row_indices[size_of_l2gmap]
2554e7931f94SStefano Zampini        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
2555e7931f94SStefano Zampini     */
2556e7931f94SStefano Zampini   } else {
2557e7931f94SStefano Zampini     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
2558e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&i);CHKERRQ(ierr);
2559e7931f94SStefano Zampini     ierr = PetscMalloc((i+2)*sizeof(PetscInt),&send_buffer_idxs);CHKERRQ(ierr);
2560e7931f94SStefano Zampini     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
2561e7931f94SStefano Zampini     send_buffer_idxs[1] = i;
2562e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2563e7931f94SStefano Zampini     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
2564e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingRestoreIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2565e7931f94SStefano Zampini     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
2566e7931f94SStefano Zampini     for (i=0;i<n_sends;i++) {
2567e7931f94SStefano Zampini       ilengths_vals[is_indices[i]] = len*len;
2568e7931f94SStefano Zampini       ilengths_idxs[is_indices[i]] = len+2;
2569e7931f94SStefano Zampini     }
2570e7931f94SStefano Zampini   }
2571e7931f94SStefano Zampini   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
2572e7931f94SStefano Zampini   buf_size_idxs = 0;
2573e7931f94SStefano Zampini   buf_size_vals = 0;
2574e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2575e7931f94SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
2576e7931f94SStefano Zampini     buf_size_vals += (PetscInt)olengths_vals[i];
2577e7931f94SStefano Zampini   }
2578e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&recv_buffer_idxs);CHKERRQ(ierr);
2579e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_vals*sizeof(PetscScalar),&recv_buffer_vals);CHKERRQ(ierr);
2580e7931f94SStefano Zampini 
2581e7931f94SStefano Zampini   /* get new tags for clean communications */
2582e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
2583e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
2584e7931f94SStefano Zampini 
2585e7931f94SStefano Zampini   /* allocate for requests */
2586e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_idxs);CHKERRQ(ierr);
2587e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_vals);CHKERRQ(ierr);
2588e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_idxs);CHKERRQ(ierr);
2589e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_vals);CHKERRQ(ierr);
2590e7931f94SStefano Zampini 
2591e7931f94SStefano Zampini   /* communications */
2592e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2593e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
2594e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2595e7931f94SStefano Zampini     source_dest = onodes[i];
2596e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
2597e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
2598e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2599e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
2600e7931f94SStefano Zampini   }
2601e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) {
2602e7931f94SStefano Zampini     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
2603e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
2604e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
2605e7931f94SStefano Zampini   }
2606e7931f94SStefano Zampini   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2607e7931f94SStefano Zampini   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
2608e7931f94SStefano Zampini 
2609e7931f94SStefano Zampini   /* assemble new l2g map */
2610e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2611e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2612e7931f94SStefano Zampini   buf_size_idxs = 0;
2613e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2614e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
2615e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2616e7931f94SStefano Zampini   }
2617e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&l2gmap_indices);CHKERRQ(ierr);
2618e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2619e7931f94SStefano Zampini   buf_size_idxs = 0;
2620e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2621e7931f94SStefano Zampini     ierr = PetscMemcpy(&l2gmap_indices[buf_size_idxs],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
2622e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
2623e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2624e7931f94SStefano Zampini   }
2625e7931f94SStefano Zampini   ierr = PetscSortRemoveDupsInt(&buf_size_idxs,l2gmap_indices);CHKERRQ(ierr);
2626e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingCreate(comm,buf_size_idxs,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
2627e7931f94SStefano Zampini   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
2628e7931f94SStefano Zampini 
2629e7931f94SStefano Zampini   /* infer new local matrix type from received local matrices type */
2630e7931f94SStefano Zampini   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
2631e7931f94SStefano 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) */
2632e7931f94SStefano Zampini   new_local_type_private = MATAIJ_PRIVATE;
2633e7931f94SStefano Zampini   new_local_type = MATSEQAIJ;
2634e7931f94SStefano Zampini   if (n_recvs) {
2635e7931f94SStefano Zampini     new_local_type_private = send_buffer_idxs[0];
2636e7931f94SStefano Zampini     ptr_idxs = recv_buffer_idxs;
2637e7931f94SStefano Zampini     for (i=0;i<n_recvs;i++) {
2638e7931f94SStefano Zampini       if ((PetscInt)new_local_type_private != *ptr_idxs) {
2639e7931f94SStefano Zampini         new_local_type_private = MATAIJ_PRIVATE;
2640e7931f94SStefano Zampini         break;
2641e7931f94SStefano Zampini       }
2642e7931f94SStefano Zampini       ptr_idxs += olengths_idxs[i];
2643e7931f94SStefano Zampini     }
2644e7931f94SStefano Zampini     switch (new_local_type_private) {
2645e7931f94SStefano Zampini       case MATDENSE_PRIVATE: /* subassembling of dense matrices does not give a dense matrix! */
2646e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
2647e7931f94SStefano Zampini         bs = 1;
2648e7931f94SStefano Zampini         break;
2649e7931f94SStefano Zampini       case MATAIJ_PRIVATE:
2650e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
2651e7931f94SStefano Zampini         bs = 1;
2652e7931f94SStefano Zampini         break;
2653e7931f94SStefano Zampini       case MATBAIJ_PRIVATE:
2654e7931f94SStefano Zampini         new_local_type = MATSEQBAIJ;
2655e7931f94SStefano Zampini         break;
2656e7931f94SStefano Zampini       case MATSBAIJ_PRIVATE:
2657e7931f94SStefano Zampini         new_local_type = MATSEQSBAIJ;
2658e7931f94SStefano Zampini         break;
2659e7931f94SStefano Zampini       default:
2660e7931f94SStefano Zampini         SETERRQ2(comm,PETSC_ERR_LIB,"Unkwown private type %d in %s",new_local_type_private,__FUNCT__);
2661e7931f94SStefano Zampini         break;
2662e7931f94SStefano Zampini     }
2663e7931f94SStefano Zampini   }
2664e7931f94SStefano Zampini 
2665e7931f94SStefano Zampini   /* create MATIS object */
2666e7931f94SStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
2667e7931f94SStefano Zampini   ierr = MatCreateIS(comm,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,&new_mat);CHKERRQ(ierr);
2668e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
2669e7931f94SStefano Zampini   ierr = MatISGetLocalMat(new_mat,&local_mat);CHKERRQ(ierr);
2670e7931f94SStefano Zampini   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
2671e7931f94SStefano Zampini   ierr = MatSetUp(local_mat);CHKERRQ(ierr); /* WARNING -> no preallocation yet */
2672e7931f94SStefano Zampini 
2673e7931f94SStefano Zampini   /* set values */
2674e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2675e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
2676e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2677e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2678e7931f94SStefano Zampini     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
2679e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
2680e7931f94SStefano Zampini       ierr = MatSetValues(new_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
2681e7931f94SStefano Zampini       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
2682e7931f94SStefano Zampini       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
2683e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
2684e7931f94SStefano Zampini     }
2685e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2686e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
2687e7931f94SStefano Zampini   }
2688e7931f94SStefano Zampini   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2689e7931f94SStefano Zampini   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2690e7931f94SStefano Zampini   ierr = MatAssemblyBegin(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2691e7931f94SStefano Zampini   ierr = MatAssemblyEnd(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2692e7931f94SStefano Zampini 
2693e7931f94SStefano Zampini   { /* check */
2694e7931f94SStefano Zampini     Vec       lvec,rvec;
2695e7931f94SStefano Zampini     PetscReal infty_error;
2696e7931f94SStefano Zampini 
2697e7931f94SStefano Zampini     ierr = MatGetVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
2698e7931f94SStefano Zampini     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
2699e7931f94SStefano Zampini     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
2700e7931f94SStefano Zampini     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
2701e7931f94SStefano Zampini     ierr = MatMultAdd(new_mat,rvec,lvec,lvec);CHKERRQ(ierr);
2702e7931f94SStefano Zampini     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
2703e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
2704e7931f94SStefano Zampini     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
2705e7931f94SStefano Zampini     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
2706e7931f94SStefano Zampini   }
2707e7931f94SStefano Zampini 
2708e7931f94SStefano Zampini   /* free workspace */
2709e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
2710e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
2711e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2712e7931f94SStefano Zampini   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
2713e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2714e7931f94SStefano Zampini   if (isdense) {
2715e7931f94SStefano Zampini     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2716e7931f94SStefano Zampini     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
2717e7931f94SStefano Zampini   } else {
2718e7931f94SStefano Zampini     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
2719e7931f94SStefano Zampini   }
2720e7931f94SStefano Zampini   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
2721e7931f94SStefano Zampini   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
2722e7931f94SStefano Zampini   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
2723e7931f94SStefano Zampini   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
2724e7931f94SStefano Zampini   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
2725e7931f94SStefano Zampini   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
2726e7931f94SStefano Zampini   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
2727e7931f94SStefano Zampini   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
2728e7931f94SStefano Zampini   ierr = PetscFree(onodes);CHKERRQ(ierr);
2729e7931f94SStefano Zampini   /* get back new mat */
2730e7931f94SStefano Zampini   *mat_n = new_mat;
2731e7931f94SStefano Zampini   PetscFunctionReturn(0);
2732e7931f94SStefano Zampini }
2733a57a6d2fSStefano Zampini 
2734c8587f34SStefano Zampini #undef __FUNCT__
27358629588bSStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
27368629588bSStefano Zampini PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
2737c8587f34SStefano Zampini {
2738c8587f34SStefano Zampini   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
2739c8587f34SStefano Zampini   PC_IS                  *pcis = (PC_IS*)pc->data;
274020a2ab83SStefano Zampini   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
2741*9881197aSStefano Zampini   MatNullSpace           CoarseNullSpace=NULL;
274220a2ab83SStefano Zampini   ISLocalToGlobalMapping coarse_islg;
274320a2ab83SStefano Zampini   IS                     coarse_is;
2744*9881197aSStefano Zampini   PetscInt               coarse_size,im_active,active_procs,*local_primal_indices=NULL;
2745c8587f34SStefano Zampini   PCType                 coarse_pc_type;
2746c8587f34SStefano Zampini   KSPType                coarse_ksp_type;
2747c8587f34SStefano Zampini   PetscBool              setsym,issym=PETSC_FALSE;
2748*9881197aSStefano Zampini   PetscErrorCode         ierr;
2749fdc09c96SStefano Zampini 
2750c8587f34SStefano Zampini   PetscFunctionBegin;
2751*9881197aSStefano Zampini   /* TODO: remove this and coarse ennums */
27529ffa7720SStefano Zampini   if (pcbddc->coarse_problem_type == SEQUENTIAL_BDDC || pcbddc->coarse_problem_type == REPLICATED_BDDC) {
27539ffa7720SStefano Zampini     pcbddc->coarse_problem_type = PARALLEL_BDDC;
27549ffa7720SStefano Zampini   }
27559ffa7720SStefano Zampini 
2756c8587f34SStefano Zampini   /* Assign global numbering to coarse dofs */
2757f34684f1SStefano Zampini   ierr = PCBDDCComputePrimalNumbering(pc,&coarse_size,&local_primal_indices);CHKERRQ(ierr);
2758c8587f34SStefano Zampini 
2759*9881197aSStefano Zampini   /* count "active processes" */
2760c8587f34SStefano Zampini   im_active = 0;
2761c8587f34SStefano Zampini   if (pcis->n) im_active = 1;
276220a2ab83SStefano Zampini   ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2763c8587f34SStefano Zampini 
2764*9881197aSStefano Zampini   /* adapt coarse problem type if needed */
2765c8587f34SStefano Zampini   if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
2766c8587f34SStefano Zampini     if (pcbddc->current_level < pcbddc->max_levels) {
2767c8587f34SStefano Zampini       if ( (active_procs/pcbddc->coarsening_ratio) < 2 ) {
276820a2ab83SStefano Zampini         if (pcbddc->dbg_flag) {
2769e7931f94SStefano Zampini           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Not enough active processes on level %d (active %d,ratio %d). Using direct solve for coarse problem\n",pcbddc->current_level,active_procs,pcbddc->coarsening_ratio);CHKERRQ(ierr);
277020a2ab83SStefano Zampini          ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2771c8587f34SStefano Zampini         }
2772c8587f34SStefano Zampini         pcbddc->coarse_problem_type = PARALLEL_BDDC;
2773c8587f34SStefano Zampini       }
2774c8587f34SStefano Zampini     } else {
277520a2ab83SStefano Zampini       if (pcbddc->dbg_flag) {
277620a2ab83SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Max number of levels reached. Using parallel direct solve for coarse problem\n",pcbddc->max_levels,active_procs,pcbddc->coarsening_ratio);CHKERRQ(ierr);
277720a2ab83SStefano Zampini         ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2778c8587f34SStefano Zampini       }
2779c8587f34SStefano Zampini       pcbddc->coarse_problem_type = PARALLEL_BDDC;
2780c8587f34SStefano Zampini     }
2781c8587f34SStefano Zampini   }
2782e7931f94SStefano Zampini 
278320a2ab83SStefano Zampini   /* creates MATIS object for coarse matrix */
2784a57a6d2fSStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,local_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
2785a57a6d2fSStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
2786a57a6d2fSStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
2787a57a6d2fSStefano Zampini   ierr = MatCreateIS(PetscObjectComm((PetscObject)pc),1,PETSC_DECIDE,PETSC_DECIDE,coarse_size,coarse_size,coarse_islg,&coarse_mat_is);CHKERRQ(ierr);
2788a57a6d2fSStefano Zampini   ierr = MatISSetLocalMat(coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
2789e7931f94SStefano Zampini   ierr = MatAssemblyBegin(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2790e7931f94SStefano Zampini   ierr = MatAssemblyEnd(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2791e7931f94SStefano Zampini 
2792*9881197aSStefano Zampini   /* Convert or subassemble MATIS depending on chosen coarse solver approach */
279320a2ab83SStefano Zampini   if (pcbddc->coarse_problem_type == PARALLEL_BDDC) {
2794a57a6d2fSStefano Zampini     ierr = MatConvert_IS_AIJ(coarse_mat_is,MATAIJ,MAT_INITIAL_MATRIX,&coarse_mat);CHKERRQ(ierr);
2795a57a6d2fSStefano Zampini     /* just for now */
2796a57a6d2fSStefano Zampini     coarse_pc_type  = PCREDUNDANT;
2797a57a6d2fSStefano Zampini     coarse_ksp_type = KSPPREONLY;
2798a57a6d2fSStefano Zampini   } else {
2799e7931f94SStefano Zampini     ierr = MatISSubassemble(coarse_mat_is,NULL,pcbddc->coarsening_ratio,&coarse_mat);CHKERRQ(ierr);
2800e7931f94SStefano Zampini     /* just for now */
2801e7931f94SStefano Zampini     coarse_pc_type  = PCBDDC;
2802e7931f94SStefano Zampini     coarse_ksp_type = KSPRICHARDSON;
2803e7931f94SStefano Zampini   }
2804e7931f94SStefano Zampini 
2805*9881197aSStefano Zampini   /* propagate symmetry info to coarse matrix */
2806*9881197aSStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
280720a2ab83SStefano Zampini   ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,issym);CHKERRQ(ierr);
280820a2ab83SStefano Zampini 
2809*9881197aSStefano Zampini   /* create local to global scatters coarse problem */
281020a2ab83SStefano Zampini   ierr = MatGetVecs(coarse_mat,&pcbddc->coarse_vec,&pcbddc->coarse_rhs);CHKERRQ(ierr);
281120a2ab83SStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
281220a2ab83SStefano Zampini 
281320a2ab83SStefano Zampini   /* free memory no longer needed */
281420a2ab83SStefano Zampini   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
281520a2ab83SStefano Zampini   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
281620a2ab83SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
281720a2ab83SStefano Zampini   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
281820a2ab83SStefano Zampini   ierr = PetscFree(local_primal_indices);CHKERRQ(ierr);
2819fdc09c96SStefano Zampini 
2820c8587f34SStefano Zampini   /* Compute coarse null space */
2821c8587f34SStefano Zampini   if (pcbddc->NullSpace) {
2822fdc635d7SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCoarse(pc,coarse_mat,&CoarseNullSpace);CHKERRQ(ierr);
2823c8587f34SStefano Zampini   }
2824c8587f34SStefano Zampini 
2825c8587f34SStefano Zampini   /* KSP for coarse problem */
282620a2ab83SStefano Zampini   {
2827*9881197aSStefano Zampini     PC        pc_temp;
2828c8587f34SStefano Zampini     PetscBool isbddc=PETSC_FALSE;
282920a2ab83SStefano Zampini     PetscInt  max_it;
2830*9881197aSStefano Zampini 
2831*9881197aSStefano Zampini     if (!pcbddc->coarse_ksp) { /* create the coarse KSP once */
283220a2ab83SStefano Zampini       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
2833c8587f34SStefano Zampini       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
283420a2ab83SStefano Zampini       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
2835c8587f34SStefano Zampini       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
2836c8587f34SStefano Zampini       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
2837c8587f34SStefano Zampini       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
2838*9881197aSStefano Zampini       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
2839*9881197aSStefano Zampini     }
2840*9881197aSStefano Zampini     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
2841c8587f34SStefano Zampini     /* Allow user's customization */
2842c8587f34SStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,"coarse_");CHKERRQ(ierr);
2843c8587f34SStefano Zampini     /* Set Up PC for coarse problem BDDC */
2844c8587f34SStefano Zampini     if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
284520a2ab83SStefano Zampini       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
2846c8587f34SStefano Zampini       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
2847c8587f34SStefano Zampini       ierr = PCBDDCSetMaxLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
2848c8587f34SStefano Zampini       ierr = PCBDDCSetCoarseProblemType(pc_temp,MULTILEVEL_BDDC);CHKERRQ(ierr);
2849c8587f34SStefano Zampini       if (CoarseNullSpace) {
2850c8587f34SStefano Zampini         ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
2851c8587f34SStefano Zampini       }
285220a2ab83SStefano Zampini       if (pcbddc->dbg_flag) {
285320a2ab83SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"----------------Level %d -> Setting up next level---------------\n",pcbddc->current_level);CHKERRQ(ierr);
285420a2ab83SStefano Zampini         ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2855c8587f34SStefano Zampini       }
2856c8587f34SStefano Zampini     } else {
2857c8587f34SStefano Zampini       if (CoarseNullSpace) {
2858c8587f34SStefano Zampini         ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
2859c8587f34SStefano Zampini       }
2860c8587f34SStefano Zampini     }
2861c8587f34SStefano Zampini     ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
2862c8587f34SStefano Zampini     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
2863c8587f34SStefano Zampini 
286420a2ab83SStefano Zampini     ierr = KSPGetTolerances(pcbddc->coarse_ksp,NULL,NULL,NULL,&max_it);CHKERRQ(ierr);
2865c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
2866c8587f34SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
286720a2ab83SStefano Zampini     if (max_it == 1) {
2868c8587f34SStefano Zampini       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
2869c8587f34SStefano Zampini       if (isbddc) {
2870c8587f34SStefano Zampini         ierr = PCBDDCSetUseExactDirichlet(pc_temp,PETSC_FALSE);CHKERRQ(ierr);
2871c8587f34SStefano Zampini       }
2872c8587f34SStefano Zampini     }
2873c8587f34SStefano Zampini   }
2874*9881197aSStefano Zampini 
2875c8587f34SStefano Zampini   /* Check coarse problem if requested */
287620a2ab83SStefano Zampini   if (pcbddc->dbg_flag) {
2877c8587f34SStefano Zampini     KSP check_ksp;
2878c8587f34SStefano Zampini     PC  check_pc;
2879c8587f34SStefano Zampini     Vec check_vec;
288020a2ab83SStefano Zampini     PetscInt its;
2881c8587f34SStefano Zampini     PetscReal   abs_infty_error,infty_error,lambda_min,lambda_max;
2882c8587f34SStefano Zampini     KSPType check_ksp_type;
2883c8587f34SStefano Zampini 
2884c8587f34SStefano Zampini     /* Create ksp object suitable for extreme eigenvalues' estimation */
288520a2ab83SStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&check_ksp);CHKERRQ(ierr);
2886fdc635d7SStefano Zampini     ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
2887983f5fd7SStefano Zampini     ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,coarse_size);CHKERRQ(ierr);
2888c8587f34SStefano Zampini     if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
2889c8587f34SStefano Zampini       if (issym) check_ksp_type = KSPCG;
2890c8587f34SStefano Zampini       else check_ksp_type = KSPGMRES;
2891c8587f34SStefano Zampini       ierr = KSPSetComputeSingularValues(check_ksp,PETSC_TRUE);CHKERRQ(ierr);
2892c8587f34SStefano Zampini     } else {
2893c8587f34SStefano Zampini       check_ksp_type = KSPPREONLY;
2894c8587f34SStefano Zampini     }
2895c8587f34SStefano Zampini     ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
2896c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
2897c8587f34SStefano Zampini     ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
2898c8587f34SStefano Zampini     ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
2899c8587f34SStefano Zampini     /* create random vec */
2900c8587f34SStefano Zampini     ierr = VecDuplicate(pcbddc->coarse_vec,&check_vec);CHKERRQ(ierr);
2901c8587f34SStefano Zampini     ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
2902c8587f34SStefano Zampini     if (CoarseNullSpace) {
2903c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec);CHKERRQ(ierr);
2904c8587f34SStefano Zampini     }
2905fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
2906c8587f34SStefano Zampini     /* solve coarse problem */
2907c8587f34SStefano Zampini     ierr = KSPSolve(check_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
2908c8587f34SStefano Zampini     if (CoarseNullSpace) {
2909c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,pcbddc->coarse_vec);CHKERRQ(ierr);
2910c8587f34SStefano Zampini     }
2911c8587f34SStefano Zampini     /* check coarse problem residual error */
2912c8587f34SStefano Zampini     ierr = VecAXPY(check_vec,-1.0,pcbddc->coarse_vec);CHKERRQ(ierr);
2913c8587f34SStefano Zampini     ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
2914fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
2915c8587f34SStefano Zampini     ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
2916c8587f34SStefano Zampini     ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
2917c8587f34SStefano Zampini     /* get eigenvalue estimation if inexact */
2918c8587f34SStefano Zampini     if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
2919c8587f34SStefano Zampini       ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
292020a2ab83SStefano Zampini       ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
292120a2ab83SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem eigenvalues estimated with %d iterations of %s.\n",its,check_ksp_type);CHKERRQ(ierr);
292220a2ab83SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem eigenvalues: % 1.14e %1.14e\n",lambda_min,lambda_max);CHKERRQ(ierr);
2923c8587f34SStefano Zampini     }
292420a2ab83SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem exact infty_error   : %1.14e\n",infty_error);CHKERRQ(ierr);
292520a2ab83SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem residual infty_error: %1.14e\n",abs_infty_error);CHKERRQ(ierr);
2926c8587f34SStefano Zampini     ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
2927c8587f34SStefano Zampini   }
292820a2ab83SStefano Zampini   if (pcbddc->dbg_flag) {
292920a2ab83SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2930c8587f34SStefano Zampini   }
2931c8587f34SStefano Zampini   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
2932fdc635d7SStefano Zampini   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
2933c8587f34SStefano Zampini   PetscFunctionReturn(0);
2934c8587f34SStefano Zampini }
29359a7d3425SStefano Zampini 
2936f34684f1SStefano Zampini #undef __FUNCT__
2937f34684f1SStefano Zampini #define __FUNCT__ "PCBDDCComputePrimalNumbering"
2938f34684f1SStefano Zampini PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
2939f34684f1SStefano Zampini {
2940f34684f1SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2941f34684f1SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
2942f34684f1SStefano Zampini   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
2943f34684f1SStefano Zampini   PetscInt       i,j,coarse_size;
2944f34684f1SStefano Zampini   PetscInt       *local_primal_indices,*auxlocal_primal,*aux_idx;
2945f34684f1SStefano Zampini   PetscErrorCode ierr;
2946f34684f1SStefano Zampini 
2947f34684f1SStefano Zampini   PetscFunctionBegin;
2948f34684f1SStefano Zampini   /* get indices in local ordering for vertices and constraints */
2949f34684f1SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&auxlocal_primal);CHKERRQ(ierr);
2950f34684f1SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&i,&aux_idx);CHKERRQ(ierr);
2951f34684f1SStefano Zampini   ierr = PetscMemcpy(auxlocal_primal,aux_idx,i*sizeof(PetscInt));CHKERRQ(ierr);
2952f34684f1SStefano Zampini   ierr = PetscFree(aux_idx);CHKERRQ(ierr);
2953f34684f1SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&j,&aux_idx);CHKERRQ(ierr);
2954f34684f1SStefano Zampini   ierr = PetscMemcpy(&auxlocal_primal[i],aux_idx,j*sizeof(PetscInt));CHKERRQ(ierr);
2955f34684f1SStefano Zampini   ierr = PetscFree(aux_idx);CHKERRQ(ierr);
2956f34684f1SStefano Zampini 
2957f34684f1SStefano Zampini   /* Compute global number of coarse dofs */
2958f34684f1SStefano Zampini   ierr = PCBDDCSubsetNumbering(PetscObjectComm((PetscObject)(pc->pmat)),matis->mapping,pcbddc->local_primal_size,auxlocal_primal,NULL,&coarse_size,&local_primal_indices);CHKERRQ(ierr);
2959f34684f1SStefano Zampini 
2960f34684f1SStefano Zampini   /* check numbering */
2961f34684f1SStefano Zampini   if (pcbddc->dbg_flag) {
2962f34684f1SStefano Zampini     PetscScalar coarsesum,*array;
2963f34684f1SStefano Zampini 
2964f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2965f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
2966f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
2967f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
2968f34684f1SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
2969f34684f1SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,auxlocal_primal[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
2970f34684f1SStefano Zampini     }
2971f34684f1SStefano Zampini     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2972f34684f1SStefano Zampini     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2973f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
2974f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2975f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2976f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2977f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2978f34684f1SStefano Zampini     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
2979f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
2980f34684f1SStefano Zampini       if (array[i] == 1.0) {
2981f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %d owned by a single process!\n",PetscGlobalRank,i);CHKERRQ(ierr);
2982f34684f1SStefano Zampini       }
2983f34684f1SStefano Zampini     }
2984f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2985f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
2986f34684f1SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
2987f34684f1SStefano Zampini     }
2988f34684f1SStefano Zampini     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
2989f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
2990f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2991f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2992f34684f1SStefano Zampini     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
2993f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
2994f34684f1SStefano Zampini     if (pcbddc->dbg_flag > 1) {
2995f34684f1SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
2996f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2997f34684f1SStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
2998f34684f1SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
2999f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_primal_indices[%d]=%d \n",i,local_primal_indices[i]);
3000f34684f1SStefano Zampini       }
3001f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3002f34684f1SStefano Zampini     }
3003f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3004f34684f1SStefano Zampini   }
3005f34684f1SStefano Zampini   ierr = PetscFree(auxlocal_primal);CHKERRQ(ierr);
3006f34684f1SStefano Zampini   /* get back data */
3007f34684f1SStefano Zampini   *coarse_size_n = coarse_size;
3008f34684f1SStefano Zampini   *local_primal_indices_n = local_primal_indices;
3009f34684f1SStefano Zampini   PetscFunctionReturn(0);
3010f34684f1SStefano Zampini }
3011f34684f1SStefano Zampini 
3012