xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision c8587f3400bb52e8a0bc75c0376dec77962410ff)
1674ae819SStefano Zampini #include "bddc.h"
2674ae819SStefano Zampini #include "bddcprivate.h"
3674ae819SStefano Zampini #include <petscblaslapack.h>
4674ae819SStefano Zampini 
5674ae819SStefano Zampini #undef __FUNCT__
6*c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpSolvers"
7*c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpSolvers(PC pc)
8*c8587f34SStefano Zampini {
9*c8587f34SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
10*c8587f34SStefano Zampini   PetscErrorCode    ierr;
11*c8587f34SStefano Zampini 
12*c8587f34SStefano Zampini   PetscFunctionBegin;
13*c8587f34SStefano Zampini   /* Compute matrix after change of basis and extract local submatrices */
14*c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalMatrices(pc);CHKERRQ(ierr);
15*c8587f34SStefano Zampini 
16*c8587f34SStefano Zampini   /* Allocate needed vectors */
17*c8587f34SStefano Zampini   ierr = PCBDDCCreateWorkVectors(pc);CHKERRQ(ierr);
18*c8587f34SStefano Zampini 
19*c8587f34SStefano Zampini   /* Setup local scatters R_to_B and (optionally) R_to_D : PCBDDCCreateWorkVectors should be called first! */
20*c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
21*c8587f34SStefano Zampini 
22*c8587f34SStefano Zampini   /* Setup local solvers ksp_D and ksp_R */
23*c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalSolvers(pc);CHKERRQ(ierr);
24*c8587f34SStefano Zampini 
25*c8587f34SStefano Zampini   /* Change global null space passed in by the user if change of basis has been requested */
26*c8587f34SStefano Zampini   if (pcbddc->NullSpace && pcbddc->use_change_of_basis) {
27*c8587f34SStefano Zampini     ierr = PCBDDCNullSpaceAdaptGlobal(pc);CHKERRQ(ierr);
28*c8587f34SStefano Zampini   }
29*c8587f34SStefano Zampini 
30*c8587f34SStefano Zampini   /* setup local correction and local part of coarse basis */
31*c8587f34SStefano Zampini   ierr = PCBDDCSetUpCoarseLocal(pc);CHKERRQ(ierr);
32*c8587f34SStefano Zampini   PetscFunctionReturn(0);
33*c8587f34SStefano Zampini }
34*c8587f34SStefano Zampini 
35*c8587f34SStefano Zampini #undef __FUNCT__
36a401a8b6SStefano Zampini #define __FUNCT__ "PCBDDCSetLevel"
37a401a8b6SStefano Zampini PetscErrorCode PCBDDCSetLevel(PC pc,PetscInt level)
38a401a8b6SStefano Zampini {
39a401a8b6SStefano Zampini   PC_BDDC  *pcbddc = (PC_BDDC*)pc->data;
40a401a8b6SStefano Zampini 
41a401a8b6SStefano Zampini   PetscFunctionBegin;
42a401a8b6SStefano Zampini   pcbddc->current_level=level;
43a401a8b6SStefano Zampini   PetscFunctionReturn(0);
44a401a8b6SStefano Zampini }
45a401a8b6SStefano Zampini 
46a401a8b6SStefano Zampini #undef __FUNCT__
47674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetCustomization"
48674ae819SStefano Zampini PetscErrorCode PCBDDCResetCustomization(PC pc)
49674ae819SStefano Zampini {
50674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
51674ae819SStefano Zampini   PetscInt       i;
52674ae819SStefano Zampini   PetscErrorCode ierr;
53674ae819SStefano Zampini 
54674ae819SStefano Zampini   PetscFunctionBegin;
55674ae819SStefano Zampini   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
56674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
57674ae819SStefano Zampini   ierr = MatNullSpaceDestroy(&pcbddc->NullSpace);CHKERRQ(ierr);
58674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
59674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
60674ae819SStefano Zampini   for (i=0;i<pcbddc->n_ISForDofs;i++) {
61674ae819SStefano Zampini     ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
62674ae819SStefano Zampini   }
63674ae819SStefano Zampini   ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
64674ae819SStefano Zampini   PetscFunctionReturn(0);
65674ae819SStefano Zampini }
66674ae819SStefano Zampini 
67674ae819SStefano Zampini #undef __FUNCT__
68674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetTopography"
69674ae819SStefano Zampini PetscErrorCode PCBDDCResetTopography(PC pc)
70674ae819SStefano Zampini {
71674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
72674ae819SStefano Zampini   PetscErrorCode ierr;
73674ae819SStefano Zampini 
74674ae819SStefano Zampini   PetscFunctionBegin;
75674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
76674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
77674ae819SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
78674ae819SStefano Zampini   PetscFunctionReturn(0);
79674ae819SStefano Zampini }
80674ae819SStefano Zampini 
81674ae819SStefano Zampini #undef __FUNCT__
82674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetSolvers"
83674ae819SStefano Zampini PetscErrorCode PCBDDCResetSolvers(PC pc)
84674ae819SStefano Zampini {
85674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
86674ae819SStefano Zampini   PetscErrorCode ierr;
87674ae819SStefano Zampini 
88674ae819SStefano Zampini   PetscFunctionBegin;
89674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
90674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_rhs);CHKERRQ(ierr);
91674ae819SStefano Zampini   ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
92674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_mat);CHKERRQ(ierr);
93674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
94674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
9515aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
9615aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
97674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
98674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
99674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
100674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
101674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
102674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
103674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec4_D);CHKERRQ(ierr);
1048ce42a96SStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
105674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
106674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
107674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
108674ae819SStefano Zampini   ierr = PetscFree(pcbddc->local_primal_indices);CHKERRQ(ierr);
109674ae819SStefano Zampini   ierr = PetscFree(pcbddc->replicated_local_primal_indices);CHKERRQ(ierr);
110674ae819SStefano Zampini   ierr = PetscFree(pcbddc->replicated_local_primal_values);CHKERRQ(ierr);
111674ae819SStefano Zampini   ierr = PetscFree(pcbddc->local_primal_displacements);CHKERRQ(ierr);
112674ae819SStefano Zampini   ierr = PetscFree(pcbddc->local_primal_sizes);CHKERRQ(ierr);
113674ae819SStefano Zampini   PetscFunctionReturn(0);
114674ae819SStefano Zampini }
115674ae819SStefano Zampini 
116674ae819SStefano Zampini #undef __FUNCT__
1176bfb1811SStefano Zampini #define __FUNCT__ "PCBDDCCreateWorkVectors"
1186bfb1811SStefano Zampini PetscErrorCode PCBDDCCreateWorkVectors(PC pc)
1196bfb1811SStefano Zampini {
1206bfb1811SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1216bfb1811SStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
1226bfb1811SStefano Zampini   VecType        impVecType;
1236bfb1811SStefano Zampini   PetscInt       n_vertices,n_constraints,local_primal_size,n_R;
1246bfb1811SStefano Zampini   PetscErrorCode ierr;
1256bfb1811SStefano Zampini 
1266bfb1811SStefano Zampini   PetscFunctionBegin;
1276bfb1811SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,NULL);CHKERRQ(ierr);
1286bfb1811SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&n_constraints,NULL);CHKERRQ(ierr);
1296bfb1811SStefano Zampini   local_primal_size = n_constraints+n_vertices;
1306bfb1811SStefano Zampini   n_R = pcis->n-n_vertices;
1316bfb1811SStefano Zampini   /* local work vectors */
1326bfb1811SStefano Zampini   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
1336bfb1811SStefano Zampini   ierr = VecDuplicate(pcis->vec1_D,&pcbddc->vec4_D);CHKERRQ(ierr);
1346bfb1811SStefano Zampini   ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
1356bfb1811SStefano Zampini   ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
1366bfb1811SStefano Zampini   ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
1376bfb1811SStefano Zampini   ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
13883b7ccabSStefano Zampini   ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
1396bfb1811SStefano Zampini   ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,local_primal_size);CHKERRQ(ierr);
1406bfb1811SStefano Zampini   ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
14183b7ccabSStefano Zampini   if (n_constraints) {
14283b7ccabSStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
14383b7ccabSStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
14483b7ccabSStefano Zampini     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
14583b7ccabSStefano Zampini   }
1466bfb1811SStefano Zampini   PetscFunctionReturn(0);
1476bfb1811SStefano Zampini }
1486bfb1811SStefano Zampini 
1496bfb1811SStefano Zampini #undef __FUNCT__
1504a78082cSStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseLocal"
1518ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpCoarseLocal(PC pc)
15288ebb749SStefano Zampini {
15325084f0cSStefano Zampini   PetscErrorCode         ierr;
15425084f0cSStefano Zampini   /* pointers to pcis and pcbddc */
15588ebb749SStefano Zampini   PC_IS*                 pcis = (PC_IS*)pc->data;
15688ebb749SStefano Zampini   PC_BDDC*               pcbddc = (PC_BDDC*)pc->data;
15725084f0cSStefano Zampini   /* submatrices of local problem */
15888ebb749SStefano Zampini   Mat                    A_RV,A_VR,A_VV;
15925084f0cSStefano Zampini   /* working matrices */
16025084f0cSStefano Zampini   Mat                    M1,M2,M3,C_CR;
16125084f0cSStefano Zampini   /* working vectors */
16225084f0cSStefano Zampini   Vec                    vec1_C,vec2_C,vec1_V,vec2_V;
16325084f0cSStefano Zampini   /* additional working stuff */
16425084f0cSStefano Zampini   IS                     is_aux;
16588ebb749SStefano Zampini   ISLocalToGlobalMapping BtoNmap;
16625084f0cSStefano Zampini   PetscScalar            *coarse_submat_vals; /* TODO: use a PETSc matrix */
16725084f0cSStefano Zampini   const PetscScalar      *array,*row_cmat_values;
16825084f0cSStefano Zampini   const PetscInt         *row_cmat_indices,*idx_R_local;
16925084f0cSStefano Zampini   PetscInt               *vertices,*idx_V_B,*auxindices;
17025084f0cSStefano Zampini   PetscInt               n_vertices,n_constraints,size_of_constraint;
17125084f0cSStefano Zampini   PetscInt               i,j,n_R,n_D,n_B;
17288ebb749SStefano Zampini   PetscBool              setsym=PETSC_FALSE,issym=PETSC_FALSE;
17325084f0cSStefano Zampini   /* Vector and matrix types */
17488ebb749SStefano Zampini   VecType                impVecType;
17588ebb749SStefano Zampini   MatType                impMatType;
17625084f0cSStefano Zampini   /* some shortcuts to scalars */
17725084f0cSStefano Zampini   PetscScalar            zero=0.0,one=1.0,m_one=-1.0;
17825084f0cSStefano Zampini   /* for debugging purposes */
17988ebb749SStefano Zampini   PetscReal              *coarsefunctions_errors,*constraints_errors;
18088ebb749SStefano Zampini 
18188ebb749SStefano Zampini   PetscFunctionBegin;
18225084f0cSStefano Zampini   /* get number of vertices and their local indices */
18325084f0cSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
18488ebb749SStefano Zampini   n_constraints = pcbddc->local_primal_size-n_vertices;
18588ebb749SStefano Zampini   /* Set Non-overlapping dimensions */
18688ebb749SStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
18788ebb749SStefano Zampini   n_R = pcis->n-n_vertices;
18888ebb749SStefano Zampini 
18988ebb749SStefano Zampini   /* Set types for local objects needed by BDDC precondtioner */
19088ebb749SStefano Zampini   impMatType = MATSEQDENSE;
19125084f0cSStefano Zampini   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
19288ebb749SStefano Zampini 
19388ebb749SStefano Zampini   /* Allocating some extra storage just to be safe */
19488ebb749SStefano Zampini   ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&auxindices);CHKERRQ(ierr);
19588ebb749SStefano Zampini   for (i=0;i<pcis->n;i++) auxindices[i]=i;
19688ebb749SStefano Zampini 
19788ebb749SStefano Zampini   /* vertices in boundary numbering */
19888ebb749SStefano Zampini   ierr = PetscMalloc(n_vertices*sizeof(PetscInt),&idx_V_B);CHKERRQ(ierr);
19988ebb749SStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(pcis->is_B_local,&BtoNmap);CHKERRQ(ierr);
20088ebb749SStefano Zampini   ierr = ISGlobalToLocalMappingApply(BtoNmap,IS_GTOLM_DROP,n_vertices,vertices,&i,idx_V_B);CHKERRQ(ierr);
20188ebb749SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&BtoNmap);CHKERRQ(ierr);
20288ebb749SStefano Zampini   if (i != n_vertices) {
20388ebb749SStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %d != %d\n",n_vertices,i);
20488ebb749SStefano Zampini   }
20588ebb749SStefano Zampini 
20688ebb749SStefano Zampini   /* some work vectors on vertices and/or constraints */
20788ebb749SStefano Zampini   if (n_vertices) {
20888ebb749SStefano Zampini     ierr = VecCreate(PETSC_COMM_SELF,&vec1_V);CHKERRQ(ierr);
20988ebb749SStefano Zampini     ierr = VecSetSizes(vec1_V,n_vertices,n_vertices);CHKERRQ(ierr);
21088ebb749SStefano Zampini     ierr = VecSetType(vec1_V,impVecType);CHKERRQ(ierr);
21188ebb749SStefano Zampini     ierr = VecDuplicate(vec1_V,&vec2_V);CHKERRQ(ierr);
21288ebb749SStefano Zampini   }
21388ebb749SStefano Zampini   if (n_constraints) {
21488ebb749SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec1_C);CHKERRQ(ierr);
21588ebb749SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec2_C);CHKERRQ(ierr);
21688ebb749SStefano Zampini   }
21725084f0cSStefano Zampini 
21888ebb749SStefano Zampini   /* Precompute stuffs needed for preprocessing and application of BDDC*/
21988ebb749SStefano Zampini   if (n_constraints) {
22088ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->local_auxmat2);CHKERRQ(ierr);
22125084f0cSStefano Zampini     ierr = MatSetSizes(pcbddc->local_auxmat2,n_R,n_constraints,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
22288ebb749SStefano Zampini     ierr = MatSetType(pcbddc->local_auxmat2,impMatType);CHKERRQ(ierr);
22325084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->local_auxmat2);CHKERRQ(ierr);
22488ebb749SStefano Zampini 
22525084f0cSStefano Zampini     /* Extract constraints on R nodes: C_{CR}  */
22625084f0cSStefano Zampini     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
2278ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
22825084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
22988ebb749SStefano Zampini 
23088ebb749SStefano Zampini     /* Assemble local_auxmat2 = - A_{RR}^{-1} C^T_{CR} needed by BDDC application */
23188ebb749SStefano Zampini     for (i=0;i<n_constraints;i++) {
23288ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
23388ebb749SStefano Zampini       /* Get row of constraint matrix in R numbering */
23425084f0cSStefano Zampini       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
23525084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_R,size_of_constraint,row_cmat_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
23625084f0cSStefano Zampini       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
23725084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_R);CHKERRQ(ierr);
23825084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_R);CHKERRQ(ierr);
23988ebb749SStefano Zampini       /* Solve for row of constraint matrix in R numbering */
24088ebb749SStefano Zampini       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
24125084f0cSStefano Zampini       /* Set values in local_auxmat2 */
24225084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
24388ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->local_auxmat2,n_R,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
24425084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
24588ebb749SStefano Zampini     }
24688ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
24788ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
24825084f0cSStefano Zampini     ierr = MatScale(pcbddc->local_auxmat2,m_one);CHKERRQ(ierr);
24988ebb749SStefano Zampini 
25088ebb749SStefano Zampini     /* Assemble explicitly M1 = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1} needed in preproc  */
25125084f0cSStefano Zampini     ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
25225084f0cSStefano Zampini     ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
25388ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&M1);CHKERRQ(ierr);
25488ebb749SStefano Zampini     ierr = MatSetSizes(M1,n_constraints,n_constraints,n_constraints,n_constraints);CHKERRQ(ierr);
25588ebb749SStefano Zampini     ierr = MatSetType(M1,impMatType);CHKERRQ(ierr);
25625084f0cSStefano Zampini     ierr = MatSetUp(M1);CHKERRQ(ierr);
25725084f0cSStefano Zampini     ierr = MatDuplicate(M1,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
25825084f0cSStefano Zampini     ierr = MatZeroEntries(M2);CHKERRQ(ierr);
25925084f0cSStefano Zampini     ierr = VecSet(vec1_C,m_one);CHKERRQ(ierr);
26025084f0cSStefano Zampini     ierr = MatDiagonalSet(M2,vec1_C,INSERT_VALUES);CHKERRQ(ierr);
26125084f0cSStefano Zampini     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
26225084f0cSStefano Zampini     ierr = MatDestroy(&M2);CHKERRQ(ierr);
26325084f0cSStefano Zampini     ierr = MatDestroy(&M3);CHKERRQ(ierr);
26488ebb749SStefano Zampini     /* Assemble local_auxmat1 = M1*C_{CR} needed by BDDC application in KSP and in preproc */
26588ebb749SStefano Zampini     ierr = MatMatMult(M1,C_CR,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
26688ebb749SStefano Zampini   }
26788ebb749SStefano Zampini 
26888ebb749SStefano Zampini   /* Get submatrices from subdomain matrix */
26988ebb749SStefano Zampini   if (n_vertices) {
27025084f0cSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,n_vertices,vertices,PETSC_COPY_VALUES,&is_aux);CHKERRQ(ierr);
2718ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
2728ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
27325084f0cSStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
27425084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
27588ebb749SStefano Zampini   }
27688ebb749SStefano Zampini 
27788ebb749SStefano Zampini   /* Matrix of coarse basis functions (local) */
27888ebb749SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
27988ebb749SStefano Zampini   ierr = MatSetSizes(pcbddc->coarse_phi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
28088ebb749SStefano Zampini   ierr = MatSetType(pcbddc->coarse_phi_B,impMatType);CHKERRQ(ierr);
28125084f0cSStefano Zampini   ierr = MatSetUp(pcbddc->coarse_phi_B);CHKERRQ(ierr);
28225084f0cSStefano Zampini   if (pcbddc->inexact_prec_type || pcbddc->dbg_flag) {
28388ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
28488ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_phi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
28588ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_phi_D,impMatType);CHKERRQ(ierr);
28625084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_phi_D);CHKERRQ(ierr);
28788ebb749SStefano Zampini   }
28888ebb749SStefano Zampini 
28925084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
2908ce42a96SStefano Zampini     ierr = ISGetIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
29188ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*coarsefunctions_errors),&coarsefunctions_errors);CHKERRQ(ierr);
29288ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*constraints_errors),&constraints_errors);CHKERRQ(ierr);
29388ebb749SStefano Zampini   }
29488ebb749SStefano Zampini   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
29588ebb749SStefano Zampini   ierr = PetscMalloc((pcbddc->local_primal_size)*(pcbddc->local_primal_size)*sizeof(PetscScalar),&coarse_submat_vals);CHKERRQ(ierr);
29688ebb749SStefano Zampini 
29788ebb749SStefano Zampini   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
29825084f0cSStefano Zampini 
29925084f0cSStefano Zampini   /* vertices */
30088ebb749SStefano Zampini   for (i=0;i<n_vertices;i++) {
30188ebb749SStefano Zampini     ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
30288ebb749SStefano Zampini     ierr = VecSetValue(vec1_V,i,one,INSERT_VALUES);CHKERRQ(ierr);
30388ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
30488ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
30525084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on constraints multipliers */
30688ebb749SStefano Zampini     ierr = MatMult(A_RV,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
30788ebb749SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
30888ebb749SStefano Zampini     ierr = VecScale(pcbddc->vec1_R,m_one);CHKERRQ(ierr);
30988ebb749SStefano Zampini     if (n_constraints) {
31088ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec1_R,vec1_C);CHKERRQ(ierr);
31188ebb749SStefano Zampini       ierr = MatMultAdd(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
31288ebb749SStefano Zampini       ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
31388ebb749SStefano Zampini     }
31488ebb749SStefano Zampini     ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
31588ebb749SStefano Zampini     ierr = MatMultAdd(A_VV,vec1_V,vec2_V,vec2_V);CHKERRQ(ierr);
31688ebb749SStefano Zampini 
31788ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
31888ebb749SStefano Zampini     /* coarse basis functions */
31988ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
32088ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
32188ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
32225084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
32388ebb749SStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
32425084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
32588ebb749SStefano Zampini     ierr = MatSetValue(pcbddc->coarse_phi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
32625084f0cSStefano Zampini     if (pcbddc->inexact_prec_type || pcbddc->dbg_flag) {
32788ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
32888ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
32925084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
33088ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
33125084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
33288ebb749SStefano Zampini     }
33325084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
33425084f0cSStefano Zampini     ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
33525084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
33625084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
33788ebb749SStefano Zampini     if (n_constraints) {
33825084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
33925084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
34025084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
34188ebb749SStefano Zampini     }
34288ebb749SStefano Zampini 
34325084f0cSStefano Zampini     /* check */
34425084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
34525084f0cSStefano Zampini       /* assemble subdomain vector on local nodes */
34688ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
34725084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
34825084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
34925084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
35025084f0cSStefano Zampini       ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
35125084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
35225084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
35388ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers (i.e. primal nodes) */
35488ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
35525084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
35625084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
35725084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
35888ebb749SStefano Zampini       if (n_constraints) {
35925084f0cSStefano Zampini         ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
36025084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
36125084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
36288ebb749SStefano Zampini       }
36325084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
36425084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
36588ebb749SStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
36688ebb749SStefano Zampini       /* check saddle point solution */
36788ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
36888ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
36988ebb749SStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i]);CHKERRQ(ierr);
37088ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
37125084f0cSStefano Zampini       /* shift by the identity matrix */
37225084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
37325084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
37425084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
37588ebb749SStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i]);CHKERRQ(ierr);
37688ebb749SStefano Zampini     }
37788ebb749SStefano Zampini   }
37888ebb749SStefano Zampini 
37925084f0cSStefano Zampini   /* constraints */
38088ebb749SStefano Zampini   for (i=0;i<n_constraints;i++) {
38188ebb749SStefano Zampini     ierr = VecSet(vec2_C,zero);CHKERRQ(ierr);
38288ebb749SStefano Zampini     ierr = VecSetValue(vec2_C,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
38388ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec2_C);CHKERRQ(ierr);
38488ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec2_C);CHKERRQ(ierr);
38525084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on vertices multipliers */
38688ebb749SStefano Zampini     ierr = MatMult(M1,vec2_C,vec1_C);CHKERRQ(ierr);
38788ebb749SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
38888ebb749SStefano Zampini     ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
38925084f0cSStefano Zampini     if (n_vertices) {
39025084f0cSStefano Zampini       ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
39125084f0cSStefano Zampini     }
39288ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
39388ebb749SStefano Zampini     /* coarse basis functions */
39425084f0cSStefano Zampini     j = i+n_vertices; /* don't touch this! */
39588ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
39688ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
39788ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
39825084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
39925084f0cSStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
40025084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
40125084f0cSStefano Zampini     if (pcbddc->inexact_prec_type || pcbddc->dbg_flag) {
40288ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40388ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
40425084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
40525084f0cSStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
40625084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
40788ebb749SStefano Zampini     }
40825084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
40988ebb749SStefano Zampini     if (n_vertices) {
41025084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
41125084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
41225084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
41388ebb749SStefano Zampini     }
41425084f0cSStefano Zampini     ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
41525084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
41625084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
41788ebb749SStefano Zampini 
41825084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
41988ebb749SStefano Zampini       /* assemble subdomain vector on nodes */
42088ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
42125084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
42225084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
42325084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
42425084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
42525084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
42688ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers */
42788ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
42888ebb749SStefano Zampini       if (n_vertices) {
42925084f0cSStefano Zampini         ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
43025084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
43125084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
43288ebb749SStefano Zampini       }
43325084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
43425084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
43525084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
43625084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
43725084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
43825084f0cSStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
43988ebb749SStefano Zampini       /* check saddle point solution */
44088ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
44188ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
44225084f0cSStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[j]);CHKERRQ(ierr);
44388ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
44425084f0cSStefano Zampini       /* shift by the identity matrix */
44525084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,j,m_one,ADD_VALUES);CHKERRQ(ierr);
44625084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
44725084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
44825084f0cSStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[j]);CHKERRQ(ierr);
44988ebb749SStefano Zampini     }
45088ebb749SStefano Zampini   }
45125084f0cSStefano Zampini   /* call assembling routines for local coarse basis */
45288ebb749SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
45388ebb749SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
45425084f0cSStefano Zampini   if (pcbddc->inexact_prec_type || pcbddc->dbg_flag) {
45588ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
45688ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
45788ebb749SStefano Zampini   }
45825084f0cSStefano Zampini 
45988ebb749SStefano Zampini   /* compute other basis functions for non-symmetric problems */
46088ebb749SStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
46188ebb749SStefano Zampini   if (!setsym || (setsym && !issym)) {
46288ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
46388ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_psi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
46488ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_psi_B,impMatType);CHKERRQ(ierr);
46525084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_psi_B);CHKERRQ(ierr);
46625084f0cSStefano Zampini     if (pcbddc->inexact_prec_type || pcbddc->dbg_flag ) {
46788ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
46888ebb749SStefano Zampini       ierr = MatSetSizes(pcbddc->coarse_psi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
46988ebb749SStefano Zampini       ierr = MatSetType(pcbddc->coarse_psi_D,impMatType);CHKERRQ(ierr);
47025084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->coarse_psi_D);CHKERRQ(ierr);
47188ebb749SStefano Zampini     }
47288ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
47388ebb749SStefano Zampini       if (n_constraints) {
47488ebb749SStefano Zampini         ierr = VecSet(vec1_C,zero);CHKERRQ(ierr);
47588ebb749SStefano Zampini         for (j=0;j<n_constraints;j++) {
47625084f0cSStefano Zampini           ierr = VecSetValue(vec1_C,j,coarse_submat_vals[(j+n_vertices)*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
47788ebb749SStefano Zampini         }
47825084f0cSStefano Zampini         ierr = VecAssemblyBegin(vec1_C);CHKERRQ(ierr);
47925084f0cSStefano Zampini         ierr = VecAssemblyEnd(vec1_C);CHKERRQ(ierr);
48088ebb749SStefano Zampini       }
48188ebb749SStefano Zampini       if (i<n_vertices) {
48288ebb749SStefano Zampini         ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
48388ebb749SStefano Zampini         ierr = VecSetValue(vec1_V,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
48488ebb749SStefano Zampini         ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
48588ebb749SStefano Zampini         ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
48688ebb749SStefano Zampini         ierr = MatMultTranspose(A_VR,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
48788ebb749SStefano Zampini         if (n_constraints) {
48888ebb749SStefano Zampini           ierr = MatMultTransposeAdd(C_CR,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
48988ebb749SStefano Zampini         }
49088ebb749SStefano Zampini       } else {
49188ebb749SStefano Zampini         ierr = MatMultTranspose(C_CR,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
49288ebb749SStefano Zampini       }
49388ebb749SStefano Zampini       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
49488ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
49588ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
49688ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
49725084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
49888ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_psi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
49925084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
50088ebb749SStefano Zampini       if (i<n_vertices) {
50188ebb749SStefano Zampini         ierr = MatSetValue(pcbddc->coarse_psi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
50288ebb749SStefano Zampini       }
50325084f0cSStefano Zampini       if (pcbddc->inexact_prec_type || pcbddc->dbg_flag) {
50488ebb749SStefano Zampini         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
50588ebb749SStefano Zampini         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
50625084f0cSStefano Zampini         ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
50788ebb749SStefano Zampini         ierr = MatSetValues(pcbddc->coarse_psi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
50825084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
50988ebb749SStefano Zampini       }
51088ebb749SStefano Zampini 
51125084f0cSStefano Zampini       if (pcbddc->dbg_flag) {
51288ebb749SStefano Zampini         /* assemble subdomain vector on nodes */
51388ebb749SStefano Zampini         ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
51425084f0cSStefano Zampini         ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
51525084f0cSStefano Zampini         ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
51625084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
51725084f0cSStefano Zampini         if (i<n_vertices) {
51825084f0cSStefano Zampini           ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
51988ebb749SStefano Zampini         }
52025084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
52125084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
52225084f0cSStefano Zampini         /* assemble subdomain vector of lagrange multipliers */
52325084f0cSStefano Zampini         for (j=0;j<pcbddc->local_primal_size;j++) {
52425084f0cSStefano Zampini           ierr = VecSetValue(pcbddc->vec1_P,j,-coarse_submat_vals[j*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
52525084f0cSStefano Zampini         }
52625084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
52725084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
52888ebb749SStefano Zampini         /* check saddle point solution */
52988ebb749SStefano Zampini         ierr = MatMultTranspose(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
53088ebb749SStefano Zampini         ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
53188ebb749SStefano Zampini         ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
53288ebb749SStefano Zampini         ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
53325084f0cSStefano Zampini         /* shift by the identity matrix */
53425084f0cSStefano Zampini         ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
53525084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
53625084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
53788ebb749SStefano Zampini         ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
53888ebb749SStefano Zampini       }
53988ebb749SStefano Zampini     }
54088ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
54188ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
54225084f0cSStefano Zampini     if ( pcbddc->inexact_prec_type || pcbddc->dbg_flag ) {
54388ebb749SStefano Zampini       ierr = MatAssemblyBegin(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
54488ebb749SStefano Zampini       ierr = MatAssemblyEnd(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
54588ebb749SStefano Zampini     }
54688ebb749SStefano Zampini   }
54788ebb749SStefano Zampini   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
54888ebb749SStefano Zampini   /* Checking coarse_sub_mat and coarse basis functios */
54988ebb749SStefano Zampini   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
55088ebb749SStefano Zampini   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
55125084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
55288ebb749SStefano Zampini     Mat         coarse_sub_mat;
55325084f0cSStefano Zampini     Mat         AUXMAT,TM1,TM2,TM3,TM4;
55488ebb749SStefano Zampini     Mat         coarse_phi_D,coarse_phi_B;
55588ebb749SStefano Zampini     Mat         coarse_psi_D,coarse_psi_B;
55688ebb749SStefano Zampini     Mat         A_II,A_BB,A_IB,A_BI;
55788ebb749SStefano Zampini     MatType     checkmattype=MATSEQAIJ;
55888ebb749SStefano Zampini     PetscReal   real_value;
55988ebb749SStefano Zampini 
56088ebb749SStefano Zampini     ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
56188ebb749SStefano Zampini     ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
56288ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
56388ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
56488ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
56588ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
56688ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
56788ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
56888ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
56988ebb749SStefano Zampini     }
57088ebb749SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
57188ebb749SStefano Zampini 
57225084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
57325084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat and local basis functions\n");CHKERRQ(ierr);
57425084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
57588ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
57688ebb749SStefano Zampini       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
57788ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
57888ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
57988ebb749SStefano Zampini       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
58088ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
58188ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
58288ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
58388ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
58488ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
58588ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
58688ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
58788ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
58888ebb749SStefano Zampini     } else {
58988ebb749SStefano Zampini       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
59088ebb749SStefano Zampini       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
59188ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
59288ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
59388ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
59488ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
59588ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
59688ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
59788ebb749SStefano Zampini     }
59888ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
59988ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
60088ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
60188ebb749SStefano Zampini     ierr = MatConvert(TM1,MATSEQDENSE,MAT_REUSE_MATRIX,&TM1);CHKERRQ(ierr);
60288ebb749SStefano Zampini     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
60388ebb749SStefano Zampini     ierr = MatNorm(TM1,NORM_INFINITY,&real_value);CHKERRQ(ierr);
60425084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"----------------------------------\n");CHKERRQ(ierr);
60525084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d \n",PetscGlobalRank);CHKERRQ(ierr);
60625084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"matrix error = % 1.14e\n",real_value);CHKERRQ(ierr);
60725084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (phi) errors\n");CHKERRQ(ierr);
60888ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
60925084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,coarsefunctions_errors[i]);CHKERRQ(ierr);
61088ebb749SStefano Zampini     }
61125084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (phi) errors\n");CHKERRQ(ierr);
61288ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
61325084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,constraints_errors[i]);CHKERRQ(ierr);
61488ebb749SStefano Zampini     }
61588ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
61625084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (psi) errors\n");CHKERRQ(ierr);
61788ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
61825084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,coarsefunctions_errors[i]);CHKERRQ(ierr);
61988ebb749SStefano Zampini       }
62025084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (psi) errors\n");CHKERRQ(ierr);
62188ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
62225084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,constraints_errors[i]);CHKERRQ(ierr);
62388ebb749SStefano Zampini       }
62488ebb749SStefano Zampini     }
62525084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
62688ebb749SStefano Zampini     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
62788ebb749SStefano Zampini     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
62888ebb749SStefano Zampini     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
62988ebb749SStefano Zampini     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
63088ebb749SStefano Zampini     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
63188ebb749SStefano Zampini     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
63288ebb749SStefano Zampini     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
63388ebb749SStefano Zampini     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
63488ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
63588ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
63688ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
63788ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
63888ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
63988ebb749SStefano Zampini     }
64088ebb749SStefano Zampini     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
6418ce42a96SStefano Zampini     ierr = ISRestoreIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
64288ebb749SStefano Zampini     ierr = PetscFree(coarsefunctions_errors);CHKERRQ(ierr);
64388ebb749SStefano Zampini     ierr = PetscFree(constraints_errors);CHKERRQ(ierr);
64488ebb749SStefano Zampini   }
64588ebb749SStefano Zampini   /* free memory */
64688ebb749SStefano Zampini   if (n_vertices) {
64788ebb749SStefano Zampini     ierr = PetscFree(vertices);CHKERRQ(ierr);
64888ebb749SStefano Zampini     ierr = VecDestroy(&vec1_V);CHKERRQ(ierr);
64988ebb749SStefano Zampini     ierr = VecDestroy(&vec2_V);CHKERRQ(ierr);
65088ebb749SStefano Zampini     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
65188ebb749SStefano Zampini     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
65288ebb749SStefano Zampini     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
65388ebb749SStefano Zampini   }
65488ebb749SStefano Zampini   if (n_constraints) {
65588ebb749SStefano Zampini     ierr = VecDestroy(&vec1_C);CHKERRQ(ierr);
65688ebb749SStefano Zampini     ierr = VecDestroy(&vec2_C);CHKERRQ(ierr);
65788ebb749SStefano Zampini     ierr = MatDestroy(&M1);CHKERRQ(ierr);
65888ebb749SStefano Zampini     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
65988ebb749SStefano Zampini   }
66088ebb749SStefano Zampini   ierr = PetscFree(auxindices);CHKERRQ(ierr);
66188ebb749SStefano Zampini   /* create coarse matrix and data structures for message passing associated actual choice of coarse problem type */
66288ebb749SStefano Zampini   ierr = PCBDDCSetUpCoarseEnvironment(pc,coarse_submat_vals);CHKERRQ(ierr);
66388ebb749SStefano Zampini   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
66488ebb749SStefano Zampini   PetscFunctionReturn(0);
66588ebb749SStefano Zampini }
66688ebb749SStefano Zampini 
66788ebb749SStefano Zampini #undef __FUNCT__
668aa0d41d4SStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalMatrices"
669aa0d41d4SStefano Zampini PetscErrorCode PCBDDCSetUpLocalMatrices(PC pc)
670aa0d41d4SStefano Zampini {
671aa0d41d4SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
672aa0d41d4SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
673aa0d41d4SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
674aa0d41d4SStefano Zampini   /* manage repeated solves */
675aa0d41d4SStefano Zampini   MatReuse          reuse;
676aa0d41d4SStefano Zampini   MatStructure      matstruct;
677aa0d41d4SStefano Zampini   PetscErrorCode    ierr;
678aa0d41d4SStefano Zampini 
679aa0d41d4SStefano Zampini   PetscFunctionBegin;
680aa0d41d4SStefano Zampini   /* get mat flags */
681aa0d41d4SStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
682aa0d41d4SStefano Zampini   reuse = MAT_INITIAL_MATRIX;
683aa0d41d4SStefano Zampini   if (pc->setupcalled) {
684aa0d41d4SStefano Zampini     /* when matstruct is SAME_PRECONDITIONER, we shouldn't be here */
685aa0d41d4SStefano Zampini     if (matstruct == SAME_PRECONDITIONER) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen");
686aa0d41d4SStefano Zampini     if (matstruct == SAME_NONZERO_PATTERN) {
687aa0d41d4SStefano Zampini       reuse = MAT_REUSE_MATRIX;
688aa0d41d4SStefano Zampini     } else {
689aa0d41d4SStefano Zampini       reuse = MAT_INITIAL_MATRIX;
690aa0d41d4SStefano Zampini     }
691aa0d41d4SStefano Zampini   }
692aa0d41d4SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
693aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
694aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
695aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
696aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BB);CHKERRQ(ierr);
697aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
698aa0d41d4SStefano Zampini   }
699aa0d41d4SStefano Zampini 
700aa0d41d4SStefano Zampini   /* transform local matrices if needed */
701aa0d41d4SStefano Zampini   if (pcbddc->use_change_of_basis) {
702aa0d41d4SStefano Zampini     Mat         change_mat_all;
703aa0d41d4SStefano Zampini     PetscScalar *row_cmat_values;
704aa0d41d4SStefano Zampini     PetscInt    *row_cmat_indices;
705aa0d41d4SStefano Zampini     PetscInt    *nnz,*is_indices,*temp_indices;
706aa0d41d4SStefano Zampini     PetscInt    i,j,k,n_D,n_B;
707aa0d41d4SStefano Zampini 
708aa0d41d4SStefano Zampini     /* Get Non-overlapping dimensions */
709aa0d41d4SStefano Zampini     n_B = pcis->n_B;
710aa0d41d4SStefano Zampini     n_D = pcis->n-n_B;
711aa0d41d4SStefano Zampini 
712aa0d41d4SStefano Zampini     /* compute nonzero structure of change of basis on all local nodes */
713aa0d41d4SStefano Zampini     ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
714aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
715aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) nnz[is_indices[i]] = 1;
716aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
717aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
718aa0d41d4SStefano Zampini     k=1;
719aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
720aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
721aa0d41d4SStefano Zampini       nnz[is_indices[i]]=j;
722aa0d41d4SStefano Zampini       if (k < j) k = j;
723aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
724aa0d41d4SStefano Zampini     }
725aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
726aa0d41d4SStefano Zampini     /* assemble change of basis matrix on the whole set of local dofs */
727aa0d41d4SStefano Zampini     ierr = PetscMalloc(k*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
728aa0d41d4SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&change_mat_all);CHKERRQ(ierr);
729aa0d41d4SStefano Zampini     ierr = MatSetSizes(change_mat_all,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
730aa0d41d4SStefano Zampini     ierr = MatSetType(change_mat_all,MATSEQAIJ);CHKERRQ(ierr);
731aa0d41d4SStefano Zampini     ierr = MatSeqAIJSetPreallocation(change_mat_all,0,nnz);CHKERRQ(ierr);
732aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
733aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) {
734aa0d41d4SStefano Zampini       ierr = MatSetValue(change_mat_all,is_indices[i],is_indices[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
735aa0d41d4SStefano Zampini     }
736aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
737aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
738aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
739aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
740aa0d41d4SStefano Zampini       for (k=0; k<j; k++) temp_indices[k]=is_indices[row_cmat_indices[k]];
741aa0d41d4SStefano Zampini       ierr = MatSetValues(change_mat_all,1,&is_indices[i],j,temp_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
742aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
743aa0d41d4SStefano Zampini     }
744aa0d41d4SStefano Zampini     ierr = MatAssemblyBegin(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
745aa0d41d4SStefano Zampini     ierr = MatAssemblyEnd(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
746aa0d41d4SStefano Zampini     /* TODO: HOW TO WORK WITH BAIJ? PtAP not provided */
747aa0d41d4SStefano Zampini     ierr = MatGetBlockSize(matis->A,&i);CHKERRQ(ierr);
748aa0d41d4SStefano Zampini     if (i==1) {
749aa0d41d4SStefano Zampini       ierr = MatPtAP(matis->A,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
750aa0d41d4SStefano Zampini     } else {
751aa0d41d4SStefano Zampini       Mat work_mat;
752aa0d41d4SStefano Zampini       ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
753aa0d41d4SStefano Zampini       ierr = MatPtAP(work_mat,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
754aa0d41d4SStefano Zampini       ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
755aa0d41d4SStefano Zampini     }
756aa0d41d4SStefano Zampini     ierr = MatDestroy(&change_mat_all);CHKERRQ(ierr);
757aa0d41d4SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
758aa0d41d4SStefano Zampini     ierr = PetscFree(temp_indices);CHKERRQ(ierr);
759aa0d41d4SStefano Zampini   } else {
760aa0d41d4SStefano Zampini     /* without change of basis, the local matrix is unchanged */
761aa0d41d4SStefano Zampini     if (!pcbddc->local_mat) {
762aa0d41d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)matis->A);CHKERRQ(ierr);
763aa0d41d4SStefano Zampini       pcbddc->local_mat = matis->A;
764aa0d41d4SStefano Zampini     }
765aa0d41d4SStefano Zampini   }
766aa0d41d4SStefano Zampini 
767aa0d41d4SStefano Zampini   /* get submatrices */
768aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_I_local,reuse,&pcis->A_II);CHKERRQ(ierr);
769aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
770aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
771aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_B_local,reuse,&pcis->A_BB);CHKERRQ(ierr);
772aa0d41d4SStefano Zampini   PetscFunctionReturn(0);
773aa0d41d4SStefano Zampini }
774aa0d41d4SStefano Zampini 
775aa0d41d4SStefano Zampini #undef __FUNCT__
776a64d13efSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalScatters"
7778ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
778a64d13efSStefano Zampini {
779a64d13efSStefano Zampini   PC_IS*         pcis = (PC_IS*)(pc->data);
780a64d13efSStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
7818ce42a96SStefano Zampini   IS             is_aux1,is_aux2;
782a64d13efSStefano Zampini   PetscInt       *vertices,*aux_array1,*aux_array2,*is_indices,*idx_R_local;
783a64d13efSStefano Zampini   PetscInt       n_vertices,n_constraints,i,j,n_R,n_D,n_B;
784a64d13efSStefano Zampini   PetscBool      *array_bool;
785a64d13efSStefano Zampini   PetscErrorCode ierr;
786a64d13efSStefano Zampini 
787a64d13efSStefano Zampini   PetscFunctionBegin;
788a64d13efSStefano Zampini   /* Set Non-overlapping dimensions */
789a64d13efSStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
790a64d13efSStefano Zampini   /* get vertex indices from constraint matrix */
791a64d13efSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
792a64d13efSStefano Zampini   /* Set number of constraints */
793a64d13efSStefano Zampini   n_constraints = pcbddc->local_primal_size-n_vertices;
794a64d13efSStefano Zampini   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
795a64d13efSStefano Zampini   ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&array_bool);CHKERRQ(ierr);
796a64d13efSStefano Zampini   for (i=0;i<pcis->n;i++) array_bool[i] = PETSC_TRUE;
797a64d13efSStefano Zampini   for (i=0;i<n_vertices;i++) array_bool[vertices[i]] = PETSC_FALSE;
798a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n-n_vertices)*sizeof(PetscInt),&idx_R_local);CHKERRQ(ierr);
799a64d13efSStefano Zampini   for (i=0, n_R=0; i<pcis->n; i++) {
800a64d13efSStefano Zampini     if (array_bool[i]) {
801a64d13efSStefano Zampini       idx_R_local[n_R] = i;
802a64d13efSStefano Zampini       n_R++;
803a64d13efSStefano Zampini     }
804a64d13efSStefano Zampini   }
805a64d13efSStefano Zampini   ierr = PetscFree(vertices);CHKERRQ(ierr);
8068ce42a96SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_R,idx_R_local,PETSC_OWN_POINTER,&pcbddc->is_R_local);CHKERRQ(ierr);
807a64d13efSStefano Zampini 
808a64d13efSStefano Zampini   /* print some info if requested */
809a64d13efSStefano Zampini   if (pcbddc->dbg_flag) {
810a64d13efSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
811a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
812a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
813a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
814a64d13efSStefano 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);
815a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr);
816a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
817a64d13efSStefano Zampini   }
818a64d13efSStefano Zampini 
819a64d13efSStefano Zampini   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
820a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
821a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array2);CHKERRQ(ierr);
822a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
823a64d13efSStefano Zampini   for (i=0; i<n_D; i++) array_bool[is_indices[i]] = PETSC_FALSE;
824a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
825a64d13efSStefano Zampini   for (i=0, j=0; i<n_R; i++) {
826a64d13efSStefano Zampini     if (array_bool[idx_R_local[i]]) {
827a64d13efSStefano Zampini       aux_array1[j] = i;
828a64d13efSStefano Zampini       j++;
829a64d13efSStefano Zampini     }
830a64d13efSStefano Zampini   }
831a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
832a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
833a64d13efSStefano Zampini   for (i=0, j=0; i<n_B; i++) {
834a64d13efSStefano Zampini     if (array_bool[is_indices[i]]) {
835a64d13efSStefano Zampini       aux_array2[j] = i; j++;
836a64d13efSStefano Zampini     }
837a64d13efSStefano Zampini   }
838a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
839a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
840a64d13efSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
841a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
842a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
843a64d13efSStefano Zampini 
844a64d13efSStefano Zampini   if (pcbddc->inexact_prec_type || pcbddc->dbg_flag ) {
845a64d13efSStefano Zampini     ierr = PetscMalloc(n_D*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
846a64d13efSStefano Zampini     for (i=0, j=0; i<n_R; i++) {
847a64d13efSStefano Zampini       if (!array_bool[idx_R_local[i]]) {
848a64d13efSStefano Zampini         aux_array1[j] = i;
849a64d13efSStefano Zampini         j++;
850a64d13efSStefano Zampini       }
851a64d13efSStefano Zampini     }
852a64d13efSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
853a64d13efSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
854a64d13efSStefano Zampini     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
855a64d13efSStefano Zampini   }
856a64d13efSStefano Zampini   ierr = PetscFree(array_bool);CHKERRQ(ierr);
857a64d13efSStefano Zampini   PetscFunctionReturn(0);
858a64d13efSStefano Zampini }
859a64d13efSStefano Zampini 
860a64d13efSStefano Zampini #undef __FUNCT__
861304d26faSStefano Zampini #define __FUNCT__ "PCBDDCSetUseExactDirichlet"
862304d26faSStefano Zampini PetscErrorCode PCBDDCSetUseExactDirichlet(PC pc,PetscBool use)
863304d26faSStefano Zampini {
864304d26faSStefano Zampini   PC_BDDC  *pcbddc = (PC_BDDC*)pc->data;
865304d26faSStefano Zampini 
866304d26faSStefano Zampini   PetscFunctionBegin;
867304d26faSStefano Zampini   pcbddc->use_exact_dirichlet=use;
868304d26faSStefano Zampini   PetscFunctionReturn(0);
869304d26faSStefano Zampini }
870304d26faSStefano Zampini 
871304d26faSStefano Zampini #undef __FUNCT__
872304d26faSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
8738ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc)
874304d26faSStefano Zampini {
875304d26faSStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
876304d26faSStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
877304d26faSStefano Zampini   PC             pc_temp;
878304d26faSStefano Zampini   Mat            A_RR;
879304d26faSStefano Zampini   Vec            vec1,vec2,vec3;
880304d26faSStefano Zampini   MatStructure   matstruct;
881304d26faSStefano Zampini   PetscScalar    m_one = -1.0;
882304d26faSStefano Zampini   PetscReal      value;
883304d26faSStefano Zampini   PetscInt       n_D,n_R,use_exact,use_exact_reduced;
884304d26faSStefano Zampini   PetscErrorCode ierr;
885304d26faSStefano Zampini 
886304d26faSStefano Zampini   PetscFunctionBegin;
887304d26faSStefano Zampini   /* Creating PC contexts for local Dirichlet and Neumann problems */
888304d26faSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
889304d26faSStefano Zampini 
890304d26faSStefano Zampini   /* DIRICHLET PROBLEM */
891ac78edfcSStefano Zampini   /* Matrix for Dirichlet problem is pcis->A_II */
8928ce42a96SStefano Zampini   ierr = ISGetSize(pcis->is_I_local,&n_D);CHKERRQ(ierr);
893304d26faSStefano Zampini   if (!pcbddc->ksp_D) { /* create object if not yet build */
894304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
895304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
896304d26faSStefano Zampini     /* default */
897304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
898304d26faSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,"dirichlet_");CHKERRQ(ierr);
899304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
900304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
901304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
902304d26faSStefano Zampini   }
903304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II,matstruct);CHKERRQ(ierr);
904304d26faSStefano Zampini   /* Allow user's customization */
905304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
906304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
907304d26faSStefano Zampini   if (!n_D) {
908304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
909304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
910304d26faSStefano Zampini   }
911304d26faSStefano Zampini   /* Set Up KSP for Dirichlet problem of BDDC */
912304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
913304d26faSStefano Zampini   /* set ksp_D into pcis data */
914304d26faSStefano Zampini   ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
915304d26faSStefano Zampini   ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
916304d26faSStefano Zampini   pcis->ksp_D = pcbddc->ksp_D;
917304d26faSStefano Zampini 
918304d26faSStefano Zampini   /* NEUMANN PROBLEM */
919304d26faSStefano Zampini   /* Matrix for Neumann problem is A_RR -> we need to create it */
9208ce42a96SStefano Zampini   ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
9218ce42a96SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
922304d26faSStefano Zampini   if (!pcbddc->ksp_R) { /* create object if not yet build */
923304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
924304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
925304d26faSStefano Zampini     /* default */
926304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
927304d26faSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,"neumann_");CHKERRQ(ierr);
928304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
929304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
930304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
931304d26faSStefano Zampini   }
932304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR,matstruct);CHKERRQ(ierr);
933304d26faSStefano Zampini   /* Allow user's customization */
934304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
935304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
936304d26faSStefano Zampini   if (!n_R) {
937304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
938304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
939304d26faSStefano Zampini   }
940304d26faSStefano Zampini   /* Set Up KSP for Neumann problem of BDDC */
941304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
942304d26faSStefano Zampini 
943304d26faSStefano Zampini   /* check Dirichlet and Neumann solvers and adapt them if a nullspace correction is needed */
944304d26faSStefano Zampini 
945304d26faSStefano Zampini   /* Dirichlet */
946304d26faSStefano Zampini   ierr = MatGetVecs(pcis->A_II,&vec1,&vec2);CHKERRQ(ierr);
947304d26faSStefano Zampini   ierr = VecDuplicate(vec1,&vec3);CHKERRQ(ierr);
948304d26faSStefano Zampini   ierr = VecSetRandom(vec1,NULL);CHKERRQ(ierr);
949304d26faSStefano Zampini   ierr = MatMult(pcis->A_II,vec1,vec2);CHKERRQ(ierr);
950304d26faSStefano Zampini   ierr = KSPSolve(pcbddc->ksp_D,vec2,vec3);CHKERRQ(ierr);
951304d26faSStefano Zampini   ierr = VecAXPY(vec3,m_one,vec1);CHKERRQ(ierr);
952304d26faSStefano Zampini   ierr = VecNorm(vec3,NORM_INFINITY,&value);CHKERRQ(ierr);
953304d26faSStefano Zampini   ierr = VecDestroy(&vec1);CHKERRQ(ierr);
954304d26faSStefano Zampini   ierr = VecDestroy(&vec2);CHKERRQ(ierr);
955304d26faSStefano Zampini   ierr = VecDestroy(&vec3);CHKERRQ(ierr);
956304d26faSStefano Zampini   /* need to be adapted? */
957304d26faSStefano Zampini   use_exact = (PetscAbsReal(value) > 1.e-4 ? 0 : 1);
958304d26faSStefano Zampini   ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_INT,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
959304d26faSStefano Zampini   ierr = PCBDDCSetUseExactDirichlet(pc,(PetscBool)use_exact_reduced);CHKERRQ(ierr);
960304d26faSStefano Zampini   /* print info */
961304d26faSStefano Zampini   if (pcbddc->dbg_flag) {
962304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
963304d26faSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
964304d26faSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Checking solution of Dirichlet and Neumann problems\n");CHKERRQ(ierr);
965304d26faSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Dirichlet solve = % 1.14e \n",PetscGlobalRank,value);CHKERRQ(ierr);
966304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
967304d26faSStefano Zampini   }
968304d26faSStefano Zampini   if (n_D && pcbddc->NullSpace && !use_exact_reduced && !pcbddc->inexact_prec_type) {
9698ce42a96SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcis->is_I_local);CHKERRQ(ierr);
970304d26faSStefano Zampini   }
971304d26faSStefano Zampini 
972304d26faSStefano Zampini   /* Neumann */
973304d26faSStefano Zampini   ierr = MatGetVecs(A_RR,&vec1,&vec2);CHKERRQ(ierr);
974304d26faSStefano Zampini   ierr = VecDuplicate(vec1,&vec3);CHKERRQ(ierr);
975304d26faSStefano Zampini   ierr = VecSetRandom(vec1,NULL);CHKERRQ(ierr);
976304d26faSStefano Zampini   ierr = MatMult(A_RR,vec1,vec2);CHKERRQ(ierr);
977304d26faSStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,vec2,vec3);CHKERRQ(ierr);
978304d26faSStefano Zampini   ierr = VecAXPY(vec3,m_one,vec1);CHKERRQ(ierr);
979304d26faSStefano Zampini   ierr = VecNorm(vec3,NORM_INFINITY,&value);CHKERRQ(ierr);
980304d26faSStefano Zampini   ierr = VecDestroy(&vec1);CHKERRQ(ierr);
981304d26faSStefano Zampini   ierr = VecDestroy(&vec2);CHKERRQ(ierr);
982304d26faSStefano Zampini   ierr = VecDestroy(&vec3);CHKERRQ(ierr);
983304d26faSStefano Zampini   /* need to be adapted? */
984304d26faSStefano Zampini   use_exact = (PetscAbsReal(value) > 1.e-4 ? 0 : 1);
985304d26faSStefano Zampini   if (PetscAbsReal(value) > 1.e-4) use_exact = 0;
986304d26faSStefano Zampini   ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_INT,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
987304d26faSStefano Zampini   /* print info */
988304d26faSStefano Zampini   if (pcbddc->dbg_flag) {
989304d26faSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for  Neumann  solve = % 1.14e \n",PetscGlobalRank,value);CHKERRQ(ierr);
990304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
991304d26faSStefano Zampini   }
992304d26faSStefano Zampini   if (n_R && pcbddc->NullSpace && !use_exact_reduced) { /* is it the right logic? */
9938ce42a96SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcbddc->is_R_local);CHKERRQ(ierr);
994304d26faSStefano Zampini   }
995304d26faSStefano Zampini 
996304d26faSStefano Zampini   /* free Neumann problem's matrix */
997304d26faSStefano Zampini   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
998304d26faSStefano Zampini   PetscFunctionReturn(0);
999304d26faSStefano Zampini }
1000304d26faSStefano Zampini 
1001304d26faSStefano Zampini #undef __FUNCT__
1002674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSolveSaddlePoint"
1003674ae819SStefano Zampini static PetscErrorCode  PCBDDCSolveSaddlePoint(PC pc)
1004674ae819SStefano Zampini {
1005674ae819SStefano Zampini   PetscErrorCode ierr;
1006674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1007674ae819SStefano Zampini 
1008674ae819SStefano Zampini   PetscFunctionBegin;
1009674ae819SStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
1010674ae819SStefano Zampini   if (pcbddc->local_auxmat1) {
1011674ae819SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec2_R,pcbddc->vec1_C);CHKERRQ(ierr);
1012674ae819SStefano Zampini     ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
1013674ae819SStefano Zampini   }
1014674ae819SStefano Zampini   PetscFunctionReturn(0);
1015674ae819SStefano Zampini }
1016674ae819SStefano Zampini 
1017674ae819SStefano Zampini #undef __FUNCT__
1018674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
1019674ae819SStefano Zampini PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc)
1020674ae819SStefano Zampini {
1021674ae819SStefano Zampini   PetscErrorCode ierr;
1022674ae819SStefano Zampini   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
1023674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)  (pc->data);
1024674ae819SStefano Zampini   const PetscScalar zero = 0.0;
1025674ae819SStefano Zampini 
1026674ae819SStefano Zampini   PetscFunctionBegin;
102715aaf578SStefano Zampini   /* Application of PHI^T (or PSI^T)  */
102815aaf578SStefano Zampini   if (pcbddc->coarse_psi_B) {
102915aaf578SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
103015aaf578SStefano Zampini     if (pcbddc->inexact_prec_type) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
103115aaf578SStefano Zampini   } else {
1032674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
1033674ae819SStefano Zampini     if (pcbddc->inexact_prec_type) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
103415aaf578SStefano Zampini   }
1035674ae819SStefano Zampini   /* Scatter data of coarse_rhs */
1036674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { ierr = VecSet(pcbddc->coarse_rhs,zero);CHKERRQ(ierr); }
1037674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1038674ae819SStefano Zampini 
1039674ae819SStefano Zampini   /* Local solution on R nodes */
1040674ae819SStefano Zampini   ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
1041674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1042674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1043674ae819SStefano Zampini   if (pcbddc->inexact_prec_type) {
1044674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1045674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1046674ae819SStefano Zampini   }
1047674ae819SStefano Zampini   ierr = PCBDDCSolveSaddlePoint(pc);CHKERRQ(ierr);
1048674ae819SStefano Zampini   ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1049674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1050674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1051674ae819SStefano Zampini   if (pcbddc->inexact_prec_type) {
1052674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1053674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1054674ae819SStefano Zampini   }
1055674ae819SStefano Zampini 
1056674ae819SStefano Zampini   /* Coarse solution */
1057674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1058674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { /* TODO remove null space when doing multilevel */
1059674ae819SStefano Zampini     ierr = KSPSolve(pcbddc->coarse_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
1060674ae819SStefano Zampini   }
1061674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1062674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd  (pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1063674ae819SStefano Zampini 
1064674ae819SStefano Zampini   /* Sum contributions from two levels */
1065674ae819SStefano Zampini   ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
1066674ae819SStefano Zampini   if (pcbddc->inexact_prec_type) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1067674ae819SStefano Zampini   PetscFunctionReturn(0);
1068674ae819SStefano Zampini }
1069674ae819SStefano Zampini 
1070674ae819SStefano Zampini #undef __FUNCT__
1071674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
1072674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1073674ae819SStefano Zampini {
1074674ae819SStefano Zampini   PetscErrorCode ierr;
1075674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1076674ae819SStefano Zampini 
1077674ae819SStefano Zampini   PetscFunctionBegin;
1078674ae819SStefano Zampini   switch (pcbddc->coarse_communications_type) {
1079674ae819SStefano Zampini     case SCATTERS_BDDC:
1080674ae819SStefano Zampini       ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1081674ae819SStefano Zampini       break;
1082674ae819SStefano Zampini     case GATHERS_BDDC:
1083674ae819SStefano Zampini       break;
1084674ae819SStefano Zampini   }
1085674ae819SStefano Zampini   PetscFunctionReturn(0);
1086674ae819SStefano Zampini }
1087674ae819SStefano Zampini 
1088674ae819SStefano Zampini #undef __FUNCT__
1089674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
1090674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1091674ae819SStefano Zampini {
1092674ae819SStefano Zampini   PetscErrorCode ierr;
1093674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1094674ae819SStefano Zampini   PetscScalar*   array_to;
1095674ae819SStefano Zampini   PetscScalar*   array_from;
1096674ae819SStefano Zampini   MPI_Comm       comm;
1097674ae819SStefano Zampini   PetscInt       i;
1098674ae819SStefano Zampini 
1099674ae819SStefano Zampini   PetscFunctionBegin;
1100674ae819SStefano Zampini   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
1101674ae819SStefano Zampini   switch (pcbddc->coarse_communications_type) {
1102674ae819SStefano Zampini     case SCATTERS_BDDC:
1103674ae819SStefano Zampini       ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1104674ae819SStefano Zampini       break;
1105674ae819SStefano Zampini     case GATHERS_BDDC:
1106674ae819SStefano Zampini       if (vec_from) {
1107674ae819SStefano Zampini         ierr = VecGetArray(vec_from,&array_from);CHKERRQ(ierr);
1108674ae819SStefano Zampini       }
1109674ae819SStefano Zampini       if (vec_to) {
1110674ae819SStefano Zampini         ierr = VecGetArray(vec_to,&array_to);CHKERRQ(ierr);
1111674ae819SStefano Zampini       }
1112674ae819SStefano Zampini       switch(pcbddc->coarse_problem_type){
1113674ae819SStefano Zampini         case SEQUENTIAL_BDDC:
1114674ae819SStefano Zampini           if (smode == SCATTER_FORWARD) {
1115674ae819SStefano 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);
1116674ae819SStefano Zampini             if (vec_to) {
1117674ae819SStefano Zampini               if (imode == ADD_VALUES) {
1118674ae819SStefano Zampini                 for (i=0;i<pcbddc->replicated_primal_size;i++) {
1119674ae819SStefano Zampini                   array_to[pcbddc->replicated_local_primal_indices[i]]+=pcbddc->replicated_local_primal_values[i];
1120674ae819SStefano Zampini                 }
1121674ae819SStefano Zampini               } else {
1122674ae819SStefano Zampini                 for (i=0;i<pcbddc->replicated_primal_size;i++) {
1123674ae819SStefano Zampini                   array_to[pcbddc->replicated_local_primal_indices[i]]=pcbddc->replicated_local_primal_values[i];
1124674ae819SStefano Zampini                 }
1125674ae819SStefano Zampini               }
1126674ae819SStefano Zampini             }
1127674ae819SStefano Zampini           } else {
1128674ae819SStefano Zampini             if (vec_from) {
1129674ae819SStefano Zampini               if (imode == ADD_VALUES) {
1130674ae819SStefano Zampini                 MPI_Comm vec_from_comm;
1131674ae819SStefano Zampini                 ierr = PetscObjectGetComm((PetscObject)(vec_from),&vec_from_comm);CHKERRQ(ierr);
1132674ae819SStefano 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);
1133674ae819SStefano Zampini               }
1134674ae819SStefano Zampini               for (i=0;i<pcbddc->replicated_primal_size;i++) {
1135674ae819SStefano Zampini                 pcbddc->replicated_local_primal_values[i]=array_from[pcbddc->replicated_local_primal_indices[i]];
1136674ae819SStefano Zampini               }
1137674ae819SStefano Zampini             }
1138674ae819SStefano 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);
1139674ae819SStefano Zampini           }
1140674ae819SStefano Zampini           break;
1141674ae819SStefano Zampini         case REPLICATED_BDDC:
1142674ae819SStefano Zampini           if (smode == SCATTER_FORWARD) {
1143674ae819SStefano 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);
1144674ae819SStefano Zampini             if (imode == ADD_VALUES) {
1145674ae819SStefano Zampini               for (i=0;i<pcbddc->replicated_primal_size;i++) {
1146674ae819SStefano Zampini                 array_to[pcbddc->replicated_local_primal_indices[i]]+=pcbddc->replicated_local_primal_values[i];
1147674ae819SStefano Zampini               }
1148674ae819SStefano Zampini             } else {
1149674ae819SStefano Zampini               for (i=0;i<pcbddc->replicated_primal_size;i++) {
1150674ae819SStefano Zampini                 array_to[pcbddc->replicated_local_primal_indices[i]]=pcbddc->replicated_local_primal_values[i];
1151674ae819SStefano Zampini               }
1152674ae819SStefano Zampini             }
1153674ae819SStefano Zampini           } else { /* no communications needed for SCATTER_REVERSE since needed data is already present */
1154674ae819SStefano Zampini             if (imode == ADD_VALUES) {
1155674ae819SStefano Zampini               for (i=0;i<pcbddc->local_primal_size;i++) {
1156674ae819SStefano Zampini                 array_to[i]+=array_from[pcbddc->local_primal_indices[i]];
1157674ae819SStefano Zampini               }
1158674ae819SStefano Zampini             } else {
1159674ae819SStefano Zampini               for (i=0;i<pcbddc->local_primal_size;i++) {
1160674ae819SStefano Zampini                 array_to[i]=array_from[pcbddc->local_primal_indices[i]];
1161674ae819SStefano Zampini               }
1162674ae819SStefano Zampini             }
1163674ae819SStefano Zampini           }
1164674ae819SStefano Zampini           break;
1165674ae819SStefano Zampini         case MULTILEVEL_BDDC:
1166674ae819SStefano Zampini           break;
1167674ae819SStefano Zampini         case PARALLEL_BDDC:
1168674ae819SStefano Zampini           break;
1169674ae819SStefano Zampini       }
1170674ae819SStefano Zampini       if (vec_from) {
1171674ae819SStefano Zampini         ierr = VecRestoreArray(vec_from,&array_from);CHKERRQ(ierr);
1172674ae819SStefano Zampini       }
1173674ae819SStefano Zampini       if (vec_to) {
1174674ae819SStefano Zampini         ierr = VecRestoreArray(vec_to,&array_to);CHKERRQ(ierr);
1175674ae819SStefano Zampini       }
1176674ae819SStefano Zampini       break;
1177674ae819SStefano Zampini   }
1178674ae819SStefano Zampini   PetscFunctionReturn(0);
1179674ae819SStefano Zampini }
1180674ae819SStefano Zampini 
1181984c4197SStefano Zampini /* uncomment for testing purposes */
1182984c4197SStefano Zampini /* #define PETSC_MISSING_LAPACK_GESVD 1 */
1183674ae819SStefano Zampini #undef __FUNCT__
1184674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp"
1185674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
1186674ae819SStefano Zampini {
1187674ae819SStefano Zampini   PetscErrorCode    ierr;
1188674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
1189674ae819SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
1190674ae819SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
1191984c4197SStefano Zampini   /* constraint and (optionally) change of basis matrix implemented as SeqAIJ */
1192674ae819SStefano Zampini   MatType           impMatType=MATSEQAIJ;
1193984c4197SStefano Zampini   /* one and zero */
1194984c4197SStefano Zampini   PetscScalar       one=1.0,zero=0.0;
1195984c4197SStefano Zampini   /* space to store constraints and their local indices */
1196984c4197SStefano Zampini   PetscScalar       *temp_quadrature_constraint;
1197984c4197SStefano Zampini   PetscInt          *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B;
1198984c4197SStefano Zampini   /* iterators */
1199984c4197SStefano Zampini   PetscInt          i,j,k,total_counts,temp_start_ptr;
1200984c4197SStefano Zampini   /* stuff to store connected components stored in pcbddc->mat_graph */
1201984c4197SStefano Zampini   IS                ISForVertices,*ISForFaces,*ISForEdges,*used_IS;
1202984c4197SStefano Zampini   PetscInt          n_ISForFaces,n_ISForEdges;
1203984c4197SStefano Zampini   PetscBool         get_faces,get_edges,get_vertices;
1204984c4197SStefano Zampini   /* near null space stuff */
1205674ae819SStefano Zampini   MatNullSpace      nearnullsp;
1206674ae819SStefano Zampini   const Vec         *nearnullvecs;
1207674ae819SStefano Zampini   Vec               *localnearnullsp;
1208984c4197SStefano Zampini   PetscBool         nnsp_has_cnst;
1209984c4197SStefano Zampini   PetscInt          nnsp_size;
1210984c4197SStefano Zampini   PetscScalar       *array;
1211984c4197SStefano Zampini   /* BLAS integers */
1212e310c8b4SStefano Zampini   PetscBLASInt      lwork,lierr;
1213e310c8b4SStefano Zampini   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
1214c4303822SStefano Zampini   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
1215984c4197SStefano Zampini   /* LAPACK working arrays for SVD or POD */
1216242a89d7SStefano Zampini   PetscBool         skip_lapack;
1217984c4197SStefano Zampini   PetscScalar       *work;
1218984c4197SStefano Zampini   PetscReal         *singular_vals;
1219984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1220984c4197SStefano Zampini   PetscReal         *rwork;
1221674ae819SStefano Zampini #endif
1222984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1223e310c8b4SStefano Zampini   PetscBLASInt      Blas_one_2=1;
1224984c4197SStefano Zampini   PetscScalar       *temp_basis,*correlation_mat;
1225b7d8b9f8SStefano Zampini #else
1226b7d8b9f8SStefano Zampini   PetscBLASInt      dummy_int_1=1,dummy_int_2=1;
1227b7d8b9f8SStefano Zampini   PetscScalar       dummy_scalar_1=0.0,dummy_scalar_2=0.0;
1228984c4197SStefano Zampini #endif
1229984c4197SStefano Zampini   /* change of basis */
1230984c4197SStefano Zampini   PetscInt          *aux_primal_numbering,*aux_primal_minloc,*global_indices;
1231984c4197SStefano Zampini   PetscBool         boolforchange,*change_basis,*touched;
1232984c4197SStefano Zampini   /* auxiliary stuff */
1233984c4197SStefano Zampini   PetscInt          *nnz,*is_indices,*local_to_B;
1234984c4197SStefano Zampini   /* some quantities */
1235984c4197SStefano Zampini   PetscInt          n_vertices,total_primal_vertices;
1236984c4197SStefano Zampini   PetscInt          size_of_constraint,max_size_of_constraint,max_constraints,temp_constraints;
1237984c4197SStefano Zampini 
1238674ae819SStefano Zampini 
1239674ae819SStefano Zampini   PetscFunctionBegin;
1240674ae819SStefano Zampini   /* Get index sets for faces, edges and vertices from graph */
1241674ae819SStefano Zampini   get_faces = PETSC_TRUE;
1242674ae819SStefano Zampini   get_edges = PETSC_TRUE;
1243674ae819SStefano Zampini   get_vertices = PETSC_TRUE;
1244674ae819SStefano Zampini   if (pcbddc->vertices_flag) {
1245674ae819SStefano Zampini     get_faces = PETSC_FALSE;
1246674ae819SStefano Zampini     get_edges = PETSC_FALSE;
1247674ae819SStefano Zampini   }
1248674ae819SStefano Zampini   if (pcbddc->constraints_flag) {
1249674ae819SStefano Zampini     get_vertices = PETSC_FALSE;
1250674ae819SStefano Zampini   }
1251674ae819SStefano Zampini   if (pcbddc->faces_flag) {
1252674ae819SStefano Zampini     get_edges = PETSC_FALSE;
1253674ae819SStefano Zampini   }
1254674ae819SStefano Zampini   if (pcbddc->edges_flag) {
1255674ae819SStefano Zampini     get_faces = PETSC_FALSE;
1256674ae819SStefano Zampini   }
1257674ae819SStefano Zampini   /* default */
1258674ae819SStefano Zampini   if (!get_faces && !get_edges && !get_vertices) {
1259674ae819SStefano Zampini     get_vertices = PETSC_TRUE;
1260674ae819SStefano Zampini   }
1261674ae819SStefano Zampini   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,get_faces,get_edges,get_vertices,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);
1262984c4197SStefano Zampini   /* print some info */
1263674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
1264674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1265674ae819SStefano Zampini     i = 0;
1266674ae819SStefano Zampini     if (ISForVertices) {
1267674ae819SStefano Zampini       ierr = ISGetSize(ISForVertices,&i);CHKERRQ(ierr);
1268674ae819SStefano Zampini     }
1269674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices\n",PetscGlobalRank,i);CHKERRQ(ierr);
1270674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges\n",PetscGlobalRank,n_ISForEdges);CHKERRQ(ierr);
127115aaf578SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces\n",PetscGlobalRank,n_ISForFaces);CHKERRQ(ierr);
1272674ae819SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1273674ae819SStefano Zampini   }
1274674ae819SStefano Zampini   /* check if near null space is attached to global mat */
1275674ae819SStefano Zampini   ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
1276674ae819SStefano Zampini   if (nearnullsp) {
1277674ae819SStefano Zampini     ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
1278984c4197SStefano Zampini   } else { /* if near null space is not provided BDDC uses constants by default */
1279984c4197SStefano Zampini     nnsp_size = 0;
1280674ae819SStefano Zampini     nnsp_has_cnst = PETSC_TRUE;
1281674ae819SStefano Zampini   }
1282984c4197SStefano Zampini   /* get max number of constraints on a single cc */
1283984c4197SStefano Zampini   max_constraints = nnsp_size;
1284984c4197SStefano Zampini   if (nnsp_has_cnst) max_constraints++;
1285984c4197SStefano Zampini 
1286674ae819SStefano Zampini   /*
1287674ae819SStefano Zampini        Evaluate maximum storage size needed by the procedure
1288674ae819SStefano Zampini        - temp_indices will contain start index of each constraint stored as follows
1289674ae819SStefano 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
1290674ae819SStefano 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
1291674ae819SStefano Zampini        - temp_quadrature_constraint  [temp_indices[i],...,temp[indices[i+1]-1] will contain the scalars representing the constraint itself
1292674ae819SStefano Zampini                                                                                                                                                          */
1293674ae819SStefano Zampini   total_counts = n_ISForFaces+n_ISForEdges;
1294984c4197SStefano Zampini   total_counts *= max_constraints;
1295674ae819SStefano Zampini   n_vertices = 0;
1296674ae819SStefano Zampini   if (ISForVertices) {
1297674ae819SStefano Zampini     ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
1298674ae819SStefano Zampini   }
1299674ae819SStefano Zampini   total_counts += n_vertices;
1300674ae819SStefano Zampini   ierr = PetscMalloc((total_counts+1)*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
1301674ae819SStefano Zampini   ierr = PetscMalloc((total_counts+1)*sizeof(PetscBool),&change_basis);CHKERRQ(ierr);
1302674ae819SStefano Zampini   total_counts = 0;
1303674ae819SStefano Zampini   max_size_of_constraint = 0;
1304674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1305674ae819SStefano Zampini     if (i<n_ISForEdges) {
1306674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1307674ae819SStefano Zampini     } else {
1308674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1309674ae819SStefano Zampini     }
1310674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
1311674ae819SStefano Zampini     total_counts += j;
1312674ae819SStefano Zampini     max_size_of_constraint = PetscMax(j,max_size_of_constraint);
1313674ae819SStefano Zampini   }
1314984c4197SStefano Zampini   total_counts *= max_constraints;
1315674ae819SStefano Zampini   total_counts += n_vertices;
1316674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&temp_quadrature_constraint);CHKERRQ(ierr);
1317674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint);CHKERRQ(ierr);
1318674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint_B);CHKERRQ(ierr);
1319984c4197SStefano Zampini   /* local to boundary numbering */
1320674ae819SStefano Zampini   ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&local_to_B);CHKERRQ(ierr);
1321674ae819SStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1322984c4197SStefano Zampini   for (i=0;i<pcis->n;i++) local_to_B[i]=-1;
1323984c4197SStefano Zampini   for (i=0;i<pcis->n_B;i++) local_to_B[is_indices[i]]=i;
1324674ae819SStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1325984c4197SStefano Zampini   /* get local part of global near null space vectors */
1326984c4197SStefano Zampini   ierr = PetscMalloc(nnsp_size*sizeof(Vec),&localnearnullsp);CHKERRQ(ierr);
1327984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1328984c4197SStefano Zampini     ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
1329984c4197SStefano Zampini     ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1330984c4197SStefano Zampini     ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1331984c4197SStefano Zampini   }
1332674ae819SStefano Zampini 
1333242a89d7SStefano Zampini   /* whether or not to skip lapack calls */
1334242a89d7SStefano Zampini   skip_lapack = PETSC_TRUE;
1335242a89d7SStefano Zampini   if (n_ISForFaces+n_ISForEdges) skip_lapack = PETSC_FALSE;
1336242a89d7SStefano Zampini 
1337984c4197SStefano Zampini   /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
1338242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1339674ae819SStefano Zampini     PetscScalar temp_work;
1340674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1341984c4197SStefano Zampini     /* Proper Orthogonal Decomposition (POD) using the snapshot method */
1342984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*max_constraints*sizeof(PetscScalar),&correlation_mat);CHKERRQ(ierr);
1343984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1344984c4197SStefano Zampini     ierr = PetscMalloc(max_size_of_constraint*max_constraints*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr);
1345674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1346984c4197SStefano Zampini     ierr = PetscMalloc(3*max_constraints*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1347674ae819SStefano Zampini #endif
1348674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1349c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
1350c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
1351674ae819SStefano Zampini     lwork = -1;
1352674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1353674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1354c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
1355674ae819SStefano Zampini #else
1356c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
1357674ae819SStefano Zampini #endif
1358674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1359984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
1360674ae819SStefano Zampini #else /* on missing GESVD */
1361674ae819SStefano Zampini     /* SVD */
1362674ae819SStefano Zampini     PetscInt max_n,min_n;
1363674ae819SStefano Zampini     max_n = max_size_of_constraint;
1364984c4197SStefano Zampini     min_n = max_constraints;
1365984c4197SStefano Zampini     if (max_size_of_constraint < max_constraints) {
1366674ae819SStefano Zampini       min_n = max_size_of_constraint;
1367984c4197SStefano Zampini       max_n = max_constraints;
1368674ae819SStefano Zampini     }
1369674ae819SStefano Zampini     ierr = PetscMalloc(min_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1370674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1371674ae819SStefano Zampini     ierr = PetscMalloc(5*min_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1372674ae819SStefano Zampini #endif
1373674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1374674ae819SStefano Zampini     lwork = -1;
1375e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
1376e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
1377b7d8b9f8SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
1378674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1379674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1380e310c8b4SStefano 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));
1381674ae819SStefano Zampini #else
1382e310c8b4SStefano 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));
1383674ae819SStefano Zampini #endif
1384674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1385984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
1386984c4197SStefano Zampini #endif /* on missing GESVD */
1387674ae819SStefano Zampini     /* Allocate optimal workspace */
1388674ae819SStefano Zampini     ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
1389984c4197SStefano Zampini     ierr = PetscMalloc((PetscInt)lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
1390674ae819SStefano Zampini   }
1391674ae819SStefano Zampini   /* Now we can loop on constraining sets */
1392674ae819SStefano Zampini   total_counts = 0;
1393674ae819SStefano Zampini   temp_indices[0] = 0;
1394674ae819SStefano Zampini   /* vertices */
1395674ae819SStefano Zampini   if (ISForVertices) {
1396674ae819SStefano Zampini     ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1397674ae819SStefano Zampini     if (nnsp_has_cnst) { /* consider all vertices */
1398674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1399674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1400674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
1401674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1402674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1403674ae819SStefano Zampini         change_basis[total_counts]=PETSC_FALSE;
1404674ae819SStefano Zampini         total_counts++;
1405674ae819SStefano Zampini       }
1406674ae819SStefano Zampini     } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
1407984c4197SStefano Zampini       PetscBool used_vertex;
1408674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1409674ae819SStefano Zampini         used_vertex = PETSC_FALSE;
1410674ae819SStefano Zampini         k = 0;
1411674ae819SStefano Zampini         while (!used_vertex && k<nnsp_size) {
1412984c4197SStefano Zampini           ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1413984c4197SStefano Zampini           if (PetscAbsScalar(array[is_indices[i]])>0.0) {
1414674ae819SStefano Zampini             temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1415674ae819SStefano Zampini             temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
1416674ae819SStefano Zampini             temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1417674ae819SStefano Zampini             temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1418674ae819SStefano Zampini             change_basis[total_counts]=PETSC_FALSE;
1419674ae819SStefano Zampini             total_counts++;
1420674ae819SStefano Zampini             used_vertex = PETSC_TRUE;
1421674ae819SStefano Zampini           }
1422984c4197SStefano Zampini           ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1423674ae819SStefano Zampini           k++;
1424674ae819SStefano Zampini         }
1425674ae819SStefano Zampini       }
1426674ae819SStefano Zampini     }
1427674ae819SStefano Zampini     ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1428674ae819SStefano Zampini     n_vertices = total_counts;
1429674ae819SStefano Zampini   }
1430984c4197SStefano Zampini 
1431674ae819SStefano Zampini   /* edges and faces */
1432674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1433674ae819SStefano Zampini     if (i<n_ISForEdges) {
1434674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1435984c4197SStefano Zampini       boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
1436674ae819SStefano Zampini     } else {
1437674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1438984c4197SStefano Zampini       boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
1439674ae819SStefano Zampini     }
1440674ae819SStefano Zampini     temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
1441674ae819SStefano Zampini     temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
1442674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
1443674ae819SStefano Zampini     ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1444984c4197SStefano Zampini     /* change of basis should not be performed on local periodic nodes */
1445984c4197SStefano Zampini     if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
1446674ae819SStefano Zampini     if (nnsp_has_cnst) {
14475b08dc53SStefano Zampini       PetscScalar quad_value;
1448674ae819SStefano Zampini       temp_constraints++;
1449674ae819SStefano Zampini       quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
1450674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1451674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
1452674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
1453674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
1454674ae819SStefano Zampini       }
1455674ae819SStefano Zampini       temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
145651b0f6cfSStefano Zampini       change_basis[total_counts]=boolforchange;
1457674ae819SStefano Zampini       total_counts++;
1458674ae819SStefano Zampini     }
1459674ae819SStefano Zampini     for (k=0;k<nnsp_size;k++) {
1460984c4197SStefano Zampini       PetscReal real_value;
1461984c4197SStefano Zampini       ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1462674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1463674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
1464674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
1465984c4197SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=array[is_indices[j]];
1466674ae819SStefano Zampini       }
1467984c4197SStefano Zampini       ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1468984c4197SStefano Zampini       /* check if array is null on the connected component */
1469e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1470e310c8b4SStefano Zampini       PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_one));
14715b08dc53SStefano Zampini       if (real_value > 0.0) { /* keep indices and values */
1472674ae819SStefano Zampini         temp_constraints++;
1473674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
147451b0f6cfSStefano Zampini         change_basis[total_counts]=boolforchange;
1475674ae819SStefano Zampini         total_counts++;
1476674ae819SStefano Zampini       }
1477674ae819SStefano Zampini     }
1478674ae819SStefano Zampini     ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1479984c4197SStefano Zampini     /* perform SVD on the constraints if use_nnsp_true has not be requested by the user */
1480984c4197SStefano Zampini     if (!pcbddc->use_nnsp_true) {
1481984c4197SStefano Zampini       PetscReal tol = 1.0e-8; /* tolerance for retaining eigenmodes */
1482674ae819SStefano Zampini 
1483674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1484984c4197SStefano Zampini       /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
1485984c4197SStefano Zampini          POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
1486984c4197SStefano Zampini          -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
1487984c4197SStefano Zampini             the constraints basis will differ (by a complex factor with absolute value equal to 1)
1488984c4197SStefano Zampini             from that computed using LAPACKgesvd
1489984c4197SStefano Zampini          -> This is due to a different computation of eigenvectors in LAPACKheev
1490984c4197SStefano Zampini          -> The quality of the POD-computed basis will be the same */
1491984c4197SStefano Zampini       ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
1492674ae819SStefano Zampini       /* Store upper triangular part of correlation matrix */
1493e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1494984c4197SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1495674ae819SStefano Zampini       for (j=0;j<temp_constraints;j++) {
1496674ae819SStefano Zampini         for (k=0;k<j+1;k++) {
1497e310c8b4SStefano 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));
1498674ae819SStefano Zampini         }
1499674ae819SStefano Zampini       }
1500e310c8b4SStefano Zampini       /* compute eigenvalues and eigenvectors of correlation matrix */
1501e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1502e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
1503674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1504c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
1505674ae819SStefano Zampini #else
1506c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
1507674ae819SStefano Zampini #endif
1508674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1509984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
1510984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
1511674ae819SStefano Zampini       j=0;
1512984c4197SStefano Zampini       while (j < temp_constraints && singular_vals[j] < tol) j++;
1513674ae819SStefano Zampini       total_counts=total_counts-j;
1514e310c8b4SStefano Zampini       /* scale and copy POD basis into used quadrature memory */
1515c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1516c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1517c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
1518c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1519c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
1520c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1521674ae819SStefano Zampini       if (j<temp_constraints) {
1522984c4197SStefano Zampini         PetscInt ii;
1523984c4197SStefano Zampini         for (k=j;k<temp_constraints;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]);
1524674ae819SStefano Zampini         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1525c4303822SStefano 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));
1526674ae819SStefano Zampini         ierr = PetscFPTrapPop();CHKERRQ(ierr);
1527984c4197SStefano Zampini         for (k=0;k<temp_constraints-j;k++) {
1528674ae819SStefano Zampini           for (ii=0;ii<size_of_constraint;ii++) {
1529984c4197SStefano 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];
1530674ae819SStefano Zampini           }
1531674ae819SStefano Zampini         }
1532674ae819SStefano Zampini       }
1533674ae819SStefano Zampini #else  /* on missing GESVD */
1534e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1535e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1536b7d8b9f8SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1537674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1538674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1539e310c8b4SStefano 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));
1540674ae819SStefano Zampini #else
1541e310c8b4SStefano 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));
1542674ae819SStefano Zampini #endif
1543984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
1544674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1545984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
1546e310c8b4SStefano Zampini       k = temp_constraints;
1547e310c8b4SStefano Zampini       if (k > size_of_constraint) k = size_of_constraint;
1548674ae819SStefano Zampini       j = 0;
1549e310c8b4SStefano Zampini       while (j < k && singular_vals[k-j-1] < tol) j++;
1550e310c8b4SStefano Zampini       total_counts = total_counts-temp_constraints+k-j;
1551984c4197SStefano Zampini #endif /* on missing GESVD */
1552674ae819SStefano Zampini     }
1553674ae819SStefano Zampini   }
1554674ae819SStefano Zampini   /* free index sets of faces, edges and vertices */
1555674ae819SStefano Zampini   for (i=0;i<n_ISForFaces;i++) {
1556674ae819SStefano Zampini     ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
1557674ae819SStefano Zampini   }
1558674ae819SStefano Zampini   ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
1559674ae819SStefano Zampini   for (i=0;i<n_ISForEdges;i++) {
1560674ae819SStefano Zampini     ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
1561674ae819SStefano Zampini   }
1562674ae819SStefano Zampini   ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
1563674ae819SStefano Zampini   ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
1564674ae819SStefano Zampini 
1565984c4197SStefano Zampini   /* free workspace */
1566242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1567984c4197SStefano Zampini     ierr = PetscFree(work);CHKERRQ(ierr);
1568984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1569984c4197SStefano Zampini     ierr = PetscFree(rwork);CHKERRQ(ierr);
1570984c4197SStefano Zampini #endif
1571984c4197SStefano Zampini     ierr = PetscFree(singular_vals);CHKERRQ(ierr);
1572984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1573984c4197SStefano Zampini     ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
1574984c4197SStefano Zampini     ierr = PetscFree(temp_basis);CHKERRQ(ierr);
1575984c4197SStefano Zampini #endif
1576984c4197SStefano Zampini   }
1577984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1578984c4197SStefano Zampini     ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
1579984c4197SStefano Zampini   }
1580984c4197SStefano Zampini   ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
1581984c4197SStefano Zampini 
1582674ae819SStefano Zampini   /* set quantities in pcbddc data structure */
1583984c4197SStefano Zampini   /* n_vertices defines the number of subdomain corners in the primal space */
1584674ae819SStefano Zampini   /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */
1585984c4197SStefano Zampini   pcbddc->local_primal_size = total_counts;
1586674ae819SStefano Zampini   pcbddc->n_vertices = n_vertices;
1587984c4197SStefano Zampini   pcbddc->n_constraints = pcbddc->local_primal_size-pcbddc->n_vertices;
1588674ae819SStefano Zampini 
1589674ae819SStefano Zampini   /* Create constraint matrix */
1590674ae819SStefano Zampini   /* The constraint matrix is used to compute the l2g map of primal dofs */
1591674ae819SStefano Zampini   /* so we need to set it up properly either with or without change of basis */
1592674ae819SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1593674ae819SStefano Zampini   ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr);
1594984c4197SStefano Zampini   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
1595984c4197SStefano Zampini   /* array to compute a local numbering of constraints : vertices first then constraints */
1596984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_numbering);CHKERRQ(ierr);
1597984c4197SStefano Zampini   /* array to select the proper local node (of minimum index with respect to global ordering) when changing the basis */
1598984c4197SStefano Zampini   /* note: it should not be needed since IS for faces and edges are already sorted by global ordering when analyzing the graph but... just in case */
1599984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_minloc);CHKERRQ(ierr);
1600984c4197SStefano Zampini   /* auxiliary stuff for basis change */
1601984c4197SStefano Zampini   ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&global_indices);CHKERRQ(ierr);
1602984c4197SStefano Zampini   ierr = PetscMalloc(pcis->n_B*sizeof(PetscBool),&touched);CHKERRQ(ierr);
1603984c4197SStefano Zampini   ierr = PetscMemzero(touched,pcis->n_B*sizeof(PetscBool));CHKERRQ(ierr);
1604984c4197SStefano Zampini 
1605984c4197SStefano Zampini   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
1606984c4197SStefano Zampini   total_primal_vertices=0;
1607984c4197SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
1608674ae819SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
1609984c4197SStefano Zampini     if (size_of_constraint == 1) {
1610984c4197SStefano Zampini       touched[temp_indices_to_constraint_B[temp_indices[i]]]=PETSC_TRUE;
1611984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]];
1612984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=0;
1613984c4197SStefano Zampini       total_primal_vertices++;
1614984c4197SStefano Zampini     } else if (change_basis[i]) { /* Same procedure used in PCBDDCGetPrimalConstraintsLocalIdx */
1615984c4197SStefano Zampini       PetscInt min_loc,min_index;
1616984c4197SStefano Zampini       ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],global_indices);CHKERRQ(ierr);
1617984c4197SStefano Zampini       /* find first untouched local node */
1618674ae819SStefano Zampini       k = 0;
1619984c4197SStefano Zampini       while (touched[temp_indices_to_constraint_B[temp_indices[i]+k]]) k++;
1620984c4197SStefano Zampini       min_index = global_indices[k];
1621984c4197SStefano Zampini       min_loc = k;
1622984c4197SStefano Zampini       /* search the minimum among global nodes already untouched on the cc */
1623984c4197SStefano Zampini       for (k=1;k<size_of_constraint;k++) {
1624984c4197SStefano Zampini         /* there can be more than one constraint on a single connected component */
1625984c4197SStefano Zampini         if (min_index > global_indices[k] && !touched[temp_indices_to_constraint_B[temp_indices[i]+k]]) {
1626984c4197SStefano Zampini           min_index = global_indices[k];
1627984c4197SStefano Zampini           min_loc = k;
1628674ae819SStefano Zampini         }
1629674ae819SStefano Zampini       }
1630984c4197SStefano Zampini       touched[temp_indices_to_constraint_B[temp_indices[i]+min_loc]] = PETSC_TRUE;
1631984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]+min_loc];
1632984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=min_loc;
1633984c4197SStefano Zampini       total_primal_vertices++;
1634984c4197SStefano Zampini     }
1635984c4197SStefano Zampini   }
1636984c4197SStefano Zampini   /* free workspace */
1637984c4197SStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
1638984c4197SStefano Zampini   ierr = PetscFree(touched);CHKERRQ(ierr);
1639674ae819SStefano Zampini   /* permute indices in order to have a sorted set of vertices */
1640984c4197SStefano Zampini   ierr = PetscSortInt(total_primal_vertices,aux_primal_numbering);
1641984c4197SStefano Zampini 
1642984c4197SStefano Zampini   /* nonzero structure of constraint matrix */
1643984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1644984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) nnz[i]=1;
1645984c4197SStefano Zampini   j=total_primal_vertices;
1646984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1647674ae819SStefano Zampini     if (!change_basis[i]) {
1648674ae819SStefano Zampini       nnz[j]=temp_indices[i+1]-temp_indices[i];
1649674ae819SStefano Zampini       j++;
1650674ae819SStefano Zampini     }
1651674ae819SStefano Zampini   }
1652674ae819SStefano Zampini   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
1653674ae819SStefano Zampini   ierr = PetscFree(nnz);CHKERRQ(ierr);
1654674ae819SStefano Zampini   /* set values in constraint matrix */
1655984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) {
1656984c4197SStefano Zampini     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,aux_primal_numbering[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
1657674ae819SStefano Zampini   }
1658984c4197SStefano Zampini   total_counts = total_primal_vertices;
1659984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1660674ae819SStefano Zampini     if (!change_basis[i]) {
1661674ae819SStefano Zampini       size_of_constraint=temp_indices[i+1]-temp_indices[i];
1662674ae819SStefano 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);
1663674ae819SStefano Zampini       total_counts++;
1664674ae819SStefano Zampini     }
1665674ae819SStefano Zampini   }
1666674ae819SStefano Zampini   /* assembling */
1667674ae819SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1668674ae819SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1669984c4197SStefano Zampini   /*
1670984c4197SStefano Zampini   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
1671984c4197SStefano Zampini   */
1672674ae819SStefano Zampini   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
1673674ae819SStefano Zampini   if (pcbddc->use_change_of_basis) {
1674984c4197SStefano Zampini     PetscBool qr_needed = PETSC_FALSE;
1675984c4197SStefano Zampini     /* change of basis acts on local interfaces -> dimension is n_B x n_B */
1676674ae819SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
1677674ae819SStefano Zampini     ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr);
1678674ae819SStefano Zampini     ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr);
1679674ae819SStefano Zampini     /* work arrays */
1680674ae819SStefano Zampini     ierr = PetscMalloc(pcis->n_B*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1681984c4197SStefano Zampini     for (i=0;i<pcis->n_B;i++) nnz[i]=1;
1682984c4197SStefano Zampini     /* nonzeros per row */
1683984c4197SStefano Zampini     for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1684674ae819SStefano Zampini       if (change_basis[i]) {
1685984c4197SStefano Zampini         qr_needed = PETSC_TRUE;
1686674ae819SStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
1687984c4197SStefano Zampini         for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1688674ae819SStefano Zampini       }
1689674ae819SStefano Zampini     }
1690674ae819SStefano Zampini     ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
1691674ae819SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
1692674ae819SStefano Zampini     /* Set initial identity in the matrix */
1693674ae819SStefano Zampini     for (i=0;i<pcis->n_B;i++) {
1694674ae819SStefano Zampini       ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
1695674ae819SStefano Zampini     }
1696984c4197SStefano Zampini 
1697674ae819SStefano Zampini     /* Now we loop on the constraints which need a change of basis */
1698674ae819SStefano Zampini     /* Change of basis matrix is evaluated as the FIRST APPROACH in */
1699984c4197SStefano Zampini     /* Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1) */
1700984c4197SStefano Zampini     /* Change of basis matrix T computed via QR decomposition of constraints */
1701984c4197SStefano Zampini     if (qr_needed) {
1702026de310SStefano Zampini       /* dual and primal dofs on a single cc */
1703984c4197SStefano Zampini       PetscInt     dual_dofs,primal_dofs;
1704026de310SStefano Zampini       /* iterator on aux_primal_minloc (ordered as read from nearnullspace: vertices, edges and then constraints) */
1705026de310SStefano Zampini       PetscInt     primal_counter;
1706984c4197SStefano Zampini       /* working stuff for GEQRF */
1707984c4197SStefano Zampini       PetscScalar  *qr_basis,*qr_tau,*qr_work,lqr_work_t;
1708984c4197SStefano Zampini       PetscBLASInt lqr_work;
1709984c4197SStefano Zampini       /* working stuff for UNGQR */
1710984c4197SStefano Zampini       PetscScalar  *gqr_work,lgqr_work_t;
1711984c4197SStefano Zampini       PetscBLASInt lgqr_work;
1712984c4197SStefano Zampini       /* working stuff for TRTRS */
1713984c4197SStefano Zampini       PetscScalar  *trs_rhs;
17143f08241aSStefano Zampini       PetscBLASInt Blas_NRHS;
1715984c4197SStefano Zampini       /* pointers for values insertion into change of basis matrix */
1716984c4197SStefano Zampini       PetscInt     *start_rows,*start_cols;
1717984c4197SStefano Zampini       PetscScalar  *start_vals;
1718984c4197SStefano Zampini       /* working stuff for values insertion */
1719984c4197SStefano Zampini       PetscBool    *is_primal;
1720984c4197SStefano Zampini 
1721984c4197SStefano Zampini       /* space to store Q */
1722984c4197SStefano Zampini       ierr = PetscMalloc((max_size_of_constraint)*(max_size_of_constraint)*sizeof(PetscScalar),&qr_basis);CHKERRQ(ierr);
1723984c4197SStefano Zampini       /* first we issue queries for optimal work */
17243f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
17253f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
17263f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1727984c4197SStefano Zampini       lqr_work = -1;
17283f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
1729984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
1730984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
1731984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lqr_work_t)*sizeof(*qr_work),&qr_work);CHKERRQ(ierr);
1732984c4197SStefano Zampini       lgqr_work = -1;
17333f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
17343f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
17353f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
17363f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
17373f08241aSStefano Zampini       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
17383f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
1739984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
1740984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
1741984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lgqr_work_t)*sizeof(*gqr_work),&gqr_work);CHKERRQ(ierr);
1742984c4197SStefano Zampini       /* array to store scaling factors for reflectors */
1743984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*sizeof(*qr_tau),&qr_tau);CHKERRQ(ierr);
1744984c4197SStefano Zampini       /* array to store rhs and solution of triangular solver */
1745984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*max_constraints*sizeof(*trs_rhs),&trs_rhs);CHKERRQ(ierr);
1746984c4197SStefano Zampini       /* array to store whether a node is primal or not */
1747984c4197SStefano Zampini       ierr = PetscMalloc(pcis->n_B*sizeof(*is_primal),&is_primal);CHKERRQ(ierr);
1748984c4197SStefano Zampini       ierr = PetscMemzero(is_primal,pcis->n_B*sizeof(*is_primal));CHKERRQ(ierr);
1749984c4197SStefano Zampini       for (i=0;i<total_primal_vertices;i++) is_primal[local_to_B[aux_primal_numbering[i]]] = PETSC_TRUE;
1750984c4197SStefano Zampini 
1751984c4197SStefano Zampini       /* allocating workspace for check */
1752984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
1753984c4197SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1754984c4197SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
1755984c4197SStefano Zampini         ierr = PetscMalloc(max_size_of_constraint*(max_constraints+max_size_of_constraint)*sizeof(*work),&work);CHKERRQ(ierr);
1756674ae819SStefano Zampini       }
1757984c4197SStefano Zampini 
1758026de310SStefano Zampini       /* loop on constraints and see whether or not they need a change of basis */
1759026de310SStefano Zampini       /* -> using implicit ordering contained in temp_indices data */
1760026de310SStefano Zampini       total_counts = pcbddc->n_vertices;
1761026de310SStefano Zampini       primal_counter = total_counts;
1762026de310SStefano Zampini       while (total_counts<pcbddc->local_primal_size) {
1763026de310SStefano Zampini         primal_dofs = 1;
1764026de310SStefano Zampini         if (change_basis[total_counts]) {
1765026de310SStefano Zampini           /* get all constraints with same support: if more then one constraint is present on the cc then surely indices are stored contiguosly */
1766026de310SStefano 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]]) {
1767026de310SStefano Zampini             primal_dofs++;
1768674ae819SStefano Zampini           }
1769984c4197SStefano Zampini           /* get constraint info */
1770026de310SStefano Zampini           size_of_constraint = temp_indices[total_counts+1]-temp_indices[total_counts];
1771984c4197SStefano Zampini           dual_dofs = size_of_constraint-primal_dofs;
1772984c4197SStefano Zampini 
1773984c4197SStefano Zampini           /* copy quadrature constraints for change of basis check */
1774984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
1775026de310SStefano 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);
1776026de310SStefano Zampini             ierr = PetscMemcpy(work,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1777674ae819SStefano Zampini           }
1778984c4197SStefano Zampini 
1779984c4197SStefano Zampini           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
1780026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1781984c4197SStefano Zampini 
1782984c4197SStefano Zampini           /* compute QR decomposition of constraints */
17833f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
17843f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
17853f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1786674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
17873f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
1788984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
1789674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1790984c4197SStefano Zampini 
1791984c4197SStefano Zampini           /* explictly compute R^-T */
1792984c4197SStefano Zampini           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
1793984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
17943f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
17953f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
17963f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
17973f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
1798984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
17993f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
1800984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
1801984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1802984c4197SStefano Zampini 
1803984c4197SStefano Zampini           /* explcitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
18043f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
18053f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
18063f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
18073f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1808984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
18093f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
1810984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
1811984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1812984c4197SStefano Zampini 
1813984c4197SStefano Zampini           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
1814984c4197SStefano Zampini              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
1815984c4197SStefano Zampini              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
18163f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
18173f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
18183f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
18193f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
18203f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
18213f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1822984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1823c4303822SStefano 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));
1824984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1825026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1826984c4197SStefano Zampini 
1827984c4197SStefano Zampini           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
1828026de310SStefano Zampini           start_rows = &temp_indices_to_constraint_B[temp_indices[total_counts]];
1829984c4197SStefano Zampini           /* insert cols for primal dofs */
1830984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) {
1831984c4197SStefano Zampini             start_vals = &qr_basis[j*size_of_constraint];
1832026de310SStefano Zampini             start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter+j]];
1833984c4197SStefano Zampini             ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1834984c4197SStefano Zampini           }
1835984c4197SStefano Zampini           /* insert cols for dual dofs */
1836984c4197SStefano Zampini           for (j=0,k=0;j<dual_dofs;k++) {
1837026de310SStefano Zampini             if (!is_primal[temp_indices_to_constraint_B[temp_indices[total_counts]+k]]) {
1838984c4197SStefano Zampini               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
1839026de310SStefano Zampini               start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+k];
1840984c4197SStefano Zampini               ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1841984c4197SStefano Zampini               j++;
1842674ae819SStefano Zampini             }
1843674ae819SStefano Zampini           }
1844984c4197SStefano Zampini 
1845984c4197SStefano Zampini           /* check change of basis */
1846984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
1847984c4197SStefano Zampini             PetscInt   ii,jj;
1848984c4197SStefano Zampini             PetscBool valid_qr=PETSC_TRUE;
1849c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
1850c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1851c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
1852c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1853c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
1854c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
1855984c4197SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1856c4303822SStefano 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));
1857984c4197SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
1858984c4197SStefano Zampini             for (jj=0;jj<size_of_constraint;jj++) {
1859984c4197SStefano Zampini               for (ii=0;ii<primal_dofs;ii++) {
1860984c4197SStefano Zampini                 if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
1861984c4197SStefano Zampini                 if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
1862674ae819SStefano Zampini               }
1863674ae819SStefano Zampini             }
1864984c4197SStefano Zampini             if (!valid_qr) {
1865984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
1866984c4197SStefano Zampini               for (jj=0;jj<size_of_constraint;jj++) {
1867984c4197SStefano Zampini                 for (ii=0;ii<primal_dofs;ii++) {
1868984c4197SStefano Zampini                   if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
1869984c4197SStefano 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]));
1870674ae819SStefano Zampini                   }
1871984c4197SStefano Zampini                   if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
1872984c4197SStefano 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]));
1873984c4197SStefano Zampini                   }
1874984c4197SStefano Zampini                 }
1875984c4197SStefano Zampini               }
1876674ae819SStefano Zampini             } else {
1877984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
1878674ae819SStefano Zampini             }
1879674ae819SStefano Zampini           }
1880026de310SStefano Zampini           /* increment primal counter */
1881026de310SStefano Zampini           primal_counter += primal_dofs;
1882984c4197SStefano Zampini         } else {
1883984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
1884026de310SStefano 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);
1885674ae819SStefano Zampini           }
1886674ae819SStefano Zampini         }
1887026de310SStefano Zampini         /* increment constraint counter total_counts */
1888026de310SStefano Zampini         total_counts += primal_dofs;
1889674ae819SStefano Zampini       }
1890984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
1891984c4197SStefano Zampini         ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1892984c4197SStefano Zampini         ierr = PetscFree(work);CHKERRQ(ierr);
1893984c4197SStefano Zampini       }
1894984c4197SStefano Zampini       /* free workspace */
1895984c4197SStefano Zampini       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
1896984c4197SStefano Zampini       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
1897984c4197SStefano Zampini       ierr = PetscFree(qr_work);CHKERRQ(ierr);
1898984c4197SStefano Zampini       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
1899984c4197SStefano Zampini       ierr = PetscFree(is_primal);CHKERRQ(ierr);
1900984c4197SStefano Zampini       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
1901674ae819SStefano Zampini     }
1902674ae819SStefano Zampini     /* assembling */
1903674ae819SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1904674ae819SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1905984c4197SStefano Zampini     /*
1906984c4197SStefano Zampini     ierr = MatView(pcbddc->ChangeOfBasisMatrix,(PetscViewer)0);CHKERRQ(ierr);
1907984c4197SStefano Zampini     */
1908674ae819SStefano Zampini   }
1909e310c8b4SStefano Zampini   /* free workspace */
1910984c4197SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
1911984c4197SStefano Zampini   ierr = PetscFree(aux_primal_minloc);CHKERRQ(ierr);
1912674ae819SStefano Zampini   ierr = PetscFree(temp_indices);CHKERRQ(ierr);
1913674ae819SStefano Zampini   ierr = PetscFree(change_basis);CHKERRQ(ierr);
1914674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr);
1915674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
1916674ae819SStefano Zampini   ierr = PetscFree(local_to_B);CHKERRQ(ierr);
1917674ae819SStefano Zampini   ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr);
1918674ae819SStefano Zampini   PetscFunctionReturn(0);
1919674ae819SStefano Zampini }
1920674ae819SStefano Zampini 
1921674ae819SStefano Zampini #undef __FUNCT__
1922674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
1923674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
1924674ae819SStefano Zampini {
1925674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
1926674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
1927674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
1928674ae819SStefano Zampini   PetscInt    bs,ierr,i,vertex_size;
1929674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
1930674ae819SStefano Zampini 
1931674ae819SStefano Zampini   PetscFunctionBegin;
1932674ae819SStefano Zampini   /* Init local Graph struct */
1933674ae819SStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr);
1934674ae819SStefano Zampini 
1935575ad6abSStefano Zampini   /* Check validity of the csr graph passed in by the user */
1936575ad6abSStefano Zampini   if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) {
1937575ad6abSStefano Zampini     ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1938575ad6abSStefano Zampini   }
1939674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
1940674ae819SStefano Zampini   if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) {
1941674ae819SStefano Zampini     Mat mat_adj;
1942674ae819SStefano Zampini     const PetscInt *xadj,*adjncy;
1943674ae819SStefano Zampini     PetscBool flg_row=PETSC_TRUE;
1944674ae819SStefano Zampini 
1945674ae819SStefano Zampini     ierr = MatConvert(matis->A,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr);
1946674ae819SStefano Zampini     ierr = MatGetRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
1947674ae819SStefano Zampini     if (!flg_row) {
1948674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ called in %s\n",__FUNCT__);
1949674ae819SStefano Zampini     }
1950674ae819SStefano Zampini     ierr = PCBDDCSetLocalAdjacencyGraph(pc,i,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
1951674ae819SStefano Zampini     ierr = MatRestoreRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
1952674ae819SStefano Zampini     if (!flg_row) {
1953674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__);
1954674ae819SStefano Zampini     }
1955674ae819SStefano Zampini     ierr = MatDestroy(&mat_adj);CHKERRQ(ierr);
1956674ae819SStefano Zampini   }
1957674ae819SStefano Zampini 
1958674ae819SStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting */
1959674ae819SStefano Zampini   vertex_size = 1;
1960674ae819SStefano Zampini   if (!pcbddc->n_ISForDofs) {
1961674ae819SStefano Zampini     IS *custom_ISForDofs;
1962674ae819SStefano Zampini 
1963674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&bs);CHKERRQ(ierr);
1964674ae819SStefano Zampini     ierr = PetscMalloc(bs*sizeof(IS),&custom_ISForDofs);CHKERRQ(ierr);
1965674ae819SStefano Zampini     for (i=0;i<bs;i++) {
1966674ae819SStefano Zampini       ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n/bs,i,bs,&custom_ISForDofs[i]);CHKERRQ(ierr);
1967674ae819SStefano Zampini     }
1968674ae819SStefano Zampini     ierr = PCBDDCSetDofsSplitting(pc,bs,custom_ISForDofs);CHKERRQ(ierr);
1969674ae819SStefano Zampini     /* remove my references to IS objects */
1970674ae819SStefano Zampini     for (i=0;i<bs;i++) {
1971674ae819SStefano Zampini       ierr = ISDestroy(&custom_ISForDofs[i]);CHKERRQ(ierr);
1972674ae819SStefano Zampini     }
1973674ae819SStefano Zampini     ierr = PetscFree(custom_ISForDofs);CHKERRQ(ierr);
1974674ae819SStefano Zampini   } else { /* mat block size as vertex size (used for elasticity) */
1975674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
1976674ae819SStefano Zampini   }
1977674ae819SStefano Zampini 
1978674ae819SStefano Zampini   /* Setup of Graph */
1979674ae819SStefano Zampini   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundaries,pcbddc->DirichletBoundaries,pcbddc->n_ISForDofs,pcbddc->ISForDofs,pcbddc->user_primal_vertices);
1980674ae819SStefano Zampini 
1981674ae819SStefano Zampini   /* Graph's connected components analysis */
1982674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
1983674ae819SStefano Zampini 
1984674ae819SStefano Zampini   /* print some info to stdout */
1985674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
1986e49050b4SStefano Zampini     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer);
1987674ae819SStefano Zampini   }
1988674ae819SStefano Zampini   PetscFunctionReturn(0);
1989674ae819SStefano Zampini }
1990674ae819SStefano Zampini 
1991674ae819SStefano Zampini #undef __FUNCT__
1992674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx"
1993674ae819SStefano Zampini PetscErrorCode  PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt *vertices_idx[])
1994674ae819SStefano Zampini {
1995674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
1996674ae819SStefano Zampini   PetscInt       *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size;
1997674ae819SStefano Zampini   PetscErrorCode ierr;
1998674ae819SStefano Zampini 
1999674ae819SStefano Zampini   PetscFunctionBegin;
2000674ae819SStefano Zampini   n = 0;
2001674ae819SStefano Zampini   vertices = 0;
2002674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2003674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr);
2004b120a5c6SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2005b120a5c6SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2006b120a5c6SStefano Zampini       if (size_of_constraint == 1) n++;
2007b120a5c6SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2008b120a5c6SStefano Zampini     }
2009811e8ca2SStefano Zampini     if (vertices_idx) {
2010b120a5c6SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&vertices);CHKERRQ(ierr);
2011b120a5c6SStefano Zampini       n = 0;
2012674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2013674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2014674ae819SStefano Zampini         if (size_of_constraint == 1) {
2015674ae819SStefano Zampini           vertices[n++]=row_cmat_indices[0];
2016674ae819SStefano Zampini         }
2017674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2018674ae819SStefano Zampini       }
2019674ae819SStefano Zampini     }
2020811e8ca2SStefano Zampini   }
2021674ae819SStefano Zampini   *n_vertices = n;
2022811e8ca2SStefano Zampini   if (vertices_idx) *vertices_idx = vertices;
2023674ae819SStefano Zampini   PetscFunctionReturn(0);
2024674ae819SStefano Zampini }
2025674ae819SStefano Zampini 
2026674ae819SStefano Zampini #undef __FUNCT__
2027674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx"
2028674ae819SStefano Zampini PetscErrorCode  PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt *constraints_idx[])
2029674ae819SStefano Zampini {
2030674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2031674ae819SStefano Zampini   PetscInt       *constraints_index,*row_cmat_indices,*row_cmat_global_indices;
2032674ae819SStefano Zampini   PetscInt       n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc;
2033674ae819SStefano Zampini   PetscBool      *touched;
2034674ae819SStefano Zampini   PetscErrorCode ierr;
2035674ae819SStefano Zampini 
2036674ae819SStefano Zampini   PetscFunctionBegin;
2037674ae819SStefano Zampini   n = 0;
2038674ae819SStefano Zampini   constraints_index = 0;
2039674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2040674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr);
2041674ae819SStefano Zampini     max_size_of_constraint = 0;
2042674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2043674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2044674ae819SStefano Zampini       if (size_of_constraint > 1) {
2045674ae819SStefano Zampini         n++;
2046674ae819SStefano Zampini       }
2047674ae819SStefano Zampini       max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint);
2048674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2049674ae819SStefano Zampini     }
2050811e8ca2SStefano Zampini     if (constraints_idx) {
2051674ae819SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&constraints_index);CHKERRQ(ierr);
2052674ae819SStefano Zampini       ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&row_cmat_global_indices);CHKERRQ(ierr);
2053674ae819SStefano Zampini       ierr = PetscMalloc(local_size*sizeof(PetscBool),&touched);CHKERRQ(ierr);
2054674ae819SStefano Zampini       ierr = PetscMemzero(touched,local_size*sizeof(PetscBool));CHKERRQ(ierr);
2055674ae819SStefano Zampini       n = 0;
2056674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2057674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2058674ae819SStefano Zampini         if (size_of_constraint > 1) {
2059674ae819SStefano Zampini           ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr);
206082d3d8afSStefano Zampini           /* find first untouched local node */
206182d3d8afSStefano Zampini           j = 0;
206282d3d8afSStefano Zampini           while(touched[row_cmat_indices[j]]) j++;
206382d3d8afSStefano Zampini           min_index = row_cmat_global_indices[j];
206482d3d8afSStefano Zampini           min_loc = j;
206582d3d8afSStefano Zampini           /* search the minimum among nodes not yet touched on the connected component
206682d3d8afSStefano Zampini              since there can be more than one constraint on a single cc */
2067674ae819SStefano Zampini           for (j=1;j<size_of_constraint;j++) {
2068674ae819SStefano Zampini             if (min_index > row_cmat_global_indices[j] && !touched[row_cmat_indices[j]]) {
2069674ae819SStefano Zampini               min_index = row_cmat_global_indices[j];
2070674ae819SStefano Zampini               min_loc = j;
2071674ae819SStefano Zampini             }
2072674ae819SStefano Zampini           }
2073674ae819SStefano Zampini           touched[row_cmat_indices[min_loc]] = PETSC_TRUE;
2074674ae819SStefano Zampini           constraints_index[n++] = row_cmat_indices[min_loc];
2075674ae819SStefano Zampini         }
2076674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2077674ae819SStefano Zampini       }
2078674ae819SStefano Zampini       ierr = PetscFree(touched);CHKERRQ(ierr);
2079674ae819SStefano Zampini       ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr);
2080811e8ca2SStefano Zampini     }
2081811e8ca2SStefano Zampini   }
2082674ae819SStefano Zampini   *n_constraints = n;
2083811e8ca2SStefano Zampini   if (constraints_idx) *constraints_idx = constraints_index;
2084674ae819SStefano Zampini   PetscFunctionReturn(0);
2085674ae819SStefano Zampini }
2086674ae819SStefano Zampini 
2087674ae819SStefano Zampini /* the next two functions has been adapted from pcis.c */
2088674ae819SStefano Zampini #undef __FUNCT__
2089674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchur"
2090674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchur(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2091674ae819SStefano Zampini {
2092674ae819SStefano Zampini   PetscErrorCode ierr;
2093674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2094674ae819SStefano Zampini 
2095674ae819SStefano Zampini   PetscFunctionBegin;
2096674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2097674ae819SStefano Zampini   ierr = MatMult(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2098674ae819SStefano Zampini   ierr = MatMult(pcis->A_IB,v,vec1_D);CHKERRQ(ierr);
2099674ae819SStefano Zampini   ierr = KSPSolve(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2100674ae819SStefano Zampini   ierr = MatMult(pcis->A_BI,vec2_D,vec2_B);CHKERRQ(ierr);
2101674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2102674ae819SStefano Zampini   PetscFunctionReturn(0);
2103674ae819SStefano Zampini }
2104674ae819SStefano Zampini 
2105674ae819SStefano Zampini #undef __FUNCT__
2106674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchurTranspose"
2107674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchurTranspose(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2108674ae819SStefano Zampini {
2109674ae819SStefano Zampini   PetscErrorCode ierr;
2110674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2111674ae819SStefano Zampini 
2112674ae819SStefano Zampini   PetscFunctionBegin;
2113674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2114674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2115674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BI,v,vec1_D);CHKERRQ(ierr);
2116674ae819SStefano Zampini   ierr = KSPSolveTranspose(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2117674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_IB,vec2_D,vec2_B);CHKERRQ(ierr);
2118674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2119674ae819SStefano Zampini   PetscFunctionReturn(0);
2120674ae819SStefano Zampini }
2121674ae819SStefano Zampini 
2122674ae819SStefano Zampini #undef __FUNCT__
2123674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
2124674ae819SStefano 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[])
2125674ae819SStefano Zampini {
2126674ae819SStefano Zampini   Vec            local_vec,global_vec;
2127674ae819SStefano Zampini   IS             seqis,paris;
2128674ae819SStefano Zampini   VecScatter     scatter_ctx;
2129674ae819SStefano Zampini   PetscScalar    *array;
2130674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
2131674ae819SStefano Zampini   PetscScalar    globalsum;
2132674ae819SStefano Zampini   PetscInt       i,j,s;
2133674ae819SStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local;
2134674ae819SStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm,max_global;
2135674ae819SStefano Zampini   PetscMPIInt    *dof_sizes,*dof_displs;
2136674ae819SStefano Zampini   PetscBool      first_found;
2137674ae819SStefano Zampini   PetscErrorCode ierr;
2138674ae819SStefano Zampini 
2139674ae819SStefano Zampini   PetscFunctionBegin;
2140674ae819SStefano Zampini   /* mpi buffers */
2141674ae819SStefano Zampini   MPI_Comm_size(comm,&size_prec_comm);
2142674ae819SStefano Zampini   MPI_Comm_rank(comm,&rank_prec_comm);
2143674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
2144674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_sizes),&dof_sizes);CHKERRQ(ierr);
2145674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_displs),&dof_displs);CHKERRQ(ierr);
2146674ae819SStefano Zampini   /* get maximum size of subset */
2147674ae819SStefano Zampini   ierr = PetscMalloc(n_local_dofs*sizeof(PetscInt),&temp_global_dofs);CHKERRQ(ierr);
2148674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
2149674ae819SStefano Zampini   max_local = 0;
2150674ae819SStefano Zampini   if (n_local_dofs) {
2151674ae819SStefano Zampini     max_local = temp_global_dofs[0];
2152674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2153674ae819SStefano Zampini       if (max_local < temp_global_dofs[i] ) {
2154674ae819SStefano Zampini         max_local = temp_global_dofs[i];
2155674ae819SStefano Zampini       }
2156674ae819SStefano Zampini     }
2157674ae819SStefano Zampini   }
2158674ae819SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);
2159674ae819SStefano Zampini   max_global++;
2160674ae819SStefano Zampini   max_local = 0;
2161674ae819SStefano Zampini   if (n_local_dofs) {
2162674ae819SStefano Zampini     max_local = local_dofs[0];
2163674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2164674ae819SStefano Zampini       if (max_local < local_dofs[i] ) {
2165674ae819SStefano Zampini         max_local = local_dofs[i];
2166674ae819SStefano Zampini       }
2167674ae819SStefano Zampini     }
2168674ae819SStefano Zampini   }
2169674ae819SStefano Zampini   max_local++;
2170674ae819SStefano Zampini   /* allocate workspace */
2171674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
2172674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
2173674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
2174674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
2175674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
2176674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
2177674ae819SStefano Zampini   /* create scatter */
2178674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
2179674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
2180674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
2181674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
2182674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
2183674ae819SStefano Zampini   /* init array */
2184674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
2185674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2186674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2187674ae819SStefano Zampini   if (local_dofs_mult) {
2188674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2189674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
2190674ae819SStefano Zampini     }
2191674ae819SStefano Zampini   } else {
2192674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2193674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
2194674ae819SStefano Zampini     }
2195674ae819SStefano Zampini   }
2196674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2197674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
2198674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2199674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2200674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
22015b08dc53SStefano Zampini   *n_global_subset = (PetscInt)PetscRealPart(globalsum);
2202674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
2203674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
2204674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
2205674ae819SStefano Zampini   nlocals = 0;
2206674ae819SStefano Zampini   first_index = -1;
2207674ae819SStefano Zampini   first_found = PETSC_FALSE;
2208674ae819SStefano Zampini   for (i=0;i<s;i++) {
22095b08dc53SStefano Zampini     if (!first_found && PetscRealPart(array[i]) > 0.0) {
2210674ae819SStefano Zampini       first_found = PETSC_TRUE;
2211674ae819SStefano Zampini       first_index = i;
2212674ae819SStefano Zampini     }
22135b08dc53SStefano Zampini     nlocals += (PetscInt)PetscRealPart(array[i]);
2214674ae819SStefano Zampini   }
2215674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2216674ae819SStefano Zampini   if (!rank_prec_comm) {
2217674ae819SStefano Zampini     dof_displs[0]=0;
2218674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
2219674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
2220674ae819SStefano Zampini     }
2221674ae819SStefano Zampini   }
2222674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2223674ae819SStefano Zampini   if (first_found) {
2224674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
2225674ae819SStefano Zampini     old_index = first_index;
2226674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
22275b08dc53SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) {
2228674ae819SStefano Zampini         array[i] += array[old_index];
2229674ae819SStefano Zampini         old_index = i;
2230674ae819SStefano Zampini       }
2231674ae819SStefano Zampini     }
2232674ae819SStefano Zampini   }
2233674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
2234674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2235674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2236674ae819SStefano Zampini   ierr = VecScatterEnd  (scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2237674ae819SStefano Zampini   /* get global ordering of local dofs */
2238674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2239674ae819SStefano Zampini   if (local_dofs_mult) {
2240674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
22415b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i];
2242674ae819SStefano Zampini     }
2243674ae819SStefano Zampini   } else {
2244674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
22455b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1;
2246674ae819SStefano Zampini     }
2247674ae819SStefano Zampini   }
2248674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2249674ae819SStefano Zampini   /* free workspace */
2250674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
2251674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
2252674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
2253674ae819SStefano Zampini   ierr = PetscFree(dof_sizes);CHKERRQ(ierr);
2254674ae819SStefano Zampini   ierr = PetscFree(dof_displs);CHKERRQ(ierr);
2255674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
2256674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
2257674ae819SStefano Zampini   PetscFunctionReturn(0);
2258674ae819SStefano Zampini }
22599a7d3425SStefano Zampini 
22609a7d3425SStefano Zampini #undef __FUNCT__
22619a7d3425SStefano Zampini #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
22629a7d3425SStefano Zampini PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
22639a7d3425SStefano Zampini {
22649a7d3425SStefano Zampini   PetscInt       i,j;
22659a7d3425SStefano Zampini   PetscScalar    *alphas;
22669a7d3425SStefano Zampini   PetscErrorCode ierr;
22679a7d3425SStefano Zampini 
22689a7d3425SStefano Zampini   PetscFunctionBegin;
22699a7d3425SStefano Zampini   /* this implements stabilized Gram-Schmidt */
22709a7d3425SStefano Zampini   ierr = PetscMalloc(n*sizeof(PetscScalar),&alphas);CHKERRQ(ierr);
22719a7d3425SStefano Zampini   for (i=0;i<n;i++) {
22729a7d3425SStefano Zampini     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
22739a7d3425SStefano Zampini     if (i<n) { ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],&alphas[i+1]);CHKERRQ(ierr); }
22749a7d3425SStefano Zampini     for (j=i+1;j<n;j++) { ierr = VecAXPY(vecs[j],PetscConj(-alphas[j]),vecs[i]);CHKERRQ(ierr); }
22759a7d3425SStefano Zampini   }
22769a7d3425SStefano Zampini   ierr = PetscFree(alphas);CHKERRQ(ierr);
22779a7d3425SStefano Zampini   PetscFunctionReturn(0);
22789a7d3425SStefano Zampini }
22799a7d3425SStefano Zampini 
2280*c8587f34SStefano Zampini /* BDDC requires metis 5.0.1 for multilevel */
2281*c8587f34SStefano Zampini #if defined(PETSC_HAVE_METIS)
2282*c8587f34SStefano Zampini #include "metis.h"
2283*c8587f34SStefano Zampini #define MetisInt    idx_t
2284*c8587f34SStefano Zampini #define MetisScalar real_t
2285*c8587f34SStefano Zampini #endif
2286*c8587f34SStefano Zampini 
2287*c8587f34SStefano Zampini #undef __FUNCT__
2288*c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseEnvironment"
2289*c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpCoarseEnvironment(PC pc,PetscScalar* coarse_submat_vals)
2290*c8587f34SStefano Zampini {
2291*c8587f34SStefano Zampini 
2292*c8587f34SStefano Zampini 
2293*c8587f34SStefano Zampini   Mat_IS    *matis    = (Mat_IS*)pc->pmat->data;
2294*c8587f34SStefano Zampini   PC_BDDC   *pcbddc   = (PC_BDDC*)pc->data;
2295*c8587f34SStefano Zampini   PC_IS     *pcis     = (PC_IS*)pc->data;
2296*c8587f34SStefano Zampini   MPI_Comm  prec_comm;
2297*c8587f34SStefano Zampini   MPI_Comm  coarse_comm;
2298*c8587f34SStefano Zampini 
2299*c8587f34SStefano Zampini   MatNullSpace CoarseNullSpace;
2300*c8587f34SStefano Zampini 
2301*c8587f34SStefano Zampini   /* common to all choiches */
2302*c8587f34SStefano Zampini   PetscScalar *temp_coarse_mat_vals;
2303*c8587f34SStefano Zampini   PetscScalar *ins_coarse_mat_vals;
2304*c8587f34SStefano Zampini   PetscInt    *ins_local_primal_indices;
2305*c8587f34SStefano Zampini   PetscMPIInt *localsizes2,*localdispl2;
2306*c8587f34SStefano Zampini   PetscMPIInt size_prec_comm;
2307*c8587f34SStefano Zampini   PetscMPIInt rank_prec_comm;
2308*c8587f34SStefano Zampini   PetscMPIInt active_rank=MPI_PROC_NULL;
2309*c8587f34SStefano Zampini   PetscMPIInt master_proc=0;
2310*c8587f34SStefano Zampini   PetscInt    ins_local_primal_size;
2311*c8587f34SStefano Zampini   /* specific to MULTILEVEL_BDDC */
2312*c8587f34SStefano Zampini   PetscMPIInt *ranks_recv=0;
2313*c8587f34SStefano Zampini   PetscMPIInt count_recv=0;
2314*c8587f34SStefano Zampini   PetscMPIInt rank_coarse_proc_send_to=-1;
2315*c8587f34SStefano Zampini   PetscMPIInt coarse_color = MPI_UNDEFINED;
2316*c8587f34SStefano Zampini   ISLocalToGlobalMapping coarse_ISLG;
2317*c8587f34SStefano Zampini   /* some other variables */
2318*c8587f34SStefano Zampini   PetscErrorCode ierr;
2319*c8587f34SStefano Zampini   MatType coarse_mat_type;
2320*c8587f34SStefano Zampini   PCType  coarse_pc_type;
2321*c8587f34SStefano Zampini   KSPType coarse_ksp_type;
2322*c8587f34SStefano Zampini   PC pc_temp;
2323*c8587f34SStefano Zampini   PetscInt i,j,k;
2324*c8587f34SStefano Zampini   PetscInt max_it_coarse_ksp=1;  /* don't increase this value */
2325*c8587f34SStefano Zampini   /* verbose output viewer */
2326*c8587f34SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
2327*c8587f34SStefano Zampini   PetscInt    dbg_flag=pcbddc->dbg_flag;
2328*c8587f34SStefano Zampini 
2329*c8587f34SStefano Zampini   PetscInt      offset,offset2;
2330*c8587f34SStefano Zampini   PetscMPIInt   im_active,active_procs;
2331*c8587f34SStefano Zampini   PetscInt      *dnz,*onz;
2332*c8587f34SStefano Zampini 
2333*c8587f34SStefano Zampini   PetscBool     setsym,issym=PETSC_FALSE;
2334*c8587f34SStefano Zampini 
2335*c8587f34SStefano Zampini   PetscFunctionBegin;
2336*c8587f34SStefano Zampini   ierr = PetscObjectGetComm((PetscObject)pc,&prec_comm);CHKERRQ(ierr);
2337*c8587f34SStefano Zampini   ins_local_primal_indices = 0;
2338*c8587f34SStefano Zampini   ins_coarse_mat_vals      = 0;
2339*c8587f34SStefano Zampini   localsizes2              = 0;
2340*c8587f34SStefano Zampini   localdispl2              = 0;
2341*c8587f34SStefano Zampini   temp_coarse_mat_vals     = 0;
2342*c8587f34SStefano Zampini   coarse_ISLG              = 0;
2343*c8587f34SStefano Zampini 
2344*c8587f34SStefano Zampini   ierr = MPI_Comm_size(prec_comm,&size_prec_comm);CHKERRQ(ierr);
2345*c8587f34SStefano Zampini   ierr = MPI_Comm_rank(prec_comm,&rank_prec_comm);CHKERRQ(ierr);
2346*c8587f34SStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
2347*c8587f34SStefano Zampini 
2348*c8587f34SStefano Zampini   /* Assign global numbering to coarse dofs */
2349*c8587f34SStefano Zampini   {
2350*c8587f34SStefano Zampini     PetscInt     *auxlocal_primal,*aux_idx;
2351*c8587f34SStefano Zampini     PetscMPIInt  mpi_local_primal_size;
2352*c8587f34SStefano Zampini     PetscScalar  coarsesum,*array;
2353*c8587f34SStefano Zampini 
2354*c8587f34SStefano Zampini     mpi_local_primal_size = (PetscMPIInt)pcbddc->local_primal_size;
2355*c8587f34SStefano Zampini 
2356*c8587f34SStefano Zampini     /* Construct needed data structures for message passing */
2357*c8587f34SStefano Zampini     j = 0;
2358*c8587f34SStefano Zampini     if (rank_prec_comm == 0 || pcbddc->coarse_problem_type == REPLICATED_BDDC || pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
2359*c8587f34SStefano Zampini       j = size_prec_comm;
2360*c8587f34SStefano Zampini     }
2361*c8587f34SStefano Zampini     ierr = PetscMalloc(j*sizeof(PetscMPIInt),&pcbddc->local_primal_sizes);CHKERRQ(ierr);
2362*c8587f34SStefano Zampini     ierr = PetscMalloc(j*sizeof(PetscMPIInt),&pcbddc->local_primal_displacements);CHKERRQ(ierr);
2363*c8587f34SStefano Zampini     /* Gather local_primal_size information for all processes  */
2364*c8587f34SStefano Zampini     if (pcbddc->coarse_problem_type == REPLICATED_BDDC || pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
2365*c8587f34SStefano Zampini       ierr = MPI_Allgather(&mpi_local_primal_size,1,MPIU_INT,&pcbddc->local_primal_sizes[0],1,MPIU_INT,prec_comm);CHKERRQ(ierr);
2366*c8587f34SStefano Zampini     } else {
2367*c8587f34SStefano Zampini       ierr = MPI_Gather(&mpi_local_primal_size,1,MPIU_INT,&pcbddc->local_primal_sizes[0],1,MPIU_INT,0,prec_comm);CHKERRQ(ierr);
2368*c8587f34SStefano Zampini     }
2369*c8587f34SStefano Zampini     pcbddc->replicated_primal_size = 0;
2370*c8587f34SStefano Zampini     for (i=0; i<j; i++) {
2371*c8587f34SStefano Zampini       pcbddc->local_primal_displacements[i] = pcbddc->replicated_primal_size ;
2372*c8587f34SStefano Zampini       pcbddc->replicated_primal_size += pcbddc->local_primal_sizes[i];
2373*c8587f34SStefano Zampini     }
2374*c8587f34SStefano Zampini 
2375*c8587f34SStefano Zampini     /* First let's count coarse dofs.
2376*c8587f34SStefano Zampini        This code fragment assumes that the number of local constraints per connected component
2377*c8587f34SStefano Zampini        is not greater than the number of nodes defined for the connected component
2378*c8587f34SStefano Zampini        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
2379*c8587f34SStefano Zampini     ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&auxlocal_primal);CHKERRQ(ierr);
2380*c8587f34SStefano Zampini     ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&i,&aux_idx);CHKERRQ(ierr);
2381*c8587f34SStefano Zampini     ierr = PetscMemcpy(auxlocal_primal,aux_idx,i*sizeof(PetscInt));CHKERRQ(ierr);
2382*c8587f34SStefano Zampini     ierr = PetscFree(aux_idx);CHKERRQ(ierr);
2383*c8587f34SStefano Zampini     ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&j,&aux_idx);CHKERRQ(ierr);
2384*c8587f34SStefano Zampini     ierr = PetscMemcpy(&auxlocal_primal[i],aux_idx,j*sizeof(PetscInt));CHKERRQ(ierr);
2385*c8587f34SStefano Zampini     ierr = PetscFree(aux_idx);CHKERRQ(ierr);
2386*c8587f34SStefano Zampini     /* Compute number of coarse dofs */
2387*c8587f34SStefano Zampini     ierr = PCBDDCSubsetNumbering(prec_comm,matis->mapping,pcbddc->local_primal_size,auxlocal_primal,NULL,&pcbddc->coarse_size,&pcbddc->local_primal_indices);CHKERRQ(ierr);
2388*c8587f34SStefano Zampini 
2389*c8587f34SStefano Zampini     if (dbg_flag) {
2390*c8587f34SStefano Zampini       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2391*c8587f34SStefano Zampini       ierr = PetscViewerASCIIPrintf(viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
2392*c8587f34SStefano Zampini       ierr = PetscViewerASCIIPrintf(viewer,"Check coarse indices\n");CHKERRQ(ierr);
2393*c8587f34SStefano Zampini       ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
2394*c8587f34SStefano Zampini       ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
2395*c8587f34SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) array[auxlocal_primal[i]]=1.0;
2396*c8587f34SStefano Zampini       ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
2397*c8587f34SStefano Zampini       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
2398*c8587f34SStefano Zampini       ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2399*c8587f34SStefano Zampini       ierr = VecScatterEnd  (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2400*c8587f34SStefano Zampini       ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2401*c8587f34SStefano Zampini       ierr = VecScatterEnd  (matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2402*c8587f34SStefano Zampini       ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
2403*c8587f34SStefano Zampini       for (i=0;i<pcis->n;i++) {
2404*c8587f34SStefano Zampini         if (array[i] == 1.0) {
2405*c8587f34SStefano Zampini           ierr = ISLocalToGlobalMappingApply(matis->mapping,1,&i,&j);CHKERRQ(ierr);
2406*c8587f34SStefano Zampini           ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d: WRONG COARSE INDEX %d (local %d)\n",PetscGlobalRank,j,i);CHKERRQ(ierr);
2407*c8587f34SStefano Zampini         }
2408*c8587f34SStefano Zampini       }
2409*c8587f34SStefano Zampini       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2410*c8587f34SStefano Zampini       for (i=0;i<pcis->n;i++) {
2411*c8587f34SStefano Zampini         if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
2412*c8587f34SStefano Zampini       }
2413*c8587f34SStefano Zampini       ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
2414*c8587f34SStefano Zampini       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
2415*c8587f34SStefano Zampini       ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2416*c8587f34SStefano Zampini       ierr = VecScatterEnd  (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2417*c8587f34SStefano Zampini       ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
2418*c8587f34SStefano Zampini       ierr = PetscViewerASCIIPrintf(viewer,"Size of coarse problem SHOULD be %lf\n",coarsesum);CHKERRQ(ierr);
2419*c8587f34SStefano Zampini       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2420*c8587f34SStefano Zampini     }
2421*c8587f34SStefano Zampini     ierr = PetscFree(auxlocal_primal);CHKERRQ(ierr);
2422*c8587f34SStefano Zampini   }
2423*c8587f34SStefano Zampini 
2424*c8587f34SStefano Zampini   if (dbg_flag) {
2425*c8587f34SStefano Zampini     ierr = PetscViewerASCIIPrintf(viewer,"Size of coarse problem is %d\n",pcbddc->coarse_size);CHKERRQ(ierr);
2426*c8587f34SStefano Zampini     if (dbg_flag > 1) {
2427*c8587f34SStefano Zampini       ierr = PetscViewerASCIIPrintf(viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
2428*c8587f34SStefano Zampini       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2429*c8587f34SStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
2430*c8587f34SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
2431*c8587f34SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(viewer,"local_primal_indices[%d]=%d \n",i,pcbddc->local_primal_indices[i]);
2432*c8587f34SStefano Zampini       }
2433*c8587f34SStefano Zampini       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2434*c8587f34SStefano Zampini     }
2435*c8587f34SStefano Zampini   }
2436*c8587f34SStefano Zampini 
2437*c8587f34SStefano Zampini   im_active = 0;
2438*c8587f34SStefano Zampini   if (pcis->n) im_active = 1;
2439*c8587f34SStefano Zampini   ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,prec_comm);CHKERRQ(ierr);
2440*c8587f34SStefano Zampini 
2441*c8587f34SStefano Zampini   /* adapt coarse problem type */
2442*c8587f34SStefano Zampini #if defined(PETSC_HAVE_METIS)
2443*c8587f34SStefano Zampini   if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
2444*c8587f34SStefano Zampini     if (pcbddc->current_level < pcbddc->max_levels) {
2445*c8587f34SStefano Zampini       if ( (active_procs/pcbddc->coarsening_ratio) < 2 ) {
2446*c8587f34SStefano Zampini         if (dbg_flag) {
2447*c8587f34SStefano 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);
2448*c8587f34SStefano Zampini          ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2449*c8587f34SStefano Zampini         }
2450*c8587f34SStefano Zampini         pcbddc->coarse_problem_type = PARALLEL_BDDC;
2451*c8587f34SStefano Zampini       }
2452*c8587f34SStefano Zampini     } else {
2453*c8587f34SStefano Zampini       if (dbg_flag) {
2454*c8587f34SStefano 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);
2455*c8587f34SStefano Zampini         ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
2456*c8587f34SStefano Zampini       }
2457*c8587f34SStefano Zampini       pcbddc->coarse_problem_type = PARALLEL_BDDC;
2458*c8587f34SStefano Zampini     }
2459*c8587f34SStefano Zampini   }
2460*c8587f34SStefano Zampini #else
2461*c8587f34SStefano Zampini   pcbddc->coarse_problem_type = PARALLEL_BDDC;
2462*c8587f34SStefano Zampini #endif
2463*c8587f34SStefano Zampini 
2464*c8587f34SStefano Zampini   switch(pcbddc->coarse_problem_type){
2465*c8587f34SStefano Zampini 
2466*c8587f34SStefano Zampini     case(MULTILEVEL_BDDC):   /* we define a coarse mesh where subdomains are elements */
2467*c8587f34SStefano Zampini     {
2468*c8587f34SStefano Zampini #if defined(PETSC_HAVE_METIS)
2469*c8587f34SStefano Zampini       /* we need additional variables */
2470*c8587f34SStefano Zampini       MetisInt    n_subdomains,n_parts,objval,ncon,faces_nvtxs;
2471*c8587f34SStefano Zampini       MetisInt    *metis_coarse_subdivision;
2472*c8587f34SStefano Zampini       MetisInt    options[METIS_NOPTIONS];
2473*c8587f34SStefano Zampini       PetscMPIInt size_coarse_comm,rank_coarse_comm;
2474*c8587f34SStefano Zampini       PetscMPIInt procs_jumps_coarse_comm;
2475*c8587f34SStefano Zampini       PetscMPIInt *coarse_subdivision;
2476*c8587f34SStefano Zampini       PetscMPIInt *total_count_recv;
2477*c8587f34SStefano Zampini       PetscMPIInt *total_ranks_recv;
2478*c8587f34SStefano Zampini       PetscMPIInt *displacements_recv;
2479*c8587f34SStefano Zampini       PetscMPIInt *my_faces_connectivity;
2480*c8587f34SStefano Zampini       PetscMPIInt *petsc_faces_adjncy;
2481*c8587f34SStefano Zampini       MetisInt    *faces_adjncy;
2482*c8587f34SStefano Zampini       MetisInt    *faces_xadj;
2483*c8587f34SStefano Zampini       PetscMPIInt *number_of_faces;
2484*c8587f34SStefano Zampini       PetscMPIInt *faces_displacements;
2485*c8587f34SStefano Zampini       PetscInt    *array_int;
2486*c8587f34SStefano Zampini       PetscMPIInt my_faces=0;
2487*c8587f34SStefano Zampini       PetscMPIInt total_faces=0;
2488*c8587f34SStefano Zampini       PetscInt    ranks_stretching_ratio;
2489*c8587f34SStefano Zampini 
2490*c8587f34SStefano Zampini       /* define some quantities */
2491*c8587f34SStefano Zampini       pcbddc->coarse_communications_type = SCATTERS_BDDC;
2492*c8587f34SStefano Zampini       coarse_mat_type = MATIS;
2493*c8587f34SStefano Zampini       coarse_pc_type  = PCBDDC;
2494*c8587f34SStefano Zampini       coarse_ksp_type = KSPRICHARDSON;
2495*c8587f34SStefano Zampini 
2496*c8587f34SStefano Zampini       /* details of coarse decomposition */
2497*c8587f34SStefano Zampini       n_subdomains = active_procs;
2498*c8587f34SStefano Zampini       n_parts      = n_subdomains/pcbddc->coarsening_ratio;
2499*c8587f34SStefano Zampini       ranks_stretching_ratio = size_prec_comm/active_procs;
2500*c8587f34SStefano Zampini       procs_jumps_coarse_comm = pcbddc->coarsening_ratio*ranks_stretching_ratio;
2501*c8587f34SStefano Zampini 
2502*c8587f34SStefano Zampini #if 0
2503*c8587f34SStefano Zampini       PetscMPIInt *old_ranks;
2504*c8587f34SStefano Zampini       PetscInt    *new_ranks,*jj,*ii;
2505*c8587f34SStefano Zampini       MatPartitioning mat_part;
2506*c8587f34SStefano Zampini       IS coarse_new_decomposition,is_numbering;
2507*c8587f34SStefano Zampini       PetscViewer viewer_test;
2508*c8587f34SStefano Zampini       MPI_Comm    test_coarse_comm;
2509*c8587f34SStefano Zampini       PetscMPIInt test_coarse_color;
2510*c8587f34SStefano Zampini       Mat         mat_adj;
2511*c8587f34SStefano Zampini       /* Create new communicator for coarse problem splitting the old one */
2512*c8587f34SStefano Zampini       /* procs with coarse_color = MPI_UNDEFINED will have coarse_comm = MPI_COMM_NULL (from mpi standards)
2513*c8587f34SStefano Zampini          key = rank_prec_comm -> keep same ordering of ranks from the old to the new communicator */
2514*c8587f34SStefano Zampini       test_coarse_color = ( im_active ? 0 : MPI_UNDEFINED );
2515*c8587f34SStefano Zampini       test_coarse_comm = MPI_COMM_NULL;
2516*c8587f34SStefano Zampini       ierr = MPI_Comm_split(prec_comm,test_coarse_color,rank_prec_comm,&test_coarse_comm);CHKERRQ(ierr);
2517*c8587f34SStefano Zampini       if (im_active) {
2518*c8587f34SStefano Zampini         ierr = PetscMalloc(n_subdomains*sizeof(PetscMPIInt),&old_ranks);
2519*c8587f34SStefano Zampini         ierr = PetscMalloc(size_prec_comm*sizeof(PetscInt),&new_ranks);
2520*c8587f34SStefano Zampini         ierr = MPI_Comm_rank(test_coarse_comm,&rank_coarse_comm);CHKERRQ(ierr);
2521*c8587f34SStefano Zampini         ierr = MPI_Comm_size(test_coarse_comm,&j);CHKERRQ(ierr);
2522*c8587f34SStefano Zampini         ierr = MPI_Allgather(&rank_prec_comm,1,MPIU_INT,old_ranks,1,MPIU_INT,test_coarse_comm);CHKERRQ(ierr);
2523*c8587f34SStefano Zampini         for (i=0; i<size_prec_comm; i++) new_ranks[i] = -1;
2524*c8587f34SStefano Zampini         for (i=0; i<n_subdomains; i++) new_ranks[old_ranks[i]] = i;
2525*c8587f34SStefano Zampini         ierr = PetscViewerASCIIOpen(test_coarse_comm,"test_mat_part.out",&viewer_test);CHKERRQ(ierr);
2526*c8587f34SStefano Zampini         k = pcis->n_neigh-1;
2527*c8587f34SStefano Zampini         ierr = PetscMalloc(2*sizeof(PetscInt),&ii);
2528*c8587f34SStefano Zampini         ii[0]=0;
2529*c8587f34SStefano Zampini         ii[1]=k;
2530*c8587f34SStefano Zampini         ierr = PetscMalloc(k*sizeof(PetscInt),&jj);
2531*c8587f34SStefano Zampini         for (i=0; i<k; i++) jj[i]=new_ranks[pcis->neigh[i+1]];
2532*c8587f34SStefano Zampini         ierr = PetscSortInt(k,jj);CHKERRQ(ierr);
2533*c8587f34SStefano Zampini         ierr = MatCreateMPIAdj(test_coarse_comm,1,n_subdomains,ii,jj,NULL,&mat_adj);CHKERRQ(ierr);
2534*c8587f34SStefano Zampini         ierr = MatView(mat_adj,viewer_test);CHKERRQ(ierr);
2535*c8587f34SStefano Zampini         ierr = MatPartitioningCreate(test_coarse_comm,&mat_part);CHKERRQ(ierr);
2536*c8587f34SStefano Zampini         ierr = MatPartitioningSetAdjacency(mat_part,mat_adj);CHKERRQ(ierr);
2537*c8587f34SStefano Zampini         ierr = MatPartitioningSetFromOptions(mat_part);CHKERRQ(ierr);
2538*c8587f34SStefano Zampini         printf("Setting Nparts %d\n",n_parts);
2539*c8587f34SStefano Zampini         ierr = MatPartitioningSetNParts(mat_part,n_parts);CHKERRQ(ierr);
2540*c8587f34SStefano Zampini         ierr = MatPartitioningView(mat_part,viewer_test);CHKERRQ(ierr);
2541*c8587f34SStefano Zampini         ierr = MatPartitioningApply(mat_part,&coarse_new_decomposition);CHKERRQ(ierr);
2542*c8587f34SStefano Zampini         ierr = ISView(coarse_new_decomposition,viewer_test);CHKERRQ(ierr);
2543*c8587f34SStefano Zampini         ierr = ISPartitioningToNumbering(coarse_new_decomposition,&is_numbering);CHKERRQ(ierr);
2544*c8587f34SStefano Zampini         ierr = ISView(is_numbering,viewer_test);CHKERRQ(ierr);
2545*c8587f34SStefano Zampini         ierr = PetscViewerDestroy(&viewer_test);CHKERRQ(ierr);
2546*c8587f34SStefano Zampini         ierr = ISDestroy(&coarse_new_decomposition);CHKERRQ(ierr);
2547*c8587f34SStefano Zampini         ierr = ISDestroy(&is_numbering);CHKERRQ(ierr);
2548*c8587f34SStefano Zampini         ierr = MatPartitioningDestroy(&mat_part);CHKERRQ(ierr);
2549*c8587f34SStefano Zampini         ierr = PetscFree(old_ranks);CHKERRQ(ierr);
2550*c8587f34SStefano Zampini         ierr = PetscFree(new_ranks);CHKERRQ(ierr);
2551*c8587f34SStefano Zampini         ierr = MPI_Comm_free(&test_coarse_comm);CHKERRQ(ierr);
2552*c8587f34SStefano Zampini       }
2553*c8587f34SStefano Zampini #endif
2554*c8587f34SStefano Zampini 
2555*c8587f34SStefano Zampini       /* build CSR graph of subdomains' connectivity */
2556*c8587f34SStefano Zampini       ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&array_int);CHKERRQ(ierr);
2557*c8587f34SStefano Zampini       ierr = PetscMemzero(array_int,pcis->n*sizeof(PetscInt));CHKERRQ(ierr);
2558*c8587f34SStefano Zampini       for (i=1;i<pcis->n_neigh;i++){/* i=1 so I don't count myself -> faces nodes counts to 1 */
2559*c8587f34SStefano Zampini         for (j=0;j<pcis->n_shared[i];j++){
2560*c8587f34SStefano Zampini           array_int[ pcis->shared[i][j] ]+=1;
2561*c8587f34SStefano Zampini         }
2562*c8587f34SStefano Zampini       }
2563*c8587f34SStefano Zampini       for (i=1;i<pcis->n_neigh;i++){
2564*c8587f34SStefano Zampini         for (j=0;j<pcis->n_shared[i];j++){
2565*c8587f34SStefano Zampini           if (array_int[ pcis->shared[i][j] ] > 0 ){
2566*c8587f34SStefano Zampini             my_faces++;
2567*c8587f34SStefano Zampini             break;
2568*c8587f34SStefano Zampini           }
2569*c8587f34SStefano Zampini         }
2570*c8587f34SStefano Zampini       }
2571*c8587f34SStefano Zampini 
2572*c8587f34SStefano Zampini       ierr = MPI_Reduce(&my_faces,&total_faces,1,MPIU_INT,MPI_SUM,master_proc,prec_comm);CHKERRQ(ierr);
2573*c8587f34SStefano Zampini       ierr = PetscMalloc (my_faces*sizeof(PetscInt),&my_faces_connectivity);CHKERRQ(ierr);
2574*c8587f34SStefano Zampini       my_faces=0;
2575*c8587f34SStefano Zampini       for (i=1;i<pcis->n_neigh;i++){
2576*c8587f34SStefano Zampini         for (j=0;j<pcis->n_shared[i];j++){
2577*c8587f34SStefano Zampini           if (array_int[ pcis->shared[i][j] ] > 0 ){
2578*c8587f34SStefano Zampini             my_faces_connectivity[my_faces]=pcis->neigh[i];
2579*c8587f34SStefano Zampini             my_faces++;
2580*c8587f34SStefano Zampini             break;
2581*c8587f34SStefano Zampini           }
2582*c8587f34SStefano Zampini         }
2583*c8587f34SStefano Zampini       }
2584*c8587f34SStefano Zampini       if (rank_prec_comm == master_proc) {
2585*c8587f34SStefano Zampini         ierr = PetscMalloc (total_faces*sizeof(PetscMPIInt),&petsc_faces_adjncy);CHKERRQ(ierr);
2586*c8587f34SStefano Zampini         ierr = PetscMalloc (size_prec_comm*sizeof(PetscMPIInt),&number_of_faces);CHKERRQ(ierr);
2587*c8587f34SStefano Zampini         ierr = PetscMalloc (total_faces*sizeof(MetisInt),&faces_adjncy);CHKERRQ(ierr);
2588*c8587f34SStefano Zampini         ierr = PetscMalloc ((n_subdomains+1)*sizeof(MetisInt),&faces_xadj);CHKERRQ(ierr);
2589*c8587f34SStefano Zampini         ierr = PetscMalloc ((size_prec_comm+1)*sizeof(PetscMPIInt),&faces_displacements);CHKERRQ(ierr);
2590*c8587f34SStefano Zampini       }
2591*c8587f34SStefano Zampini       ierr = MPI_Gather(&my_faces,1,MPIU_INT,&number_of_faces[0],1,MPIU_INT,master_proc,prec_comm);CHKERRQ(ierr);
2592*c8587f34SStefano Zampini       if (rank_prec_comm == master_proc) {
2593*c8587f34SStefano Zampini         faces_xadj[0]=0;
2594*c8587f34SStefano Zampini         faces_displacements[0]=0;
2595*c8587f34SStefano Zampini         j=0;
2596*c8587f34SStefano Zampini         for (i=1;i<size_prec_comm+1;i++) {
2597*c8587f34SStefano Zampini           faces_displacements[i]=faces_displacements[i-1]+number_of_faces[i-1];
2598*c8587f34SStefano Zampini           if (number_of_faces[i-1]) {
2599*c8587f34SStefano Zampini             j++;
2600*c8587f34SStefano Zampini             faces_xadj[j]=faces_xadj[j-1]+number_of_faces[i-1];
2601*c8587f34SStefano Zampini           }
2602*c8587f34SStefano Zampini         }
2603*c8587f34SStefano Zampini       }
2604*c8587f34SStefano 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);
2605*c8587f34SStefano Zampini       ierr = PetscFree(my_faces_connectivity);CHKERRQ(ierr);
2606*c8587f34SStefano Zampini       ierr = PetscFree(array_int);CHKERRQ(ierr);
2607*c8587f34SStefano Zampini       if (rank_prec_comm == master_proc) {
2608*c8587f34SStefano Zampini         for (i=0;i<total_faces;i++) faces_adjncy[i]=(MetisInt)(petsc_faces_adjncy[i]/ranks_stretching_ratio); /* cast to MetisInt */
2609*c8587f34SStefano Zampini         ierr = PetscFree(faces_displacements);CHKERRQ(ierr);
2610*c8587f34SStefano Zampini         ierr = PetscFree(number_of_faces);CHKERRQ(ierr);
2611*c8587f34SStefano Zampini         ierr = PetscFree(petsc_faces_adjncy);CHKERRQ(ierr);
2612*c8587f34SStefano Zampini       }
2613*c8587f34SStefano Zampini 
2614*c8587f34SStefano Zampini       if ( rank_prec_comm == master_proc ) {
2615*c8587f34SStefano Zampini 
2616*c8587f34SStefano Zampini         PetscInt heuristic_for_metis=3;
2617*c8587f34SStefano Zampini 
2618*c8587f34SStefano Zampini         ncon=1;
2619*c8587f34SStefano Zampini         faces_nvtxs=n_subdomains;
2620*c8587f34SStefano Zampini         /* partition graoh induced by face connectivity */
2621*c8587f34SStefano Zampini         ierr = PetscMalloc (n_subdomains*sizeof(MetisInt),&metis_coarse_subdivision);CHKERRQ(ierr);
2622*c8587f34SStefano Zampini         ierr = METIS_SetDefaultOptions(options);
2623*c8587f34SStefano Zampini         /* we need a contiguous partition of the coarse mesh */
2624*c8587f34SStefano Zampini         options[METIS_OPTION_CONTIG]=1;
2625*c8587f34SStefano Zampini         options[METIS_OPTION_NITER]=30;
2626*c8587f34SStefano Zampini         if (pcbddc->coarsening_ratio > 1) {
2627*c8587f34SStefano Zampini           if (n_subdomains>n_parts*heuristic_for_metis) {
2628*c8587f34SStefano Zampini             options[METIS_OPTION_IPTYPE]=METIS_IPTYPE_EDGE;
2629*c8587f34SStefano Zampini             options[METIS_OPTION_OBJTYPE]=METIS_OBJTYPE_CUT;
2630*c8587f34SStefano Zampini             ierr = METIS_PartGraphKway(&faces_nvtxs,&ncon,faces_xadj,faces_adjncy,NULL,NULL,NULL,&n_parts,NULL,NULL,options,&objval,metis_coarse_subdivision);
2631*c8587f34SStefano 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);
2632*c8587f34SStefano Zampini           } else {
2633*c8587f34SStefano Zampini             ierr = METIS_PartGraphRecursive(&faces_nvtxs,&ncon,faces_xadj,faces_adjncy,NULL,NULL,NULL,&n_parts,NULL,NULL,options,&objval,metis_coarse_subdivision);
2634*c8587f34SStefano 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);
2635*c8587f34SStefano Zampini           }
2636*c8587f34SStefano Zampini         } else {
2637*c8587f34SStefano Zampini           for (i=0;i<n_subdomains;i++) metis_coarse_subdivision[i]=i;
2638*c8587f34SStefano Zampini         }
2639*c8587f34SStefano Zampini         ierr = PetscFree(faces_xadj);CHKERRQ(ierr);
2640*c8587f34SStefano Zampini         ierr = PetscFree(faces_adjncy);CHKERRQ(ierr);
2641*c8587f34SStefano Zampini         ierr = PetscMalloc(size_prec_comm*sizeof(PetscMPIInt),&coarse_subdivision);CHKERRQ(ierr);
2642*c8587f34SStefano Zampini 
2643*c8587f34SStefano Zampini         /* copy/cast values avoiding possible type conflicts between PETSc, MPI and METIS */
2644*c8587f34SStefano Zampini         for (i=0;i<size_prec_comm;i++) coarse_subdivision[i]=MPI_PROC_NULL;
2645*c8587f34SStefano Zampini         for (i=0;i<n_subdomains;i++) coarse_subdivision[ranks_stretching_ratio*i]=(PetscInt)(metis_coarse_subdivision[i]);
2646*c8587f34SStefano Zampini         ierr = PetscFree(metis_coarse_subdivision);CHKERRQ(ierr);
2647*c8587f34SStefano Zampini       }
2648*c8587f34SStefano Zampini 
2649*c8587f34SStefano Zampini       /* Create new communicator for coarse problem splitting the old one */
2650*c8587f34SStefano Zampini       if ( !(rank_prec_comm%procs_jumps_coarse_comm) && rank_prec_comm < procs_jumps_coarse_comm*n_parts ){
2651*c8587f34SStefano Zampini         coarse_color=0;              /* for communicator splitting */
2652*c8587f34SStefano Zampini         active_rank=rank_prec_comm;  /* for insertion of matrix values */
2653*c8587f34SStefano Zampini       }
2654*c8587f34SStefano Zampini       /* procs with coarse_color = MPI_UNDEFINED will have coarse_comm = MPI_COMM_NULL (from mpi standards)
2655*c8587f34SStefano Zampini          key = rank_prec_comm -> keep same ordering of ranks from the old to the new communicator */
2656*c8587f34SStefano Zampini       ierr = MPI_Comm_split(prec_comm,coarse_color,rank_prec_comm,&coarse_comm);CHKERRQ(ierr);
2657*c8587f34SStefano Zampini 
2658*c8587f34SStefano Zampini       if ( coarse_color == 0 ) {
2659*c8587f34SStefano Zampini         ierr = MPI_Comm_size(coarse_comm,&size_coarse_comm);CHKERRQ(ierr);
2660*c8587f34SStefano Zampini         ierr = MPI_Comm_rank(coarse_comm,&rank_coarse_comm);CHKERRQ(ierr);
2661*c8587f34SStefano Zampini       } else {
2662*c8587f34SStefano Zampini         rank_coarse_comm = MPI_PROC_NULL;
2663*c8587f34SStefano Zampini       }
2664*c8587f34SStefano Zampini 
2665*c8587f34SStefano Zampini       /* master proc take care of arranging and distributing coarse information */
2666*c8587f34SStefano Zampini       if (rank_coarse_comm == master_proc) {
2667*c8587f34SStefano Zampini         ierr = PetscMalloc (size_coarse_comm*sizeof(PetscMPIInt),&displacements_recv);CHKERRQ(ierr);
2668*c8587f34SStefano Zampini         ierr = PetscMalloc (size_coarse_comm*sizeof(PetscMPIInt),&total_count_recv);CHKERRQ(ierr);
2669*c8587f34SStefano Zampini         ierr = PetscMalloc (n_subdomains*sizeof(PetscMPIInt),&total_ranks_recv);CHKERRQ(ierr);
2670*c8587f34SStefano Zampini         /* some initializations */
2671*c8587f34SStefano Zampini         displacements_recv[0]=0;
2672*c8587f34SStefano Zampini         ierr = PetscMemzero(total_count_recv,size_coarse_comm*sizeof(PetscMPIInt));CHKERRQ(ierr);
2673*c8587f34SStefano Zampini         /* count from how many processes the j-th process of the coarse decomposition will receive data */
2674*c8587f34SStefano Zampini         for (j=0;j<size_coarse_comm;j++) {
2675*c8587f34SStefano Zampini           for (i=0;i<size_prec_comm;i++) {
2676*c8587f34SStefano Zampini           if (coarse_subdivision[i]==j) total_count_recv[j]++;
2677*c8587f34SStefano Zampini           }
2678*c8587f34SStefano Zampini         }
2679*c8587f34SStefano Zampini         /* displacements needed for scatterv of total_ranks_recv */
2680*c8587f34SStefano Zampini       for (i=1; i<size_coarse_comm; i++) displacements_recv[i]=displacements_recv[i-1]+total_count_recv[i-1];
2681*c8587f34SStefano Zampini 
2682*c8587f34SStefano Zampini         /* Now fill properly total_ranks_recv -> each coarse process will receive the ranks (in prec_comm communicator) of its friend (sending) processes */
2683*c8587f34SStefano Zampini         ierr = PetscMemzero(total_count_recv,size_coarse_comm*sizeof(PetscMPIInt));CHKERRQ(ierr);
2684*c8587f34SStefano Zampini         for (j=0;j<size_coarse_comm;j++) {
2685*c8587f34SStefano Zampini           for (i=0;i<size_prec_comm;i++) {
2686*c8587f34SStefano Zampini             if (coarse_subdivision[i]==j) {
2687*c8587f34SStefano Zampini               total_ranks_recv[displacements_recv[j]+total_count_recv[j]]=i;
2688*c8587f34SStefano Zampini               total_count_recv[j]+=1;
2689*c8587f34SStefano Zampini             }
2690*c8587f34SStefano Zampini           }
2691*c8587f34SStefano Zampini         }
2692*c8587f34SStefano Zampini         /*for (j=0;j<size_coarse_comm;j++) {
2693*c8587f34SStefano Zampini           printf("process %d in new rank will receive from %d processes (original ranks follows)\n",j,total_count_recv[j]);
2694*c8587f34SStefano Zampini           for (i=0;i<total_count_recv[j];i++) {
2695*c8587f34SStefano Zampini             printf("%d ",total_ranks_recv[displacements_recv[j]+i]);
2696*c8587f34SStefano Zampini           }
2697*c8587f34SStefano Zampini           printf("\n");
2698*c8587f34SStefano Zampini         }*/
2699*c8587f34SStefano Zampini 
2700*c8587f34SStefano Zampini         /* identify new decomposition in terms of ranks in the old communicator */
2701*c8587f34SStefano Zampini         for (i=0;i<n_subdomains;i++) {
2702*c8587f34SStefano Zampini           coarse_subdivision[ranks_stretching_ratio*i]=coarse_subdivision[ranks_stretching_ratio*i]*procs_jumps_coarse_comm;
2703*c8587f34SStefano Zampini         }
2704*c8587f34SStefano Zampini         /*printf("coarse_subdivision in old end new ranks\n");
2705*c8587f34SStefano Zampini         for (i=0;i<size_prec_comm;i++)
2706*c8587f34SStefano Zampini           if (coarse_subdivision[i]!=MPI_PROC_NULL) {
2707*c8587f34SStefano Zampini             printf("%d=(%d %d), ",i,coarse_subdivision[i],coarse_subdivision[i]/procs_jumps_coarse_comm);
2708*c8587f34SStefano Zampini           } else {
2709*c8587f34SStefano Zampini             printf("%d=(%d %d), ",i,coarse_subdivision[i],coarse_subdivision[i]);
2710*c8587f34SStefano Zampini           }
2711*c8587f34SStefano Zampini         printf("\n");*/
2712*c8587f34SStefano Zampini       }
2713*c8587f34SStefano Zampini 
2714*c8587f34SStefano Zampini       /* Scatter new decomposition for send details */
2715*c8587f34SStefano Zampini       ierr = MPI_Scatter(&coarse_subdivision[0],1,MPIU_INT,&rank_coarse_proc_send_to,1,MPIU_INT,master_proc,prec_comm);CHKERRQ(ierr);
2716*c8587f34SStefano Zampini       /* Scatter receiving details to members of coarse decomposition */
2717*c8587f34SStefano Zampini       if ( coarse_color == 0) {
2718*c8587f34SStefano Zampini         ierr = MPI_Scatter(&total_count_recv[0],1,MPIU_INT,&count_recv,1,MPIU_INT,master_proc,coarse_comm);CHKERRQ(ierr);
2719*c8587f34SStefano Zampini         ierr = PetscMalloc (count_recv*sizeof(PetscMPIInt),&ranks_recv);CHKERRQ(ierr);
2720*c8587f34SStefano 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);
2721*c8587f34SStefano Zampini       }
2722*c8587f34SStefano Zampini 
2723*c8587f34SStefano Zampini       /*printf("I will send my matrix data to proc  %d\n",rank_coarse_proc_send_to);
2724*c8587f34SStefano Zampini       if (coarse_color == 0) {
2725*c8587f34SStefano Zampini         printf("I will receive some matrix data from %d processes (ranks follows)\n",count_recv);
2726*c8587f34SStefano Zampini         for (i=0;i<count_recv;i++)
2727*c8587f34SStefano Zampini           printf("%d ",ranks_recv[i]);
2728*c8587f34SStefano Zampini         printf("\n");
2729*c8587f34SStefano Zampini       }*/
2730*c8587f34SStefano Zampini 
2731*c8587f34SStefano Zampini       if (rank_prec_comm == master_proc) {
2732*c8587f34SStefano Zampini         ierr = PetscFree(coarse_subdivision);CHKERRQ(ierr);
2733*c8587f34SStefano Zampini         ierr = PetscFree(total_count_recv);CHKERRQ(ierr);
2734*c8587f34SStefano Zampini         ierr = PetscFree(total_ranks_recv);CHKERRQ(ierr);
2735*c8587f34SStefano Zampini         ierr = PetscFree(displacements_recv);CHKERRQ(ierr);
2736*c8587f34SStefano Zampini       }
2737*c8587f34SStefano Zampini #endif
2738*c8587f34SStefano Zampini       break;
2739*c8587f34SStefano Zampini     }
2740*c8587f34SStefano Zampini 
2741*c8587f34SStefano Zampini     case(REPLICATED_BDDC):
2742*c8587f34SStefano Zampini 
2743*c8587f34SStefano Zampini       pcbddc->coarse_communications_type = GATHERS_BDDC;
2744*c8587f34SStefano Zampini       coarse_mat_type = MATSEQAIJ;
2745*c8587f34SStefano Zampini       coarse_pc_type  = PCLU;
2746*c8587f34SStefano Zampini       coarse_ksp_type  = KSPPREONLY;
2747*c8587f34SStefano Zampini       coarse_comm = PETSC_COMM_SELF;
2748*c8587f34SStefano Zampini       active_rank = rank_prec_comm;
2749*c8587f34SStefano Zampini       break;
2750*c8587f34SStefano Zampini 
2751*c8587f34SStefano Zampini     case(PARALLEL_BDDC):
2752*c8587f34SStefano Zampini 
2753*c8587f34SStefano Zampini       pcbddc->coarse_communications_type = SCATTERS_BDDC;
2754*c8587f34SStefano Zampini       coarse_mat_type = MATAIJ;
2755*c8587f34SStefano Zampini       coarse_pc_type  = PCREDUNDANT;
2756*c8587f34SStefano Zampini       coarse_ksp_type  = KSPPREONLY;
2757*c8587f34SStefano Zampini       coarse_comm = prec_comm;
2758*c8587f34SStefano Zampini       active_rank = rank_prec_comm;
2759*c8587f34SStefano Zampini       break;
2760*c8587f34SStefano Zampini 
2761*c8587f34SStefano Zampini     case(SEQUENTIAL_BDDC):
2762*c8587f34SStefano Zampini       pcbddc->coarse_communications_type = GATHERS_BDDC;
2763*c8587f34SStefano Zampini       coarse_mat_type = MATAIJ;
2764*c8587f34SStefano Zampini       coarse_pc_type = PCLU;
2765*c8587f34SStefano Zampini       coarse_ksp_type  = KSPPREONLY;
2766*c8587f34SStefano Zampini       coarse_comm = PETSC_COMM_SELF;
2767*c8587f34SStefano Zampini       active_rank = master_proc;
2768*c8587f34SStefano Zampini       break;
2769*c8587f34SStefano Zampini   }
2770*c8587f34SStefano Zampini 
2771*c8587f34SStefano Zampini   switch(pcbddc->coarse_communications_type){
2772*c8587f34SStefano Zampini 
2773*c8587f34SStefano Zampini     case(SCATTERS_BDDC):
2774*c8587f34SStefano Zampini       {
2775*c8587f34SStefano Zampini         if (pcbddc->coarse_problem_type==MULTILEVEL_BDDC) {
2776*c8587f34SStefano Zampini 
2777*c8587f34SStefano Zampini           IS coarse_IS;
2778*c8587f34SStefano Zampini 
2779*c8587f34SStefano Zampini           if(pcbddc->coarsening_ratio == 1) {
2780*c8587f34SStefano Zampini             ins_local_primal_size = pcbddc->local_primal_size;
2781*c8587f34SStefano Zampini             ins_local_primal_indices = pcbddc->local_primal_indices;
2782*c8587f34SStefano Zampini             if (coarse_color == 0) { ierr = PetscFree(ranks_recv);CHKERRQ(ierr); }
2783*c8587f34SStefano Zampini             /* nonzeros */
2784*c8587f34SStefano Zampini             ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&dnz);CHKERRQ(ierr);
2785*c8587f34SStefano Zampini             ierr = PetscMemzero(dnz,ins_local_primal_size*sizeof(PetscInt));CHKERRQ(ierr);
2786*c8587f34SStefano Zampini             for (i=0;i<ins_local_primal_size;i++) {
2787*c8587f34SStefano Zampini               dnz[i] = ins_local_primal_size;
2788*c8587f34SStefano Zampini             }
2789*c8587f34SStefano Zampini           } else {
2790*c8587f34SStefano Zampini             PetscMPIInt send_size;
2791*c8587f34SStefano Zampini             PetscMPIInt *send_buffer;
2792*c8587f34SStefano Zampini             PetscInt    *aux_ins_indices;
2793*c8587f34SStefano Zampini             PetscInt    ii,jj;
2794*c8587f34SStefano Zampini             MPI_Request *requests;
2795*c8587f34SStefano Zampini 
2796*c8587f34SStefano Zampini             ierr = PetscMalloc(count_recv*sizeof(PetscMPIInt),&localdispl2);CHKERRQ(ierr);
2797*c8587f34SStefano Zampini             /* reusing pcbddc->local_primal_displacements and pcbddc->replicated_primal_size */
2798*c8587f34SStefano Zampini             ierr = PetscFree(pcbddc->local_primal_displacements);CHKERRQ(ierr);
2799*c8587f34SStefano Zampini             ierr = PetscMalloc((count_recv+1)*sizeof(PetscMPIInt),&pcbddc->local_primal_displacements);CHKERRQ(ierr);
2800*c8587f34SStefano Zampini             pcbddc->replicated_primal_size = count_recv;
2801*c8587f34SStefano Zampini             j = 0;
2802*c8587f34SStefano Zampini             for (i=0;i<count_recv;i++) {
2803*c8587f34SStefano Zampini               pcbddc->local_primal_displacements[i] = j;
2804*c8587f34SStefano Zampini               j += pcbddc->local_primal_sizes[ranks_recv[i]];
2805*c8587f34SStefano Zampini             }
2806*c8587f34SStefano Zampini             pcbddc->local_primal_displacements[count_recv] = j;
2807*c8587f34SStefano Zampini             ierr = PetscMalloc(j*sizeof(PetscMPIInt),&pcbddc->replicated_local_primal_indices);CHKERRQ(ierr);
2808*c8587f34SStefano Zampini             /* allocate auxiliary space */
2809*c8587f34SStefano Zampini             ierr = PetscMalloc(count_recv*sizeof(PetscMPIInt),&localsizes2);CHKERRQ(ierr);
2810*c8587f34SStefano Zampini             ierr = PetscMalloc(pcbddc->coarse_size*sizeof(PetscInt),&aux_ins_indices);CHKERRQ(ierr);
2811*c8587f34SStefano Zampini             ierr = PetscMemzero(aux_ins_indices,pcbddc->coarse_size*sizeof(PetscInt));CHKERRQ(ierr);
2812*c8587f34SStefano Zampini             /* allocate stuffs for message massing */
2813*c8587f34SStefano Zampini             ierr = PetscMalloc((count_recv+1)*sizeof(MPI_Request),&requests);CHKERRQ(ierr);
2814*c8587f34SStefano Zampini             for (i=0;i<count_recv+1;i++) { requests[i]=MPI_REQUEST_NULL; }
2815*c8587f34SStefano Zampini             /* send indices to be inserted */
2816*c8587f34SStefano Zampini             for (i=0;i<count_recv;i++) {
2817*c8587f34SStefano Zampini               send_size = pcbddc->local_primal_sizes[ranks_recv[i]];
2818*c8587f34SStefano 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);
2819*c8587f34SStefano Zampini             }
2820*c8587f34SStefano Zampini             if (rank_coarse_proc_send_to != MPI_PROC_NULL ) {
2821*c8587f34SStefano Zampini               send_size = pcbddc->local_primal_size;
2822*c8587f34SStefano Zampini               ierr = PetscMalloc(send_size*sizeof(PetscMPIInt),&send_buffer);CHKERRQ(ierr);
2823*c8587f34SStefano Zampini               for (i=0;i<send_size;i++) {
2824*c8587f34SStefano Zampini                 send_buffer[i]=(PetscMPIInt)pcbddc->local_primal_indices[i];
2825*c8587f34SStefano Zampini               }
2826*c8587f34SStefano Zampini               ierr = MPI_Isend(send_buffer,send_size,MPIU_INT,rank_coarse_proc_send_to,999,prec_comm,&requests[count_recv]);CHKERRQ(ierr);
2827*c8587f34SStefano Zampini             }
2828*c8587f34SStefano Zampini             ierr = MPI_Waitall(count_recv+1,requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2829*c8587f34SStefano Zampini             if (rank_coarse_proc_send_to != MPI_PROC_NULL ) {
2830*c8587f34SStefano Zampini               ierr = PetscFree(send_buffer);CHKERRQ(ierr);
2831*c8587f34SStefano Zampini             }
2832*c8587f34SStefano Zampini             j = 0;
2833*c8587f34SStefano Zampini             for (i=0;i<count_recv;i++) {
2834*c8587f34SStefano Zampini               ii = pcbddc->local_primal_displacements[i+1]-pcbddc->local_primal_displacements[i];
2835*c8587f34SStefano Zampini               localsizes2[i] = ii*ii;
2836*c8587f34SStefano Zampini               localdispl2[i] = j;
2837*c8587f34SStefano Zampini               j += localsizes2[i];
2838*c8587f34SStefano Zampini               jj = pcbddc->local_primal_displacements[i];
2839*c8587f34SStefano Zampini               /* it counts the coarse subdomains sharing the coarse node */
2840*c8587f34SStefano Zampini               for (k=0;k<ii;k++) {
2841*c8587f34SStefano Zampini                 aux_ins_indices[pcbddc->replicated_local_primal_indices[jj+k]] += 1;
2842*c8587f34SStefano Zampini               }
2843*c8587f34SStefano Zampini             }
2844*c8587f34SStefano Zampini             /* temp_coarse_mat_vals used to store matrix values to be received */
2845*c8587f34SStefano Zampini             ierr = PetscMalloc(j*sizeof(PetscScalar),&temp_coarse_mat_vals);CHKERRQ(ierr);
2846*c8587f34SStefano Zampini             /* evaluate how many values I will insert in coarse mat */
2847*c8587f34SStefano Zampini             ins_local_primal_size = 0;
2848*c8587f34SStefano Zampini             for (i=0;i<pcbddc->coarse_size;i++) {
2849*c8587f34SStefano Zampini               if (aux_ins_indices[i]) {
2850*c8587f34SStefano Zampini                 ins_local_primal_size++;
2851*c8587f34SStefano Zampini               }
2852*c8587f34SStefano Zampini             }
2853*c8587f34SStefano Zampini             /* evaluate indices I will insert in coarse mat */
2854*c8587f34SStefano Zampini             ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr);
2855*c8587f34SStefano Zampini             j = 0;
2856*c8587f34SStefano Zampini             for(i=0;i<pcbddc->coarse_size;i++) {
2857*c8587f34SStefano Zampini               if(aux_ins_indices[i]) {
2858*c8587f34SStefano Zampini                 ins_local_primal_indices[j] = i;
2859*c8587f34SStefano Zampini                 j++;
2860*c8587f34SStefano Zampini               }
2861*c8587f34SStefano Zampini             }
2862*c8587f34SStefano Zampini             /* processes partecipating in coarse problem receive matrix data from their friends */
2863*c8587f34SStefano Zampini             for (i=0;i<count_recv;i++) {
2864*c8587f34SStefano Zampini               ierr = MPI_Irecv(&temp_coarse_mat_vals[localdispl2[i]],localsizes2[i],MPIU_SCALAR,ranks_recv[i],666,prec_comm,&requests[i]);CHKERRQ(ierr);
2865*c8587f34SStefano Zampini             }
2866*c8587f34SStefano Zampini             if (rank_coarse_proc_send_to != MPI_PROC_NULL ) {
2867*c8587f34SStefano Zampini               send_size = pcbddc->local_primal_size*pcbddc->local_primal_size;
2868*c8587f34SStefano 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);
2869*c8587f34SStefano Zampini             }
2870*c8587f34SStefano Zampini             ierr = MPI_Waitall(count_recv+1,requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2871*c8587f34SStefano Zampini             /* nonzeros */
2872*c8587f34SStefano Zampini             ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&dnz);CHKERRQ(ierr);
2873*c8587f34SStefano Zampini             ierr = PetscMemzero(dnz,ins_local_primal_size*sizeof(PetscInt));CHKERRQ(ierr);
2874*c8587f34SStefano Zampini             /* use aux_ins_indices to realize a global to local mapping */
2875*c8587f34SStefano Zampini             j=0;
2876*c8587f34SStefano Zampini             for(i=0;i<pcbddc->coarse_size;i++){
2877*c8587f34SStefano Zampini               if(aux_ins_indices[i]==0){
2878*c8587f34SStefano Zampini                 aux_ins_indices[i]=-1;
2879*c8587f34SStefano Zampini               } else {
2880*c8587f34SStefano Zampini                 aux_ins_indices[i]=j;
2881*c8587f34SStefano Zampini                 j++;
2882*c8587f34SStefano Zampini               }
2883*c8587f34SStefano Zampini             }
2884*c8587f34SStefano Zampini             for (i=0;i<count_recv;i++) {
2885*c8587f34SStefano Zampini               j = pcbddc->local_primal_sizes[ranks_recv[i]];
2886*c8587f34SStefano Zampini               for (k=0;k<j;k++) {
2887*c8587f34SStefano Zampini                 dnz[aux_ins_indices[pcbddc->replicated_local_primal_indices[pcbddc->local_primal_displacements[i]+k]]] += j;
2888*c8587f34SStefano Zampini               }
2889*c8587f34SStefano Zampini             }
2890*c8587f34SStefano Zampini             /* check */
2891*c8587f34SStefano Zampini             for (i=0;i<ins_local_primal_size;i++) {
2892*c8587f34SStefano Zampini               if (dnz[i] > ins_local_primal_size) {
2893*c8587f34SStefano Zampini                 dnz[i] = ins_local_primal_size;
2894*c8587f34SStefano Zampini               }
2895*c8587f34SStefano Zampini             }
2896*c8587f34SStefano Zampini             ierr = PetscFree(requests);CHKERRQ(ierr);
2897*c8587f34SStefano Zampini             ierr = PetscFree(aux_ins_indices);CHKERRQ(ierr);
2898*c8587f34SStefano Zampini             if (coarse_color == 0) { ierr = PetscFree(ranks_recv);CHKERRQ(ierr); }
2899*c8587f34SStefano Zampini           }
2900*c8587f34SStefano Zampini           /* create local to global mapping needed by coarse MATIS */
2901*c8587f34SStefano Zampini           if (coarse_comm != MPI_COMM_NULL ) {ierr = MPI_Comm_free(&coarse_comm);CHKERRQ(ierr);}
2902*c8587f34SStefano Zampini           coarse_comm = prec_comm;
2903*c8587f34SStefano Zampini           active_rank = rank_prec_comm;
2904*c8587f34SStefano Zampini           ierr = ISCreateGeneral(coarse_comm,ins_local_primal_size,ins_local_primal_indices,PETSC_COPY_VALUES,&coarse_IS);CHKERRQ(ierr);
2905*c8587f34SStefano Zampini           ierr = ISLocalToGlobalMappingCreateIS(coarse_IS,&coarse_ISLG);CHKERRQ(ierr);
2906*c8587f34SStefano Zampini           ierr = ISDestroy(&coarse_IS);CHKERRQ(ierr);
2907*c8587f34SStefano Zampini         } else if (pcbddc->coarse_problem_type==PARALLEL_BDDC) {
2908*c8587f34SStefano Zampini           /* arrays for values insertion */
2909*c8587f34SStefano Zampini           ins_local_primal_size = pcbddc->local_primal_size;
2910*c8587f34SStefano Zampini           ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr);
2911*c8587f34SStefano Zampini           ierr = PetscMalloc(ins_local_primal_size*ins_local_primal_size*sizeof(PetscScalar),&ins_coarse_mat_vals);CHKERRQ(ierr);
2912*c8587f34SStefano Zampini           for (j=0;j<ins_local_primal_size;j++){
2913*c8587f34SStefano Zampini             ins_local_primal_indices[j]=pcbddc->local_primal_indices[j];
2914*c8587f34SStefano Zampini             for (i=0;i<ins_local_primal_size;i++) {
2915*c8587f34SStefano Zampini               ins_coarse_mat_vals[j*ins_local_primal_size+i]=coarse_submat_vals[j*ins_local_primal_size+i];
2916*c8587f34SStefano Zampini             }
2917*c8587f34SStefano Zampini           }
2918*c8587f34SStefano Zampini         }
2919*c8587f34SStefano Zampini         break;
2920*c8587f34SStefano Zampini 
2921*c8587f34SStefano Zampini     }
2922*c8587f34SStefano Zampini 
2923*c8587f34SStefano Zampini     case(GATHERS_BDDC):
2924*c8587f34SStefano Zampini       {
2925*c8587f34SStefano Zampini 
2926*c8587f34SStefano Zampini         PetscMPIInt mysize,mysize2;
2927*c8587f34SStefano Zampini         PetscMPIInt *send_buffer;
2928*c8587f34SStefano Zampini 
2929*c8587f34SStefano Zampini         if (rank_prec_comm==active_rank) {
2930*c8587f34SStefano Zampini           ierr = PetscMalloc ( pcbddc->replicated_primal_size*sizeof(PetscMPIInt),&pcbddc->replicated_local_primal_indices);CHKERRQ(ierr);
2931*c8587f34SStefano Zampini           ierr = PetscMalloc ( pcbddc->replicated_primal_size*sizeof(PetscScalar),&pcbddc->replicated_local_primal_values);CHKERRQ(ierr);
2932*c8587f34SStefano Zampini           ierr = PetscMalloc ( size_prec_comm*sizeof(PetscMPIInt),&localsizes2);CHKERRQ(ierr);
2933*c8587f34SStefano Zampini           ierr = PetscMalloc ( size_prec_comm*sizeof(PetscMPIInt),&localdispl2);CHKERRQ(ierr);
2934*c8587f34SStefano Zampini           /* arrays for values insertion */
2935*c8587f34SStefano Zampini       for (i=0;i<size_prec_comm;i++) localsizes2[i]=pcbddc->local_primal_sizes[i]*pcbddc->local_primal_sizes[i];
2936*c8587f34SStefano Zampini           localdispl2[0]=0;
2937*c8587f34SStefano Zampini       for (i=1;i<size_prec_comm;i++) localdispl2[i]=localsizes2[i-1]+localdispl2[i-1];
2938*c8587f34SStefano Zampini           j=0;
2939*c8587f34SStefano Zampini       for (i=0;i<size_prec_comm;i++) j+=localsizes2[i];
2940*c8587f34SStefano Zampini           ierr = PetscMalloc ( j*sizeof(PetscScalar),&temp_coarse_mat_vals);CHKERRQ(ierr);
2941*c8587f34SStefano Zampini         }
2942*c8587f34SStefano Zampini 
2943*c8587f34SStefano Zampini         mysize=pcbddc->local_primal_size;
2944*c8587f34SStefano Zampini         mysize2=pcbddc->local_primal_size*pcbddc->local_primal_size;
2945*c8587f34SStefano Zampini         ierr = PetscMalloc(mysize*sizeof(PetscMPIInt),&send_buffer);CHKERRQ(ierr);
2946*c8587f34SStefano Zampini     for (i=0; i<mysize; i++) send_buffer[i]=(PetscMPIInt)pcbddc->local_primal_indices[i];
2947*c8587f34SStefano Zampini 
2948*c8587f34SStefano Zampini         if (pcbddc->coarse_problem_type == SEQUENTIAL_BDDC){
2949*c8587f34SStefano 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);
2950*c8587f34SStefano 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);
2951*c8587f34SStefano Zampini         } else {
2952*c8587f34SStefano 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);
2953*c8587f34SStefano Zampini           ierr = MPI_Allgatherv(&coarse_submat_vals[0],mysize2,MPIU_SCALAR,&temp_coarse_mat_vals[0],localsizes2,localdispl2,MPIU_SCALAR,prec_comm);CHKERRQ(ierr);
2954*c8587f34SStefano Zampini         }
2955*c8587f34SStefano Zampini         ierr = PetscFree(send_buffer);CHKERRQ(ierr);
2956*c8587f34SStefano Zampini         break;
2957*c8587f34SStefano Zampini       }/* switch on coarse problem and communications associated with finished */
2958*c8587f34SStefano Zampini   }
2959*c8587f34SStefano Zampini 
2960*c8587f34SStefano Zampini   /* Now create and fill up coarse matrix */
2961*c8587f34SStefano Zampini   if ( rank_prec_comm == active_rank ) {
2962*c8587f34SStefano Zampini 
2963*c8587f34SStefano Zampini     Mat matis_coarse_local_mat;
2964*c8587f34SStefano Zampini 
2965*c8587f34SStefano Zampini     if (pcbddc->coarse_problem_type != MULTILEVEL_BDDC) {
2966*c8587f34SStefano Zampini       ierr = MatCreate(coarse_comm,&pcbddc->coarse_mat);CHKERRQ(ierr);
2967*c8587f34SStefano Zampini       ierr = MatSetSizes(pcbddc->coarse_mat,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size);CHKERRQ(ierr);
2968*c8587f34SStefano Zampini       ierr = MatSetType(pcbddc->coarse_mat,coarse_mat_type);CHKERRQ(ierr);
2969*c8587f34SStefano Zampini       ierr = MatSetOptionsPrefix(pcbddc->coarse_mat,"coarse_");CHKERRQ(ierr);
2970*c8587f34SStefano Zampini       ierr = MatSetFromOptions(pcbddc->coarse_mat);CHKERRQ(ierr);
2971*c8587f34SStefano Zampini       ierr = MatSetUp(pcbddc->coarse_mat);CHKERRQ(ierr);
2972*c8587f34SStefano Zampini       ierr = MatSetOption(pcbddc->coarse_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr); /* local values stored in column major */
2973*c8587f34SStefano Zampini       ierr = MatSetOption(pcbddc->coarse_mat,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr);
2974*c8587f34SStefano Zampini     } else {
2975*c8587f34SStefano Zampini       ierr = MatCreateIS(coarse_comm,1,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size,coarse_ISLG,&pcbddc->coarse_mat);CHKERRQ(ierr);
2976*c8587f34SStefano Zampini       ierr = MatSetUp(pcbddc->coarse_mat);CHKERRQ(ierr);
2977*c8587f34SStefano Zampini       ierr = MatISGetLocalMat(pcbddc->coarse_mat,&matis_coarse_local_mat);CHKERRQ(ierr);
2978*c8587f34SStefano Zampini       ierr = MatSetOptionsPrefix(pcbddc->coarse_mat,"coarse_");CHKERRQ(ierr);
2979*c8587f34SStefano Zampini       ierr = MatSetFromOptions(pcbddc->coarse_mat);CHKERRQ(ierr);
2980*c8587f34SStefano Zampini       ierr = MatSetUp(matis_coarse_local_mat);CHKERRQ(ierr);
2981*c8587f34SStefano Zampini       ierr = MatSetOption(matis_coarse_local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr); /* local values stored in column major */
2982*c8587f34SStefano Zampini       ierr = MatSetOption(matis_coarse_local_mat,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr);
2983*c8587f34SStefano Zampini     }
2984*c8587f34SStefano Zampini     /* preallocation */
2985*c8587f34SStefano Zampini     if (pcbddc->coarse_problem_type != MULTILEVEL_BDDC) {
2986*c8587f34SStefano Zampini 
2987*c8587f34SStefano Zampini       PetscInt lrows,lcols,bs;
2988*c8587f34SStefano Zampini 
2989*c8587f34SStefano Zampini       ierr = MatGetLocalSize(pcbddc->coarse_mat,&lrows,&lcols);CHKERRQ(ierr);
2990*c8587f34SStefano Zampini       ierr = MatPreallocateInitialize(coarse_comm,lrows,lcols,dnz,onz);CHKERRQ(ierr);
2991*c8587f34SStefano Zampini       ierr = MatGetBlockSize(pcbddc->coarse_mat,&bs);CHKERRQ(ierr);
2992*c8587f34SStefano Zampini 
2993*c8587f34SStefano Zampini       if (pcbddc->coarse_problem_type == PARALLEL_BDDC) {
2994*c8587f34SStefano Zampini 
2995*c8587f34SStefano Zampini         Vec         vec_dnz,vec_onz;
2996*c8587f34SStefano Zampini         PetscScalar *my_dnz,*my_onz,*array;
2997*c8587f34SStefano Zampini         PetscInt    *mat_ranges,*row_ownership;
2998*c8587f34SStefano Zampini         PetscInt    coarse_index_row,coarse_index_col,owner;
2999*c8587f34SStefano Zampini 
3000*c8587f34SStefano Zampini         ierr = VecCreate(prec_comm,&vec_dnz);CHKERRQ(ierr);
3001*c8587f34SStefano Zampini         ierr = VecSetBlockSize(vec_dnz,bs);CHKERRQ(ierr);
3002*c8587f34SStefano Zampini         ierr = VecSetSizes(vec_dnz,PETSC_DECIDE,pcbddc->coarse_size);CHKERRQ(ierr);
3003*c8587f34SStefano Zampini         ierr = VecSetType(vec_dnz,VECMPI);CHKERRQ(ierr);
3004*c8587f34SStefano Zampini         ierr = VecDuplicate(vec_dnz,&vec_onz);CHKERRQ(ierr);
3005*c8587f34SStefano Zampini 
3006*c8587f34SStefano Zampini         ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscScalar),&my_dnz);CHKERRQ(ierr);
3007*c8587f34SStefano Zampini         ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscScalar),&my_onz);CHKERRQ(ierr);
3008*c8587f34SStefano Zampini         ierr = PetscMemzero(my_dnz,pcbddc->local_primal_size*sizeof(PetscScalar));CHKERRQ(ierr);
3009*c8587f34SStefano Zampini         ierr = PetscMemzero(my_onz,pcbddc->local_primal_size*sizeof(PetscScalar));CHKERRQ(ierr);
3010*c8587f34SStefano Zampini 
3011*c8587f34SStefano Zampini         ierr = PetscMalloc(pcbddc->coarse_size*sizeof(PetscInt),&row_ownership);CHKERRQ(ierr);
3012*c8587f34SStefano Zampini         ierr = MatGetOwnershipRanges(pcbddc->coarse_mat,(const PetscInt**)&mat_ranges);CHKERRQ(ierr);
3013*c8587f34SStefano Zampini         for (i=0;i<size_prec_comm;i++) {
3014*c8587f34SStefano Zampini           for (j=mat_ranges[i];j<mat_ranges[i+1];j++) {
3015*c8587f34SStefano Zampini             row_ownership[j]=i;
3016*c8587f34SStefano Zampini           }
3017*c8587f34SStefano Zampini         }
3018*c8587f34SStefano Zampini 
3019*c8587f34SStefano Zampini         for (i=0;i<pcbddc->local_primal_size;i++) {
3020*c8587f34SStefano Zampini           coarse_index_row = pcbddc->local_primal_indices[i];
3021*c8587f34SStefano Zampini           owner = row_ownership[coarse_index_row];
3022*c8587f34SStefano Zampini           for (j=i;j<pcbddc->local_primal_size;j++) {
3023*c8587f34SStefano Zampini             owner = row_ownership[coarse_index_row];
3024*c8587f34SStefano Zampini             coarse_index_col = pcbddc->local_primal_indices[j];
3025*c8587f34SStefano Zampini             if (coarse_index_col > mat_ranges[owner]-1 && coarse_index_col < mat_ranges[owner+1] ) {
3026*c8587f34SStefano Zampini               my_dnz[i] += 1.0;
3027*c8587f34SStefano Zampini             } else {
3028*c8587f34SStefano Zampini               my_onz[i] += 1.0;
3029*c8587f34SStefano Zampini             }
3030*c8587f34SStefano Zampini             if (i != j) {
3031*c8587f34SStefano Zampini               owner = row_ownership[coarse_index_col];
3032*c8587f34SStefano Zampini               if (coarse_index_row > mat_ranges[owner]-1 && coarse_index_row < mat_ranges[owner+1] ) {
3033*c8587f34SStefano Zampini                 my_dnz[j] += 1.0;
3034*c8587f34SStefano Zampini               } else {
3035*c8587f34SStefano Zampini                 my_onz[j] += 1.0;
3036*c8587f34SStefano Zampini               }
3037*c8587f34SStefano Zampini             }
3038*c8587f34SStefano Zampini           }
3039*c8587f34SStefano Zampini         }
3040*c8587f34SStefano Zampini         ierr = VecSet(vec_dnz,0.0);CHKERRQ(ierr);
3041*c8587f34SStefano Zampini         ierr = VecSet(vec_onz,0.0);CHKERRQ(ierr);
3042*c8587f34SStefano Zampini         if (pcbddc->local_primal_size) {
3043*c8587f34SStefano Zampini           ierr = VecSetValues(vec_dnz,pcbddc->local_primal_size,pcbddc->local_primal_indices,my_dnz,ADD_VALUES);CHKERRQ(ierr);
3044*c8587f34SStefano Zampini           ierr = VecSetValues(vec_onz,pcbddc->local_primal_size,pcbddc->local_primal_indices,my_onz,ADD_VALUES);CHKERRQ(ierr);
3045*c8587f34SStefano Zampini         }
3046*c8587f34SStefano Zampini         ierr = VecAssemblyBegin(vec_dnz);CHKERRQ(ierr);
3047*c8587f34SStefano Zampini         ierr = VecAssemblyBegin(vec_onz);CHKERRQ(ierr);
3048*c8587f34SStefano Zampini         ierr = VecAssemblyEnd(vec_dnz);CHKERRQ(ierr);
3049*c8587f34SStefano Zampini         ierr = VecAssemblyEnd(vec_onz);CHKERRQ(ierr);
3050*c8587f34SStefano Zampini         j = mat_ranges[rank_prec_comm+1]-mat_ranges[rank_prec_comm];
3051*c8587f34SStefano Zampini         ierr = VecGetArray(vec_dnz,&array);CHKERRQ(ierr);
3052*c8587f34SStefano Zampini         for (i=0; i<j; i++) dnz[i] = (PetscInt)PetscRealPart(array[i]);
3053*c8587f34SStefano Zampini 
3054*c8587f34SStefano Zampini         ierr = VecRestoreArray(vec_dnz,&array);CHKERRQ(ierr);
3055*c8587f34SStefano Zampini         ierr = VecGetArray(vec_onz,&array);CHKERRQ(ierr);
3056*c8587f34SStefano Zampini         for (i=0;i<j;i++) onz[i] = (PetscInt)PetscRealPart(array[i]);
3057*c8587f34SStefano Zampini 
3058*c8587f34SStefano Zampini         ierr = VecRestoreArray(vec_onz,&array);CHKERRQ(ierr);
3059*c8587f34SStefano Zampini         ierr = PetscFree(my_dnz);CHKERRQ(ierr);
3060*c8587f34SStefano Zampini         ierr = PetscFree(my_onz);CHKERRQ(ierr);
3061*c8587f34SStefano Zampini         ierr = PetscFree(row_ownership);CHKERRQ(ierr);
3062*c8587f34SStefano Zampini         ierr = VecDestroy(&vec_dnz);CHKERRQ(ierr);
3063*c8587f34SStefano Zampini         ierr = VecDestroy(&vec_onz);CHKERRQ(ierr);
3064*c8587f34SStefano Zampini       } else {
3065*c8587f34SStefano Zampini         for (k=0;k<size_prec_comm;k++){
3066*c8587f34SStefano Zampini           offset=pcbddc->local_primal_displacements[k];
3067*c8587f34SStefano Zampini           offset2=localdispl2[k];
3068*c8587f34SStefano Zampini           ins_local_primal_size = pcbddc->local_primal_sizes[k];
3069*c8587f34SStefano Zampini           ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr);
3070*c8587f34SStefano Zampini           for (j=0;j<ins_local_primal_size;j++){
3071*c8587f34SStefano Zampini             ins_local_primal_indices[j]=(PetscInt)pcbddc->replicated_local_primal_indices[offset+j];
3072*c8587f34SStefano Zampini           }
3073*c8587f34SStefano Zampini           for (j=0;j<ins_local_primal_size;j++) {
3074*c8587f34SStefano Zampini             ierr = MatPreallocateSet(ins_local_primal_indices[j],ins_local_primal_size,ins_local_primal_indices,dnz,onz);CHKERRQ(ierr);
3075*c8587f34SStefano Zampini           }
3076*c8587f34SStefano Zampini           ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr);
3077*c8587f34SStefano Zampini         }
3078*c8587f34SStefano Zampini       }
3079*c8587f34SStefano Zampini 
3080*c8587f34SStefano Zampini       /* check */
3081*c8587f34SStefano Zampini       for (i=0;i<lrows;i++) {
3082*c8587f34SStefano Zampini         if (dnz[i]>lcols) dnz[i]=lcols;
3083*c8587f34SStefano Zampini         if (onz[i]>pcbddc->coarse_size-lcols) onz[i]=pcbddc->coarse_size-lcols;
3084*c8587f34SStefano Zampini       }
3085*c8587f34SStefano Zampini       ierr = MatSeqAIJSetPreallocation(pcbddc->coarse_mat,0,dnz);CHKERRQ(ierr);
3086*c8587f34SStefano Zampini       ierr = MatMPIAIJSetPreallocation(pcbddc->coarse_mat,0,dnz,0,onz);CHKERRQ(ierr);
3087*c8587f34SStefano Zampini       ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
3088*c8587f34SStefano Zampini     } else {
3089*c8587f34SStefano Zampini       ierr = MatSeqAIJSetPreallocation(matis_coarse_local_mat,0,dnz);CHKERRQ(ierr);
3090*c8587f34SStefano Zampini       ierr = PetscFree(dnz);CHKERRQ(ierr);
3091*c8587f34SStefano Zampini     }
3092*c8587f34SStefano Zampini     /* insert values */
3093*c8587f34SStefano Zampini     if (pcbddc->coarse_problem_type == PARALLEL_BDDC) {
3094*c8587f34SStefano 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);
3095*c8587f34SStefano Zampini     } else if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
3096*c8587f34SStefano Zampini       if (pcbddc->coarsening_ratio == 1) {
3097*c8587f34SStefano Zampini         ins_coarse_mat_vals = coarse_submat_vals;
3098*c8587f34SStefano 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);
3099*c8587f34SStefano Zampini       } else {
3100*c8587f34SStefano Zampini         ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr);
3101*c8587f34SStefano Zampini         for (k=0;k<pcbddc->replicated_primal_size;k++) {
3102*c8587f34SStefano Zampini           offset = pcbddc->local_primal_displacements[k];
3103*c8587f34SStefano Zampini           offset2 = localdispl2[k];
3104*c8587f34SStefano Zampini           ins_local_primal_size = pcbddc->local_primal_displacements[k+1]-pcbddc->local_primal_displacements[k];
3105*c8587f34SStefano Zampini           ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr);
3106*c8587f34SStefano Zampini           for (j=0;j<ins_local_primal_size;j++){
3107*c8587f34SStefano Zampini             ins_local_primal_indices[j]=(PetscInt)pcbddc->replicated_local_primal_indices[offset+j];
3108*c8587f34SStefano Zampini           }
3109*c8587f34SStefano Zampini           ins_coarse_mat_vals = &temp_coarse_mat_vals[offset2];
3110*c8587f34SStefano 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);
3111*c8587f34SStefano Zampini           ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr);
3112*c8587f34SStefano Zampini         }
3113*c8587f34SStefano Zampini       }
3114*c8587f34SStefano Zampini       ins_local_primal_indices = 0;
3115*c8587f34SStefano Zampini       ins_coarse_mat_vals = 0;
3116*c8587f34SStefano Zampini     } else {
3117*c8587f34SStefano Zampini       for (k=0;k<size_prec_comm;k++){
3118*c8587f34SStefano Zampini         offset=pcbddc->local_primal_displacements[k];
3119*c8587f34SStefano Zampini         offset2=localdispl2[k];
3120*c8587f34SStefano Zampini         ins_local_primal_size = pcbddc->local_primal_sizes[k];
3121*c8587f34SStefano Zampini         ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr);
3122*c8587f34SStefano Zampini         for (j=0;j<ins_local_primal_size;j++){
3123*c8587f34SStefano Zampini           ins_local_primal_indices[j]=(PetscInt)pcbddc->replicated_local_primal_indices[offset+j];
3124*c8587f34SStefano Zampini         }
3125*c8587f34SStefano Zampini         ins_coarse_mat_vals = &temp_coarse_mat_vals[offset2];
3126*c8587f34SStefano 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);
3127*c8587f34SStefano Zampini         ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr);
3128*c8587f34SStefano Zampini       }
3129*c8587f34SStefano Zampini       ins_local_primal_indices = 0;
3130*c8587f34SStefano Zampini       ins_coarse_mat_vals = 0;
3131*c8587f34SStefano Zampini     }
3132*c8587f34SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3133*c8587f34SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3134*c8587f34SStefano Zampini     /* symmetry of coarse matrix */
3135*c8587f34SStefano Zampini     if (issym) {
3136*c8587f34SStefano Zampini       ierr = MatSetOption(pcbddc->coarse_mat,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
3137*c8587f34SStefano Zampini     }
3138*c8587f34SStefano Zampini     ierr = MatGetVecs(pcbddc->coarse_mat,&pcbddc->coarse_vec,&pcbddc->coarse_rhs);CHKERRQ(ierr);
3139*c8587f34SStefano Zampini   }
3140*c8587f34SStefano Zampini 
3141*c8587f34SStefano Zampini   /* create loc to glob scatters if needed */
3142*c8587f34SStefano Zampini   if (pcbddc->coarse_communications_type == SCATTERS_BDDC) {
3143*c8587f34SStefano Zampini      IS local_IS,global_IS;
3144*c8587f34SStefano Zampini      ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size,0,1,&local_IS);CHKERRQ(ierr);
3145*c8587f34SStefano Zampini      ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_indices,PETSC_COPY_VALUES,&global_IS);CHKERRQ(ierr);
3146*c8587f34SStefano Zampini      ierr = VecScatterCreate(pcbddc->vec1_P,local_IS,pcbddc->coarse_vec,global_IS,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3147*c8587f34SStefano Zampini      ierr = ISDestroy(&local_IS);CHKERRQ(ierr);
3148*c8587f34SStefano Zampini      ierr = ISDestroy(&global_IS);CHKERRQ(ierr);
3149*c8587f34SStefano Zampini   }
3150*c8587f34SStefano Zampini 
3151*c8587f34SStefano Zampini   /* free memory no longer needed */
3152*c8587f34SStefano Zampini   if (coarse_ISLG)              { ierr = ISLocalToGlobalMappingDestroy(&coarse_ISLG);CHKERRQ(ierr); }
3153*c8587f34SStefano Zampini   if (ins_local_primal_indices) { ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr); }
3154*c8587f34SStefano Zampini   if (ins_coarse_mat_vals)      { ierr = PetscFree(ins_coarse_mat_vals);CHKERRQ(ierr); }
3155*c8587f34SStefano Zampini   if (localsizes2)              { ierr = PetscFree(localsizes2);CHKERRQ(ierr); }
3156*c8587f34SStefano Zampini   if (localdispl2)              { ierr = PetscFree(localdispl2);CHKERRQ(ierr); }
3157*c8587f34SStefano Zampini   if (temp_coarse_mat_vals)     { ierr = PetscFree(temp_coarse_mat_vals);CHKERRQ(ierr); }
3158*c8587f34SStefano Zampini 
3159*c8587f34SStefano Zampini   /* Compute coarse null space */
3160*c8587f34SStefano Zampini   CoarseNullSpace = 0;
3161*c8587f34SStefano Zampini   if (pcbddc->NullSpace) {
3162*c8587f34SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCoarse(pc,&CoarseNullSpace);CHKERRQ(ierr);
3163*c8587f34SStefano Zampini   }
3164*c8587f34SStefano Zampini 
3165*c8587f34SStefano Zampini   /* KSP for coarse problem */
3166*c8587f34SStefano Zampini   if (rank_prec_comm == active_rank) {
3167*c8587f34SStefano Zampini     PetscBool isbddc=PETSC_FALSE;
3168*c8587f34SStefano Zampini 
3169*c8587f34SStefano Zampini     ierr = KSPCreate(coarse_comm,&pcbddc->coarse_ksp);CHKERRQ(ierr);
3170*c8587f34SStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
3171*c8587f34SStefano Zampini     ierr = KSPSetOperators(pcbddc->coarse_ksp,pcbddc->coarse_mat,pcbddc->coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
3172*c8587f34SStefano Zampini     ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,max_it_coarse_ksp);CHKERRQ(ierr);
3173*c8587f34SStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
3174*c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3175*c8587f34SStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
3176*c8587f34SStefano Zampini     /* Allow user's customization */
3177*c8587f34SStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,"coarse_");CHKERRQ(ierr);
3178*c8587f34SStefano Zampini     /* Set Up PC for coarse problem BDDC */
3179*c8587f34SStefano Zampini     if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
3180*c8587f34SStefano Zampini       i = pcbddc->current_level+1;
3181*c8587f34SStefano Zampini       ierr = PCBDDCSetLevel(pc_temp,i);CHKERRQ(ierr);
3182*c8587f34SStefano Zampini       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
3183*c8587f34SStefano Zampini       ierr = PCBDDCSetMaxLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
3184*c8587f34SStefano Zampini       ierr = PCBDDCSetCoarseProblemType(pc_temp,MULTILEVEL_BDDC);CHKERRQ(ierr);
3185*c8587f34SStefano Zampini       if (CoarseNullSpace) {
3186*c8587f34SStefano Zampini         ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
3187*c8587f34SStefano Zampini       }
3188*c8587f34SStefano Zampini       if (dbg_flag) {
3189*c8587f34SStefano Zampini         ierr = PetscViewerASCIIPrintf(viewer,"----------------Level %d: Setting up level %d---------------\n",pcbddc->current_level,i);CHKERRQ(ierr);
3190*c8587f34SStefano Zampini         ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
3191*c8587f34SStefano Zampini       }
3192*c8587f34SStefano Zampini     } else {
3193*c8587f34SStefano Zampini       if (CoarseNullSpace) {
3194*c8587f34SStefano Zampini         ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
3195*c8587f34SStefano Zampini       }
3196*c8587f34SStefano Zampini     }
3197*c8587f34SStefano Zampini     ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
3198*c8587f34SStefano Zampini     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
3199*c8587f34SStefano Zampini 
3200*c8587f34SStefano Zampini     ierr = KSPGetTolerances(pcbddc->coarse_ksp,NULL,NULL,NULL,&j);CHKERRQ(ierr);
3201*c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3202*c8587f34SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
3203*c8587f34SStefano Zampini     if (j == 1) {
3204*c8587f34SStefano Zampini       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
3205*c8587f34SStefano Zampini       if (isbddc) {
3206*c8587f34SStefano Zampini         ierr = PCBDDCSetUseExactDirichlet(pc_temp,PETSC_FALSE);CHKERRQ(ierr);
3207*c8587f34SStefano Zampini       }
3208*c8587f34SStefano Zampini     }
3209*c8587f34SStefano Zampini   }
3210*c8587f34SStefano Zampini   /* Check coarse problem if requested */
3211*c8587f34SStefano Zampini   if ( dbg_flag && rank_prec_comm == active_rank ) {
3212*c8587f34SStefano Zampini     KSP check_ksp;
3213*c8587f34SStefano Zampini     PC  check_pc;
3214*c8587f34SStefano Zampini     Vec check_vec;
3215*c8587f34SStefano Zampini     PetscReal   abs_infty_error,infty_error,lambda_min,lambda_max;
3216*c8587f34SStefano Zampini     KSPType check_ksp_type;
3217*c8587f34SStefano Zampini 
3218*c8587f34SStefano Zampini     /* Create ksp object suitable for extreme eigenvalues' estimation */
3219*c8587f34SStefano Zampini     ierr = KSPCreate(coarse_comm,&check_ksp);CHKERRQ(ierr);
3220*c8587f34SStefano Zampini     ierr = KSPSetOperators(check_ksp,pcbddc->coarse_mat,pcbddc->coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
3221*c8587f34SStefano Zampini     ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
3222*c8587f34SStefano Zampini     if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
3223*c8587f34SStefano Zampini       if (issym) check_ksp_type = KSPCG;
3224*c8587f34SStefano Zampini       else check_ksp_type = KSPGMRES;
3225*c8587f34SStefano Zampini       ierr = KSPSetComputeSingularValues(check_ksp,PETSC_TRUE);CHKERRQ(ierr);
3226*c8587f34SStefano Zampini     } else {
3227*c8587f34SStefano Zampini       check_ksp_type = KSPPREONLY;
3228*c8587f34SStefano Zampini     }
3229*c8587f34SStefano Zampini     ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
3230*c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
3231*c8587f34SStefano Zampini     ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
3232*c8587f34SStefano Zampini     ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
3233*c8587f34SStefano Zampini     /* create random vec */
3234*c8587f34SStefano Zampini     ierr = VecDuplicate(pcbddc->coarse_vec,&check_vec);CHKERRQ(ierr);
3235*c8587f34SStefano Zampini     ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
3236*c8587f34SStefano Zampini     if (CoarseNullSpace) {
3237*c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec);CHKERRQ(ierr);
3238*c8587f34SStefano Zampini     }
3239*c8587f34SStefano Zampini     ierr = MatMult(pcbddc->coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3240*c8587f34SStefano Zampini     /* solve coarse problem */
3241*c8587f34SStefano Zampini     ierr = KSPSolve(check_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
3242*c8587f34SStefano Zampini     if (CoarseNullSpace) {
3243*c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,pcbddc->coarse_vec);CHKERRQ(ierr);
3244*c8587f34SStefano Zampini     }
3245*c8587f34SStefano Zampini     /* check coarse problem residual error */
3246*c8587f34SStefano Zampini     ierr = VecAXPY(check_vec,-1.0,pcbddc->coarse_vec);CHKERRQ(ierr);
3247*c8587f34SStefano Zampini     ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3248*c8587f34SStefano Zampini     ierr = MatMult(pcbddc->coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3249*c8587f34SStefano Zampini     ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
3250*c8587f34SStefano Zampini     ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
3251*c8587f34SStefano Zampini     /* get eigenvalue estimation if inexact */
3252*c8587f34SStefano Zampini     if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) {
3253*c8587f34SStefano Zampini       ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
3254*c8587f34SStefano Zampini       ierr = KSPGetIterationNumber(check_ksp,&k);CHKERRQ(ierr);
3255*c8587f34SStefano Zampini       ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem eigenvalues estimated with %d iterations of %s.\n",k,check_ksp_type);CHKERRQ(ierr);
3256*c8587f34SStefano Zampini       ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem eigenvalues: % 1.14e %1.14e\n",lambda_min,lambda_max);CHKERRQ(ierr);
3257*c8587f34SStefano Zampini     }
3258*c8587f34SStefano Zampini     ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem exact infty_error   : %1.14e\n",infty_error);CHKERRQ(ierr);
3259*c8587f34SStefano Zampini     ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem residual infty_error: %1.14e\n",abs_infty_error);CHKERRQ(ierr);
3260*c8587f34SStefano Zampini     ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
3261*c8587f34SStefano Zampini   }
3262*c8587f34SStefano Zampini   if (dbg_flag) {
3263*c8587f34SStefano Zampini     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
3264*c8587f34SStefano Zampini   }
3265*c8587f34SStefano Zampini   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
3266*c8587f34SStefano Zampini 
3267*c8587f34SStefano Zampini   PetscFunctionReturn(0);
3268*c8587f34SStefano Zampini }
32699a7d3425SStefano Zampini 
3270