xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 8629588b77265804a2d0a4b5f5e07d5e1abdef9d)
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;
10*8629588bSStefano 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 
31*8629588bSStefano Zampini   /*
32*8629588bSStefano Zampini      Setup local correction and local part of coarse basis.
33*8629588bSStefano Zampini      Gives back the dense local part of the coarse matrix in column major ordering
34*8629588bSStefano Zampini   */
35*8629588bSStefano Zampini   ierr = PCBDDCSetUpCoarseLocal(pc,&coarse_submat_vals);CHKERRQ(ierr);
36*8629588bSStefano Zampini 
37*8629588bSStefano Zampini   /* Compute total number of coarse nodes and setup coarse solver */
38*8629588bSStefano Zampini   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
39*8629588bSStefano Zampini 
40*8629588bSStefano Zampini   /* free */
41*8629588bSStefano 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 = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
102674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_mat);CHKERRQ(ierr);
103674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
104674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
10515aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
10615aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
107674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
108674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
109674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
110674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
111674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
112674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
113674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec4_D);CHKERRQ(ierr);
1148ce42a96SStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
115674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
116674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
117674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
118674ae819SStefano Zampini   ierr = PetscFree(pcbddc->local_primal_indices);CHKERRQ(ierr);
119674ae819SStefano Zampini   ierr = PetscFree(pcbddc->replicated_local_primal_indices);CHKERRQ(ierr);
120674ae819SStefano Zampini   ierr = PetscFree(pcbddc->replicated_local_primal_values);CHKERRQ(ierr);
121674ae819SStefano Zampini   ierr = PetscFree(pcbddc->local_primal_displacements);CHKERRQ(ierr);
122674ae819SStefano Zampini   ierr = PetscFree(pcbddc->local_primal_sizes);CHKERRQ(ierr);
123674ae819SStefano Zampini   PetscFunctionReturn(0);
124674ae819SStefano Zampini }
125674ae819SStefano Zampini 
126674ae819SStefano Zampini #undef __FUNCT__
1276bfb1811SStefano Zampini #define __FUNCT__ "PCBDDCCreateWorkVectors"
1286bfb1811SStefano Zampini PetscErrorCode PCBDDCCreateWorkVectors(PC pc)
1296bfb1811SStefano Zampini {
1306bfb1811SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1316bfb1811SStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
1326bfb1811SStefano Zampini   VecType        impVecType;
1336bfb1811SStefano Zampini   PetscInt       n_vertices,n_constraints,local_primal_size,n_R;
1346bfb1811SStefano Zampini   PetscErrorCode ierr;
1356bfb1811SStefano Zampini 
1366bfb1811SStefano Zampini   PetscFunctionBegin;
1376bfb1811SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,NULL);CHKERRQ(ierr);
1386bfb1811SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&n_constraints,NULL);CHKERRQ(ierr);
1396bfb1811SStefano Zampini   local_primal_size = n_constraints+n_vertices;
1406bfb1811SStefano Zampini   n_R = pcis->n-n_vertices;
1416bfb1811SStefano Zampini   /* local work vectors */
1426bfb1811SStefano Zampini   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
1436bfb1811SStefano Zampini   ierr = VecDuplicate(pcis->vec1_D,&pcbddc->vec4_D);CHKERRQ(ierr);
1446bfb1811SStefano Zampini   ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
1456bfb1811SStefano Zampini   ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
1466bfb1811SStefano Zampini   ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
1476bfb1811SStefano Zampini   ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
14883b7ccabSStefano Zampini   ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
1496bfb1811SStefano Zampini   ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,local_primal_size);CHKERRQ(ierr);
1506bfb1811SStefano Zampini   ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
15183b7ccabSStefano Zampini   if (n_constraints) {
15283b7ccabSStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
15383b7ccabSStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
15483b7ccabSStefano Zampini     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
15583b7ccabSStefano Zampini   }
1566bfb1811SStefano Zampini   PetscFunctionReturn(0);
1576bfb1811SStefano Zampini }
1586bfb1811SStefano Zampini 
1596bfb1811SStefano Zampini #undef __FUNCT__
1604a78082cSStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseLocal"
161*8629588bSStefano Zampini PetscErrorCode PCBDDCSetUpCoarseLocal(PC pc, PetscScalar **coarse_submat_vals_n)
16288ebb749SStefano Zampini {
16325084f0cSStefano Zampini   PetscErrorCode         ierr;
16425084f0cSStefano Zampini   /* pointers to pcis and pcbddc */
16588ebb749SStefano Zampini   PC_IS*                 pcis = (PC_IS*)pc->data;
16688ebb749SStefano Zampini   PC_BDDC*               pcbddc = (PC_BDDC*)pc->data;
16725084f0cSStefano Zampini   /* submatrices of local problem */
16888ebb749SStefano Zampini   Mat                    A_RV,A_VR,A_VV;
16925084f0cSStefano Zampini   /* working matrices */
17025084f0cSStefano Zampini   Mat                    M1,M2,M3,C_CR;
17125084f0cSStefano Zampini   /* working vectors */
17225084f0cSStefano Zampini   Vec                    vec1_C,vec2_C,vec1_V,vec2_V;
17325084f0cSStefano Zampini   /* additional working stuff */
17425084f0cSStefano Zampini   IS                     is_aux;
17588ebb749SStefano Zampini   ISLocalToGlobalMapping BtoNmap;
17625084f0cSStefano Zampini   PetscScalar            *coarse_submat_vals; /* TODO: use a PETSc matrix */
17725084f0cSStefano Zampini   const PetscScalar      *array,*row_cmat_values;
17825084f0cSStefano Zampini   const PetscInt         *row_cmat_indices,*idx_R_local;
17925084f0cSStefano Zampini   PetscInt               *vertices,*idx_V_B,*auxindices;
18025084f0cSStefano Zampini   PetscInt               n_vertices,n_constraints,size_of_constraint;
18125084f0cSStefano Zampini   PetscInt               i,j,n_R,n_D,n_B;
18288ebb749SStefano Zampini   PetscBool              setsym=PETSC_FALSE,issym=PETSC_FALSE;
18325084f0cSStefano Zampini   /* Vector and matrix types */
18488ebb749SStefano Zampini   VecType                impVecType;
18588ebb749SStefano Zampini   MatType                impMatType;
18625084f0cSStefano Zampini   /* some shortcuts to scalars */
18725084f0cSStefano Zampini   PetscScalar            zero=0.0,one=1.0,m_one=-1.0;
18825084f0cSStefano Zampini   /* for debugging purposes */
18988ebb749SStefano Zampini   PetscReal              *coarsefunctions_errors,*constraints_errors;
19088ebb749SStefano Zampini 
19188ebb749SStefano Zampini   PetscFunctionBegin;
19225084f0cSStefano Zampini   /* get number of vertices and their local indices */
19325084f0cSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
19488ebb749SStefano Zampini   n_constraints = pcbddc->local_primal_size-n_vertices;
19588ebb749SStefano Zampini   /* Set Non-overlapping dimensions */
19688ebb749SStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
19788ebb749SStefano Zampini   n_R = pcis->n-n_vertices;
19888ebb749SStefano Zampini 
19988ebb749SStefano Zampini   /* Set types for local objects needed by BDDC precondtioner */
20088ebb749SStefano Zampini   impMatType = MATSEQDENSE;
20125084f0cSStefano Zampini   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
20288ebb749SStefano Zampini 
20388ebb749SStefano Zampini   /* Allocating some extra storage just to be safe */
20488ebb749SStefano Zampini   ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&auxindices);CHKERRQ(ierr);
20588ebb749SStefano Zampini   for (i=0;i<pcis->n;i++) auxindices[i]=i;
20688ebb749SStefano Zampini 
20788ebb749SStefano Zampini   /* vertices in boundary numbering */
20888ebb749SStefano Zampini   ierr = PetscMalloc(n_vertices*sizeof(PetscInt),&idx_V_B);CHKERRQ(ierr);
20988ebb749SStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(pcis->is_B_local,&BtoNmap);CHKERRQ(ierr);
21088ebb749SStefano Zampini   ierr = ISGlobalToLocalMappingApply(BtoNmap,IS_GTOLM_DROP,n_vertices,vertices,&i,idx_V_B);CHKERRQ(ierr);
21188ebb749SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&BtoNmap);CHKERRQ(ierr);
21288ebb749SStefano Zampini   if (i != n_vertices) {
21388ebb749SStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %d != %d\n",n_vertices,i);
21488ebb749SStefano Zampini   }
21588ebb749SStefano Zampini 
21688ebb749SStefano Zampini   /* some work vectors on vertices and/or constraints */
21788ebb749SStefano Zampini   if (n_vertices) {
21888ebb749SStefano Zampini     ierr = VecCreate(PETSC_COMM_SELF,&vec1_V);CHKERRQ(ierr);
21988ebb749SStefano Zampini     ierr = VecSetSizes(vec1_V,n_vertices,n_vertices);CHKERRQ(ierr);
22088ebb749SStefano Zampini     ierr = VecSetType(vec1_V,impVecType);CHKERRQ(ierr);
22188ebb749SStefano Zampini     ierr = VecDuplicate(vec1_V,&vec2_V);CHKERRQ(ierr);
22288ebb749SStefano Zampini   }
22388ebb749SStefano Zampini   if (n_constraints) {
22488ebb749SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec1_C);CHKERRQ(ierr);
22588ebb749SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec2_C);CHKERRQ(ierr);
22688ebb749SStefano Zampini   }
22725084f0cSStefano Zampini 
22888ebb749SStefano Zampini   /* Precompute stuffs needed for preprocessing and application of BDDC*/
22988ebb749SStefano Zampini   if (n_constraints) {
23088ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->local_auxmat2);CHKERRQ(ierr);
23125084f0cSStefano Zampini     ierr = MatSetSizes(pcbddc->local_auxmat2,n_R,n_constraints,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
23288ebb749SStefano Zampini     ierr = MatSetType(pcbddc->local_auxmat2,impMatType);CHKERRQ(ierr);
23325084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->local_auxmat2);CHKERRQ(ierr);
23488ebb749SStefano Zampini 
23525084f0cSStefano Zampini     /* Extract constraints on R nodes: C_{CR}  */
23625084f0cSStefano Zampini     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
2378ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
23825084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
23988ebb749SStefano Zampini 
24088ebb749SStefano Zampini     /* Assemble local_auxmat2 = - A_{RR}^{-1} C^T_{CR} needed by BDDC application */
24188ebb749SStefano Zampini     for (i=0;i<n_constraints;i++) {
24288ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
24388ebb749SStefano Zampini       /* Get row of constraint matrix in R numbering */
24425084f0cSStefano Zampini       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
24525084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_R,size_of_constraint,row_cmat_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
24625084f0cSStefano Zampini       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
24725084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_R);CHKERRQ(ierr);
24825084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_R);CHKERRQ(ierr);
24988ebb749SStefano Zampini       /* Solve for row of constraint matrix in R numbering */
25088ebb749SStefano Zampini       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
25125084f0cSStefano Zampini       /* Set values in local_auxmat2 */
25225084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
25388ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->local_auxmat2,n_R,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
25425084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
25588ebb749SStefano Zampini     }
25688ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
25788ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
25825084f0cSStefano Zampini     ierr = MatScale(pcbddc->local_auxmat2,m_one);CHKERRQ(ierr);
25988ebb749SStefano Zampini 
26088ebb749SStefano Zampini     /* Assemble explicitly M1 = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1} needed in preproc  */
26125084f0cSStefano Zampini     ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
26225084f0cSStefano Zampini     ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
26388ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&M1);CHKERRQ(ierr);
26488ebb749SStefano Zampini     ierr = MatSetSizes(M1,n_constraints,n_constraints,n_constraints,n_constraints);CHKERRQ(ierr);
26588ebb749SStefano Zampini     ierr = MatSetType(M1,impMatType);CHKERRQ(ierr);
26625084f0cSStefano Zampini     ierr = MatSetUp(M1);CHKERRQ(ierr);
26725084f0cSStefano Zampini     ierr = MatDuplicate(M1,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
26825084f0cSStefano Zampini     ierr = MatZeroEntries(M2);CHKERRQ(ierr);
26925084f0cSStefano Zampini     ierr = VecSet(vec1_C,m_one);CHKERRQ(ierr);
27025084f0cSStefano Zampini     ierr = MatDiagonalSet(M2,vec1_C,INSERT_VALUES);CHKERRQ(ierr);
27125084f0cSStefano Zampini     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
27225084f0cSStefano Zampini     ierr = MatDestroy(&M2);CHKERRQ(ierr);
27325084f0cSStefano Zampini     ierr = MatDestroy(&M3);CHKERRQ(ierr);
27488ebb749SStefano Zampini     /* Assemble local_auxmat1 = M1*C_{CR} needed by BDDC application in KSP and in preproc */
27588ebb749SStefano Zampini     ierr = MatMatMult(M1,C_CR,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
27688ebb749SStefano Zampini   }
27788ebb749SStefano Zampini 
27888ebb749SStefano Zampini   /* Get submatrices from subdomain matrix */
27988ebb749SStefano Zampini   if (n_vertices) {
28025084f0cSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,n_vertices,vertices,PETSC_COPY_VALUES,&is_aux);CHKERRQ(ierr);
2818ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
2828ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
28325084f0cSStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
28425084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
28588ebb749SStefano Zampini   }
28688ebb749SStefano Zampini 
28788ebb749SStefano Zampini   /* Matrix of coarse basis functions (local) */
28888ebb749SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
28988ebb749SStefano Zampini   ierr = MatSetSizes(pcbddc->coarse_phi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
29088ebb749SStefano Zampini   ierr = MatSetType(pcbddc->coarse_phi_B,impMatType);CHKERRQ(ierr);
29125084f0cSStefano Zampini   ierr = MatSetUp(pcbddc->coarse_phi_B);CHKERRQ(ierr);
29225084f0cSStefano Zampini   if (pcbddc->inexact_prec_type || pcbddc->dbg_flag) {
29388ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
29488ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_phi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
29588ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_phi_D,impMatType);CHKERRQ(ierr);
29625084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_phi_D);CHKERRQ(ierr);
29788ebb749SStefano Zampini   }
29888ebb749SStefano Zampini 
29925084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
3008ce42a96SStefano Zampini     ierr = ISGetIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
30188ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*coarsefunctions_errors),&coarsefunctions_errors);CHKERRQ(ierr);
30288ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*constraints_errors),&constraints_errors);CHKERRQ(ierr);
30388ebb749SStefano Zampini   }
30488ebb749SStefano Zampini   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
30588ebb749SStefano Zampini   ierr = PetscMalloc((pcbddc->local_primal_size)*(pcbddc->local_primal_size)*sizeof(PetscScalar),&coarse_submat_vals);CHKERRQ(ierr);
30688ebb749SStefano Zampini 
30788ebb749SStefano Zampini   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
30825084f0cSStefano Zampini 
30925084f0cSStefano Zampini   /* vertices */
31088ebb749SStefano Zampini   for (i=0;i<n_vertices;i++) {
31188ebb749SStefano Zampini     ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
31288ebb749SStefano Zampini     ierr = VecSetValue(vec1_V,i,one,INSERT_VALUES);CHKERRQ(ierr);
31388ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
31488ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
31525084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on constraints multipliers */
31688ebb749SStefano Zampini     ierr = MatMult(A_RV,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
31788ebb749SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
31888ebb749SStefano Zampini     ierr = VecScale(pcbddc->vec1_R,m_one);CHKERRQ(ierr);
31988ebb749SStefano Zampini     if (n_constraints) {
32088ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec1_R,vec1_C);CHKERRQ(ierr);
32188ebb749SStefano Zampini       ierr = MatMultAdd(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
32288ebb749SStefano Zampini       ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
32388ebb749SStefano Zampini     }
32488ebb749SStefano Zampini     ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
32588ebb749SStefano Zampini     ierr = MatMultAdd(A_VV,vec1_V,vec2_V,vec2_V);CHKERRQ(ierr);
32688ebb749SStefano Zampini 
32788ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
32888ebb749SStefano Zampini     /* coarse basis functions */
32988ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
33088ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
33188ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
33225084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
33388ebb749SStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
33425084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
33588ebb749SStefano Zampini     ierr = MatSetValue(pcbddc->coarse_phi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
33625084f0cSStefano Zampini     if (pcbddc->inexact_prec_type || pcbddc->dbg_flag) {
33788ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
33888ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
33925084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
34088ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
34125084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
34288ebb749SStefano Zampini     }
34325084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
34425084f0cSStefano Zampini     ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
34525084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
34625084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
34788ebb749SStefano Zampini     if (n_constraints) {
34825084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
34925084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
35025084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
35188ebb749SStefano Zampini     }
35288ebb749SStefano Zampini 
35325084f0cSStefano Zampini     /* check */
35425084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
35525084f0cSStefano Zampini       /* assemble subdomain vector on local nodes */
35688ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
35725084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
35825084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
35925084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
36025084f0cSStefano Zampini       ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
36125084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
36225084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
36388ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers (i.e. primal nodes) */
36488ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
36525084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
36625084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
36725084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
36888ebb749SStefano Zampini       if (n_constraints) {
36925084f0cSStefano Zampini         ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
37025084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
37125084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
37288ebb749SStefano Zampini       }
37325084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
37425084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
37588ebb749SStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
37688ebb749SStefano Zampini       /* check saddle point solution */
37788ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
37888ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
37988ebb749SStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i]);CHKERRQ(ierr);
38088ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
38125084f0cSStefano Zampini       /* shift by the identity matrix */
38225084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
38325084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
38425084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
38588ebb749SStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i]);CHKERRQ(ierr);
38688ebb749SStefano Zampini     }
38788ebb749SStefano Zampini   }
38888ebb749SStefano Zampini 
38925084f0cSStefano Zampini   /* constraints */
39088ebb749SStefano Zampini   for (i=0;i<n_constraints;i++) {
39188ebb749SStefano Zampini     ierr = VecSet(vec2_C,zero);CHKERRQ(ierr);
39288ebb749SStefano Zampini     ierr = VecSetValue(vec2_C,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
39388ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec2_C);CHKERRQ(ierr);
39488ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec2_C);CHKERRQ(ierr);
39525084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on vertices multipliers */
39688ebb749SStefano Zampini     ierr = MatMult(M1,vec2_C,vec1_C);CHKERRQ(ierr);
39788ebb749SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
39888ebb749SStefano Zampini     ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
39925084f0cSStefano Zampini     if (n_vertices) {
40025084f0cSStefano Zampini       ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
40125084f0cSStefano Zampini     }
40288ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
40388ebb749SStefano Zampini     /* coarse basis functions */
40425084f0cSStefano Zampini     j = i+n_vertices; /* don't touch this! */
40588ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
40688ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40788ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40825084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
40925084f0cSStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
41025084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
41125084f0cSStefano Zampini     if (pcbddc->inexact_prec_type || pcbddc->dbg_flag) {
41288ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
41388ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
41425084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
41525084f0cSStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
41625084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
41788ebb749SStefano Zampini     }
41825084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
41988ebb749SStefano Zampini     if (n_vertices) {
42025084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
42125084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
42225084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
42388ebb749SStefano Zampini     }
42425084f0cSStefano Zampini     ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
42525084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
42625084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
42788ebb749SStefano Zampini 
42825084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
42988ebb749SStefano Zampini       /* assemble subdomain vector on nodes */
43088ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
43125084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
43225084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
43325084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
43425084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
43525084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
43688ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers */
43788ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
43888ebb749SStefano Zampini       if (n_vertices) {
43925084f0cSStefano Zampini         ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
44025084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
44125084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
44288ebb749SStefano Zampini       }
44325084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
44425084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
44525084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
44625084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
44725084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
44825084f0cSStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
44988ebb749SStefano Zampini       /* check saddle point solution */
45088ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
45188ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
45225084f0cSStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[j]);CHKERRQ(ierr);
45388ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
45425084f0cSStefano Zampini       /* shift by the identity matrix */
45525084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,j,m_one,ADD_VALUES);CHKERRQ(ierr);
45625084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
45725084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
45825084f0cSStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[j]);CHKERRQ(ierr);
45988ebb749SStefano Zampini     }
46088ebb749SStefano Zampini   }
46125084f0cSStefano Zampini   /* call assembling routines for local coarse basis */
46288ebb749SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
46388ebb749SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
46425084f0cSStefano Zampini   if (pcbddc->inexact_prec_type || pcbddc->dbg_flag) {
46588ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
46688ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
46788ebb749SStefano Zampini   }
46825084f0cSStefano Zampini 
46988ebb749SStefano Zampini   /* compute other basis functions for non-symmetric problems */
47088ebb749SStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
47188ebb749SStefano Zampini   if (!setsym || (setsym && !issym)) {
47288ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
47388ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_psi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
47488ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_psi_B,impMatType);CHKERRQ(ierr);
47525084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_psi_B);CHKERRQ(ierr);
47625084f0cSStefano Zampini     if (pcbddc->inexact_prec_type || pcbddc->dbg_flag ) {
47788ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
47888ebb749SStefano Zampini       ierr = MatSetSizes(pcbddc->coarse_psi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
47988ebb749SStefano Zampini       ierr = MatSetType(pcbddc->coarse_psi_D,impMatType);CHKERRQ(ierr);
48025084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->coarse_psi_D);CHKERRQ(ierr);
48188ebb749SStefano Zampini     }
48288ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
48388ebb749SStefano Zampini       if (n_constraints) {
48488ebb749SStefano Zampini         ierr = VecSet(vec1_C,zero);CHKERRQ(ierr);
48588ebb749SStefano Zampini         for (j=0;j<n_constraints;j++) {
48625084f0cSStefano Zampini           ierr = VecSetValue(vec1_C,j,coarse_submat_vals[(j+n_vertices)*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
48788ebb749SStefano Zampini         }
48825084f0cSStefano Zampini         ierr = VecAssemblyBegin(vec1_C);CHKERRQ(ierr);
48925084f0cSStefano Zampini         ierr = VecAssemblyEnd(vec1_C);CHKERRQ(ierr);
49088ebb749SStefano Zampini       }
49188ebb749SStefano Zampini       if (i<n_vertices) {
49288ebb749SStefano Zampini         ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
49388ebb749SStefano Zampini         ierr = VecSetValue(vec1_V,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
49488ebb749SStefano Zampini         ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
49588ebb749SStefano Zampini         ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
49688ebb749SStefano Zampini         ierr = MatMultTranspose(A_VR,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
49788ebb749SStefano Zampini         if (n_constraints) {
49888ebb749SStefano Zampini           ierr = MatMultTransposeAdd(C_CR,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
49988ebb749SStefano Zampini         }
50088ebb749SStefano Zampini       } else {
50188ebb749SStefano Zampini         ierr = MatMultTranspose(C_CR,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
50288ebb749SStefano Zampini       }
50388ebb749SStefano Zampini       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
50488ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
50588ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
50688ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
50725084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
50888ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_psi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
50925084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
51088ebb749SStefano Zampini       if (i<n_vertices) {
51188ebb749SStefano Zampini         ierr = MatSetValue(pcbddc->coarse_psi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
51288ebb749SStefano Zampini       }
51325084f0cSStefano Zampini       if (pcbddc->inexact_prec_type || pcbddc->dbg_flag) {
51488ebb749SStefano Zampini         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
51588ebb749SStefano Zampini         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
51625084f0cSStefano Zampini         ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
51788ebb749SStefano Zampini         ierr = MatSetValues(pcbddc->coarse_psi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
51825084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
51988ebb749SStefano Zampini       }
52088ebb749SStefano Zampini 
52125084f0cSStefano Zampini       if (pcbddc->dbg_flag) {
52288ebb749SStefano Zampini         /* assemble subdomain vector on nodes */
52388ebb749SStefano Zampini         ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
52425084f0cSStefano Zampini         ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
52525084f0cSStefano Zampini         ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
52625084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
52725084f0cSStefano Zampini         if (i<n_vertices) {
52825084f0cSStefano Zampini           ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
52988ebb749SStefano Zampini         }
53025084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
53125084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
53225084f0cSStefano Zampini         /* assemble subdomain vector of lagrange multipliers */
53325084f0cSStefano Zampini         for (j=0;j<pcbddc->local_primal_size;j++) {
53425084f0cSStefano Zampini           ierr = VecSetValue(pcbddc->vec1_P,j,-coarse_submat_vals[j*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
53525084f0cSStefano Zampini         }
53625084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
53725084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
53888ebb749SStefano Zampini         /* check saddle point solution */
53988ebb749SStefano Zampini         ierr = MatMultTranspose(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
54088ebb749SStefano Zampini         ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
54188ebb749SStefano Zampini         ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
54288ebb749SStefano Zampini         ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
54325084f0cSStefano Zampini         /* shift by the identity matrix */
54425084f0cSStefano Zampini         ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
54525084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
54625084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
54788ebb749SStefano Zampini         ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
54888ebb749SStefano Zampini       }
54988ebb749SStefano Zampini     }
55088ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
55188ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
55225084f0cSStefano Zampini     if ( pcbddc->inexact_prec_type || pcbddc->dbg_flag ) {
55388ebb749SStefano Zampini       ierr = MatAssemblyBegin(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
55488ebb749SStefano Zampini       ierr = MatAssemblyEnd(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
55588ebb749SStefano Zampini     }
55688ebb749SStefano Zampini   }
55788ebb749SStefano Zampini   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
55888ebb749SStefano Zampini   /* Checking coarse_sub_mat and coarse basis functios */
55988ebb749SStefano Zampini   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
56088ebb749SStefano Zampini   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
56125084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
56288ebb749SStefano Zampini     Mat         coarse_sub_mat;
56325084f0cSStefano Zampini     Mat         AUXMAT,TM1,TM2,TM3,TM4;
56488ebb749SStefano Zampini     Mat         coarse_phi_D,coarse_phi_B;
56588ebb749SStefano Zampini     Mat         coarse_psi_D,coarse_psi_B;
56688ebb749SStefano Zampini     Mat         A_II,A_BB,A_IB,A_BI;
56788ebb749SStefano Zampini     MatType     checkmattype=MATSEQAIJ;
56888ebb749SStefano Zampini     PetscReal   real_value;
56988ebb749SStefano Zampini 
57088ebb749SStefano Zampini     ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
57188ebb749SStefano Zampini     ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
57288ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
57388ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
57488ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
57588ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
57688ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
57788ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
57888ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
57988ebb749SStefano Zampini     }
58088ebb749SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
58188ebb749SStefano Zampini 
58225084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
58325084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat and local basis functions\n");CHKERRQ(ierr);
58425084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
58588ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
58688ebb749SStefano Zampini       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
58788ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
58888ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
58988ebb749SStefano Zampini       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
59088ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
59188ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
59288ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
59388ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
59488ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
59588ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
59688ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
59788ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
59888ebb749SStefano Zampini     } else {
59988ebb749SStefano Zampini       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
60088ebb749SStefano Zampini       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
60188ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
60288ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
60388ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
60488ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
60588ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
60688ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
60788ebb749SStefano Zampini     }
60888ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
60988ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
61088ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
61188ebb749SStefano Zampini     ierr = MatConvert(TM1,MATSEQDENSE,MAT_REUSE_MATRIX,&TM1);CHKERRQ(ierr);
61288ebb749SStefano Zampini     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
61388ebb749SStefano Zampini     ierr = MatNorm(TM1,NORM_INFINITY,&real_value);CHKERRQ(ierr);
61425084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"----------------------------------\n");CHKERRQ(ierr);
61525084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d \n",PetscGlobalRank);CHKERRQ(ierr);
61625084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"matrix error = % 1.14e\n",real_value);CHKERRQ(ierr);
61725084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (phi) errors\n");CHKERRQ(ierr);
61888ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
61925084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,coarsefunctions_errors[i]);CHKERRQ(ierr);
62088ebb749SStefano Zampini     }
62125084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (phi) errors\n");CHKERRQ(ierr);
62288ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
62325084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,constraints_errors[i]);CHKERRQ(ierr);
62488ebb749SStefano Zampini     }
62588ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
62625084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (psi) errors\n");CHKERRQ(ierr);
62788ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
62825084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,coarsefunctions_errors[i]);CHKERRQ(ierr);
62988ebb749SStefano Zampini       }
63025084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (psi) errors\n");CHKERRQ(ierr);
63188ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
63225084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,constraints_errors[i]);CHKERRQ(ierr);
63388ebb749SStefano Zampini       }
63488ebb749SStefano Zampini     }
63525084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
63688ebb749SStefano Zampini     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
63788ebb749SStefano Zampini     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
63888ebb749SStefano Zampini     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
63988ebb749SStefano Zampini     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
64088ebb749SStefano Zampini     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
64188ebb749SStefano Zampini     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
64288ebb749SStefano Zampini     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
64388ebb749SStefano Zampini     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
64488ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
64588ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
64688ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
64788ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
64888ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
64988ebb749SStefano Zampini     }
65088ebb749SStefano Zampini     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
6518ce42a96SStefano Zampini     ierr = ISRestoreIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
65288ebb749SStefano Zampini     ierr = PetscFree(coarsefunctions_errors);CHKERRQ(ierr);
65388ebb749SStefano Zampini     ierr = PetscFree(constraints_errors);CHKERRQ(ierr);
65488ebb749SStefano Zampini   }
65588ebb749SStefano Zampini   /* free memory */
65688ebb749SStefano Zampini   if (n_vertices) {
65788ebb749SStefano Zampini     ierr = PetscFree(vertices);CHKERRQ(ierr);
65888ebb749SStefano Zampini     ierr = VecDestroy(&vec1_V);CHKERRQ(ierr);
65988ebb749SStefano Zampini     ierr = VecDestroy(&vec2_V);CHKERRQ(ierr);
66088ebb749SStefano Zampini     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
66188ebb749SStefano Zampini     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
66288ebb749SStefano Zampini     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
66388ebb749SStefano Zampini   }
66488ebb749SStefano Zampini   if (n_constraints) {
66588ebb749SStefano Zampini     ierr = VecDestroy(&vec1_C);CHKERRQ(ierr);
66688ebb749SStefano Zampini     ierr = VecDestroy(&vec2_C);CHKERRQ(ierr);
66788ebb749SStefano Zampini     ierr = MatDestroy(&M1);CHKERRQ(ierr);
66888ebb749SStefano Zampini     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
66988ebb749SStefano Zampini   }
67088ebb749SStefano Zampini   ierr = PetscFree(auxindices);CHKERRQ(ierr);
671*8629588bSStefano Zampini   /* get back data */
672*8629588bSStefano Zampini   *coarse_submat_vals_n = coarse_submat_vals;
67388ebb749SStefano Zampini   PetscFunctionReturn(0);
67488ebb749SStefano Zampini }
67588ebb749SStefano Zampini 
67688ebb749SStefano Zampini #undef __FUNCT__
677aa0d41d4SStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalMatrices"
678aa0d41d4SStefano Zampini PetscErrorCode PCBDDCSetUpLocalMatrices(PC pc)
679aa0d41d4SStefano Zampini {
680aa0d41d4SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
681aa0d41d4SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
682aa0d41d4SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
683aa0d41d4SStefano Zampini   /* manage repeated solves */
684aa0d41d4SStefano Zampini   MatReuse          reuse;
685aa0d41d4SStefano Zampini   MatStructure      matstruct;
686aa0d41d4SStefano Zampini   PetscErrorCode    ierr;
687aa0d41d4SStefano Zampini 
688aa0d41d4SStefano Zampini   PetscFunctionBegin;
689aa0d41d4SStefano Zampini   /* get mat flags */
690aa0d41d4SStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
691aa0d41d4SStefano Zampini   reuse = MAT_INITIAL_MATRIX;
692aa0d41d4SStefano Zampini   if (pc->setupcalled) {
693aa0d41d4SStefano Zampini     /* when matstruct is SAME_PRECONDITIONER, we shouldn't be here */
694aa0d41d4SStefano Zampini     if (matstruct == SAME_PRECONDITIONER) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen");
695aa0d41d4SStefano Zampini     if (matstruct == SAME_NONZERO_PATTERN) {
696aa0d41d4SStefano Zampini       reuse = MAT_REUSE_MATRIX;
697aa0d41d4SStefano Zampini     } else {
698aa0d41d4SStefano Zampini       reuse = MAT_INITIAL_MATRIX;
699aa0d41d4SStefano Zampini     }
700aa0d41d4SStefano Zampini   }
701aa0d41d4SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
702aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
703aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
704aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
705aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BB);CHKERRQ(ierr);
706aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
707aa0d41d4SStefano Zampini   }
708aa0d41d4SStefano Zampini 
709aa0d41d4SStefano Zampini   /* transform local matrices if needed */
710aa0d41d4SStefano Zampini   if (pcbddc->use_change_of_basis) {
711aa0d41d4SStefano Zampini     Mat         change_mat_all;
712aa0d41d4SStefano Zampini     PetscScalar *row_cmat_values;
713aa0d41d4SStefano Zampini     PetscInt    *row_cmat_indices;
714aa0d41d4SStefano Zampini     PetscInt    *nnz,*is_indices,*temp_indices;
715aa0d41d4SStefano Zampini     PetscInt    i,j,k,n_D,n_B;
716aa0d41d4SStefano Zampini 
717aa0d41d4SStefano Zampini     /* Get Non-overlapping dimensions */
718aa0d41d4SStefano Zampini     n_B = pcis->n_B;
719aa0d41d4SStefano Zampini     n_D = pcis->n-n_B;
720aa0d41d4SStefano Zampini 
721aa0d41d4SStefano Zampini     /* compute nonzero structure of change of basis on all local nodes */
722aa0d41d4SStefano Zampini     ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
723aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
724aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) nnz[is_indices[i]] = 1;
725aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
726aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
727aa0d41d4SStefano Zampini     k=1;
728aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
729aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
730aa0d41d4SStefano Zampini       nnz[is_indices[i]]=j;
731aa0d41d4SStefano Zampini       if (k < j) k = j;
732aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
733aa0d41d4SStefano Zampini     }
734aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
735aa0d41d4SStefano Zampini     /* assemble change of basis matrix on the whole set of local dofs */
736aa0d41d4SStefano Zampini     ierr = PetscMalloc(k*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
737aa0d41d4SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&change_mat_all);CHKERRQ(ierr);
738aa0d41d4SStefano Zampini     ierr = MatSetSizes(change_mat_all,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
739aa0d41d4SStefano Zampini     ierr = MatSetType(change_mat_all,MATSEQAIJ);CHKERRQ(ierr);
740aa0d41d4SStefano Zampini     ierr = MatSeqAIJSetPreallocation(change_mat_all,0,nnz);CHKERRQ(ierr);
741aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
742aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) {
743aa0d41d4SStefano Zampini       ierr = MatSetValue(change_mat_all,is_indices[i],is_indices[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
744aa0d41d4SStefano Zampini     }
745aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
746aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
747aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
748aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
749aa0d41d4SStefano Zampini       for (k=0; k<j; k++) temp_indices[k]=is_indices[row_cmat_indices[k]];
750aa0d41d4SStefano Zampini       ierr = MatSetValues(change_mat_all,1,&is_indices[i],j,temp_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
751aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
752aa0d41d4SStefano Zampini     }
753aa0d41d4SStefano Zampini     ierr = MatAssemblyBegin(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
754aa0d41d4SStefano Zampini     ierr = MatAssemblyEnd(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
755aa0d41d4SStefano Zampini     /* TODO: HOW TO WORK WITH BAIJ? PtAP not provided */
756aa0d41d4SStefano Zampini     ierr = MatGetBlockSize(matis->A,&i);CHKERRQ(ierr);
757aa0d41d4SStefano Zampini     if (i==1) {
758aa0d41d4SStefano Zampini       ierr = MatPtAP(matis->A,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
759aa0d41d4SStefano Zampini     } else {
760aa0d41d4SStefano Zampini       Mat work_mat;
761aa0d41d4SStefano Zampini       ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
762aa0d41d4SStefano Zampini       ierr = MatPtAP(work_mat,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
763aa0d41d4SStefano Zampini       ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
764aa0d41d4SStefano Zampini     }
765aa0d41d4SStefano Zampini     ierr = MatDestroy(&change_mat_all);CHKERRQ(ierr);
766aa0d41d4SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
767aa0d41d4SStefano Zampini     ierr = PetscFree(temp_indices);CHKERRQ(ierr);
768aa0d41d4SStefano Zampini   } else {
769aa0d41d4SStefano Zampini     /* without change of basis, the local matrix is unchanged */
770aa0d41d4SStefano Zampini     if (!pcbddc->local_mat) {
771aa0d41d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)matis->A);CHKERRQ(ierr);
772aa0d41d4SStefano Zampini       pcbddc->local_mat = matis->A;
773aa0d41d4SStefano Zampini     }
774aa0d41d4SStefano Zampini   }
775aa0d41d4SStefano Zampini 
776aa0d41d4SStefano Zampini   /* get submatrices */
777aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_I_local,reuse,&pcis->A_II);CHKERRQ(ierr);
778aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
779aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
780aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_B_local,reuse,&pcis->A_BB);CHKERRQ(ierr);
781aa0d41d4SStefano Zampini   PetscFunctionReturn(0);
782aa0d41d4SStefano Zampini }
783aa0d41d4SStefano Zampini 
784aa0d41d4SStefano Zampini #undef __FUNCT__
785a64d13efSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalScatters"
7868ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
787a64d13efSStefano Zampini {
788a64d13efSStefano Zampini   PC_IS*         pcis = (PC_IS*)(pc->data);
789a64d13efSStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
7908ce42a96SStefano Zampini   IS             is_aux1,is_aux2;
791a64d13efSStefano Zampini   PetscInt       *vertices,*aux_array1,*aux_array2,*is_indices,*idx_R_local;
792a64d13efSStefano Zampini   PetscInt       n_vertices,n_constraints,i,j,n_R,n_D,n_B;
7934641a718SStefano Zampini   PetscBT        bitmask;
794a64d13efSStefano Zampini   PetscErrorCode ierr;
795a64d13efSStefano Zampini 
796a64d13efSStefano Zampini   PetscFunctionBegin;
797a64d13efSStefano Zampini   /* Set Non-overlapping dimensions */
798a64d13efSStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
799a64d13efSStefano Zampini   /* get vertex indices from constraint matrix */
800a64d13efSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
801a64d13efSStefano Zampini   /* Set number of constraints */
802a64d13efSStefano Zampini   n_constraints = pcbddc->local_primal_size-n_vertices;
8034641a718SStefano Zampini   /* create auxiliary bitmask */
8044641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
8054641a718SStefano Zampini   for (i=0;i<n_vertices;i++) {
8064641a718SStefano Zampini     ierr = PetscBTSet(bitmask,vertices[i]);CHKERRQ(ierr);
8074641a718SStefano Zampini   }
808a64d13efSStefano Zampini   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
809a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n-n_vertices)*sizeof(PetscInt),&idx_R_local);CHKERRQ(ierr);
810a64d13efSStefano Zampini   for (i=0, n_R=0; i<pcis->n; i++) {
8114641a718SStefano Zampini     if (!PetscBTLookup(bitmask,i)) {
812a64d13efSStefano Zampini       idx_R_local[n_R] = i;
813a64d13efSStefano Zampini       n_R++;
814a64d13efSStefano Zampini     }
815a64d13efSStefano Zampini   }
816a64d13efSStefano Zampini   ierr = PetscFree(vertices);CHKERRQ(ierr);
8178ce42a96SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_R,idx_R_local,PETSC_OWN_POINTER,&pcbddc->is_R_local);CHKERRQ(ierr);
818a64d13efSStefano Zampini 
819a64d13efSStefano Zampini   /* print some info if requested */
820a64d13efSStefano Zampini   if (pcbddc->dbg_flag) {
821a64d13efSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
822a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
823a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
824a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
825a64d13efSStefano 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);
826a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr);
827a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
828a64d13efSStefano Zampini   }
829a64d13efSStefano Zampini 
830a64d13efSStefano Zampini   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
831a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
832a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array2);CHKERRQ(ierr);
833a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
8344641a718SStefano Zampini   for (i=0; i<n_D; i++) {
8354641a718SStefano Zampini     ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
8364641a718SStefano Zampini   }
837a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
838a64d13efSStefano Zampini   for (i=0, j=0; i<n_R; i++) {
8394641a718SStefano Zampini     if (!PetscBTLookup(bitmask,idx_R_local[i])) {
8404641a718SStefano Zampini       aux_array1[j++] = i;
841a64d13efSStefano Zampini     }
842a64d13efSStefano Zampini   }
843a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
844a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
845a64d13efSStefano Zampini   for (i=0, j=0; i<n_B; i++) {
8464641a718SStefano Zampini     if (!PetscBTLookup(bitmask,is_indices[i])) {
8474641a718SStefano Zampini       aux_array2[j++] = i;
848a64d13efSStefano Zampini     }
849a64d13efSStefano Zampini   }
850a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
851a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
852a64d13efSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
853a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
854a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
855a64d13efSStefano Zampini 
856a64d13efSStefano Zampini   if (pcbddc->inexact_prec_type || pcbddc->dbg_flag ) {
857a64d13efSStefano Zampini     ierr = PetscMalloc(n_D*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
858a64d13efSStefano Zampini     for (i=0, j=0; i<n_R; i++) {
8594641a718SStefano Zampini       if (PetscBTLookup(bitmask,idx_R_local[i])) {
8604641a718SStefano Zampini         aux_array1[j++] = i;
861a64d13efSStefano Zampini       }
862a64d13efSStefano Zampini     }
863a64d13efSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
864a64d13efSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
865a64d13efSStefano Zampini     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
866a64d13efSStefano Zampini   }
8674641a718SStefano Zampini   ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
868a64d13efSStefano Zampini   PetscFunctionReturn(0);
869a64d13efSStefano Zampini }
870a64d13efSStefano Zampini 
871a64d13efSStefano Zampini #undef __FUNCT__
872304d26faSStefano Zampini #define __FUNCT__ "PCBDDCSetUseExactDirichlet"
873304d26faSStefano Zampini PetscErrorCode PCBDDCSetUseExactDirichlet(PC pc,PetscBool use)
874304d26faSStefano Zampini {
875304d26faSStefano Zampini   PC_BDDC  *pcbddc = (PC_BDDC*)pc->data;
876304d26faSStefano Zampini 
877304d26faSStefano Zampini   PetscFunctionBegin;
878304d26faSStefano Zampini   pcbddc->use_exact_dirichlet=use;
879304d26faSStefano Zampini   PetscFunctionReturn(0);
880304d26faSStefano Zampini }
881304d26faSStefano Zampini 
882304d26faSStefano Zampini #undef __FUNCT__
883304d26faSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
8848ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc)
885304d26faSStefano Zampini {
886304d26faSStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
887304d26faSStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
888304d26faSStefano Zampini   PC             pc_temp;
889304d26faSStefano Zampini   Mat            A_RR;
890304d26faSStefano Zampini   Vec            vec1,vec2,vec3;
891304d26faSStefano Zampini   MatStructure   matstruct;
892304d26faSStefano Zampini   PetscScalar    m_one = -1.0;
893304d26faSStefano Zampini   PetscReal      value;
894304d26faSStefano Zampini   PetscInt       n_D,n_R,use_exact,use_exact_reduced;
895304d26faSStefano Zampini   PetscErrorCode ierr;
896304d26faSStefano Zampini 
897304d26faSStefano Zampini   PetscFunctionBegin;
898304d26faSStefano Zampini   /* Creating PC contexts for local Dirichlet and Neumann problems */
899304d26faSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
900304d26faSStefano Zampini 
901304d26faSStefano Zampini   /* DIRICHLET PROBLEM */
902ac78edfcSStefano Zampini   /* Matrix for Dirichlet problem is pcis->A_II */
9038ce42a96SStefano Zampini   ierr = ISGetSize(pcis->is_I_local,&n_D);CHKERRQ(ierr);
904304d26faSStefano Zampini   if (!pcbddc->ksp_D) { /* create object if not yet build */
905304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
906304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
907304d26faSStefano Zampini     /* default */
908304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
909304d26faSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,"dirichlet_");CHKERRQ(ierr);
910304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
911304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
912304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
913304d26faSStefano Zampini   }
914304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II,matstruct);CHKERRQ(ierr);
915304d26faSStefano Zampini   /* Allow user's customization */
916304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
917304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
918304d26faSStefano Zampini   if (!n_D) {
919304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
920304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
921304d26faSStefano Zampini   }
922304d26faSStefano Zampini   /* Set Up KSP for Dirichlet problem of BDDC */
923304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
924304d26faSStefano Zampini   /* set ksp_D into pcis data */
925304d26faSStefano Zampini   ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
926304d26faSStefano Zampini   ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
927304d26faSStefano Zampini   pcis->ksp_D = pcbddc->ksp_D;
928304d26faSStefano Zampini 
929304d26faSStefano Zampini   /* NEUMANN PROBLEM */
930304d26faSStefano Zampini   /* Matrix for Neumann problem is A_RR -> we need to create it */
9318ce42a96SStefano Zampini   ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
9328ce42a96SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
933304d26faSStefano Zampini   if (!pcbddc->ksp_R) { /* create object if not yet build */
934304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
935304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
936304d26faSStefano Zampini     /* default */
937304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
938304d26faSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,"neumann_");CHKERRQ(ierr);
939304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
940304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
941304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
942304d26faSStefano Zampini   }
943304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR,matstruct);CHKERRQ(ierr);
944304d26faSStefano Zampini   /* Allow user's customization */
945304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
946304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
947304d26faSStefano Zampini   if (!n_R) {
948304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
949304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
950304d26faSStefano Zampini   }
951304d26faSStefano Zampini   /* Set Up KSP for Neumann problem of BDDC */
952304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
953304d26faSStefano Zampini 
954304d26faSStefano Zampini   /* check Dirichlet and Neumann solvers and adapt them if a nullspace correction is needed */
955304d26faSStefano Zampini 
956304d26faSStefano Zampini   /* Dirichlet */
957304d26faSStefano Zampini   ierr = MatGetVecs(pcis->A_II,&vec1,&vec2);CHKERRQ(ierr);
958304d26faSStefano Zampini   ierr = VecDuplicate(vec1,&vec3);CHKERRQ(ierr);
959304d26faSStefano Zampini   ierr = VecSetRandom(vec1,NULL);CHKERRQ(ierr);
960304d26faSStefano Zampini   ierr = MatMult(pcis->A_II,vec1,vec2);CHKERRQ(ierr);
961304d26faSStefano Zampini   ierr = KSPSolve(pcbddc->ksp_D,vec2,vec3);CHKERRQ(ierr);
962304d26faSStefano Zampini   ierr = VecAXPY(vec3,m_one,vec1);CHKERRQ(ierr);
963304d26faSStefano Zampini   ierr = VecNorm(vec3,NORM_INFINITY,&value);CHKERRQ(ierr);
964304d26faSStefano Zampini   ierr = VecDestroy(&vec1);CHKERRQ(ierr);
965304d26faSStefano Zampini   ierr = VecDestroy(&vec2);CHKERRQ(ierr);
966304d26faSStefano Zampini   ierr = VecDestroy(&vec3);CHKERRQ(ierr);
967304d26faSStefano Zampini   /* need to be adapted? */
968304d26faSStefano Zampini   use_exact = (PetscAbsReal(value) > 1.e-4 ? 0 : 1);
969304d26faSStefano Zampini   ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_INT,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
970304d26faSStefano Zampini   ierr = PCBDDCSetUseExactDirichlet(pc,(PetscBool)use_exact_reduced);CHKERRQ(ierr);
971304d26faSStefano Zampini   /* print info */
972304d26faSStefano Zampini   if (pcbddc->dbg_flag) {
973304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
974304d26faSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
975304d26faSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Checking solution of Dirichlet and Neumann problems\n");CHKERRQ(ierr);
976304d26faSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Dirichlet solve = % 1.14e \n",PetscGlobalRank,value);CHKERRQ(ierr);
977304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
978304d26faSStefano Zampini   }
979304d26faSStefano Zampini   if (n_D && pcbddc->NullSpace && !use_exact_reduced && !pcbddc->inexact_prec_type) {
9808ce42a96SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcis->is_I_local);CHKERRQ(ierr);
981304d26faSStefano Zampini   }
982304d26faSStefano Zampini 
983304d26faSStefano Zampini   /* Neumann */
984304d26faSStefano Zampini   ierr = MatGetVecs(A_RR,&vec1,&vec2);CHKERRQ(ierr);
985304d26faSStefano Zampini   ierr = VecDuplicate(vec1,&vec3);CHKERRQ(ierr);
986304d26faSStefano Zampini   ierr = VecSetRandom(vec1,NULL);CHKERRQ(ierr);
987304d26faSStefano Zampini   ierr = MatMult(A_RR,vec1,vec2);CHKERRQ(ierr);
988304d26faSStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,vec2,vec3);CHKERRQ(ierr);
989304d26faSStefano Zampini   ierr = VecAXPY(vec3,m_one,vec1);CHKERRQ(ierr);
990304d26faSStefano Zampini   ierr = VecNorm(vec3,NORM_INFINITY,&value);CHKERRQ(ierr);
991304d26faSStefano Zampini   ierr = VecDestroy(&vec1);CHKERRQ(ierr);
992304d26faSStefano Zampini   ierr = VecDestroy(&vec2);CHKERRQ(ierr);
993304d26faSStefano Zampini   ierr = VecDestroy(&vec3);CHKERRQ(ierr);
994304d26faSStefano Zampini   /* need to be adapted? */
995304d26faSStefano Zampini   use_exact = (PetscAbsReal(value) > 1.e-4 ? 0 : 1);
996304d26faSStefano Zampini   if (PetscAbsReal(value) > 1.e-4) use_exact = 0;
997304d26faSStefano Zampini   ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_INT,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
998304d26faSStefano Zampini   /* print info */
999304d26faSStefano Zampini   if (pcbddc->dbg_flag) {
1000304d26faSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for  Neumann  solve = % 1.14e \n",PetscGlobalRank,value);CHKERRQ(ierr);
1001304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1002304d26faSStefano Zampini   }
1003304d26faSStefano Zampini   if (n_R && pcbddc->NullSpace && !use_exact_reduced) { /* is it the right logic? */
10048ce42a96SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcbddc->is_R_local);CHKERRQ(ierr);
1005304d26faSStefano Zampini   }
1006304d26faSStefano Zampini 
1007304d26faSStefano Zampini   /* free Neumann problem's matrix */
1008304d26faSStefano Zampini   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1009304d26faSStefano Zampini   PetscFunctionReturn(0);
1010304d26faSStefano Zampini }
1011304d26faSStefano Zampini 
1012304d26faSStefano Zampini #undef __FUNCT__
1013674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSolveSaddlePoint"
1014674ae819SStefano Zampini static PetscErrorCode  PCBDDCSolveSaddlePoint(PC pc)
1015674ae819SStefano Zampini {
1016674ae819SStefano Zampini   PetscErrorCode ierr;
1017674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1018674ae819SStefano Zampini 
1019674ae819SStefano Zampini   PetscFunctionBegin;
1020674ae819SStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
1021674ae819SStefano Zampini   if (pcbddc->local_auxmat1) {
1022674ae819SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec2_R,pcbddc->vec1_C);CHKERRQ(ierr);
1023674ae819SStefano Zampini     ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
1024674ae819SStefano Zampini   }
1025674ae819SStefano Zampini   PetscFunctionReturn(0);
1026674ae819SStefano Zampini }
1027674ae819SStefano Zampini 
1028674ae819SStefano Zampini #undef __FUNCT__
1029674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
1030674ae819SStefano Zampini PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc)
1031674ae819SStefano Zampini {
1032674ae819SStefano Zampini   PetscErrorCode ierr;
1033674ae819SStefano Zampini   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
1034674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)  (pc->data);
1035674ae819SStefano Zampini   const PetscScalar zero = 0.0;
1036674ae819SStefano Zampini 
1037674ae819SStefano Zampini   PetscFunctionBegin;
103815aaf578SStefano Zampini   /* Application of PHI^T (or PSI^T)  */
103915aaf578SStefano Zampini   if (pcbddc->coarse_psi_B) {
104015aaf578SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
104115aaf578SStefano Zampini     if (pcbddc->inexact_prec_type) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
104215aaf578SStefano Zampini   } else {
1043674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
1044674ae819SStefano Zampini     if (pcbddc->inexact_prec_type) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
104515aaf578SStefano Zampini   }
1046674ae819SStefano Zampini   /* Scatter data of coarse_rhs */
1047674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { ierr = VecSet(pcbddc->coarse_rhs,zero);CHKERRQ(ierr); }
1048674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1049674ae819SStefano Zampini 
1050674ae819SStefano Zampini   /* Local solution on R nodes */
1051674ae819SStefano Zampini   ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
1052674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1053674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1054674ae819SStefano Zampini   if (pcbddc->inexact_prec_type) {
1055674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1056674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1057674ae819SStefano Zampini   }
1058674ae819SStefano Zampini   ierr = PCBDDCSolveSaddlePoint(pc);CHKERRQ(ierr);
1059674ae819SStefano Zampini   ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1060674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1061674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1062674ae819SStefano Zampini   if (pcbddc->inexact_prec_type) {
1063674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1064674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1065674ae819SStefano Zampini   }
1066674ae819SStefano Zampini 
1067674ae819SStefano Zampini   /* Coarse solution */
1068674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1069674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { /* TODO remove null space when doing multilevel */
1070674ae819SStefano Zampini     ierr = KSPSolve(pcbddc->coarse_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
1071674ae819SStefano Zampini   }
1072674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1073674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd  (pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1074674ae819SStefano Zampini 
1075674ae819SStefano Zampini   /* Sum contributions from two levels */
1076674ae819SStefano Zampini   ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
1077674ae819SStefano Zampini   if (pcbddc->inexact_prec_type) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1078674ae819SStefano Zampini   PetscFunctionReturn(0);
1079674ae819SStefano Zampini }
1080674ae819SStefano Zampini 
1081674ae819SStefano Zampini #undef __FUNCT__
1082674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
1083674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1084674ae819SStefano Zampini {
1085674ae819SStefano Zampini   PetscErrorCode ierr;
1086674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1087674ae819SStefano Zampini 
1088674ae819SStefano Zampini   PetscFunctionBegin;
1089674ae819SStefano Zampini   switch (pcbddc->coarse_communications_type) {
1090674ae819SStefano Zampini     case SCATTERS_BDDC:
1091674ae819SStefano Zampini       ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1092674ae819SStefano Zampini       break;
1093674ae819SStefano Zampini     case GATHERS_BDDC:
1094674ae819SStefano Zampini       break;
1095674ae819SStefano Zampini   }
1096674ae819SStefano Zampini   PetscFunctionReturn(0);
1097674ae819SStefano Zampini }
1098674ae819SStefano Zampini 
1099674ae819SStefano Zampini #undef __FUNCT__
1100674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
1101674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1102674ae819SStefano Zampini {
1103674ae819SStefano Zampini   PetscErrorCode ierr;
1104674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1105674ae819SStefano Zampini   PetscScalar*   array_to;
1106674ae819SStefano Zampini   PetscScalar*   array_from;
1107674ae819SStefano Zampini   MPI_Comm       comm;
1108674ae819SStefano Zampini   PetscInt       i;
1109674ae819SStefano Zampini 
1110674ae819SStefano Zampini   PetscFunctionBegin;
1111674ae819SStefano Zampini   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
1112674ae819SStefano Zampini   switch (pcbddc->coarse_communications_type) {
1113674ae819SStefano Zampini     case SCATTERS_BDDC:
1114674ae819SStefano Zampini       ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1115674ae819SStefano Zampini       break;
1116674ae819SStefano Zampini     case GATHERS_BDDC:
1117674ae819SStefano Zampini       if (vec_from) {
1118674ae819SStefano Zampini         ierr = VecGetArray(vec_from,&array_from);CHKERRQ(ierr);
1119674ae819SStefano Zampini       }
1120674ae819SStefano Zampini       if (vec_to) {
1121674ae819SStefano Zampini         ierr = VecGetArray(vec_to,&array_to);CHKERRQ(ierr);
1122674ae819SStefano Zampini       }
1123674ae819SStefano Zampini       switch(pcbddc->coarse_problem_type){
1124674ae819SStefano Zampini         case SEQUENTIAL_BDDC:
1125674ae819SStefano Zampini           if (smode == SCATTER_FORWARD) {
1126674ae819SStefano Zampini             ierr = MPI_Gatherv(&array_from[0],pcbddc->local_primal_size,MPIU_SCALAR,&pcbddc->replicated_local_primal_values[0],pcbddc->local_primal_sizes,pcbddc->local_primal_displacements,MPIU_SCALAR,0,comm);CHKERRQ(ierr);
1127674ae819SStefano Zampini             if (vec_to) {
1128674ae819SStefano Zampini               if (imode == ADD_VALUES) {
1129674ae819SStefano Zampini                 for (i=0;i<pcbddc->replicated_primal_size;i++) {
1130674ae819SStefano Zampini                   array_to[pcbddc->replicated_local_primal_indices[i]]+=pcbddc->replicated_local_primal_values[i];
1131674ae819SStefano Zampini                 }
1132674ae819SStefano Zampini               } else {
1133674ae819SStefano Zampini                 for (i=0;i<pcbddc->replicated_primal_size;i++) {
1134674ae819SStefano Zampini                   array_to[pcbddc->replicated_local_primal_indices[i]]=pcbddc->replicated_local_primal_values[i];
1135674ae819SStefano Zampini                 }
1136674ae819SStefano Zampini               }
1137674ae819SStefano Zampini             }
1138674ae819SStefano Zampini           } else {
1139674ae819SStefano Zampini             if (vec_from) {
1140674ae819SStefano Zampini               if (imode == ADD_VALUES) {
1141674ae819SStefano Zampini                 MPI_Comm vec_from_comm;
1142674ae819SStefano Zampini                 ierr = PetscObjectGetComm((PetscObject)(vec_from),&vec_from_comm);CHKERRQ(ierr);
1143674ae819SStefano Zampini                 SETERRQ2(vec_from_comm,PETSC_ERR_SUP,"Unsupported insert mode ADD_VALUES for SCATTER_REVERSE in %s for case %d\n",__FUNCT__,pcbddc->coarse_problem_type);
1144674ae819SStefano Zampini               }
1145674ae819SStefano Zampini               for (i=0;i<pcbddc->replicated_primal_size;i++) {
1146674ae819SStefano Zampini                 pcbddc->replicated_local_primal_values[i]=array_from[pcbddc->replicated_local_primal_indices[i]];
1147674ae819SStefano Zampini               }
1148674ae819SStefano Zampini             }
1149674ae819SStefano Zampini             ierr = MPI_Scatterv(&pcbddc->replicated_local_primal_values[0],pcbddc->local_primal_sizes,pcbddc->local_primal_displacements,MPIU_SCALAR,&array_to[0],pcbddc->local_primal_size,MPIU_SCALAR,0,comm);CHKERRQ(ierr);
1150674ae819SStefano Zampini           }
1151674ae819SStefano Zampini           break;
1152674ae819SStefano Zampini         case REPLICATED_BDDC:
1153674ae819SStefano Zampini           if (smode == SCATTER_FORWARD) {
1154674ae819SStefano Zampini             ierr = MPI_Allgatherv(&array_from[0],pcbddc->local_primal_size,MPIU_SCALAR,&pcbddc->replicated_local_primal_values[0],pcbddc->local_primal_sizes,pcbddc->local_primal_displacements,MPIU_SCALAR,comm);CHKERRQ(ierr);
1155674ae819SStefano Zampini             if (imode == ADD_VALUES) {
1156674ae819SStefano Zampini               for (i=0;i<pcbddc->replicated_primal_size;i++) {
1157674ae819SStefano Zampini                 array_to[pcbddc->replicated_local_primal_indices[i]]+=pcbddc->replicated_local_primal_values[i];
1158674ae819SStefano Zampini               }
1159674ae819SStefano Zampini             } else {
1160674ae819SStefano Zampini               for (i=0;i<pcbddc->replicated_primal_size;i++) {
1161674ae819SStefano Zampini                 array_to[pcbddc->replicated_local_primal_indices[i]]=pcbddc->replicated_local_primal_values[i];
1162674ae819SStefano Zampini               }
1163674ae819SStefano Zampini             }
1164674ae819SStefano Zampini           } else { /* no communications needed for SCATTER_REVERSE since needed data is already present */
1165674ae819SStefano Zampini             if (imode == ADD_VALUES) {
1166674ae819SStefano Zampini               for (i=0;i<pcbddc->local_primal_size;i++) {
1167674ae819SStefano Zampini                 array_to[i]+=array_from[pcbddc->local_primal_indices[i]];
1168674ae819SStefano Zampini               }
1169674ae819SStefano Zampini             } else {
1170674ae819SStefano Zampini               for (i=0;i<pcbddc->local_primal_size;i++) {
1171674ae819SStefano Zampini                 array_to[i]=array_from[pcbddc->local_primal_indices[i]];
1172674ae819SStefano Zampini               }
1173674ae819SStefano Zampini             }
1174674ae819SStefano Zampini           }
1175674ae819SStefano Zampini           break;
1176674ae819SStefano Zampini         case MULTILEVEL_BDDC:
1177674ae819SStefano Zampini           break;
1178674ae819SStefano Zampini         case PARALLEL_BDDC:
1179674ae819SStefano Zampini           break;
1180674ae819SStefano Zampini       }
1181674ae819SStefano Zampini       if (vec_from) {
1182674ae819SStefano Zampini         ierr = VecRestoreArray(vec_from,&array_from);CHKERRQ(ierr);
1183674ae819SStefano Zampini       }
1184674ae819SStefano Zampini       if (vec_to) {
1185674ae819SStefano Zampini         ierr = VecRestoreArray(vec_to,&array_to);CHKERRQ(ierr);
1186674ae819SStefano Zampini       }
1187674ae819SStefano Zampini       break;
1188674ae819SStefano Zampini   }
1189674ae819SStefano Zampini   PetscFunctionReturn(0);
1190674ae819SStefano Zampini }
1191674ae819SStefano Zampini 
1192984c4197SStefano Zampini /* uncomment for testing purposes */
1193984c4197SStefano Zampini /* #define PETSC_MISSING_LAPACK_GESVD 1 */
1194674ae819SStefano Zampini #undef __FUNCT__
1195674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp"
1196674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
1197674ae819SStefano Zampini {
1198674ae819SStefano Zampini   PetscErrorCode    ierr;
1199674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
1200674ae819SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
1201674ae819SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
1202984c4197SStefano Zampini   /* constraint and (optionally) change of basis matrix implemented as SeqAIJ */
1203674ae819SStefano Zampini   MatType           impMatType=MATSEQAIJ;
1204984c4197SStefano Zampini   /* one and zero */
1205984c4197SStefano Zampini   PetscScalar       one=1.0,zero=0.0;
1206984c4197SStefano Zampini   /* space to store constraints and their local indices */
1207984c4197SStefano Zampini   PetscScalar       *temp_quadrature_constraint;
1208984c4197SStefano Zampini   PetscInt          *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B;
1209984c4197SStefano Zampini   /* iterators */
1210984c4197SStefano Zampini   PetscInt          i,j,k,total_counts,temp_start_ptr;
1211984c4197SStefano Zampini   /* stuff to store connected components stored in pcbddc->mat_graph */
1212984c4197SStefano Zampini   IS                ISForVertices,*ISForFaces,*ISForEdges,*used_IS;
1213984c4197SStefano Zampini   PetscInt          n_ISForFaces,n_ISForEdges;
1214984c4197SStefano Zampini   PetscBool         get_faces,get_edges,get_vertices;
1215984c4197SStefano Zampini   /* near null space stuff */
1216674ae819SStefano Zampini   MatNullSpace      nearnullsp;
1217674ae819SStefano Zampini   const Vec         *nearnullvecs;
1218674ae819SStefano Zampini   Vec               *localnearnullsp;
1219984c4197SStefano Zampini   PetscBool         nnsp_has_cnst;
1220984c4197SStefano Zampini   PetscInt          nnsp_size;
1221984c4197SStefano Zampini   PetscScalar       *array;
1222984c4197SStefano Zampini   /* BLAS integers */
1223e310c8b4SStefano Zampini   PetscBLASInt      lwork,lierr;
1224e310c8b4SStefano Zampini   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
1225c4303822SStefano Zampini   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
1226984c4197SStefano Zampini   /* LAPACK working arrays for SVD or POD */
1227242a89d7SStefano Zampini   PetscBool         skip_lapack;
1228984c4197SStefano Zampini   PetscScalar       *work;
1229984c4197SStefano Zampini   PetscReal         *singular_vals;
1230984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1231984c4197SStefano Zampini   PetscReal         *rwork;
1232674ae819SStefano Zampini #endif
1233984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1234e310c8b4SStefano Zampini   PetscBLASInt      Blas_one_2=1;
1235984c4197SStefano Zampini   PetscScalar       *temp_basis,*correlation_mat;
1236b7d8b9f8SStefano Zampini #else
1237b7d8b9f8SStefano Zampini   PetscBLASInt      dummy_int_1=1,dummy_int_2=1;
1238b7d8b9f8SStefano Zampini   PetscScalar       dummy_scalar_1=0.0,dummy_scalar_2=0.0;
1239984c4197SStefano Zampini #endif
1240984c4197SStefano Zampini   /* change of basis */
1241984c4197SStefano Zampini   PetscInt          *aux_primal_numbering,*aux_primal_minloc,*global_indices;
12424641a718SStefano Zampini   PetscBool         boolforchange;
12434641a718SStefano Zampini   PetscBT           touched,change_basis;
1244984c4197SStefano Zampini   /* auxiliary stuff */
1245984c4197SStefano Zampini   PetscInt          *nnz,*is_indices,*local_to_B;
1246984c4197SStefano Zampini   /* some quantities */
1247984c4197SStefano Zampini   PetscInt          n_vertices,total_primal_vertices;
1248984c4197SStefano Zampini   PetscInt          size_of_constraint,max_size_of_constraint,max_constraints,temp_constraints;
1249984c4197SStefano Zampini 
1250674ae819SStefano Zampini 
1251674ae819SStefano Zampini   PetscFunctionBegin;
1252674ae819SStefano Zampini   /* Get index sets for faces, edges and vertices from graph */
1253674ae819SStefano Zampini   get_faces = PETSC_TRUE;
1254674ae819SStefano Zampini   get_edges = PETSC_TRUE;
1255674ae819SStefano Zampini   get_vertices = PETSC_TRUE;
1256674ae819SStefano Zampini   if (pcbddc->vertices_flag) {
1257674ae819SStefano Zampini     get_faces = PETSC_FALSE;
1258674ae819SStefano Zampini     get_edges = PETSC_FALSE;
1259674ae819SStefano Zampini   }
1260674ae819SStefano Zampini   if (pcbddc->constraints_flag) {
1261674ae819SStefano Zampini     get_vertices = PETSC_FALSE;
1262674ae819SStefano Zampini   }
1263674ae819SStefano Zampini   if (pcbddc->faces_flag) {
1264674ae819SStefano Zampini     get_edges = PETSC_FALSE;
1265674ae819SStefano Zampini   }
1266674ae819SStefano Zampini   if (pcbddc->edges_flag) {
1267674ae819SStefano Zampini     get_faces = PETSC_FALSE;
1268674ae819SStefano Zampini   }
1269674ae819SStefano Zampini   /* default */
1270674ae819SStefano Zampini   if (!get_faces && !get_edges && !get_vertices) {
1271674ae819SStefano Zampini     get_vertices = PETSC_TRUE;
1272674ae819SStefano Zampini   }
1273674ae819SStefano Zampini   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,get_faces,get_edges,get_vertices,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);
1274984c4197SStefano Zampini   /* print some info */
1275674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
1276674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1277674ae819SStefano Zampini     i = 0;
1278674ae819SStefano Zampini     if (ISForVertices) {
1279674ae819SStefano Zampini       ierr = ISGetSize(ISForVertices,&i);CHKERRQ(ierr);
1280674ae819SStefano Zampini     }
1281674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices\n",PetscGlobalRank,i);CHKERRQ(ierr);
1282674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges\n",PetscGlobalRank,n_ISForEdges);CHKERRQ(ierr);
128315aaf578SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces\n",PetscGlobalRank,n_ISForFaces);CHKERRQ(ierr);
1284674ae819SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1285674ae819SStefano Zampini   }
1286674ae819SStefano Zampini   /* check if near null space is attached to global mat */
1287674ae819SStefano Zampini   ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
1288674ae819SStefano Zampini   if (nearnullsp) {
1289674ae819SStefano Zampini     ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
1290984c4197SStefano Zampini   } else { /* if near null space is not provided BDDC uses constants by default */
1291984c4197SStefano Zampini     nnsp_size = 0;
1292674ae819SStefano Zampini     nnsp_has_cnst = PETSC_TRUE;
1293674ae819SStefano Zampini   }
1294984c4197SStefano Zampini   /* get max number of constraints on a single cc */
1295984c4197SStefano Zampini   max_constraints = nnsp_size;
1296984c4197SStefano Zampini   if (nnsp_has_cnst) max_constraints++;
1297984c4197SStefano Zampini 
1298674ae819SStefano Zampini   /*
1299674ae819SStefano Zampini        Evaluate maximum storage size needed by the procedure
1300674ae819SStefano Zampini        - temp_indices will contain start index of each constraint stored as follows
1301674ae819SStefano 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
1302674ae819SStefano 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
1303674ae819SStefano Zampini        - temp_quadrature_constraint  [temp_indices[i],...,temp[indices[i+1]-1] will contain the scalars representing the constraint itself
1304674ae819SStefano Zampini                                                                                                                                                          */
1305674ae819SStefano Zampini   total_counts = n_ISForFaces+n_ISForEdges;
1306984c4197SStefano Zampini   total_counts *= max_constraints;
1307674ae819SStefano Zampini   n_vertices = 0;
1308674ae819SStefano Zampini   if (ISForVertices) {
1309674ae819SStefano Zampini     ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
1310674ae819SStefano Zampini   }
1311674ae819SStefano Zampini   total_counts += n_vertices;
1312674ae819SStefano Zampini   ierr = PetscMalloc((total_counts+1)*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
13134641a718SStefano Zampini   ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
1314674ae819SStefano Zampini   total_counts = 0;
1315674ae819SStefano Zampini   max_size_of_constraint = 0;
1316674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1317674ae819SStefano Zampini     if (i<n_ISForEdges) {
1318674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1319674ae819SStefano Zampini     } else {
1320674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1321674ae819SStefano Zampini     }
1322674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
1323674ae819SStefano Zampini     total_counts += j;
1324674ae819SStefano Zampini     max_size_of_constraint = PetscMax(j,max_size_of_constraint);
1325674ae819SStefano Zampini   }
1326984c4197SStefano Zampini   total_counts *= max_constraints;
1327674ae819SStefano Zampini   total_counts += n_vertices;
1328674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&temp_quadrature_constraint);CHKERRQ(ierr);
1329674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint);CHKERRQ(ierr);
1330674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint_B);CHKERRQ(ierr);
1331984c4197SStefano Zampini   /* local to boundary numbering */
1332674ae819SStefano Zampini   ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&local_to_B);CHKERRQ(ierr);
1333674ae819SStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1334984c4197SStefano Zampini   for (i=0;i<pcis->n;i++) local_to_B[i]=-1;
1335984c4197SStefano Zampini   for (i=0;i<pcis->n_B;i++) local_to_B[is_indices[i]]=i;
1336674ae819SStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1337984c4197SStefano Zampini   /* get local part of global near null space vectors */
1338984c4197SStefano Zampini   ierr = PetscMalloc(nnsp_size*sizeof(Vec),&localnearnullsp);CHKERRQ(ierr);
1339984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1340984c4197SStefano Zampini     ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
1341984c4197SStefano Zampini     ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1342984c4197SStefano Zampini     ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1343984c4197SStefano Zampini   }
1344674ae819SStefano Zampini 
1345242a89d7SStefano Zampini   /* whether or not to skip lapack calls */
1346242a89d7SStefano Zampini   skip_lapack = PETSC_TRUE;
1347242a89d7SStefano Zampini   if (n_ISForFaces+n_ISForEdges) skip_lapack = PETSC_FALSE;
1348242a89d7SStefano Zampini 
1349984c4197SStefano Zampini   /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
1350242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1351674ae819SStefano Zampini     PetscScalar temp_work;
1352674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1353984c4197SStefano Zampini     /* Proper Orthogonal Decomposition (POD) using the snapshot method */
1354984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*max_constraints*sizeof(PetscScalar),&correlation_mat);CHKERRQ(ierr);
1355984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1356984c4197SStefano Zampini     ierr = PetscMalloc(max_size_of_constraint*max_constraints*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr);
1357674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1358984c4197SStefano Zampini     ierr = PetscMalloc(3*max_constraints*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1359674ae819SStefano Zampini #endif
1360674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1361c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
1362c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
1363674ae819SStefano Zampini     lwork = -1;
1364674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1365674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1366c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
1367674ae819SStefano Zampini #else
1368c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
1369674ae819SStefano Zampini #endif
1370674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1371984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
1372674ae819SStefano Zampini #else /* on missing GESVD */
1373674ae819SStefano Zampini     /* SVD */
1374674ae819SStefano Zampini     PetscInt max_n,min_n;
1375674ae819SStefano Zampini     max_n = max_size_of_constraint;
1376984c4197SStefano Zampini     min_n = max_constraints;
1377984c4197SStefano Zampini     if (max_size_of_constraint < max_constraints) {
1378674ae819SStefano Zampini       min_n = max_size_of_constraint;
1379984c4197SStefano Zampini       max_n = max_constraints;
1380674ae819SStefano Zampini     }
1381674ae819SStefano Zampini     ierr = PetscMalloc(min_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1382674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1383674ae819SStefano Zampini     ierr = PetscMalloc(5*min_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1384674ae819SStefano Zampini #endif
1385674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1386674ae819SStefano Zampini     lwork = -1;
1387e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
1388e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
1389b7d8b9f8SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
1390674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1391674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1392e310c8b4SStefano 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));
1393674ae819SStefano Zampini #else
1394e310c8b4SStefano 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));
1395674ae819SStefano Zampini #endif
1396674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1397984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
1398984c4197SStefano Zampini #endif /* on missing GESVD */
1399674ae819SStefano Zampini     /* Allocate optimal workspace */
1400674ae819SStefano Zampini     ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
1401984c4197SStefano Zampini     ierr = PetscMalloc((PetscInt)lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
1402674ae819SStefano Zampini   }
1403674ae819SStefano Zampini   /* Now we can loop on constraining sets */
1404674ae819SStefano Zampini   total_counts = 0;
1405674ae819SStefano Zampini   temp_indices[0] = 0;
1406674ae819SStefano Zampini   /* vertices */
1407674ae819SStefano Zampini   if (ISForVertices) {
1408674ae819SStefano Zampini     ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1409674ae819SStefano Zampini     if (nnsp_has_cnst) { /* consider all vertices */
1410674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1411674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1412674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
1413674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1414674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1415674ae819SStefano Zampini         total_counts++;
1416674ae819SStefano Zampini       }
1417674ae819SStefano Zampini     } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
1418984c4197SStefano Zampini       PetscBool used_vertex;
1419674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1420674ae819SStefano Zampini         used_vertex = PETSC_FALSE;
1421674ae819SStefano Zampini         k = 0;
1422674ae819SStefano Zampini         while (!used_vertex && k<nnsp_size) {
1423984c4197SStefano Zampini           ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1424984c4197SStefano Zampini           if (PetscAbsScalar(array[is_indices[i]])>0.0) {
1425674ae819SStefano Zampini             temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1426674ae819SStefano Zampini             temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
1427674ae819SStefano Zampini             temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1428674ae819SStefano Zampini             temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1429674ae819SStefano Zampini             total_counts++;
1430674ae819SStefano Zampini             used_vertex = PETSC_TRUE;
1431674ae819SStefano Zampini           }
1432984c4197SStefano Zampini           ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1433674ae819SStefano Zampini           k++;
1434674ae819SStefano Zampini         }
1435674ae819SStefano Zampini       }
1436674ae819SStefano Zampini     }
1437674ae819SStefano Zampini     ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1438674ae819SStefano Zampini     n_vertices = total_counts;
1439674ae819SStefano Zampini   }
1440984c4197SStefano Zampini 
1441674ae819SStefano Zampini   /* edges and faces */
1442674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1443674ae819SStefano Zampini     if (i<n_ISForEdges) {
1444674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1445984c4197SStefano Zampini       boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
1446674ae819SStefano Zampini     } else {
1447674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1448984c4197SStefano Zampini       boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
1449674ae819SStefano Zampini     }
1450674ae819SStefano Zampini     temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
1451674ae819SStefano Zampini     temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
1452674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
1453674ae819SStefano Zampini     ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1454984c4197SStefano Zampini     /* change of basis should not be performed on local periodic nodes */
1455984c4197SStefano Zampini     if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
1456674ae819SStefano Zampini     if (nnsp_has_cnst) {
14575b08dc53SStefano Zampini       PetscScalar quad_value;
1458674ae819SStefano Zampini       temp_constraints++;
1459674ae819SStefano Zampini       quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
1460674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1461674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
1462674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
1463674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
1464674ae819SStefano Zampini       }
1465674ae819SStefano Zampini       temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
14664641a718SStefano Zampini       if (boolforchange) {
14674641a718SStefano Zampini         ierr = PetscBTSet(change_basis,total_counts);CHKERRQ(ierr);
14684641a718SStefano Zampini       }
1469674ae819SStefano Zampini       total_counts++;
1470674ae819SStefano Zampini     }
1471674ae819SStefano Zampini     for (k=0;k<nnsp_size;k++) {
1472984c4197SStefano Zampini       PetscReal real_value;
1473984c4197SStefano Zampini       ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1474674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1475674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
1476674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
1477984c4197SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=array[is_indices[j]];
1478674ae819SStefano Zampini       }
1479984c4197SStefano Zampini       ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1480984c4197SStefano Zampini       /* check if array is null on the connected component */
1481e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1482e310c8b4SStefano Zampini       PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_one));
14835b08dc53SStefano Zampini       if (real_value > 0.0) { /* keep indices and values */
1484674ae819SStefano Zampini         temp_constraints++;
1485674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
14864641a718SStefano Zampini         if (boolforchange) {
14874641a718SStefano Zampini           ierr = PetscBTSet(change_basis,total_counts);CHKERRQ(ierr);
14884641a718SStefano Zampini         }
1489674ae819SStefano Zampini         total_counts++;
1490674ae819SStefano Zampini       }
1491674ae819SStefano Zampini     }
1492674ae819SStefano Zampini     ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1493984c4197SStefano Zampini     /* perform SVD on the constraints if use_nnsp_true has not be requested by the user */
1494984c4197SStefano Zampini     if (!pcbddc->use_nnsp_true) {
1495984c4197SStefano Zampini       PetscReal tol = 1.0e-8; /* tolerance for retaining eigenmodes */
1496674ae819SStefano Zampini 
1497674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1498984c4197SStefano Zampini       /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
1499984c4197SStefano Zampini          POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
1500984c4197SStefano Zampini          -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
1501984c4197SStefano Zampini             the constraints basis will differ (by a complex factor with absolute value equal to 1)
1502984c4197SStefano Zampini             from that computed using LAPACKgesvd
1503984c4197SStefano Zampini          -> This is due to a different computation of eigenvectors in LAPACKheev
1504984c4197SStefano Zampini          -> The quality of the POD-computed basis will be the same */
1505984c4197SStefano Zampini       ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
1506674ae819SStefano Zampini       /* Store upper triangular part of correlation matrix */
1507e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1508984c4197SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1509674ae819SStefano Zampini       for (j=0;j<temp_constraints;j++) {
1510674ae819SStefano Zampini         for (k=0;k<j+1;k++) {
1511e310c8b4SStefano 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));
1512674ae819SStefano Zampini         }
1513674ae819SStefano Zampini       }
1514e310c8b4SStefano Zampini       /* compute eigenvalues and eigenvectors of correlation matrix */
1515e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1516e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
1517674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1518c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
1519674ae819SStefano Zampini #else
1520c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
1521674ae819SStefano Zampini #endif
1522674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1523984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
1524984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
1525674ae819SStefano Zampini       j=0;
1526984c4197SStefano Zampini       while (j < temp_constraints && singular_vals[j] < tol) j++;
1527674ae819SStefano Zampini       total_counts=total_counts-j;
1528e310c8b4SStefano Zampini       /* scale and copy POD basis into used quadrature memory */
1529c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1530c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1531c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
1532c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1533c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
1534c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1535674ae819SStefano Zampini       if (j<temp_constraints) {
1536984c4197SStefano Zampini         PetscInt ii;
1537984c4197SStefano Zampini         for (k=j;k<temp_constraints;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]);
1538674ae819SStefano Zampini         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1539c4303822SStefano 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));
1540674ae819SStefano Zampini         ierr = PetscFPTrapPop();CHKERRQ(ierr);
1541984c4197SStefano Zampini         for (k=0;k<temp_constraints-j;k++) {
1542674ae819SStefano Zampini           for (ii=0;ii<size_of_constraint;ii++) {
1543984c4197SStefano 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];
1544674ae819SStefano Zampini           }
1545674ae819SStefano Zampini         }
1546674ae819SStefano Zampini       }
1547674ae819SStefano Zampini #else  /* on missing GESVD */
1548e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1549e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1550b7d8b9f8SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1551674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1552674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1553e310c8b4SStefano 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));
1554674ae819SStefano Zampini #else
1555e310c8b4SStefano 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));
1556674ae819SStefano Zampini #endif
1557984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
1558674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1559984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
1560e310c8b4SStefano Zampini       k = temp_constraints;
1561e310c8b4SStefano Zampini       if (k > size_of_constraint) k = size_of_constraint;
1562674ae819SStefano Zampini       j = 0;
1563e310c8b4SStefano Zampini       while (j < k && singular_vals[k-j-1] < tol) j++;
1564e310c8b4SStefano Zampini       total_counts = total_counts-temp_constraints+k-j;
1565984c4197SStefano Zampini #endif /* on missing GESVD */
1566674ae819SStefano Zampini     }
1567674ae819SStefano Zampini   }
1568674ae819SStefano Zampini   /* free index sets of faces, edges and vertices */
1569674ae819SStefano Zampini   for (i=0;i<n_ISForFaces;i++) {
1570674ae819SStefano Zampini     ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
1571674ae819SStefano Zampini   }
1572674ae819SStefano Zampini   ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
1573674ae819SStefano Zampini   for (i=0;i<n_ISForEdges;i++) {
1574674ae819SStefano Zampini     ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
1575674ae819SStefano Zampini   }
1576674ae819SStefano Zampini   ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
1577674ae819SStefano Zampini   ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
1578674ae819SStefano Zampini 
1579984c4197SStefano Zampini   /* free workspace */
1580242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1581984c4197SStefano Zampini     ierr = PetscFree(work);CHKERRQ(ierr);
1582984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1583984c4197SStefano Zampini     ierr = PetscFree(rwork);CHKERRQ(ierr);
1584984c4197SStefano Zampini #endif
1585984c4197SStefano Zampini     ierr = PetscFree(singular_vals);CHKERRQ(ierr);
1586984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1587984c4197SStefano Zampini     ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
1588984c4197SStefano Zampini     ierr = PetscFree(temp_basis);CHKERRQ(ierr);
1589984c4197SStefano Zampini #endif
1590984c4197SStefano Zampini   }
1591984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1592984c4197SStefano Zampini     ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
1593984c4197SStefano Zampini   }
1594984c4197SStefano Zampini   ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
1595984c4197SStefano Zampini 
1596674ae819SStefano Zampini   /* set quantities in pcbddc data structure */
1597984c4197SStefano Zampini   /* n_vertices defines the number of subdomain corners in the primal space */
1598674ae819SStefano Zampini   /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */
1599984c4197SStefano Zampini   pcbddc->local_primal_size = total_counts;
1600674ae819SStefano Zampini   pcbddc->n_vertices = n_vertices;
1601984c4197SStefano Zampini   pcbddc->n_constraints = pcbddc->local_primal_size-pcbddc->n_vertices;
1602674ae819SStefano Zampini 
1603674ae819SStefano Zampini   /* Create constraint matrix */
1604674ae819SStefano Zampini   /* The constraint matrix is used to compute the l2g map of primal dofs */
1605674ae819SStefano Zampini   /* so we need to set it up properly either with or without change of basis */
1606674ae819SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1607674ae819SStefano Zampini   ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr);
1608984c4197SStefano Zampini   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
1609984c4197SStefano Zampini   /* array to compute a local numbering of constraints : vertices first then constraints */
1610984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_numbering);CHKERRQ(ierr);
1611984c4197SStefano Zampini   /* array to select the proper local node (of minimum index with respect to global ordering) when changing the basis */
1612984c4197SStefano 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 */
1613984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_minloc);CHKERRQ(ierr);
1614984c4197SStefano Zampini   /* auxiliary stuff for basis change */
1615984c4197SStefano Zampini   ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&global_indices);CHKERRQ(ierr);
16164641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n_B,&touched);CHKERRQ(ierr);
1617984c4197SStefano Zampini 
1618984c4197SStefano Zampini   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
1619984c4197SStefano Zampini   total_primal_vertices=0;
1620984c4197SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
1621674ae819SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
1622984c4197SStefano Zampini     if (size_of_constraint == 1) {
16234641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]]);CHKERRQ(ierr);
1624984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]];
1625984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=0;
1626984c4197SStefano Zampini       total_primal_vertices++;
16274641a718SStefano Zampini     } else if (PetscBTLookup(change_basis,i)) { /* Same procedure used in PCBDDCGetPrimalConstraintsLocalIdx */
1628984c4197SStefano Zampini       PetscInt min_loc,min_index;
1629984c4197SStefano Zampini       ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],global_indices);CHKERRQ(ierr);
1630984c4197SStefano Zampini       /* find first untouched local node */
1631674ae819SStefano Zampini       k = 0;
16324641a718SStefano Zampini       while (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) k++;
1633984c4197SStefano Zampini       min_index = global_indices[k];
1634984c4197SStefano Zampini       min_loc = k;
1635984c4197SStefano Zampini       /* search the minimum among global nodes already untouched on the cc */
1636984c4197SStefano Zampini       for (k=1;k<size_of_constraint;k++) {
1637984c4197SStefano Zampini         /* there can be more than one constraint on a single connected component */
16384641a718SStefano Zampini         if (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k]) && min_index > global_indices[k]) {
1639984c4197SStefano Zampini           min_index = global_indices[k];
1640984c4197SStefano Zampini           min_loc = k;
1641674ae819SStefano Zampini         }
1642674ae819SStefano Zampini       }
16434641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]+min_loc]);CHKERRQ(ierr);
1644984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]+min_loc];
1645984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=min_loc;
1646984c4197SStefano Zampini       total_primal_vertices++;
1647984c4197SStefano Zampini     }
1648984c4197SStefano Zampini   }
1649984c4197SStefano Zampini   /* free workspace */
1650984c4197SStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
16514641a718SStefano Zampini   ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
1652674ae819SStefano Zampini   /* permute indices in order to have a sorted set of vertices */
1653984c4197SStefano Zampini   ierr = PetscSortInt(total_primal_vertices,aux_primal_numbering);
1654984c4197SStefano Zampini 
1655984c4197SStefano Zampini   /* nonzero structure of constraint matrix */
1656984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1657984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) nnz[i]=1;
1658984c4197SStefano Zampini   j=total_primal_vertices;
1659984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
16604641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1661674ae819SStefano Zampini       nnz[j]=temp_indices[i+1]-temp_indices[i];
1662674ae819SStefano Zampini       j++;
1663674ae819SStefano Zampini     }
1664674ae819SStefano Zampini   }
1665674ae819SStefano Zampini   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
1666674ae819SStefano Zampini   ierr = PetscFree(nnz);CHKERRQ(ierr);
1667674ae819SStefano Zampini   /* set values in constraint matrix */
1668984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) {
1669984c4197SStefano Zampini     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,aux_primal_numbering[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
1670674ae819SStefano Zampini   }
1671984c4197SStefano Zampini   total_counts = total_primal_vertices;
1672984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
16734641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1674674ae819SStefano Zampini       size_of_constraint=temp_indices[i+1]-temp_indices[i];
1675674ae819SStefano 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);
1676674ae819SStefano Zampini       total_counts++;
1677674ae819SStefano Zampini     }
1678674ae819SStefano Zampini   }
1679674ae819SStefano Zampini   /* assembling */
1680674ae819SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1681674ae819SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1682984c4197SStefano Zampini   /*
1683984c4197SStefano Zampini   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
1684984c4197SStefano Zampini   */
1685674ae819SStefano Zampini   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
1686674ae819SStefano Zampini   if (pcbddc->use_change_of_basis) {
1687984c4197SStefano Zampini     PetscBool qr_needed = PETSC_FALSE;
1688984c4197SStefano Zampini     /* change of basis acts on local interfaces -> dimension is n_B x n_B */
1689674ae819SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
1690674ae819SStefano Zampini     ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr);
1691674ae819SStefano Zampini     ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr);
1692674ae819SStefano Zampini     /* work arrays */
1693674ae819SStefano Zampini     ierr = PetscMalloc(pcis->n_B*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1694984c4197SStefano Zampini     for (i=0;i<pcis->n_B;i++) nnz[i]=1;
1695984c4197SStefano Zampini     /* nonzeros per row */
1696984c4197SStefano Zampini     for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
16974641a718SStefano Zampini       if (PetscBTLookup(change_basis,i)) {
1698984c4197SStefano Zampini         qr_needed = PETSC_TRUE;
1699674ae819SStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
1700984c4197SStefano Zampini         for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1701674ae819SStefano Zampini       }
1702674ae819SStefano Zampini     }
1703674ae819SStefano Zampini     ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
1704674ae819SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
1705674ae819SStefano Zampini     /* Set initial identity in the matrix */
1706674ae819SStefano Zampini     for (i=0;i<pcis->n_B;i++) {
1707674ae819SStefano Zampini       ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
1708674ae819SStefano Zampini     }
1709984c4197SStefano Zampini 
1710674ae819SStefano Zampini     /* Now we loop on the constraints which need a change of basis */
1711674ae819SStefano Zampini     /* Change of basis matrix is evaluated as the FIRST APPROACH in */
1712984c4197SStefano Zampini     /* Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1) */
1713984c4197SStefano Zampini     /* Change of basis matrix T computed via QR decomposition of constraints */
1714984c4197SStefano Zampini     if (qr_needed) {
1715026de310SStefano Zampini       /* dual and primal dofs on a single cc */
1716984c4197SStefano Zampini       PetscInt     dual_dofs,primal_dofs;
1717026de310SStefano Zampini       /* iterator on aux_primal_minloc (ordered as read from nearnullspace: vertices, edges and then constraints) */
1718026de310SStefano Zampini       PetscInt     primal_counter;
1719984c4197SStefano Zampini       /* working stuff for GEQRF */
1720984c4197SStefano Zampini       PetscScalar  *qr_basis,*qr_tau,*qr_work,lqr_work_t;
1721984c4197SStefano Zampini       PetscBLASInt lqr_work;
1722984c4197SStefano Zampini       /* working stuff for UNGQR */
1723984c4197SStefano Zampini       PetscScalar  *gqr_work,lgqr_work_t;
1724984c4197SStefano Zampini       PetscBLASInt lgqr_work;
1725984c4197SStefano Zampini       /* working stuff for TRTRS */
1726984c4197SStefano Zampini       PetscScalar  *trs_rhs;
17273f08241aSStefano Zampini       PetscBLASInt Blas_NRHS;
1728984c4197SStefano Zampini       /* pointers for values insertion into change of basis matrix */
1729984c4197SStefano Zampini       PetscInt     *start_rows,*start_cols;
1730984c4197SStefano Zampini       PetscScalar  *start_vals;
1731984c4197SStefano Zampini       /* working stuff for values insertion */
17324641a718SStefano Zampini       PetscBT      is_primal;
1733984c4197SStefano Zampini 
1734984c4197SStefano Zampini       /* space to store Q */
1735984c4197SStefano Zampini       ierr = PetscMalloc((max_size_of_constraint)*(max_size_of_constraint)*sizeof(PetscScalar),&qr_basis);CHKERRQ(ierr);
1736984c4197SStefano Zampini       /* first we issue queries for optimal work */
17373f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
17383f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
17393f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1740984c4197SStefano Zampini       lqr_work = -1;
17413f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
1742984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
1743984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
1744984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lqr_work_t)*sizeof(*qr_work),&qr_work);CHKERRQ(ierr);
1745984c4197SStefano Zampini       lgqr_work = -1;
17463f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
17473f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
17483f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
17493f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
17503f08241aSStefano Zampini       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
17513f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
1752984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
1753984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
1754984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lgqr_work_t)*sizeof(*gqr_work),&gqr_work);CHKERRQ(ierr);
1755984c4197SStefano Zampini       /* array to store scaling factors for reflectors */
1756984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*sizeof(*qr_tau),&qr_tau);CHKERRQ(ierr);
1757984c4197SStefano Zampini       /* array to store rhs and solution of triangular solver */
1758984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*max_constraints*sizeof(*trs_rhs),&trs_rhs);CHKERRQ(ierr);
1759984c4197SStefano Zampini       /* array to store whether a node is primal or not */
17604641a718SStefano Zampini       ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
17614641a718SStefano Zampini       for (i=0;i<total_primal_vertices;i++) {
17624641a718SStefano Zampini         ierr = PetscBTSet(is_primal,local_to_B[aux_primal_numbering[i]]);CHKERRQ(ierr);
17634641a718SStefano Zampini       }
1764984c4197SStefano Zampini 
1765984c4197SStefano Zampini       /* allocating workspace for check */
1766984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
1767984c4197SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1768984c4197SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
1769984c4197SStefano Zampini         ierr = PetscMalloc(max_size_of_constraint*(max_constraints+max_size_of_constraint)*sizeof(*work),&work);CHKERRQ(ierr);
1770674ae819SStefano Zampini       }
1771984c4197SStefano Zampini 
1772026de310SStefano Zampini       /* loop on constraints and see whether or not they need a change of basis */
1773026de310SStefano Zampini       /* -> using implicit ordering contained in temp_indices data */
1774026de310SStefano Zampini       total_counts = pcbddc->n_vertices;
1775026de310SStefano Zampini       primal_counter = total_counts;
1776026de310SStefano Zampini       while (total_counts<pcbddc->local_primal_size) {
1777026de310SStefano Zampini         primal_dofs = 1;
17784641a718SStefano Zampini         if (PetscBTLookup(change_basis,total_counts)) {
1779026de310SStefano Zampini           /* get all constraints with same support: if more then one constraint is present on the cc then surely indices are stored contiguosly */
1780026de310SStefano 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]]) {
1781026de310SStefano Zampini             primal_dofs++;
1782674ae819SStefano Zampini           }
1783984c4197SStefano Zampini           /* get constraint info */
1784026de310SStefano Zampini           size_of_constraint = temp_indices[total_counts+1]-temp_indices[total_counts];
1785984c4197SStefano Zampini           dual_dofs = size_of_constraint-primal_dofs;
1786984c4197SStefano Zampini 
1787984c4197SStefano Zampini           /* copy quadrature constraints for change of basis check */
1788984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
1789026de310SStefano 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);
1790026de310SStefano Zampini             ierr = PetscMemcpy(work,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1791674ae819SStefano Zampini           }
1792984c4197SStefano Zampini 
1793984c4197SStefano Zampini           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
1794026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1795984c4197SStefano Zampini 
1796984c4197SStefano Zampini           /* compute QR decomposition of constraints */
17973f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
17983f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
17993f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1800674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
18013f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
1802984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
1803674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1804984c4197SStefano Zampini 
1805984c4197SStefano Zampini           /* explictly compute R^-T */
1806984c4197SStefano Zampini           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
1807984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
18083f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
18093f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
18103f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
18113f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
1812984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
18133f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
1814984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
1815984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1816984c4197SStefano Zampini 
1817984c4197SStefano Zampini           /* explcitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
18183f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
18193f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
18203f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
18213f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1822984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
18233f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
1824984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
1825984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1826984c4197SStefano Zampini 
1827984c4197SStefano Zampini           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
1828984c4197SStefano Zampini              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
1829984c4197SStefano Zampini              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
18303f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
18313f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
18323f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
18333f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
18343f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
18353f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1836984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1837c4303822SStefano 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));
1838984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1839026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1840984c4197SStefano Zampini 
1841984c4197SStefano Zampini           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
1842026de310SStefano Zampini           start_rows = &temp_indices_to_constraint_B[temp_indices[total_counts]];
1843984c4197SStefano Zampini           /* insert cols for primal dofs */
1844984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) {
1845984c4197SStefano Zampini             start_vals = &qr_basis[j*size_of_constraint];
1846026de310SStefano Zampini             start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter+j]];
1847984c4197SStefano Zampini             ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1848984c4197SStefano Zampini           }
1849984c4197SStefano Zampini           /* insert cols for dual dofs */
1850984c4197SStefano Zampini           for (j=0,k=0;j<dual_dofs;k++) {
18514641a718SStefano Zampini             if (!PetscBTLookup(is_primal,temp_indices_to_constraint_B[temp_indices[total_counts]+k])) {
1852984c4197SStefano Zampini               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
1853026de310SStefano Zampini               start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+k];
1854984c4197SStefano Zampini               ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1855984c4197SStefano Zampini               j++;
1856674ae819SStefano Zampini             }
1857674ae819SStefano Zampini           }
1858984c4197SStefano Zampini 
1859984c4197SStefano Zampini           /* check change of basis */
1860984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
1861984c4197SStefano Zampini             PetscInt   ii,jj;
1862984c4197SStefano Zampini             PetscBool valid_qr=PETSC_TRUE;
1863c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
1864c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1865c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
1866c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1867c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
1868c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
1869984c4197SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1870c4303822SStefano 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));
1871984c4197SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
1872984c4197SStefano Zampini             for (jj=0;jj<size_of_constraint;jj++) {
1873984c4197SStefano Zampini               for (ii=0;ii<primal_dofs;ii++) {
1874984c4197SStefano Zampini                 if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
1875984c4197SStefano Zampini                 if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
1876674ae819SStefano Zampini               }
1877674ae819SStefano Zampini             }
1878984c4197SStefano Zampini             if (!valid_qr) {
1879984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
1880984c4197SStefano Zampini               for (jj=0;jj<size_of_constraint;jj++) {
1881984c4197SStefano Zampini                 for (ii=0;ii<primal_dofs;ii++) {
1882984c4197SStefano Zampini                   if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
1883984c4197SStefano 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]));
1884674ae819SStefano Zampini                   }
1885984c4197SStefano Zampini                   if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
1886984c4197SStefano 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]));
1887984c4197SStefano Zampini                   }
1888984c4197SStefano Zampini                 }
1889984c4197SStefano Zampini               }
1890674ae819SStefano Zampini             } else {
1891984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
1892674ae819SStefano Zampini             }
1893674ae819SStefano Zampini           }
1894026de310SStefano Zampini           /* increment primal counter */
1895026de310SStefano Zampini           primal_counter += primal_dofs;
1896984c4197SStefano Zampini         } else {
1897984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
1898026de310SStefano 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);
1899674ae819SStefano Zampini           }
1900674ae819SStefano Zampini         }
1901026de310SStefano Zampini         /* increment constraint counter total_counts */
1902026de310SStefano Zampini         total_counts += primal_dofs;
1903674ae819SStefano Zampini       }
1904984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
1905984c4197SStefano Zampini         ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1906984c4197SStefano Zampini         ierr = PetscFree(work);CHKERRQ(ierr);
1907984c4197SStefano Zampini       }
1908984c4197SStefano Zampini       /* free workspace */
1909984c4197SStefano Zampini       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
1910984c4197SStefano Zampini       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
1911984c4197SStefano Zampini       ierr = PetscFree(qr_work);CHKERRQ(ierr);
1912984c4197SStefano Zampini       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
19134641a718SStefano Zampini       ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
1914984c4197SStefano Zampini       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
1915674ae819SStefano Zampini     }
1916674ae819SStefano Zampini     /* assembling */
1917674ae819SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1918674ae819SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1919984c4197SStefano Zampini     /*
1920984c4197SStefano Zampini     ierr = MatView(pcbddc->ChangeOfBasisMatrix,(PetscViewer)0);CHKERRQ(ierr);
1921984c4197SStefano Zampini     */
1922674ae819SStefano Zampini   }
1923e310c8b4SStefano Zampini   /* free workspace */
1924984c4197SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
1925984c4197SStefano Zampini   ierr = PetscFree(aux_primal_minloc);CHKERRQ(ierr);
1926674ae819SStefano Zampini   ierr = PetscFree(temp_indices);CHKERRQ(ierr);
19274641a718SStefano Zampini   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
1928674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr);
1929674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
1930674ae819SStefano Zampini   ierr = PetscFree(local_to_B);CHKERRQ(ierr);
1931674ae819SStefano Zampini   ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr);
1932674ae819SStefano Zampini   PetscFunctionReturn(0);
1933674ae819SStefano Zampini }
1934674ae819SStefano Zampini 
1935674ae819SStefano Zampini #undef __FUNCT__
1936674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
1937674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
1938674ae819SStefano Zampini {
1939674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
1940674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
1941674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
1942674ae819SStefano Zampini   PetscInt    bs,ierr,i,vertex_size;
1943674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
1944674ae819SStefano Zampini 
1945674ae819SStefano Zampini   PetscFunctionBegin;
1946674ae819SStefano Zampini   /* Init local Graph struct */
1947674ae819SStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr);
1948674ae819SStefano Zampini 
1949575ad6abSStefano Zampini   /* Check validity of the csr graph passed in by the user */
1950575ad6abSStefano Zampini   if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) {
1951575ad6abSStefano Zampini     ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1952575ad6abSStefano Zampini   }
1953674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
1954674ae819SStefano Zampini   if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) {
1955674ae819SStefano Zampini     Mat mat_adj;
1956674ae819SStefano Zampini     const PetscInt *xadj,*adjncy;
1957674ae819SStefano Zampini     PetscBool flg_row=PETSC_TRUE;
1958674ae819SStefano Zampini 
1959674ae819SStefano Zampini     ierr = MatConvert(matis->A,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr);
1960674ae819SStefano Zampini     ierr = MatGetRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
1961674ae819SStefano Zampini     if (!flg_row) {
1962674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ called in %s\n",__FUNCT__);
1963674ae819SStefano Zampini     }
1964674ae819SStefano Zampini     ierr = PCBDDCSetLocalAdjacencyGraph(pc,i,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
1965674ae819SStefano Zampini     ierr = MatRestoreRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
1966674ae819SStefano Zampini     if (!flg_row) {
1967674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__);
1968674ae819SStefano Zampini     }
1969674ae819SStefano Zampini     ierr = MatDestroy(&mat_adj);CHKERRQ(ierr);
1970674ae819SStefano Zampini   }
1971674ae819SStefano Zampini 
1972674ae819SStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting */
1973674ae819SStefano Zampini   vertex_size = 1;
1974674ae819SStefano Zampini   if (!pcbddc->n_ISForDofs) {
1975674ae819SStefano Zampini     IS *custom_ISForDofs;
1976674ae819SStefano Zampini 
1977674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&bs);CHKERRQ(ierr);
1978674ae819SStefano Zampini     ierr = PetscMalloc(bs*sizeof(IS),&custom_ISForDofs);CHKERRQ(ierr);
1979674ae819SStefano Zampini     for (i=0;i<bs;i++) {
1980674ae819SStefano Zampini       ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n/bs,i,bs,&custom_ISForDofs[i]);CHKERRQ(ierr);
1981674ae819SStefano Zampini     }
1982674ae819SStefano Zampini     ierr = PCBDDCSetDofsSplitting(pc,bs,custom_ISForDofs);CHKERRQ(ierr);
1983674ae819SStefano Zampini     /* remove my references to IS objects */
1984674ae819SStefano Zampini     for (i=0;i<bs;i++) {
1985674ae819SStefano Zampini       ierr = ISDestroy(&custom_ISForDofs[i]);CHKERRQ(ierr);
1986674ae819SStefano Zampini     }
1987674ae819SStefano Zampini     ierr = PetscFree(custom_ISForDofs);CHKERRQ(ierr);
1988674ae819SStefano Zampini   } else { /* mat block size as vertex size (used for elasticity) */
1989674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
1990674ae819SStefano Zampini   }
1991674ae819SStefano Zampini 
1992674ae819SStefano Zampini   /* Setup of Graph */
1993674ae819SStefano Zampini   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundaries,pcbddc->DirichletBoundaries,pcbddc->n_ISForDofs,pcbddc->ISForDofs,pcbddc->user_primal_vertices);
1994674ae819SStefano Zampini 
1995674ae819SStefano Zampini   /* Graph's connected components analysis */
1996674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
1997674ae819SStefano Zampini 
1998674ae819SStefano Zampini   /* print some info to stdout */
1999674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
2000e49050b4SStefano Zampini     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer);
2001674ae819SStefano Zampini   }
2002674ae819SStefano Zampini   PetscFunctionReturn(0);
2003674ae819SStefano Zampini }
2004674ae819SStefano Zampini 
2005674ae819SStefano Zampini #undef __FUNCT__
2006674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx"
2007674ae819SStefano Zampini PetscErrorCode  PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt *vertices_idx[])
2008674ae819SStefano Zampini {
2009674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2010674ae819SStefano Zampini   PetscInt       *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size;
2011674ae819SStefano Zampini   PetscErrorCode ierr;
2012674ae819SStefano Zampini 
2013674ae819SStefano Zampini   PetscFunctionBegin;
2014674ae819SStefano Zampini   n = 0;
2015674ae819SStefano Zampini   vertices = 0;
2016674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2017674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr);
2018b120a5c6SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2019b120a5c6SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2020b120a5c6SStefano Zampini       if (size_of_constraint == 1) n++;
2021b120a5c6SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2022b120a5c6SStefano Zampini     }
2023811e8ca2SStefano Zampini     if (vertices_idx) {
2024b120a5c6SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&vertices);CHKERRQ(ierr);
2025b120a5c6SStefano Zampini       n = 0;
2026674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2027674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2028674ae819SStefano Zampini         if (size_of_constraint == 1) {
2029674ae819SStefano Zampini           vertices[n++]=row_cmat_indices[0];
2030674ae819SStefano Zampini         }
2031674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2032674ae819SStefano Zampini       }
2033674ae819SStefano Zampini     }
2034811e8ca2SStefano Zampini   }
2035674ae819SStefano Zampini   *n_vertices = n;
2036811e8ca2SStefano Zampini   if (vertices_idx) *vertices_idx = vertices;
2037674ae819SStefano Zampini   PetscFunctionReturn(0);
2038674ae819SStefano Zampini }
2039674ae819SStefano Zampini 
2040674ae819SStefano Zampini #undef __FUNCT__
2041674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx"
2042674ae819SStefano Zampini PetscErrorCode  PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt *constraints_idx[])
2043674ae819SStefano Zampini {
2044674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2045674ae819SStefano Zampini   PetscInt       *constraints_index,*row_cmat_indices,*row_cmat_global_indices;
2046674ae819SStefano Zampini   PetscInt       n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc;
20474641a718SStefano Zampini   PetscBT        touched;
2048674ae819SStefano Zampini   PetscErrorCode ierr;
2049674ae819SStefano Zampini 
2050674ae819SStefano Zampini   PetscFunctionBegin;
2051674ae819SStefano Zampini   n = 0;
2052674ae819SStefano Zampini   constraints_index = 0;
2053674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2054674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr);
2055674ae819SStefano Zampini     max_size_of_constraint = 0;
2056674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2057674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2058674ae819SStefano Zampini       if (size_of_constraint > 1) {
2059674ae819SStefano Zampini         n++;
2060674ae819SStefano Zampini       }
2061674ae819SStefano Zampini       max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint);
2062674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2063674ae819SStefano Zampini     }
2064811e8ca2SStefano Zampini     if (constraints_idx) {
2065674ae819SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&constraints_index);CHKERRQ(ierr);
2066674ae819SStefano Zampini       ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&row_cmat_global_indices);CHKERRQ(ierr);
20674641a718SStefano Zampini       ierr = PetscBTCreate(local_size,&touched);CHKERRQ(ierr);
2068674ae819SStefano Zampini       n = 0;
2069674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2070674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2071674ae819SStefano Zampini         if (size_of_constraint > 1) {
2072674ae819SStefano Zampini           ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr);
207382d3d8afSStefano Zampini           /* find first untouched local node */
207482d3d8afSStefano Zampini           j = 0;
20754641a718SStefano Zampini           while (PetscBTLookup(touched,row_cmat_indices[j])) j++;
207682d3d8afSStefano Zampini           min_index = row_cmat_global_indices[j];
207782d3d8afSStefano Zampini           min_loc = j;
207882d3d8afSStefano Zampini           /* search the minimum among nodes not yet touched on the connected component
207982d3d8afSStefano Zampini              since there can be more than one constraint on a single cc */
2080674ae819SStefano Zampini           for (j=1;j<size_of_constraint;j++) {
20814641a718SStefano Zampini             if (!PetscBTLookup(touched,row_cmat_indices[j]) && min_index > row_cmat_global_indices[j]) {
2082674ae819SStefano Zampini               min_index = row_cmat_global_indices[j];
2083674ae819SStefano Zampini               min_loc = j;
2084674ae819SStefano Zampini             }
2085674ae819SStefano Zampini           }
20864641a718SStefano Zampini           ierr = PetscBTSet(touched,row_cmat_indices[min_loc]);CHKERRQ(ierr);
2087674ae819SStefano Zampini           constraints_index[n++] = row_cmat_indices[min_loc];
2088674ae819SStefano Zampini         }
2089674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2090674ae819SStefano Zampini       }
20914641a718SStefano Zampini       ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2092674ae819SStefano Zampini       ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr);
2093811e8ca2SStefano Zampini     }
2094811e8ca2SStefano Zampini   }
2095674ae819SStefano Zampini   *n_constraints = n;
2096811e8ca2SStefano Zampini   if (constraints_idx) *constraints_idx = constraints_index;
2097674ae819SStefano Zampini   PetscFunctionReturn(0);
2098674ae819SStefano Zampini }
2099674ae819SStefano Zampini 
2100674ae819SStefano Zampini /* the next two functions has been adapted from pcis.c */
2101674ae819SStefano Zampini #undef __FUNCT__
2102674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchur"
2103674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchur(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2104674ae819SStefano Zampini {
2105674ae819SStefano Zampini   PetscErrorCode ierr;
2106674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2107674ae819SStefano Zampini 
2108674ae819SStefano Zampini   PetscFunctionBegin;
2109674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2110674ae819SStefano Zampini   ierr = MatMult(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2111674ae819SStefano Zampini   ierr = MatMult(pcis->A_IB,v,vec1_D);CHKERRQ(ierr);
2112674ae819SStefano Zampini   ierr = KSPSolve(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2113674ae819SStefano Zampini   ierr = MatMult(pcis->A_BI,vec2_D,vec2_B);CHKERRQ(ierr);
2114674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2115674ae819SStefano Zampini   PetscFunctionReturn(0);
2116674ae819SStefano Zampini }
2117674ae819SStefano Zampini 
2118674ae819SStefano Zampini #undef __FUNCT__
2119674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchurTranspose"
2120674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchurTranspose(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2121674ae819SStefano Zampini {
2122674ae819SStefano Zampini   PetscErrorCode ierr;
2123674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2124674ae819SStefano Zampini 
2125674ae819SStefano Zampini   PetscFunctionBegin;
2126674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2127674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2128674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BI,v,vec1_D);CHKERRQ(ierr);
2129674ae819SStefano Zampini   ierr = KSPSolveTranspose(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2130674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_IB,vec2_D,vec2_B);CHKERRQ(ierr);
2131674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2132674ae819SStefano Zampini   PetscFunctionReturn(0);
2133674ae819SStefano Zampini }
2134674ae819SStefano Zampini 
2135674ae819SStefano Zampini #undef __FUNCT__
2136674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
2137674ae819SStefano 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[])
2138674ae819SStefano Zampini {
2139674ae819SStefano Zampini   Vec            local_vec,global_vec;
2140674ae819SStefano Zampini   IS             seqis,paris;
2141674ae819SStefano Zampini   VecScatter     scatter_ctx;
2142674ae819SStefano Zampini   PetscScalar    *array;
2143674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
2144674ae819SStefano Zampini   PetscScalar    globalsum;
2145674ae819SStefano Zampini   PetscInt       i,j,s;
2146674ae819SStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local;
2147674ae819SStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm,max_global;
2148674ae819SStefano Zampini   PetscMPIInt    *dof_sizes,*dof_displs;
2149674ae819SStefano Zampini   PetscBool      first_found;
2150674ae819SStefano Zampini   PetscErrorCode ierr;
2151674ae819SStefano Zampini 
2152674ae819SStefano Zampini   PetscFunctionBegin;
2153674ae819SStefano Zampini   /* mpi buffers */
2154674ae819SStefano Zampini   MPI_Comm_size(comm,&size_prec_comm);
2155674ae819SStefano Zampini   MPI_Comm_rank(comm,&rank_prec_comm);
2156674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
2157674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_sizes),&dof_sizes);CHKERRQ(ierr);
2158674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_displs),&dof_displs);CHKERRQ(ierr);
2159674ae819SStefano Zampini   /* get maximum size of subset */
2160674ae819SStefano Zampini   ierr = PetscMalloc(n_local_dofs*sizeof(PetscInt),&temp_global_dofs);CHKERRQ(ierr);
2161674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
2162674ae819SStefano Zampini   max_local = 0;
2163674ae819SStefano Zampini   if (n_local_dofs) {
2164674ae819SStefano Zampini     max_local = temp_global_dofs[0];
2165674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2166674ae819SStefano Zampini       if (max_local < temp_global_dofs[i] ) {
2167674ae819SStefano Zampini         max_local = temp_global_dofs[i];
2168674ae819SStefano Zampini       }
2169674ae819SStefano Zampini     }
2170674ae819SStefano Zampini   }
2171674ae819SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);
2172674ae819SStefano Zampini   max_global++;
2173674ae819SStefano Zampini   max_local = 0;
2174674ae819SStefano Zampini   if (n_local_dofs) {
2175674ae819SStefano Zampini     max_local = local_dofs[0];
2176674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2177674ae819SStefano Zampini       if (max_local < local_dofs[i] ) {
2178674ae819SStefano Zampini         max_local = local_dofs[i];
2179674ae819SStefano Zampini       }
2180674ae819SStefano Zampini     }
2181674ae819SStefano Zampini   }
2182674ae819SStefano Zampini   max_local++;
2183674ae819SStefano Zampini   /* allocate workspace */
2184674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
2185674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
2186674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
2187674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
2188674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
2189674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
2190674ae819SStefano Zampini   /* create scatter */
2191674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
2192674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
2193674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
2194674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
2195674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
2196674ae819SStefano Zampini   /* init array */
2197674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
2198674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2199674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2200674ae819SStefano Zampini   if (local_dofs_mult) {
2201674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2202674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
2203674ae819SStefano Zampini     }
2204674ae819SStefano Zampini   } else {
2205674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2206674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
2207674ae819SStefano Zampini     }
2208674ae819SStefano Zampini   }
2209674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2210674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
2211674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2212674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2213674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
22145b08dc53SStefano Zampini   *n_global_subset = (PetscInt)PetscRealPart(globalsum);
2215674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
2216674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
2217674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
2218674ae819SStefano Zampini   nlocals = 0;
2219674ae819SStefano Zampini   first_index = -1;
2220674ae819SStefano Zampini   first_found = PETSC_FALSE;
2221674ae819SStefano Zampini   for (i=0;i<s;i++) {
22225b08dc53SStefano Zampini     if (!first_found && PetscRealPart(array[i]) > 0.0) {
2223674ae819SStefano Zampini       first_found = PETSC_TRUE;
2224674ae819SStefano Zampini       first_index = i;
2225674ae819SStefano Zampini     }
22265b08dc53SStefano Zampini     nlocals += (PetscInt)PetscRealPart(array[i]);
2227674ae819SStefano Zampini   }
2228674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2229674ae819SStefano Zampini   if (!rank_prec_comm) {
2230674ae819SStefano Zampini     dof_displs[0]=0;
2231674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
2232674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
2233674ae819SStefano Zampini     }
2234674ae819SStefano Zampini   }
2235674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2236674ae819SStefano Zampini   if (first_found) {
2237674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
2238674ae819SStefano Zampini     old_index = first_index;
2239674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
22405b08dc53SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) {
2241674ae819SStefano Zampini         array[i] += array[old_index];
2242674ae819SStefano Zampini         old_index = i;
2243674ae819SStefano Zampini       }
2244674ae819SStefano Zampini     }
2245674ae819SStefano Zampini   }
2246674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
2247674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2248674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2249674ae819SStefano Zampini   ierr = VecScatterEnd  (scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2250674ae819SStefano Zampini   /* get global ordering of local dofs */
2251674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2252674ae819SStefano Zampini   if (local_dofs_mult) {
2253674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
22545b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i];
2255674ae819SStefano Zampini     }
2256674ae819SStefano Zampini   } else {
2257674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
22585b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1;
2259674ae819SStefano Zampini     }
2260674ae819SStefano Zampini   }
2261674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2262674ae819SStefano Zampini   /* free workspace */
2263674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
2264674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
2265674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
2266674ae819SStefano Zampini   ierr = PetscFree(dof_sizes);CHKERRQ(ierr);
2267674ae819SStefano Zampini   ierr = PetscFree(dof_displs);CHKERRQ(ierr);
2268674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
2269674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
2270674ae819SStefano Zampini   PetscFunctionReturn(0);
2271674ae819SStefano Zampini }
22729a7d3425SStefano Zampini 
22739a7d3425SStefano Zampini #undef __FUNCT__
22749a7d3425SStefano Zampini #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
22759a7d3425SStefano Zampini PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
22769a7d3425SStefano Zampini {
22779a7d3425SStefano Zampini   PetscInt       i,j;
22789a7d3425SStefano Zampini   PetscScalar    *alphas;
22799a7d3425SStefano Zampini   PetscErrorCode ierr;
22809a7d3425SStefano Zampini 
22819a7d3425SStefano Zampini   PetscFunctionBegin;
22829a7d3425SStefano Zampini   /* this implements stabilized Gram-Schmidt */
22839a7d3425SStefano Zampini   ierr = PetscMalloc(n*sizeof(PetscScalar),&alphas);CHKERRQ(ierr);
22849a7d3425SStefano Zampini   for (i=0;i<n;i++) {
22859a7d3425SStefano Zampini     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
22869a7d3425SStefano Zampini     if (i<n) { ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],&alphas[i+1]);CHKERRQ(ierr); }
22879a7d3425SStefano Zampini     for (j=i+1;j<n;j++) { ierr = VecAXPY(vecs[j],PetscConj(-alphas[j]),vecs[i]);CHKERRQ(ierr); }
22889a7d3425SStefano Zampini   }
22899a7d3425SStefano Zampini   ierr = PetscFree(alphas);CHKERRQ(ierr);
22909a7d3425SStefano Zampini   PetscFunctionReturn(0);
22919a7d3425SStefano Zampini }
22929a7d3425SStefano Zampini 
2293c8587f34SStefano Zampini /* BDDC requires metis 5.0.1 for multilevel */
2294c8587f34SStefano Zampini #if defined(PETSC_HAVE_METIS)
2295c8587f34SStefano Zampini #include "metis.h"
2296c8587f34SStefano Zampini #define MetisInt    idx_t
2297c8587f34SStefano Zampini #define MetisScalar real_t
2298c8587f34SStefano Zampini #endif
2299c8587f34SStefano Zampini 
2300c8587f34SStefano Zampini #undef __FUNCT__
2301*8629588bSStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
2302*8629588bSStefano Zampini PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
2303c8587f34SStefano Zampini {
2304c8587f34SStefano Zampini   Mat_IS    *matis    = (Mat_IS*)pc->pmat->data;
2305c8587f34SStefano Zampini   PC_BDDC   *pcbddc   = (PC_BDDC*)pc->data;
2306c8587f34SStefano Zampini   PC_IS     *pcis     = (PC_IS*)pc->data;
2307c8587f34SStefano Zampini   MPI_Comm  prec_comm;
2308c8587f34SStefano Zampini   MPI_Comm  coarse_comm;
2309c8587f34SStefano Zampini 
2310983f5fd7SStefano Zampini   PetscInt  coarse_size;
2311983f5fd7SStefano Zampini 
2312c8587f34SStefano Zampini   MatNullSpace CoarseNullSpace;
2313c8587f34SStefano Zampini 
2314c8587f34SStefano Zampini   /* common to all choiches */
2315c8587f34SStefano Zampini   PetscScalar *temp_coarse_mat_vals;
2316c8587f34SStefano Zampini   PetscScalar *ins_coarse_mat_vals;
2317c8587f34SStefano Zampini   PetscInt    *ins_local_primal_indices;
2318c8587f34SStefano Zampini   PetscMPIInt *localsizes2,*localdispl2;
2319c8587f34SStefano Zampini   PetscMPIInt size_prec_comm;
2320c8587f34SStefano Zampini   PetscMPIInt rank_prec_comm;
2321c8587f34SStefano Zampini   PetscMPIInt active_rank=MPI_PROC_NULL;
2322c8587f34SStefano Zampini   PetscMPIInt master_proc=0;
2323c8587f34SStefano Zampini   PetscInt    ins_local_primal_size;
2324c8587f34SStefano Zampini   /* specific to MULTILEVEL_BDDC */
2325c8587f34SStefano Zampini   PetscMPIInt *ranks_recv=0;
2326c8587f34SStefano Zampini   PetscMPIInt count_recv=0;
2327c8587f34SStefano Zampini   PetscMPIInt rank_coarse_proc_send_to=-1;
2328c8587f34SStefano Zampini   PetscMPIInt coarse_color = MPI_UNDEFINED;
2329c8587f34SStefano Zampini   ISLocalToGlobalMapping coarse_ISLG;
2330c8587f34SStefano Zampini   /* some other variables */
2331c8587f34SStefano Zampini   PetscErrorCode ierr;
2332c8587f34SStefano Zampini   MatType coarse_mat_type;
2333c8587f34SStefano Zampini   PCType  coarse_pc_type;
2334c8587f34SStefano Zampini   KSPType coarse_ksp_type;
2335c8587f34SStefano Zampini   PC pc_temp;
2336c8587f34SStefano Zampini   PetscInt i,j,k;
2337c8587f34SStefano Zampini   PetscInt max_it_coarse_ksp=1;  /* don't increase this value */
2338c8587f34SStefano Zampini   /* verbose output viewer */
2339c8587f34SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
2340c8587f34SStefano Zampini   PetscInt    dbg_flag=pcbddc->dbg_flag;
2341c8587f34SStefano Zampini 
2342c8587f34SStefano Zampini   PetscInt      offset,offset2;
2343c8587f34SStefano Zampini   PetscMPIInt   im_active,active_procs;
2344c8587f34SStefano Zampini   PetscInt      *dnz,*onz;
2345c8587f34SStefano Zampini 
2346c8587f34SStefano Zampini   PetscBool     setsym,issym=PETSC_FALSE;
2347c8587f34SStefano Zampini 
2348c8587f34SStefano Zampini   PetscFunctionBegin;
2349c8587f34SStefano Zampini   ierr = PetscObjectGetComm((PetscObject)pc,&prec_comm);CHKERRQ(ierr);
2350c8587f34SStefano Zampini   ins_local_primal_indices = 0;
2351c8587f34SStefano Zampini   ins_coarse_mat_vals      = 0;
2352c8587f34SStefano Zampini   localsizes2              = 0;
2353c8587f34SStefano Zampini   localdispl2              = 0;
2354c8587f34SStefano Zampini   temp_coarse_mat_vals     = 0;
2355c8587f34SStefano Zampini   coarse_ISLG              = 0;
2356c8587f34SStefano Zampini 
2357c8587f34SStefano Zampini   ierr = MPI_Comm_size(prec_comm,&size_prec_comm);CHKERRQ(ierr);
2358c8587f34SStefano Zampini   ierr = MPI_Comm_rank(prec_comm,&rank_prec_comm);CHKERRQ(ierr);
2359c8587f34SStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
2360c8587f34SStefano Zampini 
2361c8587f34SStefano Zampini   /* Assign global numbering to coarse dofs */
2362c8587f34SStefano Zampini   {
2363c8587f34SStefano Zampini     PetscInt     *auxlocal_primal,*aux_idx;
2364c8587f34SStefano Zampini     PetscMPIInt  mpi_local_primal_size;
2365c8587f34SStefano Zampini     PetscScalar  coarsesum,*array;
2366c8587f34SStefano Zampini 
2367c8587f34SStefano Zampini     mpi_local_primal_size = (PetscMPIInt)pcbddc->local_primal_size;
2368c8587f34SStefano Zampini 
2369c8587f34SStefano Zampini     /* Construct needed data structures for message passing */
2370c8587f34SStefano Zampini     j = 0;
2371c8587f34SStefano Zampini     if (rank_prec_comm == 0 || pcbddc->coarse_problem_type == REPLICATED_BDDC || pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
2372c8587f34SStefano Zampini       j = size_prec_comm;
2373c8587f34SStefano Zampini     }
2374c8587f34SStefano Zampini     ierr = PetscMalloc(j*sizeof(PetscMPIInt),&pcbddc->local_primal_sizes);CHKERRQ(ierr);
2375c8587f34SStefano Zampini     ierr = PetscMalloc(j*sizeof(PetscMPIInt),&pcbddc->local_primal_displacements);CHKERRQ(ierr);
2376c8587f34SStefano Zampini     /* Gather local_primal_size information for all processes  */
2377c8587f34SStefano Zampini     if (pcbddc->coarse_problem_type == REPLICATED_BDDC || pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
2378c8587f34SStefano Zampini       ierr = MPI_Allgather(&mpi_local_primal_size,1,MPIU_INT,&pcbddc->local_primal_sizes[0],1,MPIU_INT,prec_comm);CHKERRQ(ierr);
2379c8587f34SStefano Zampini     } else {
2380c8587f34SStefano Zampini       ierr = MPI_Gather(&mpi_local_primal_size,1,MPIU_INT,&pcbddc->local_primal_sizes[0],1,MPIU_INT,0,prec_comm);CHKERRQ(ierr);
2381c8587f34SStefano Zampini     }
2382c8587f34SStefano Zampini     pcbddc->replicated_primal_size = 0;
2383c8587f34SStefano Zampini     for (i=0; i<j; i++) {
2384c8587f34SStefano Zampini       pcbddc->local_primal_displacements[i] = pcbddc->replicated_primal_size ;
2385c8587f34SStefano Zampini       pcbddc->replicated_primal_size += pcbddc->local_primal_sizes[i];
2386c8587f34SStefano Zampini     }
2387c8587f34SStefano Zampini 
2388983f5fd7SStefano Zampini     /* This code fragment assumes that the number of local constraints per connected component
2389c8587f34SStefano Zampini        is not greater than the number of nodes defined for the connected component
2390c8587f34SStefano Zampini        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
2391c8587f34SStefano Zampini     ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&auxlocal_primal);CHKERRQ(ierr);
2392c8587f34SStefano Zampini     ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&i,&aux_idx);CHKERRQ(ierr);
2393c8587f34SStefano Zampini     ierr = PetscMemcpy(auxlocal_primal,aux_idx,i*sizeof(PetscInt));CHKERRQ(ierr);
2394c8587f34SStefano Zampini     ierr = PetscFree(aux_idx);CHKERRQ(ierr);
2395c8587f34SStefano Zampini     ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&j,&aux_idx);CHKERRQ(ierr);
2396c8587f34SStefano Zampini     ierr = PetscMemcpy(&auxlocal_primal[i],aux_idx,j*sizeof(PetscInt));CHKERRQ(ierr);
2397c8587f34SStefano Zampini     ierr = PetscFree(aux_idx);CHKERRQ(ierr);
2398c8587f34SStefano Zampini     /* Compute number of coarse dofs */
2399983f5fd7SStefano Zampini     ierr = PCBDDCSubsetNumbering(prec_comm,matis->mapping,pcbddc->local_primal_size,auxlocal_primal,NULL,&coarse_size,&pcbddc->local_primal_indices);CHKERRQ(ierr);
2400c8587f34SStefano Zampini 
2401c8587f34SStefano Zampini     if (dbg_flag) {
2402c8587f34SStefano Zampini       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2403c8587f34SStefano Zampini       ierr = PetscViewerASCIIPrintf(viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
2404c8587f34SStefano Zampini       ierr = PetscViewerASCIIPrintf(viewer,"Check coarse indices\n");CHKERRQ(ierr);
2405c8587f34SStefano Zampini       ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
2406c8587f34SStefano Zampini       ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
2407c8587f34SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) array[auxlocal_primal[i]]=1.0;
2408c8587f34SStefano Zampini       ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
2409c8587f34SStefano Zampini       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
2410c8587f34SStefano Zampini       ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2411c8587f34SStefano Zampini       ierr = VecScatterEnd  (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2412c8587f34SStefano Zampini       ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2413c8587f34SStefano Zampini       ierr = VecScatterEnd  (matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2414c8587f34SStefano Zampini       ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
2415c8587f34SStefano Zampini       for (i=0;i<pcis->n;i++) {
2416c8587f34SStefano Zampini         if (array[i] == 1.0) {
2417c8587f34SStefano Zampini           ierr = ISLocalToGlobalMappingApply(matis->mapping,1,&i,&j);CHKERRQ(ierr);
2418c8587f34SStefano Zampini           ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d: WRONG COARSE INDEX %d (local %d)\n",PetscGlobalRank,j,i);CHKERRQ(ierr);
2419c8587f34SStefano Zampini         }
2420c8587f34SStefano Zampini       }
2421c8587f34SStefano Zampini       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2422c8587f34SStefano Zampini       for (i=0;i<pcis->n;i++) {
2423c8587f34SStefano Zampini         if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
2424c8587f34SStefano Zampini       }
2425c8587f34SStefano Zampini       ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
2426c8587f34SStefano Zampini       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
2427c8587f34SStefano Zampini       ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2428c8587f34SStefano Zampini       ierr = VecScatterEnd  (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2429c8587f34SStefano Zampini       ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
2430c8587f34SStefano Zampini       ierr = PetscViewerASCIIPrintf(viewer,"Size of coarse problem SHOULD be %lf\n",coarsesum);CHKERRQ(ierr);
2431c8587f34SStefano Zampini       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2432c8587f34SStefano Zampini     }
2433c8587f34SStefano Zampini     ierr = PetscFree(auxlocal_primal);CHKERRQ(ierr);
2434c8587f34SStefano Zampini   }
2435c8587f34SStefano Zampini 
2436c8587f34SStefano Zampini   if (dbg_flag) {
2437983f5fd7SStefano Zampini     ierr = PetscViewerASCIIPrintf(viewer,"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr);
2438c8587f34SStefano Zampini     if (dbg_flag > 1) {
2439c8587f34SStefano Zampini       ierr = PetscViewerASCIIPrintf(viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
2440c8587f34SStefano Zampini       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2441c8587f34SStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
2442c8587f34SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
2443c8587f34SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(viewer,"local_primal_indices[%d]=%d \n",i,pcbddc->local_primal_indices[i]);
2444c8587f34SStefano Zampini       }
2445c8587f34SStefano Zampini       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2446c8587f34SStefano Zampini     }
2447c8587f34SStefano Zampini   }
2448c8587f34SStefano Zampini 
2449c8587f34SStefano Zampini   im_active = 0;
2450c8587f34SStefano Zampini   if (pcis->n) im_active = 1;
2451c8587f34SStefano Zampini   ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,prec_comm);CHKERRQ(ierr);
2452c8587f34SStefano Zampini 
2453c8587f34SStefano Zampini   /* adapt coarse problem type */
2454c8587f34SStefano Zampini #if defined(PETSC_HAVE_METIS)
2455c8587f34SStefano Zampini   if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
2456c8587f34SStefano Zampini     if (pcbddc->current_level < pcbddc->max_levels) {
2457c8587f34SStefano Zampini       if ( (active_procs/pcbddc->coarsening_ratio) < 2 ) {
2458c8587f34SStefano Zampini         if (dbg_flag) {
2459c8587f34SStefano Zampini           ierr = PetscViewerASCIIPrintf(viewer,"Not enough active processes on level %d (active %d,ratio %d). Parallel direct solve for coarse problem\n",pcbddc->current_level,active_procs,pcbddc->coarsening_ratio);CHKERRQ(ierr);
2460c8587f34SStefano Zampini          ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2461c8587f34SStefano Zampini         }
2462c8587f34SStefano Zampini         pcbddc->coarse_problem_type = PARALLEL_BDDC;
2463c8587f34SStefano Zampini       }
2464c8587f34SStefano Zampini     } else {
2465c8587f34SStefano Zampini       if (dbg_flag) {
2466c8587f34SStefano Zampini         ierr = PetscViewerASCIIPrintf(viewer,"Max number of levels reached. Using parallel direct solve for coarse problem\n",pcbddc->max_levels,active_procs,pcbddc->coarsening_ratio);CHKERRQ(ierr);
2467c8587f34SStefano Zampini         ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2468c8587f34SStefano Zampini       }
2469c8587f34SStefano Zampini       pcbddc->coarse_problem_type = PARALLEL_BDDC;
2470c8587f34SStefano Zampini     }
2471c8587f34SStefano Zampini   }
2472c8587f34SStefano Zampini #else
2473c8587f34SStefano Zampini   pcbddc->coarse_problem_type = PARALLEL_BDDC;
2474c8587f34SStefano Zampini #endif
2475c8587f34SStefano Zampini 
2476c8587f34SStefano Zampini   switch(pcbddc->coarse_problem_type){
2477c8587f34SStefano Zampini 
2478c8587f34SStefano Zampini     case(MULTILEVEL_BDDC):   /* we define a coarse mesh where subdomains are elements */
2479c8587f34SStefano Zampini     {
2480c8587f34SStefano Zampini #if defined(PETSC_HAVE_METIS)
2481c8587f34SStefano Zampini       /* we need additional variables */
2482c8587f34SStefano Zampini       MetisInt    n_subdomains,n_parts,objval,ncon,faces_nvtxs;
2483c8587f34SStefano Zampini       MetisInt    *metis_coarse_subdivision;
2484c8587f34SStefano Zampini       MetisInt    options[METIS_NOPTIONS];
2485c8587f34SStefano Zampini       PetscMPIInt size_coarse_comm,rank_coarse_comm;
2486c8587f34SStefano Zampini       PetscMPIInt procs_jumps_coarse_comm;
2487c8587f34SStefano Zampini       PetscMPIInt *coarse_subdivision;
2488c8587f34SStefano Zampini       PetscMPIInt *total_count_recv;
2489c8587f34SStefano Zampini       PetscMPIInt *total_ranks_recv;
2490c8587f34SStefano Zampini       PetscMPIInt *displacements_recv;
2491c8587f34SStefano Zampini       PetscMPIInt *my_faces_connectivity;
2492c8587f34SStefano Zampini       PetscMPIInt *petsc_faces_adjncy;
2493c8587f34SStefano Zampini       MetisInt    *faces_adjncy;
2494c8587f34SStefano Zampini       MetisInt    *faces_xadj;
2495c8587f34SStefano Zampini       PetscMPIInt *number_of_faces;
2496c8587f34SStefano Zampini       PetscMPIInt *faces_displacements;
2497c8587f34SStefano Zampini       PetscInt    *array_int;
2498c8587f34SStefano Zampini       PetscMPIInt my_faces=0;
2499c8587f34SStefano Zampini       PetscMPIInt total_faces=0;
2500c8587f34SStefano Zampini       PetscInt    ranks_stretching_ratio;
2501c8587f34SStefano Zampini 
2502c8587f34SStefano Zampini       /* define some quantities */
2503c8587f34SStefano Zampini       pcbddc->coarse_communications_type = SCATTERS_BDDC;
2504c8587f34SStefano Zampini       coarse_mat_type = MATIS;
2505c8587f34SStefano Zampini       coarse_pc_type  = PCBDDC;
2506c8587f34SStefano Zampini       coarse_ksp_type = KSPRICHARDSON;
2507c8587f34SStefano Zampini 
2508c8587f34SStefano Zampini       /* details of coarse decomposition */
2509c8587f34SStefano Zampini       n_subdomains = active_procs;
2510c8587f34SStefano Zampini       n_parts      = n_subdomains/pcbddc->coarsening_ratio;
2511c8587f34SStefano Zampini       ranks_stretching_ratio = size_prec_comm/active_procs;
2512c8587f34SStefano Zampini       procs_jumps_coarse_comm = pcbddc->coarsening_ratio*ranks_stretching_ratio;
2513c8587f34SStefano Zampini 
2514c8587f34SStefano Zampini #if 0
2515c8587f34SStefano Zampini       PetscMPIInt *old_ranks;
2516c8587f34SStefano Zampini       PetscInt    *new_ranks,*jj,*ii;
2517c8587f34SStefano Zampini       MatPartitioning mat_part;
2518c8587f34SStefano Zampini       IS coarse_new_decomposition,is_numbering;
2519c8587f34SStefano Zampini       PetscViewer viewer_test;
2520c8587f34SStefano Zampini       MPI_Comm    test_coarse_comm;
2521c8587f34SStefano Zampini       PetscMPIInt test_coarse_color;
2522c8587f34SStefano Zampini       Mat         mat_adj;
2523c8587f34SStefano Zampini       /* Create new communicator for coarse problem splitting the old one */
2524c8587f34SStefano Zampini       /* procs with coarse_color = MPI_UNDEFINED will have coarse_comm = MPI_COMM_NULL (from mpi standards)
2525c8587f34SStefano Zampini          key = rank_prec_comm -> keep same ordering of ranks from the old to the new communicator */
2526c8587f34SStefano Zampini       test_coarse_color = ( im_active ? 0 : MPI_UNDEFINED );
2527c8587f34SStefano Zampini       test_coarse_comm = MPI_COMM_NULL;
2528c8587f34SStefano Zampini       ierr = MPI_Comm_split(prec_comm,test_coarse_color,rank_prec_comm,&test_coarse_comm);CHKERRQ(ierr);
2529c8587f34SStefano Zampini       if (im_active) {
2530c8587f34SStefano Zampini         ierr = PetscMalloc(n_subdomains*sizeof(PetscMPIInt),&old_ranks);
2531c8587f34SStefano Zampini         ierr = PetscMalloc(size_prec_comm*sizeof(PetscInt),&new_ranks);
2532c8587f34SStefano Zampini         ierr = MPI_Comm_rank(test_coarse_comm,&rank_coarse_comm);CHKERRQ(ierr);
2533c8587f34SStefano Zampini         ierr = MPI_Comm_size(test_coarse_comm,&j);CHKERRQ(ierr);
2534c8587f34SStefano Zampini         ierr = MPI_Allgather(&rank_prec_comm,1,MPIU_INT,old_ranks,1,MPIU_INT,test_coarse_comm);CHKERRQ(ierr);
2535c8587f34SStefano Zampini         for (i=0; i<size_prec_comm; i++) new_ranks[i] = -1;
2536c8587f34SStefano Zampini         for (i=0; i<n_subdomains; i++) new_ranks[old_ranks[i]] = i;
2537c8587f34SStefano Zampini         ierr = PetscViewerASCIIOpen(test_coarse_comm,"test_mat_part.out",&viewer_test);CHKERRQ(ierr);
2538c8587f34SStefano Zampini         k = pcis->n_neigh-1;
2539c8587f34SStefano Zampini         ierr = PetscMalloc(2*sizeof(PetscInt),&ii);
2540c8587f34SStefano Zampini         ii[0]=0;
2541c8587f34SStefano Zampini         ii[1]=k;
2542c8587f34SStefano Zampini         ierr = PetscMalloc(k*sizeof(PetscInt),&jj);
2543c8587f34SStefano Zampini         for (i=0; i<k; i++) jj[i]=new_ranks[pcis->neigh[i+1]];
2544c8587f34SStefano Zampini         ierr = PetscSortInt(k,jj);CHKERRQ(ierr);
2545c8587f34SStefano Zampini         ierr = MatCreateMPIAdj(test_coarse_comm,1,n_subdomains,ii,jj,NULL,&mat_adj);CHKERRQ(ierr);
2546c8587f34SStefano Zampini         ierr = MatView(mat_adj,viewer_test);CHKERRQ(ierr);
2547c8587f34SStefano Zampini         ierr = MatPartitioningCreate(test_coarse_comm,&mat_part);CHKERRQ(ierr);
2548c8587f34SStefano Zampini         ierr = MatPartitioningSetAdjacency(mat_part,mat_adj);CHKERRQ(ierr);
2549c8587f34SStefano Zampini         ierr = MatPartitioningSetFromOptions(mat_part);CHKERRQ(ierr);
2550c8587f34SStefano Zampini         printf("Setting Nparts %d\n",n_parts);
2551c8587f34SStefano Zampini         ierr = MatPartitioningSetNParts(mat_part,n_parts);CHKERRQ(ierr);
2552c8587f34SStefano Zampini         ierr = MatPartitioningView(mat_part,viewer_test);CHKERRQ(ierr);
2553c8587f34SStefano Zampini         ierr = MatPartitioningApply(mat_part,&coarse_new_decomposition);CHKERRQ(ierr);
2554c8587f34SStefano Zampini         ierr = ISView(coarse_new_decomposition,viewer_test);CHKERRQ(ierr);
2555c8587f34SStefano Zampini         ierr = ISPartitioningToNumbering(coarse_new_decomposition,&is_numbering);CHKERRQ(ierr);
2556c8587f34SStefano Zampini         ierr = ISView(is_numbering,viewer_test);CHKERRQ(ierr);
2557c8587f34SStefano Zampini         ierr = PetscViewerDestroy(&viewer_test);CHKERRQ(ierr);
2558c8587f34SStefano Zampini         ierr = ISDestroy(&coarse_new_decomposition);CHKERRQ(ierr);
2559c8587f34SStefano Zampini         ierr = ISDestroy(&is_numbering);CHKERRQ(ierr);
2560c8587f34SStefano Zampini         ierr = MatPartitioningDestroy(&mat_part);CHKERRQ(ierr);
2561c8587f34SStefano Zampini         ierr = PetscFree(old_ranks);CHKERRQ(ierr);
2562c8587f34SStefano Zampini         ierr = PetscFree(new_ranks);CHKERRQ(ierr);
2563c8587f34SStefano Zampini         ierr = MPI_Comm_free(&test_coarse_comm);CHKERRQ(ierr);
2564c8587f34SStefano Zampini       }
2565c8587f34SStefano Zampini #endif
2566c8587f34SStefano Zampini 
2567c8587f34SStefano Zampini       /* build CSR graph of subdomains' connectivity */
2568c8587f34SStefano Zampini       ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&array_int);CHKERRQ(ierr);
2569c8587f34SStefano Zampini       ierr = PetscMemzero(array_int,pcis->n*sizeof(PetscInt));CHKERRQ(ierr);
2570c8587f34SStefano Zampini       for (i=1;i<pcis->n_neigh;i++){/* i=1 so I don't count myself -> faces nodes counts to 1 */
2571c8587f34SStefano Zampini         for (j=0;j<pcis->n_shared[i];j++){
2572c8587f34SStefano Zampini           array_int[ pcis->shared[i][j] ]+=1;
2573c8587f34SStefano Zampini         }
2574c8587f34SStefano Zampini       }
2575c8587f34SStefano Zampini       for (i=1;i<pcis->n_neigh;i++){
2576c8587f34SStefano Zampini         for (j=0;j<pcis->n_shared[i];j++){
2577c8587f34SStefano Zampini           if (array_int[ pcis->shared[i][j] ] > 0 ){
2578c8587f34SStefano Zampini             my_faces++;
2579c8587f34SStefano Zampini             break;
2580c8587f34SStefano Zampini           }
2581c8587f34SStefano Zampini         }
2582c8587f34SStefano Zampini       }
2583c8587f34SStefano Zampini 
2584c8587f34SStefano Zampini       ierr = MPI_Reduce(&my_faces,&total_faces,1,MPIU_INT,MPI_SUM,master_proc,prec_comm);CHKERRQ(ierr);
2585c8587f34SStefano Zampini       ierr = PetscMalloc (my_faces*sizeof(PetscInt),&my_faces_connectivity);CHKERRQ(ierr);
2586c8587f34SStefano Zampini       my_faces=0;
2587c8587f34SStefano Zampini       for (i=1;i<pcis->n_neigh;i++){
2588c8587f34SStefano Zampini         for (j=0;j<pcis->n_shared[i];j++){
2589c8587f34SStefano Zampini           if (array_int[ pcis->shared[i][j] ] > 0 ){
2590c8587f34SStefano Zampini             my_faces_connectivity[my_faces]=pcis->neigh[i];
2591c8587f34SStefano Zampini             my_faces++;
2592c8587f34SStefano Zampini             break;
2593c8587f34SStefano Zampini           }
2594c8587f34SStefano Zampini         }
2595c8587f34SStefano Zampini       }
2596c8587f34SStefano Zampini       if (rank_prec_comm == master_proc) {
2597c8587f34SStefano Zampini         ierr = PetscMalloc (total_faces*sizeof(PetscMPIInt),&petsc_faces_adjncy);CHKERRQ(ierr);
2598c8587f34SStefano Zampini         ierr = PetscMalloc (size_prec_comm*sizeof(PetscMPIInt),&number_of_faces);CHKERRQ(ierr);
2599c8587f34SStefano Zampini         ierr = PetscMalloc (total_faces*sizeof(MetisInt),&faces_adjncy);CHKERRQ(ierr);
2600c8587f34SStefano Zampini         ierr = PetscMalloc ((n_subdomains+1)*sizeof(MetisInt),&faces_xadj);CHKERRQ(ierr);
2601c8587f34SStefano Zampini         ierr = PetscMalloc ((size_prec_comm+1)*sizeof(PetscMPIInt),&faces_displacements);CHKERRQ(ierr);
2602c8587f34SStefano Zampini       }
2603c8587f34SStefano Zampini       ierr = MPI_Gather(&my_faces,1,MPIU_INT,&number_of_faces[0],1,MPIU_INT,master_proc,prec_comm);CHKERRQ(ierr);
2604c8587f34SStefano Zampini       if (rank_prec_comm == master_proc) {
2605c8587f34SStefano Zampini         faces_xadj[0]=0;
2606c8587f34SStefano Zampini         faces_displacements[0]=0;
2607c8587f34SStefano Zampini         j=0;
2608c8587f34SStefano Zampini         for (i=1;i<size_prec_comm+1;i++) {
2609c8587f34SStefano Zampini           faces_displacements[i]=faces_displacements[i-1]+number_of_faces[i-1];
2610c8587f34SStefano Zampini           if (number_of_faces[i-1]) {
2611c8587f34SStefano Zampini             j++;
2612c8587f34SStefano Zampini             faces_xadj[j]=faces_xadj[j-1]+number_of_faces[i-1];
2613c8587f34SStefano Zampini           }
2614c8587f34SStefano Zampini         }
2615c8587f34SStefano Zampini       }
2616c8587f34SStefano Zampini       ierr = MPI_Gatherv(&my_faces_connectivity[0],my_faces,MPIU_INT,&petsc_faces_adjncy[0],number_of_faces,faces_displacements,MPIU_INT,master_proc,prec_comm);CHKERRQ(ierr);
2617c8587f34SStefano Zampini       ierr = PetscFree(my_faces_connectivity);CHKERRQ(ierr);
2618c8587f34SStefano Zampini       ierr = PetscFree(array_int);CHKERRQ(ierr);
2619c8587f34SStefano Zampini       if (rank_prec_comm == master_proc) {
2620c8587f34SStefano Zampini         for (i=0;i<total_faces;i++) faces_adjncy[i]=(MetisInt)(petsc_faces_adjncy[i]/ranks_stretching_ratio); /* cast to MetisInt */
2621c8587f34SStefano Zampini         ierr = PetscFree(faces_displacements);CHKERRQ(ierr);
2622c8587f34SStefano Zampini         ierr = PetscFree(number_of_faces);CHKERRQ(ierr);
2623c8587f34SStefano Zampini         ierr = PetscFree(petsc_faces_adjncy);CHKERRQ(ierr);
2624c8587f34SStefano Zampini       }
2625c8587f34SStefano Zampini 
2626c8587f34SStefano Zampini       if ( rank_prec_comm == master_proc ) {
2627c8587f34SStefano Zampini 
2628c8587f34SStefano Zampini         PetscInt heuristic_for_metis=3;
2629c8587f34SStefano Zampini 
2630c8587f34SStefano Zampini         ncon=1;
2631c8587f34SStefano Zampini         faces_nvtxs=n_subdomains;
2632c8587f34SStefano Zampini         /* partition graoh induced by face connectivity */
2633c8587f34SStefano Zampini         ierr = PetscMalloc (n_subdomains*sizeof(MetisInt),&metis_coarse_subdivision);CHKERRQ(ierr);
2634c8587f34SStefano Zampini         ierr = METIS_SetDefaultOptions(options);
2635c8587f34SStefano Zampini         /* we need a contiguous partition of the coarse mesh */
2636c8587f34SStefano Zampini         options[METIS_OPTION_CONTIG]=1;
2637c8587f34SStefano Zampini         options[METIS_OPTION_NITER]=30;
2638c8587f34SStefano Zampini         if (pcbddc->coarsening_ratio > 1) {
2639c8587f34SStefano Zampini           if (n_subdomains>n_parts*heuristic_for_metis) {
2640c8587f34SStefano Zampini             options[METIS_OPTION_IPTYPE]=METIS_IPTYPE_EDGE;
2641c8587f34SStefano Zampini             options[METIS_OPTION_OBJTYPE]=METIS_OBJTYPE_CUT;
2642c8587f34SStefano Zampini             ierr = METIS_PartGraphKway(&faces_nvtxs,&ncon,faces_xadj,faces_adjncy,NULL,NULL,NULL,&n_parts,NULL,NULL,options,&objval,metis_coarse_subdivision);
2643c8587f34SStefano Zampini             if (ierr != METIS_OK) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in METIS_PartGraphKway (metis error code %D) called from PCBDDCSetUpCoarseEnvironment\n",ierr);
2644c8587f34SStefano Zampini           } else {
2645c8587f34SStefano Zampini             ierr = METIS_PartGraphRecursive(&faces_nvtxs,&ncon,faces_xadj,faces_adjncy,NULL,NULL,NULL,&n_parts,NULL,NULL,options,&objval,metis_coarse_subdivision);
2646c8587f34SStefano Zampini             if (ierr != METIS_OK) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in METIS_PartGraphRecursive (metis error code %D) called from PCBDDCSetUpCoarseEnvironment\n",ierr);
2647c8587f34SStefano Zampini           }
2648c8587f34SStefano Zampini         } else {
2649c8587f34SStefano Zampini           for (i=0;i<n_subdomains;i++) metis_coarse_subdivision[i]=i;
2650c8587f34SStefano Zampini         }
2651c8587f34SStefano Zampini         ierr = PetscFree(faces_xadj);CHKERRQ(ierr);
2652c8587f34SStefano Zampini         ierr = PetscFree(faces_adjncy);CHKERRQ(ierr);
2653c8587f34SStefano Zampini         ierr = PetscMalloc(size_prec_comm*sizeof(PetscMPIInt),&coarse_subdivision);CHKERRQ(ierr);
2654c8587f34SStefano Zampini 
2655c8587f34SStefano Zampini         /* copy/cast values avoiding possible type conflicts between PETSc, MPI and METIS */
2656c8587f34SStefano Zampini         for (i=0;i<size_prec_comm;i++) coarse_subdivision[i]=MPI_PROC_NULL;
2657c8587f34SStefano Zampini         for (i=0;i<n_subdomains;i++) coarse_subdivision[ranks_stretching_ratio*i]=(PetscInt)(metis_coarse_subdivision[i]);
2658c8587f34SStefano Zampini         ierr = PetscFree(metis_coarse_subdivision);CHKERRQ(ierr);
2659c8587f34SStefano Zampini       }
2660c8587f34SStefano Zampini 
2661c8587f34SStefano Zampini       /* Create new communicator for coarse problem splitting the old one */
2662c8587f34SStefano Zampini       if ( !(rank_prec_comm%procs_jumps_coarse_comm) && rank_prec_comm < procs_jumps_coarse_comm*n_parts ){
2663c8587f34SStefano Zampini         coarse_color=0;              /* for communicator splitting */
2664c8587f34SStefano Zampini         active_rank=rank_prec_comm;  /* for insertion of matrix values */
2665c8587f34SStefano Zampini       }
2666c8587f34SStefano Zampini       /* procs with coarse_color = MPI_UNDEFINED will have coarse_comm = MPI_COMM_NULL (from mpi standards)
2667c8587f34SStefano Zampini          key = rank_prec_comm -> keep same ordering of ranks from the old to the new communicator */
2668c8587f34SStefano Zampini       ierr = MPI_Comm_split(prec_comm,coarse_color,rank_prec_comm,&coarse_comm);CHKERRQ(ierr);
2669c8587f34SStefano Zampini 
2670c8587f34SStefano Zampini       if ( coarse_color == 0 ) {
2671c8587f34SStefano Zampini         ierr = MPI_Comm_size(coarse_comm,&size_coarse_comm);CHKERRQ(ierr);
2672c8587f34SStefano Zampini         ierr = MPI_Comm_rank(coarse_comm,&rank_coarse_comm);CHKERRQ(ierr);
2673c8587f34SStefano Zampini       } else {
2674c8587f34SStefano Zampini         rank_coarse_comm = MPI_PROC_NULL;
2675c8587f34SStefano Zampini       }
2676c8587f34SStefano Zampini 
2677c8587f34SStefano Zampini       /* master proc take care of arranging and distributing coarse information */
2678c8587f34SStefano Zampini       if (rank_coarse_comm == master_proc) {
2679c8587f34SStefano Zampini         ierr = PetscMalloc (size_coarse_comm*sizeof(PetscMPIInt),&displacements_recv);CHKERRQ(ierr);
2680c8587f34SStefano Zampini         ierr = PetscMalloc (size_coarse_comm*sizeof(PetscMPIInt),&total_count_recv);CHKERRQ(ierr);
2681c8587f34SStefano Zampini         ierr = PetscMalloc (n_subdomains*sizeof(PetscMPIInt),&total_ranks_recv);CHKERRQ(ierr);
2682c8587f34SStefano Zampini         /* some initializations */
2683c8587f34SStefano Zampini         displacements_recv[0]=0;
2684c8587f34SStefano Zampini         ierr = PetscMemzero(total_count_recv,size_coarse_comm*sizeof(PetscMPIInt));CHKERRQ(ierr);
2685c8587f34SStefano Zampini         /* count from how many processes the j-th process of the coarse decomposition will receive data */
2686c8587f34SStefano Zampini         for (j=0;j<size_coarse_comm;j++) {
2687c8587f34SStefano Zampini           for (i=0;i<size_prec_comm;i++) {
2688c8587f34SStefano Zampini           if (coarse_subdivision[i]==j) total_count_recv[j]++;
2689c8587f34SStefano Zampini           }
2690c8587f34SStefano Zampini         }
2691c8587f34SStefano Zampini         /* displacements needed for scatterv of total_ranks_recv */
2692c8587f34SStefano Zampini       for (i=1; i<size_coarse_comm; i++) displacements_recv[i]=displacements_recv[i-1]+total_count_recv[i-1];
2693c8587f34SStefano Zampini 
2694c8587f34SStefano Zampini         /* Now fill properly total_ranks_recv -> each coarse process will receive the ranks (in prec_comm communicator) of its friend (sending) processes */
2695c8587f34SStefano Zampini         ierr = PetscMemzero(total_count_recv,size_coarse_comm*sizeof(PetscMPIInt));CHKERRQ(ierr);
2696c8587f34SStefano Zampini         for (j=0;j<size_coarse_comm;j++) {
2697c8587f34SStefano Zampini           for (i=0;i<size_prec_comm;i++) {
2698c8587f34SStefano Zampini             if (coarse_subdivision[i]==j) {
2699c8587f34SStefano Zampini               total_ranks_recv[displacements_recv[j]+total_count_recv[j]]=i;
2700c8587f34SStefano Zampini               total_count_recv[j]+=1;
2701c8587f34SStefano Zampini             }
2702c8587f34SStefano Zampini           }
2703c8587f34SStefano Zampini         }
2704c8587f34SStefano Zampini         /*for (j=0;j<size_coarse_comm;j++) {
2705c8587f34SStefano Zampini           printf("process %d in new rank will receive from %d processes (original ranks follows)\n",j,total_count_recv[j]);
2706c8587f34SStefano Zampini           for (i=0;i<total_count_recv[j];i++) {
2707c8587f34SStefano Zampini             printf("%d ",total_ranks_recv[displacements_recv[j]+i]);
2708c8587f34SStefano Zampini           }
2709c8587f34SStefano Zampini           printf("\n");
2710c8587f34SStefano Zampini         }*/
2711c8587f34SStefano Zampini 
2712c8587f34SStefano Zampini         /* identify new decomposition in terms of ranks in the old communicator */
2713c8587f34SStefano Zampini         for (i=0;i<n_subdomains;i++) {
2714c8587f34SStefano Zampini           coarse_subdivision[ranks_stretching_ratio*i]=coarse_subdivision[ranks_stretching_ratio*i]*procs_jumps_coarse_comm;
2715c8587f34SStefano Zampini         }
2716c8587f34SStefano Zampini         /*printf("coarse_subdivision in old end new ranks\n");
2717c8587f34SStefano Zampini         for (i=0;i<size_prec_comm;i++)
2718c8587f34SStefano Zampini           if (coarse_subdivision[i]!=MPI_PROC_NULL) {
2719c8587f34SStefano Zampini             printf("%d=(%d %d), ",i,coarse_subdivision[i],coarse_subdivision[i]/procs_jumps_coarse_comm);
2720c8587f34SStefano Zampini           } else {
2721c8587f34SStefano Zampini             printf("%d=(%d %d), ",i,coarse_subdivision[i],coarse_subdivision[i]);
2722c8587f34SStefano Zampini           }
2723c8587f34SStefano Zampini         printf("\n");*/
2724c8587f34SStefano Zampini       }
2725c8587f34SStefano Zampini 
2726c8587f34SStefano Zampini       /* Scatter new decomposition for send details */
2727c8587f34SStefano Zampini       ierr = MPI_Scatter(&coarse_subdivision[0],1,MPIU_INT,&rank_coarse_proc_send_to,1,MPIU_INT,master_proc,prec_comm);CHKERRQ(ierr);
2728c8587f34SStefano Zampini       /* Scatter receiving details to members of coarse decomposition */
2729c8587f34SStefano Zampini       if ( coarse_color == 0) {
2730c8587f34SStefano Zampini         ierr = MPI_Scatter(&total_count_recv[0],1,MPIU_INT,&count_recv,1,MPIU_INT,master_proc,coarse_comm);CHKERRQ(ierr);
2731c8587f34SStefano Zampini         ierr = PetscMalloc (count_recv*sizeof(PetscMPIInt),&ranks_recv);CHKERRQ(ierr);
2732c8587f34SStefano Zampini         ierr = MPI_Scatterv(&total_ranks_recv[0],total_count_recv,displacements_recv,MPIU_INT,&ranks_recv[0],count_recv,MPIU_INT,master_proc,coarse_comm);CHKERRQ(ierr);
2733c8587f34SStefano Zampini       }
2734c8587f34SStefano Zampini 
2735c8587f34SStefano Zampini       /*printf("I will send my matrix data to proc  %d\n",rank_coarse_proc_send_to);
2736c8587f34SStefano Zampini       if (coarse_color == 0) {
2737c8587f34SStefano Zampini         printf("I will receive some matrix data from %d processes (ranks follows)\n",count_recv);
2738c8587f34SStefano Zampini         for (i=0;i<count_recv;i++)
2739c8587f34SStefano Zampini           printf("%d ",ranks_recv[i]);
2740c8587f34SStefano Zampini         printf("\n");
2741c8587f34SStefano Zampini       }*/
2742c8587f34SStefano Zampini 
2743c8587f34SStefano Zampini       if (rank_prec_comm == master_proc) {
2744c8587f34SStefano Zampini         ierr = PetscFree(coarse_subdivision);CHKERRQ(ierr);
2745c8587f34SStefano Zampini         ierr = PetscFree(total_count_recv);CHKERRQ(ierr);
2746c8587f34SStefano Zampini         ierr = PetscFree(total_ranks_recv);CHKERRQ(ierr);
2747c8587f34SStefano Zampini         ierr = PetscFree(displacements_recv);CHKERRQ(ierr);
2748c8587f34SStefano Zampini       }
2749c8587f34SStefano Zampini #endif
2750c8587f34SStefano Zampini       break;
2751c8587f34SStefano Zampini     }
2752c8587f34SStefano Zampini 
2753c8587f34SStefano Zampini     case(REPLICATED_BDDC):
2754c8587f34SStefano Zampini 
2755c8587f34SStefano Zampini       pcbddc->coarse_communications_type = GATHERS_BDDC;
2756c8587f34SStefano Zampini       coarse_mat_type = MATSEQAIJ;
2757c8587f34SStefano Zampini       coarse_pc_type  = PCLU;
2758c8587f34SStefano Zampini       coarse_ksp_type  = KSPPREONLY;
2759c8587f34SStefano Zampini       coarse_comm = PETSC_COMM_SELF;
2760c8587f34SStefano Zampini       active_rank = rank_prec_comm;
2761c8587f34SStefano Zampini       break;
2762c8587f34SStefano Zampini 
2763c8587f34SStefano Zampini     case(PARALLEL_BDDC):
2764c8587f34SStefano Zampini 
2765c8587f34SStefano Zampini       pcbddc->coarse_communications_type = SCATTERS_BDDC;
2766c8587f34SStefano Zampini       coarse_mat_type = MATAIJ;
2767c8587f34SStefano Zampini       coarse_pc_type  = PCREDUNDANT;
2768c8587f34SStefano Zampini       coarse_ksp_type  = KSPPREONLY;
2769c8587f34SStefano Zampini       coarse_comm = prec_comm;
2770c8587f34SStefano Zampini       active_rank = rank_prec_comm;
2771c8587f34SStefano Zampini       break;
2772c8587f34SStefano Zampini 
2773c8587f34SStefano Zampini     case(SEQUENTIAL_BDDC):
2774c8587f34SStefano Zampini       pcbddc->coarse_communications_type = GATHERS_BDDC;
2775c8587f34SStefano Zampini       coarse_mat_type = MATAIJ;
2776c8587f34SStefano Zampini       coarse_pc_type = PCLU;
2777c8587f34SStefano Zampini       coarse_ksp_type  = KSPPREONLY;
2778c8587f34SStefano Zampini       coarse_comm = PETSC_COMM_SELF;
2779c8587f34SStefano Zampini       active_rank = master_proc;
2780c8587f34SStefano Zampini       break;
2781c8587f34SStefano Zampini   }
2782c8587f34SStefano Zampini 
2783c8587f34SStefano Zampini   switch(pcbddc->coarse_communications_type){
2784c8587f34SStefano Zampini 
2785c8587f34SStefano Zampini     case(SCATTERS_BDDC):
2786c8587f34SStefano Zampini       {
2787c8587f34SStefano Zampini         if (pcbddc->coarse_problem_type==MULTILEVEL_BDDC) {
2788c8587f34SStefano Zampini 
2789c8587f34SStefano Zampini           IS coarse_IS;
2790c8587f34SStefano Zampini 
2791c8587f34SStefano Zampini           if(pcbddc->coarsening_ratio == 1) {
2792c8587f34SStefano Zampini             ins_local_primal_size = pcbddc->local_primal_size;
2793c8587f34SStefano Zampini             ins_local_primal_indices = pcbddc->local_primal_indices;
2794c8587f34SStefano Zampini             if (coarse_color == 0) { ierr = PetscFree(ranks_recv);CHKERRQ(ierr); }
2795c8587f34SStefano Zampini             /* nonzeros */
2796c8587f34SStefano Zampini             ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&dnz);CHKERRQ(ierr);
2797c8587f34SStefano Zampini             ierr = PetscMemzero(dnz,ins_local_primal_size*sizeof(PetscInt));CHKERRQ(ierr);
2798c8587f34SStefano Zampini             for (i=0;i<ins_local_primal_size;i++) {
2799c8587f34SStefano Zampini               dnz[i] = ins_local_primal_size;
2800c8587f34SStefano Zampini             }
2801c8587f34SStefano Zampini           } else {
2802c8587f34SStefano Zampini             PetscMPIInt send_size;
2803c8587f34SStefano Zampini             PetscMPIInt *send_buffer;
2804c8587f34SStefano Zampini             PetscInt    *aux_ins_indices;
2805c8587f34SStefano Zampini             PetscInt    ii,jj;
2806c8587f34SStefano Zampini             MPI_Request *requests;
2807c8587f34SStefano Zampini 
2808c8587f34SStefano Zampini             ierr = PetscMalloc(count_recv*sizeof(PetscMPIInt),&localdispl2);CHKERRQ(ierr);
2809c8587f34SStefano Zampini             /* reusing pcbddc->local_primal_displacements and pcbddc->replicated_primal_size */
2810c8587f34SStefano Zampini             ierr = PetscFree(pcbddc->local_primal_displacements);CHKERRQ(ierr);
2811c8587f34SStefano Zampini             ierr = PetscMalloc((count_recv+1)*sizeof(PetscMPIInt),&pcbddc->local_primal_displacements);CHKERRQ(ierr);
2812c8587f34SStefano Zampini             pcbddc->replicated_primal_size = count_recv;
2813c8587f34SStefano Zampini             j = 0;
2814c8587f34SStefano Zampini             for (i=0;i<count_recv;i++) {
2815c8587f34SStefano Zampini               pcbddc->local_primal_displacements[i] = j;
2816c8587f34SStefano Zampini               j += pcbddc->local_primal_sizes[ranks_recv[i]];
2817c8587f34SStefano Zampini             }
2818c8587f34SStefano Zampini             pcbddc->local_primal_displacements[count_recv] = j;
2819c8587f34SStefano Zampini             ierr = PetscMalloc(j*sizeof(PetscMPIInt),&pcbddc->replicated_local_primal_indices);CHKERRQ(ierr);
2820c8587f34SStefano Zampini             /* allocate auxiliary space */
2821c8587f34SStefano Zampini             ierr = PetscMalloc(count_recv*sizeof(PetscMPIInt),&localsizes2);CHKERRQ(ierr);
2822983f5fd7SStefano Zampini             ierr = PetscMalloc(coarse_size*sizeof(PetscInt),&aux_ins_indices);CHKERRQ(ierr);
2823983f5fd7SStefano Zampini             ierr = PetscMemzero(aux_ins_indices,coarse_size*sizeof(PetscInt));CHKERRQ(ierr);
2824c8587f34SStefano Zampini             /* allocate stuffs for message massing */
2825c8587f34SStefano Zampini             ierr = PetscMalloc((count_recv+1)*sizeof(MPI_Request),&requests);CHKERRQ(ierr);
2826c8587f34SStefano Zampini             for (i=0;i<count_recv+1;i++) { requests[i]=MPI_REQUEST_NULL; }
2827c8587f34SStefano Zampini             /* send indices to be inserted */
2828c8587f34SStefano Zampini             for (i=0;i<count_recv;i++) {
2829c8587f34SStefano Zampini               send_size = pcbddc->local_primal_sizes[ranks_recv[i]];
2830c8587f34SStefano Zampini               ierr = MPI_Irecv(&pcbddc->replicated_local_primal_indices[pcbddc->local_primal_displacements[i]],send_size,MPIU_INT,ranks_recv[i],999,prec_comm,&requests[i]);CHKERRQ(ierr);
2831c8587f34SStefano Zampini             }
2832c8587f34SStefano Zampini             if (rank_coarse_proc_send_to != MPI_PROC_NULL ) {
2833c8587f34SStefano Zampini               send_size = pcbddc->local_primal_size;
2834c8587f34SStefano Zampini               ierr = PetscMalloc(send_size*sizeof(PetscMPIInt),&send_buffer);CHKERRQ(ierr);
2835c8587f34SStefano Zampini               for (i=0;i<send_size;i++) {
2836c8587f34SStefano Zampini                 send_buffer[i]=(PetscMPIInt)pcbddc->local_primal_indices[i];
2837c8587f34SStefano Zampini               }
2838c8587f34SStefano Zampini               ierr = MPI_Isend(send_buffer,send_size,MPIU_INT,rank_coarse_proc_send_to,999,prec_comm,&requests[count_recv]);CHKERRQ(ierr);
2839c8587f34SStefano Zampini             }
2840c8587f34SStefano Zampini             ierr = MPI_Waitall(count_recv+1,requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2841c8587f34SStefano Zampini             if (rank_coarse_proc_send_to != MPI_PROC_NULL ) {
2842c8587f34SStefano Zampini               ierr = PetscFree(send_buffer);CHKERRQ(ierr);
2843c8587f34SStefano Zampini             }
2844c8587f34SStefano Zampini             j = 0;
2845c8587f34SStefano Zampini             for (i=0;i<count_recv;i++) {
2846c8587f34SStefano Zampini               ii = pcbddc->local_primal_displacements[i+1]-pcbddc->local_primal_displacements[i];
2847c8587f34SStefano Zampini               localsizes2[i] = ii*ii;
2848c8587f34SStefano Zampini               localdispl2[i] = j;
2849c8587f34SStefano Zampini               j += localsizes2[i];
2850c8587f34SStefano Zampini               jj = pcbddc->local_primal_displacements[i];
2851c8587f34SStefano Zampini               /* it counts the coarse subdomains sharing the coarse node */
2852c8587f34SStefano Zampini               for (k=0;k<ii;k++) {
2853c8587f34SStefano Zampini                 aux_ins_indices[pcbddc->replicated_local_primal_indices[jj+k]] += 1;
2854c8587f34SStefano Zampini               }
2855c8587f34SStefano Zampini             }
2856c8587f34SStefano Zampini             /* temp_coarse_mat_vals used to store matrix values to be received */
2857c8587f34SStefano Zampini             ierr = PetscMalloc(j*sizeof(PetscScalar),&temp_coarse_mat_vals);CHKERRQ(ierr);
2858c8587f34SStefano Zampini             /* evaluate how many values I will insert in coarse mat */
2859c8587f34SStefano Zampini             ins_local_primal_size = 0;
2860983f5fd7SStefano Zampini             for (i=0;i<coarse_size;i++) {
2861c8587f34SStefano Zampini               if (aux_ins_indices[i]) {
2862c8587f34SStefano Zampini                 ins_local_primal_size++;
2863c8587f34SStefano Zampini               }
2864c8587f34SStefano Zampini             }
2865c8587f34SStefano Zampini             /* evaluate indices I will insert in coarse mat */
2866c8587f34SStefano Zampini             ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr);
2867c8587f34SStefano Zampini             j = 0;
2868983f5fd7SStefano Zampini             for(i=0;i<coarse_size;i++) {
2869c8587f34SStefano Zampini               if(aux_ins_indices[i]) {
2870c8587f34SStefano Zampini                 ins_local_primal_indices[j] = i;
2871c8587f34SStefano Zampini                 j++;
2872c8587f34SStefano Zampini               }
2873c8587f34SStefano Zampini             }
2874c8587f34SStefano Zampini             /* processes partecipating in coarse problem receive matrix data from their friends */
2875c8587f34SStefano Zampini             for (i=0;i<count_recv;i++) {
2876c8587f34SStefano Zampini               ierr = MPI_Irecv(&temp_coarse_mat_vals[localdispl2[i]],localsizes2[i],MPIU_SCALAR,ranks_recv[i],666,prec_comm,&requests[i]);CHKERRQ(ierr);
2877c8587f34SStefano Zampini             }
2878c8587f34SStefano Zampini             if (rank_coarse_proc_send_to != MPI_PROC_NULL ) {
2879c8587f34SStefano Zampini               send_size = pcbddc->local_primal_size*pcbddc->local_primal_size;
2880c8587f34SStefano Zampini               ierr = MPI_Isend(&coarse_submat_vals[0],send_size,MPIU_SCALAR,rank_coarse_proc_send_to,666,prec_comm,&requests[count_recv]);CHKERRQ(ierr);
2881c8587f34SStefano Zampini             }
2882c8587f34SStefano Zampini             ierr = MPI_Waitall(count_recv+1,requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2883c8587f34SStefano Zampini             /* nonzeros */
2884c8587f34SStefano Zampini             ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&dnz);CHKERRQ(ierr);
2885c8587f34SStefano Zampini             ierr = PetscMemzero(dnz,ins_local_primal_size*sizeof(PetscInt));CHKERRQ(ierr);
2886c8587f34SStefano Zampini             /* use aux_ins_indices to realize a global to local mapping */
2887c8587f34SStefano Zampini             j=0;
2888983f5fd7SStefano Zampini             for(i=0;i<coarse_size;i++){
2889c8587f34SStefano Zampini               if(aux_ins_indices[i]==0){
2890c8587f34SStefano Zampini                 aux_ins_indices[i]=-1;
2891c8587f34SStefano Zampini               } else {
2892c8587f34SStefano Zampini                 aux_ins_indices[i]=j;
2893c8587f34SStefano Zampini                 j++;
2894c8587f34SStefano Zampini               }
2895c8587f34SStefano Zampini             }
2896c8587f34SStefano Zampini             for (i=0;i<count_recv;i++) {
2897c8587f34SStefano Zampini               j = pcbddc->local_primal_sizes[ranks_recv[i]];
2898c8587f34SStefano Zampini               for (k=0;k<j;k++) {
2899c8587f34SStefano Zampini                 dnz[aux_ins_indices[pcbddc->replicated_local_primal_indices[pcbddc->local_primal_displacements[i]+k]]] += j;
2900c8587f34SStefano Zampini               }
2901c8587f34SStefano Zampini             }
2902c8587f34SStefano Zampini             /* check */
2903c8587f34SStefano Zampini             for (i=0;i<ins_local_primal_size;i++) {
2904c8587f34SStefano Zampini               if (dnz[i] > ins_local_primal_size) {
2905c8587f34SStefano Zampini                 dnz[i] = ins_local_primal_size;
2906c8587f34SStefano Zampini               }
2907c8587f34SStefano Zampini             }
2908c8587f34SStefano Zampini             ierr = PetscFree(requests);CHKERRQ(ierr);
2909c8587f34SStefano Zampini             ierr = PetscFree(aux_ins_indices);CHKERRQ(ierr);
2910c8587f34SStefano Zampini             if (coarse_color == 0) { ierr = PetscFree(ranks_recv);CHKERRQ(ierr); }
2911c8587f34SStefano Zampini           }
2912c8587f34SStefano Zampini           /* create local to global mapping needed by coarse MATIS */
2913c8587f34SStefano Zampini           if (coarse_comm != MPI_COMM_NULL ) {ierr = MPI_Comm_free(&coarse_comm);CHKERRQ(ierr);}
2914c8587f34SStefano Zampini           coarse_comm = prec_comm;
2915c8587f34SStefano Zampini           active_rank = rank_prec_comm;
2916c8587f34SStefano Zampini           ierr = ISCreateGeneral(coarse_comm,ins_local_primal_size,ins_local_primal_indices,PETSC_COPY_VALUES,&coarse_IS);CHKERRQ(ierr);
2917c8587f34SStefano Zampini           ierr = ISLocalToGlobalMappingCreateIS(coarse_IS,&coarse_ISLG);CHKERRQ(ierr);
2918c8587f34SStefano Zampini           ierr = ISDestroy(&coarse_IS);CHKERRQ(ierr);
2919c8587f34SStefano Zampini         } else if (pcbddc->coarse_problem_type==PARALLEL_BDDC) {
2920c8587f34SStefano Zampini           /* arrays for values insertion */
2921c8587f34SStefano Zampini           ins_local_primal_size = pcbddc->local_primal_size;
2922c8587f34SStefano Zampini           ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr);
2923c8587f34SStefano Zampini           ierr = PetscMalloc(ins_local_primal_size*ins_local_primal_size*sizeof(PetscScalar),&ins_coarse_mat_vals);CHKERRQ(ierr);
2924c8587f34SStefano Zampini           for (j=0;j<ins_local_primal_size;j++){
2925c8587f34SStefano Zampini             ins_local_primal_indices[j]=pcbddc->local_primal_indices[j];
2926c8587f34SStefano Zampini             for (i=0;i<ins_local_primal_size;i++) {
2927c8587f34SStefano Zampini               ins_coarse_mat_vals[j*ins_local_primal_size+i]=coarse_submat_vals[j*ins_local_primal_size+i];
2928c8587f34SStefano Zampini             }
2929c8587f34SStefano Zampini           }
2930c8587f34SStefano Zampini         }
2931c8587f34SStefano Zampini         break;
2932c8587f34SStefano Zampini 
2933c8587f34SStefano Zampini     }
2934c8587f34SStefano Zampini 
2935c8587f34SStefano Zampini     case(GATHERS_BDDC):
2936c8587f34SStefano Zampini       {
2937c8587f34SStefano Zampini 
2938c8587f34SStefano Zampini         PetscMPIInt mysize,mysize2;
2939c8587f34SStefano Zampini         PetscMPIInt *send_buffer;
2940c8587f34SStefano Zampini 
2941c8587f34SStefano Zampini         if (rank_prec_comm==active_rank) {
2942c8587f34SStefano Zampini           ierr = PetscMalloc ( pcbddc->replicated_primal_size*sizeof(PetscMPIInt),&pcbddc->replicated_local_primal_indices);CHKERRQ(ierr);
2943c8587f34SStefano Zampini           ierr = PetscMalloc ( pcbddc->replicated_primal_size*sizeof(PetscScalar),&pcbddc->replicated_local_primal_values);CHKERRQ(ierr);
2944c8587f34SStefano Zampini           ierr = PetscMalloc ( size_prec_comm*sizeof(PetscMPIInt),&localsizes2);CHKERRQ(ierr);
2945c8587f34SStefano Zampini           ierr = PetscMalloc ( size_prec_comm*sizeof(PetscMPIInt),&localdispl2);CHKERRQ(ierr);
2946c8587f34SStefano Zampini           /* arrays for values insertion */
2947c8587f34SStefano Zampini       for (i=0;i<size_prec_comm;i++) localsizes2[i]=pcbddc->local_primal_sizes[i]*pcbddc->local_primal_sizes[i];
2948c8587f34SStefano Zampini           localdispl2[0]=0;
2949c8587f34SStefano Zampini       for (i=1;i<size_prec_comm;i++) localdispl2[i]=localsizes2[i-1]+localdispl2[i-1];
2950c8587f34SStefano Zampini           j=0;
2951c8587f34SStefano Zampini       for (i=0;i<size_prec_comm;i++) j+=localsizes2[i];
2952c8587f34SStefano Zampini           ierr = PetscMalloc ( j*sizeof(PetscScalar),&temp_coarse_mat_vals);CHKERRQ(ierr);
2953c8587f34SStefano Zampini         }
2954c8587f34SStefano Zampini 
2955c8587f34SStefano Zampini         mysize=pcbddc->local_primal_size;
2956c8587f34SStefano Zampini         mysize2=pcbddc->local_primal_size*pcbddc->local_primal_size;
2957c8587f34SStefano Zampini         ierr = PetscMalloc(mysize*sizeof(PetscMPIInt),&send_buffer);CHKERRQ(ierr);
2958c8587f34SStefano Zampini     for (i=0; i<mysize; i++) send_buffer[i]=(PetscMPIInt)pcbddc->local_primal_indices[i];
2959c8587f34SStefano Zampini 
2960c8587f34SStefano Zampini         if (pcbddc->coarse_problem_type == SEQUENTIAL_BDDC){
2961c8587f34SStefano Zampini           ierr = MPI_Gatherv(send_buffer,mysize,MPIU_INT,&pcbddc->replicated_local_primal_indices[0],pcbddc->local_primal_sizes,pcbddc->local_primal_displacements,MPIU_INT,master_proc,prec_comm);CHKERRQ(ierr);
2962c8587f34SStefano Zampini           ierr = MPI_Gatherv(&coarse_submat_vals[0],mysize2,MPIU_SCALAR,&temp_coarse_mat_vals[0],localsizes2,localdispl2,MPIU_SCALAR,master_proc,prec_comm);CHKERRQ(ierr);
2963c8587f34SStefano Zampini         } else {
2964c8587f34SStefano Zampini           ierr = MPI_Allgatherv(send_buffer,mysize,MPIU_INT,&pcbddc->replicated_local_primal_indices[0],pcbddc->local_primal_sizes,pcbddc->local_primal_displacements,MPIU_INT,prec_comm);CHKERRQ(ierr);
2965c8587f34SStefano Zampini           ierr = MPI_Allgatherv(&coarse_submat_vals[0],mysize2,MPIU_SCALAR,&temp_coarse_mat_vals[0],localsizes2,localdispl2,MPIU_SCALAR,prec_comm);CHKERRQ(ierr);
2966c8587f34SStefano Zampini         }
2967c8587f34SStefano Zampini         ierr = PetscFree(send_buffer);CHKERRQ(ierr);
2968c8587f34SStefano Zampini         break;
2969c8587f34SStefano Zampini       }/* switch on coarse problem and communications associated with finished */
2970c8587f34SStefano Zampini   }
2971c8587f34SStefano Zampini 
2972c8587f34SStefano Zampini   /* Now create and fill up coarse matrix */
2973c8587f34SStefano Zampini   if ( rank_prec_comm == active_rank ) {
2974c8587f34SStefano Zampini 
2975c8587f34SStefano Zampini     Mat matis_coarse_local_mat;
2976c8587f34SStefano Zampini 
2977c8587f34SStefano Zampini     if (pcbddc->coarse_problem_type != MULTILEVEL_BDDC) {
2978c8587f34SStefano Zampini       ierr = MatCreate(coarse_comm,&pcbddc->coarse_mat);CHKERRQ(ierr);
2979983f5fd7SStefano Zampini       ierr = MatSetSizes(pcbddc->coarse_mat,PETSC_DECIDE,PETSC_DECIDE,coarse_size,coarse_size);CHKERRQ(ierr);
2980c8587f34SStefano Zampini       ierr = MatSetType(pcbddc->coarse_mat,coarse_mat_type);CHKERRQ(ierr);
2981c8587f34SStefano Zampini       ierr = MatSetOptionsPrefix(pcbddc->coarse_mat,"coarse_");CHKERRQ(ierr);
2982c8587f34SStefano Zampini       ierr = MatSetFromOptions(pcbddc->coarse_mat);CHKERRQ(ierr);
2983c8587f34SStefano Zampini       ierr = MatSetUp(pcbddc->coarse_mat);CHKERRQ(ierr);
2984c8587f34SStefano Zampini       ierr = MatSetOption(pcbddc->coarse_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr); /* local values stored in column major */
2985c8587f34SStefano Zampini       ierr = MatSetOption(pcbddc->coarse_mat,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr);
2986c8587f34SStefano Zampini     } else {
2987983f5fd7SStefano Zampini       ierr = MatCreateIS(coarse_comm,1,PETSC_DECIDE,PETSC_DECIDE,coarse_size,coarse_size,coarse_ISLG,&pcbddc->coarse_mat);CHKERRQ(ierr);
2988c8587f34SStefano Zampini       ierr = MatSetUp(pcbddc->coarse_mat);CHKERRQ(ierr);
2989c8587f34SStefano Zampini       ierr = MatISGetLocalMat(pcbddc->coarse_mat,&matis_coarse_local_mat);CHKERRQ(ierr);
2990c8587f34SStefano Zampini       ierr = MatSetOptionsPrefix(pcbddc->coarse_mat,"coarse_");CHKERRQ(ierr);
2991c8587f34SStefano Zampini       ierr = MatSetFromOptions(pcbddc->coarse_mat);CHKERRQ(ierr);
2992c8587f34SStefano Zampini       ierr = MatSetUp(matis_coarse_local_mat);CHKERRQ(ierr);
2993c8587f34SStefano Zampini       ierr = MatSetOption(matis_coarse_local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr); /* local values stored in column major */
2994c8587f34SStefano Zampini       ierr = MatSetOption(matis_coarse_local_mat,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr);
2995c8587f34SStefano Zampini     }
2996c8587f34SStefano Zampini     /* preallocation */
2997c8587f34SStefano Zampini     if (pcbddc->coarse_problem_type != MULTILEVEL_BDDC) {
2998c8587f34SStefano Zampini 
2999c8587f34SStefano Zampini       PetscInt lrows,lcols,bs;
3000c8587f34SStefano Zampini 
3001c8587f34SStefano Zampini       ierr = MatGetLocalSize(pcbddc->coarse_mat,&lrows,&lcols);CHKERRQ(ierr);
3002c8587f34SStefano Zampini       ierr = MatPreallocateInitialize(coarse_comm,lrows,lcols,dnz,onz);CHKERRQ(ierr);
3003c8587f34SStefano Zampini       ierr = MatGetBlockSize(pcbddc->coarse_mat,&bs);CHKERRQ(ierr);
3004c8587f34SStefano Zampini 
3005c8587f34SStefano Zampini       if (pcbddc->coarse_problem_type == PARALLEL_BDDC) {
3006c8587f34SStefano Zampini 
3007c8587f34SStefano Zampini         Vec         vec_dnz,vec_onz;
3008c8587f34SStefano Zampini         PetscScalar *my_dnz,*my_onz,*array;
3009c8587f34SStefano Zampini         PetscInt    *mat_ranges,*row_ownership;
3010c8587f34SStefano Zampini         PetscInt    coarse_index_row,coarse_index_col,owner;
3011c8587f34SStefano Zampini 
3012c8587f34SStefano Zampini         ierr = VecCreate(prec_comm,&vec_dnz);CHKERRQ(ierr);
3013c8587f34SStefano Zampini         ierr = VecSetBlockSize(vec_dnz,bs);CHKERRQ(ierr);
3014983f5fd7SStefano Zampini         ierr = VecSetSizes(vec_dnz,PETSC_DECIDE,coarse_size);CHKERRQ(ierr);
3015c8587f34SStefano Zampini         ierr = VecSetType(vec_dnz,VECMPI);CHKERRQ(ierr);
3016c8587f34SStefano Zampini         ierr = VecDuplicate(vec_dnz,&vec_onz);CHKERRQ(ierr);
3017c8587f34SStefano Zampini 
3018c8587f34SStefano Zampini         ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscScalar),&my_dnz);CHKERRQ(ierr);
3019c8587f34SStefano Zampini         ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscScalar),&my_onz);CHKERRQ(ierr);
3020c8587f34SStefano Zampini         ierr = PetscMemzero(my_dnz,pcbddc->local_primal_size*sizeof(PetscScalar));CHKERRQ(ierr);
3021c8587f34SStefano Zampini         ierr = PetscMemzero(my_onz,pcbddc->local_primal_size*sizeof(PetscScalar));CHKERRQ(ierr);
3022c8587f34SStefano Zampini 
3023983f5fd7SStefano Zampini         ierr = PetscMalloc(coarse_size*sizeof(PetscInt),&row_ownership);CHKERRQ(ierr);
3024c8587f34SStefano Zampini         ierr = MatGetOwnershipRanges(pcbddc->coarse_mat,(const PetscInt**)&mat_ranges);CHKERRQ(ierr);
3025c8587f34SStefano Zampini         for (i=0;i<size_prec_comm;i++) {
3026c8587f34SStefano Zampini           for (j=mat_ranges[i];j<mat_ranges[i+1];j++) {
3027c8587f34SStefano Zampini             row_ownership[j]=i;
3028c8587f34SStefano Zampini           }
3029c8587f34SStefano Zampini         }
3030c8587f34SStefano Zampini 
3031c8587f34SStefano Zampini         for (i=0;i<pcbddc->local_primal_size;i++) {
3032c8587f34SStefano Zampini           coarse_index_row = pcbddc->local_primal_indices[i];
3033c8587f34SStefano Zampini           owner = row_ownership[coarse_index_row];
3034c8587f34SStefano Zampini           for (j=i;j<pcbddc->local_primal_size;j++) {
3035c8587f34SStefano Zampini             owner = row_ownership[coarse_index_row];
3036c8587f34SStefano Zampini             coarse_index_col = pcbddc->local_primal_indices[j];
3037c8587f34SStefano Zampini             if (coarse_index_col > mat_ranges[owner]-1 && coarse_index_col < mat_ranges[owner+1] ) {
3038c8587f34SStefano Zampini               my_dnz[i] += 1.0;
3039c8587f34SStefano Zampini             } else {
3040c8587f34SStefano Zampini               my_onz[i] += 1.0;
3041c8587f34SStefano Zampini             }
3042c8587f34SStefano Zampini             if (i != j) {
3043c8587f34SStefano Zampini               owner = row_ownership[coarse_index_col];
3044c8587f34SStefano Zampini               if (coarse_index_row > mat_ranges[owner]-1 && coarse_index_row < mat_ranges[owner+1] ) {
3045c8587f34SStefano Zampini                 my_dnz[j] += 1.0;
3046c8587f34SStefano Zampini               } else {
3047c8587f34SStefano Zampini                 my_onz[j] += 1.0;
3048c8587f34SStefano Zampini               }
3049c8587f34SStefano Zampini             }
3050c8587f34SStefano Zampini           }
3051c8587f34SStefano Zampini         }
3052c8587f34SStefano Zampini         ierr = VecSet(vec_dnz,0.0);CHKERRQ(ierr);
3053c8587f34SStefano Zampini         ierr = VecSet(vec_onz,0.0);CHKERRQ(ierr);
3054c8587f34SStefano Zampini         if (pcbddc->local_primal_size) {
3055c8587f34SStefano Zampini           ierr = VecSetValues(vec_dnz,pcbddc->local_primal_size,pcbddc->local_primal_indices,my_dnz,ADD_VALUES);CHKERRQ(ierr);
3056c8587f34SStefano Zampini           ierr = VecSetValues(vec_onz,pcbddc->local_primal_size,pcbddc->local_primal_indices,my_onz,ADD_VALUES);CHKERRQ(ierr);
3057c8587f34SStefano Zampini         }
3058c8587f34SStefano Zampini         ierr = VecAssemblyBegin(vec_dnz);CHKERRQ(ierr);
3059c8587f34SStefano Zampini         ierr = VecAssemblyBegin(vec_onz);CHKERRQ(ierr);
3060c8587f34SStefano Zampini         ierr = VecAssemblyEnd(vec_dnz);CHKERRQ(ierr);
3061c8587f34SStefano Zampini         ierr = VecAssemblyEnd(vec_onz);CHKERRQ(ierr);
3062c8587f34SStefano Zampini         j = mat_ranges[rank_prec_comm+1]-mat_ranges[rank_prec_comm];
3063c8587f34SStefano Zampini         ierr = VecGetArray(vec_dnz,&array);CHKERRQ(ierr);
3064c8587f34SStefano Zampini         for (i=0; i<j; i++) dnz[i] = (PetscInt)PetscRealPart(array[i]);
3065c8587f34SStefano Zampini 
3066c8587f34SStefano Zampini         ierr = VecRestoreArray(vec_dnz,&array);CHKERRQ(ierr);
3067c8587f34SStefano Zampini         ierr = VecGetArray(vec_onz,&array);CHKERRQ(ierr);
3068c8587f34SStefano Zampini         for (i=0;i<j;i++) onz[i] = (PetscInt)PetscRealPart(array[i]);
3069c8587f34SStefano Zampini 
3070c8587f34SStefano Zampini         ierr = VecRestoreArray(vec_onz,&array);CHKERRQ(ierr);
3071c8587f34SStefano Zampini         ierr = PetscFree(my_dnz);CHKERRQ(ierr);
3072c8587f34SStefano Zampini         ierr = PetscFree(my_onz);CHKERRQ(ierr);
3073c8587f34SStefano Zampini         ierr = PetscFree(row_ownership);CHKERRQ(ierr);
3074c8587f34SStefano Zampini         ierr = VecDestroy(&vec_dnz);CHKERRQ(ierr);
3075c8587f34SStefano Zampini         ierr = VecDestroy(&vec_onz);CHKERRQ(ierr);
3076c8587f34SStefano Zampini       } else {
3077c8587f34SStefano Zampini         for (k=0;k<size_prec_comm;k++){
3078c8587f34SStefano Zampini           offset=pcbddc->local_primal_displacements[k];
3079c8587f34SStefano Zampini           offset2=localdispl2[k];
3080c8587f34SStefano Zampini           ins_local_primal_size = pcbddc->local_primal_sizes[k];
3081c8587f34SStefano Zampini           ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr);
3082c8587f34SStefano Zampini           for (j=0;j<ins_local_primal_size;j++){
3083c8587f34SStefano Zampini             ins_local_primal_indices[j]=(PetscInt)pcbddc->replicated_local_primal_indices[offset+j];
3084c8587f34SStefano Zampini           }
3085c8587f34SStefano Zampini           for (j=0;j<ins_local_primal_size;j++) {
3086c8587f34SStefano Zampini             ierr = MatPreallocateSet(ins_local_primal_indices[j],ins_local_primal_size,ins_local_primal_indices,dnz,onz);CHKERRQ(ierr);
3087c8587f34SStefano Zampini           }
3088c8587f34SStefano Zampini           ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr);
3089c8587f34SStefano Zampini         }
3090c8587f34SStefano Zampini       }
3091c8587f34SStefano Zampini 
3092c8587f34SStefano Zampini       /* check */
3093c8587f34SStefano Zampini       for (i=0;i<lrows;i++) {
3094c8587f34SStefano Zampini         if (dnz[i]>lcols) dnz[i]=lcols;
3095983f5fd7SStefano Zampini         if (onz[i]>coarse_size-lcols) onz[i]=coarse_size-lcols;
3096c8587f34SStefano Zampini       }
3097c8587f34SStefano Zampini       ierr = MatSeqAIJSetPreallocation(pcbddc->coarse_mat,0,dnz);CHKERRQ(ierr);
3098c8587f34SStefano Zampini       ierr = MatMPIAIJSetPreallocation(pcbddc->coarse_mat,0,dnz,0,onz);CHKERRQ(ierr);
3099c8587f34SStefano Zampini       ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
3100c8587f34SStefano Zampini     } else {
3101c8587f34SStefano Zampini       ierr = MatSeqAIJSetPreallocation(matis_coarse_local_mat,0,dnz);CHKERRQ(ierr);
3102c8587f34SStefano Zampini       ierr = PetscFree(dnz);CHKERRQ(ierr);
3103c8587f34SStefano Zampini     }
3104c8587f34SStefano Zampini     /* insert values */
3105c8587f34SStefano Zampini     if (pcbddc->coarse_problem_type == PARALLEL_BDDC) {
3106c8587f34SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_mat,ins_local_primal_size,ins_local_primal_indices,ins_local_primal_size,ins_local_primal_indices,ins_coarse_mat_vals,ADD_VALUES);CHKERRQ(ierr);
3107c8587f34SStefano Zampini     } else if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
3108c8587f34SStefano Zampini       if (pcbddc->coarsening_ratio == 1) {
3109c8587f34SStefano Zampini         ins_coarse_mat_vals = coarse_submat_vals;
3110c8587f34SStefano Zampini         ierr = MatSetValues(pcbddc->coarse_mat,ins_local_primal_size,ins_local_primal_indices,ins_local_primal_size,ins_local_primal_indices,ins_coarse_mat_vals,INSERT_VALUES);CHKERRQ(ierr);
3111c8587f34SStefano Zampini       } else {
3112c8587f34SStefano Zampini         ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr);
3113c8587f34SStefano Zampini         for (k=0;k<pcbddc->replicated_primal_size;k++) {
3114c8587f34SStefano Zampini           offset = pcbddc->local_primal_displacements[k];
3115c8587f34SStefano Zampini           offset2 = localdispl2[k];
3116c8587f34SStefano Zampini           ins_local_primal_size = pcbddc->local_primal_displacements[k+1]-pcbddc->local_primal_displacements[k];
3117c8587f34SStefano Zampini           ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr);
3118c8587f34SStefano Zampini           for (j=0;j<ins_local_primal_size;j++){
3119c8587f34SStefano Zampini             ins_local_primal_indices[j]=(PetscInt)pcbddc->replicated_local_primal_indices[offset+j];
3120c8587f34SStefano Zampini           }
3121c8587f34SStefano Zampini           ins_coarse_mat_vals = &temp_coarse_mat_vals[offset2];
3122c8587f34SStefano Zampini           ierr = MatSetValues(pcbddc->coarse_mat,ins_local_primal_size,ins_local_primal_indices,ins_local_primal_size,ins_local_primal_indices,ins_coarse_mat_vals,ADD_VALUES);CHKERRQ(ierr);
3123c8587f34SStefano Zampini           ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr);
3124c8587f34SStefano Zampini         }
3125c8587f34SStefano Zampini       }
3126c8587f34SStefano Zampini       ins_local_primal_indices = 0;
3127c8587f34SStefano Zampini       ins_coarse_mat_vals = 0;
3128c8587f34SStefano Zampini     } else {
3129c8587f34SStefano Zampini       for (k=0;k<size_prec_comm;k++){
3130c8587f34SStefano Zampini         offset=pcbddc->local_primal_displacements[k];
3131c8587f34SStefano Zampini         offset2=localdispl2[k];
3132c8587f34SStefano Zampini         ins_local_primal_size = pcbddc->local_primal_sizes[k];
3133c8587f34SStefano Zampini         ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr);
3134c8587f34SStefano Zampini         for (j=0;j<ins_local_primal_size;j++){
3135c8587f34SStefano Zampini           ins_local_primal_indices[j]=(PetscInt)pcbddc->replicated_local_primal_indices[offset+j];
3136c8587f34SStefano Zampini         }
3137c8587f34SStefano Zampini         ins_coarse_mat_vals = &temp_coarse_mat_vals[offset2];
3138c8587f34SStefano Zampini         ierr = MatSetValues(pcbddc->coarse_mat,ins_local_primal_size,ins_local_primal_indices,ins_local_primal_size,ins_local_primal_indices,ins_coarse_mat_vals,ADD_VALUES);CHKERRQ(ierr);
3139c8587f34SStefano Zampini         ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr);
3140c8587f34SStefano Zampini       }
3141c8587f34SStefano Zampini       ins_local_primal_indices = 0;
3142c8587f34SStefano Zampini       ins_coarse_mat_vals = 0;
3143c8587f34SStefano Zampini     }
3144c8587f34SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3145c8587f34SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3146c8587f34SStefano Zampini     /* symmetry of coarse matrix */
3147c8587f34SStefano Zampini     if (issym) {
3148c8587f34SStefano Zampini       ierr = MatSetOption(pcbddc->coarse_mat,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
3149c8587f34SStefano Zampini     }
3150c8587f34SStefano Zampini     ierr = MatGetVecs(pcbddc->coarse_mat,&pcbddc->coarse_vec,&pcbddc->coarse_rhs);CHKERRQ(ierr);
3151c8587f34SStefano Zampini   }
3152c8587f34SStefano Zampini 
3153c8587f34SStefano Zampini   /* create loc to glob scatters if needed */
3154c8587f34SStefano Zampini   if (pcbddc->coarse_communications_type == SCATTERS_BDDC) {
3155c8587f34SStefano Zampini      IS local_IS,global_IS;
3156c8587f34SStefano Zampini      ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size,0,1,&local_IS);CHKERRQ(ierr);
3157c8587f34SStefano Zampini      ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_indices,PETSC_COPY_VALUES,&global_IS);CHKERRQ(ierr);
3158c8587f34SStefano Zampini      ierr = VecScatterCreate(pcbddc->vec1_P,local_IS,pcbddc->coarse_vec,global_IS,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3159c8587f34SStefano Zampini      ierr = ISDestroy(&local_IS);CHKERRQ(ierr);
3160c8587f34SStefano Zampini      ierr = ISDestroy(&global_IS);CHKERRQ(ierr);
3161c8587f34SStefano Zampini   }
3162c8587f34SStefano Zampini 
3163c8587f34SStefano Zampini   /* free memory no longer needed */
3164c8587f34SStefano Zampini   if (coarse_ISLG)              { ierr = ISLocalToGlobalMappingDestroy(&coarse_ISLG);CHKERRQ(ierr); }
3165c8587f34SStefano Zampini   if (ins_local_primal_indices) { ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr); }
3166c8587f34SStefano Zampini   if (ins_coarse_mat_vals)      { ierr = PetscFree(ins_coarse_mat_vals);CHKERRQ(ierr); }
3167c8587f34SStefano Zampini   if (localsizes2)              { ierr = PetscFree(localsizes2);CHKERRQ(ierr); }
3168c8587f34SStefano Zampini   if (localdispl2)              { ierr = PetscFree(localdispl2);CHKERRQ(ierr); }
3169c8587f34SStefano Zampini   if (temp_coarse_mat_vals)     { ierr = PetscFree(temp_coarse_mat_vals);CHKERRQ(ierr); }
3170c8587f34SStefano Zampini 
3171c8587f34SStefano Zampini   /* Compute coarse null space */
3172c8587f34SStefano Zampini   CoarseNullSpace = 0;
3173c8587f34SStefano Zampini   if (pcbddc->NullSpace) {
3174c8587f34SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCoarse(pc,&CoarseNullSpace);CHKERRQ(ierr);
3175c8587f34SStefano Zampini   }
3176c8587f34SStefano Zampini 
3177c8587f34SStefano Zampini   /* KSP for coarse problem */
3178c8587f34SStefano Zampini   if (rank_prec_comm == active_rank) {
3179c8587f34SStefano Zampini     PetscBool isbddc=PETSC_FALSE;
3180c8587f34SStefano Zampini 
3181c8587f34SStefano Zampini     ierr = KSPCreate(coarse_comm,&pcbddc->coarse_ksp);CHKERRQ(ierr);
3182c8587f34SStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
3183c8587f34SStefano Zampini     ierr = KSPSetOperators(pcbddc->coarse_ksp,pcbddc->coarse_mat,pcbddc->coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
3184c8587f34SStefano Zampini     ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,max_it_coarse_ksp);CHKERRQ(ierr);
3185c8587f34SStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
3186c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3187c8587f34SStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
3188c8587f34SStefano Zampini     /* Allow user's customization */
3189c8587f34SStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,"coarse_");CHKERRQ(ierr);
3190c8587f34SStefano Zampini     /* Set Up PC for coarse problem BDDC */
3191c8587f34SStefano Zampini     if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
3192c8587f34SStefano Zampini       i = pcbddc->current_level+1;
3193c8587f34SStefano Zampini       ierr = PCBDDCSetLevel(pc_temp,i);CHKERRQ(ierr);
3194c8587f34SStefano Zampini       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
3195c8587f34SStefano Zampini       ierr = PCBDDCSetMaxLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
3196c8587f34SStefano Zampini       ierr = PCBDDCSetCoarseProblemType(pc_temp,MULTILEVEL_BDDC);CHKERRQ(ierr);
3197c8587f34SStefano Zampini       if (CoarseNullSpace) {
3198c8587f34SStefano Zampini         ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
3199c8587f34SStefano Zampini       }
3200c8587f34SStefano Zampini       if (dbg_flag) {
3201c8587f34SStefano Zampini         ierr = PetscViewerASCIIPrintf(viewer,"----------------Level %d: Setting up level %d---------------\n",pcbddc->current_level,i);CHKERRQ(ierr);
3202c8587f34SStefano Zampini         ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
3203c8587f34SStefano Zampini       }
3204c8587f34SStefano Zampini     } else {
3205c8587f34SStefano Zampini       if (CoarseNullSpace) {
3206c8587f34SStefano Zampini         ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
3207c8587f34SStefano Zampini       }
3208c8587f34SStefano Zampini     }
3209c8587f34SStefano Zampini     ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
3210c8587f34SStefano Zampini     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
3211c8587f34SStefano Zampini 
3212c8587f34SStefano Zampini     ierr = KSPGetTolerances(pcbddc->coarse_ksp,NULL,NULL,NULL,&j);CHKERRQ(ierr);
3213c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3214c8587f34SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
3215c8587f34SStefano Zampini     if (j == 1) {
3216c8587f34SStefano Zampini       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
3217c8587f34SStefano Zampini       if (isbddc) {
3218c8587f34SStefano Zampini         ierr = PCBDDCSetUseExactDirichlet(pc_temp,PETSC_FALSE);CHKERRQ(ierr);
3219c8587f34SStefano Zampini       }
3220c8587f34SStefano Zampini     }
3221c8587f34SStefano Zampini   }
3222c8587f34SStefano Zampini   /* Check coarse problem if requested */
3223c8587f34SStefano Zampini   if ( dbg_flag && rank_prec_comm == active_rank ) {
3224c8587f34SStefano Zampini     KSP check_ksp;
3225c8587f34SStefano Zampini     PC  check_pc;
3226c8587f34SStefano Zampini     Vec check_vec;
3227c8587f34SStefano Zampini     PetscReal   abs_infty_error,infty_error,lambda_min,lambda_max;
3228c8587f34SStefano Zampini     KSPType check_ksp_type;
3229c8587f34SStefano Zampini 
3230c8587f34SStefano Zampini     /* Create ksp object suitable for extreme eigenvalues' estimation */
3231c8587f34SStefano Zampini     ierr = KSPCreate(coarse_comm,&check_ksp);CHKERRQ(ierr);
3232c8587f34SStefano Zampini     ierr = KSPSetOperators(check_ksp,pcbddc->coarse_mat,pcbddc->coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
3233983f5fd7SStefano Zampini     ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,coarse_size);CHKERRQ(ierr);
3234c8587f34SStefano Zampini     if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
3235c8587f34SStefano Zampini       if (issym) check_ksp_type = KSPCG;
3236c8587f34SStefano Zampini       else check_ksp_type = KSPGMRES;
3237c8587f34SStefano Zampini       ierr = KSPSetComputeSingularValues(check_ksp,PETSC_TRUE);CHKERRQ(ierr);
3238c8587f34SStefano Zampini     } else {
3239c8587f34SStefano Zampini       check_ksp_type = KSPPREONLY;
3240c8587f34SStefano Zampini     }
3241c8587f34SStefano Zampini     ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
3242c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
3243c8587f34SStefano Zampini     ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
3244c8587f34SStefano Zampini     ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
3245c8587f34SStefano Zampini     /* create random vec */
3246c8587f34SStefano Zampini     ierr = VecDuplicate(pcbddc->coarse_vec,&check_vec);CHKERRQ(ierr);
3247c8587f34SStefano Zampini     ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
3248c8587f34SStefano Zampini     if (CoarseNullSpace) {
3249c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec);CHKERRQ(ierr);
3250c8587f34SStefano Zampini     }
3251c8587f34SStefano Zampini     ierr = MatMult(pcbddc->coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3252c8587f34SStefano Zampini     /* solve coarse problem */
3253c8587f34SStefano Zampini     ierr = KSPSolve(check_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
3254c8587f34SStefano Zampini     if (CoarseNullSpace) {
3255c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,pcbddc->coarse_vec);CHKERRQ(ierr);
3256c8587f34SStefano Zampini     }
3257c8587f34SStefano Zampini     /* check coarse problem residual error */
3258c8587f34SStefano Zampini     ierr = VecAXPY(check_vec,-1.0,pcbddc->coarse_vec);CHKERRQ(ierr);
3259c8587f34SStefano Zampini     ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3260c8587f34SStefano Zampini     ierr = MatMult(pcbddc->coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3261c8587f34SStefano Zampini     ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
3262c8587f34SStefano Zampini     ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
3263c8587f34SStefano Zampini     /* get eigenvalue estimation if inexact */
3264c8587f34SStefano Zampini     if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
3265c8587f34SStefano Zampini       ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
3266c8587f34SStefano Zampini       ierr = KSPGetIterationNumber(check_ksp,&k);CHKERRQ(ierr);
3267c8587f34SStefano Zampini       ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem eigenvalues estimated with %d iterations of %s.\n",k,check_ksp_type);CHKERRQ(ierr);
3268c8587f34SStefano Zampini       ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem eigenvalues: % 1.14e %1.14e\n",lambda_min,lambda_max);CHKERRQ(ierr);
3269c8587f34SStefano Zampini     }
3270c8587f34SStefano Zampini     ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem exact infty_error   : %1.14e\n",infty_error);CHKERRQ(ierr);
3271c8587f34SStefano Zampini     ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem residual infty_error: %1.14e\n",abs_infty_error);CHKERRQ(ierr);
3272c8587f34SStefano Zampini     ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
3273c8587f34SStefano Zampini   }
3274c8587f34SStefano Zampini   if (dbg_flag) {
3275c8587f34SStefano Zampini     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
3276c8587f34SStefano Zampini   }
3277c8587f34SStefano Zampini   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
3278c8587f34SStefano Zampini 
3279c8587f34SStefano Zampini   PetscFunctionReturn(0);
3280c8587f34SStefano Zampini }
32819a7d3425SStefano Zampini 
3282