xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision e7b262bd15c243e4ce99a2dc4dbebe8833bdd9c2)
1674ae819SStefano Zampini #include "bddc.h"
2674ae819SStefano Zampini #include "bddcprivate.h"
3674ae819SStefano Zampini #include <petscblaslapack.h>
4674ae819SStefano Zampini 
5674ae819SStefano Zampini #undef __FUNCT__
6c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpSolvers"
7c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpSolvers(PC pc)
8c8587f34SStefano Zampini {
9c8587f34SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
108629588bSStefano Zampini   PetscScalar    *coarse_submat_vals;
11c8587f34SStefano Zampini   PetscErrorCode ierr;
12c8587f34SStefano Zampini 
13c8587f34SStefano Zampini   PetscFunctionBegin;
14c8587f34SStefano Zampini   /* Compute matrix after change of basis and extract local submatrices */
15c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalMatrices(pc);CHKERRQ(ierr);
16c8587f34SStefano Zampini 
17c8587f34SStefano Zampini 
18c8587f34SStefano Zampini   /* Setup local scatters R_to_B and (optionally) R_to_D : PCBDDCCreateWorkVectors should be called first! */
19c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
20c8587f34SStefano Zampini 
21c8587f34SStefano Zampini   /* Setup local solvers ksp_D and ksp_R */
22c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalSolvers(pc);CHKERRQ(ierr);
23c8587f34SStefano Zampini 
24c8587f34SStefano Zampini   /* Change global null space passed in by the user if change of basis has been requested */
25c8587f34SStefano Zampini   if (pcbddc->NullSpace && pcbddc->use_change_of_basis) {
26c8587f34SStefano Zampini     ierr = PCBDDCNullSpaceAdaptGlobal(pc);CHKERRQ(ierr);
27c8587f34SStefano Zampini   }
28c8587f34SStefano Zampini 
298629588bSStefano Zampini   /*
308629588bSStefano Zampini      Setup local correction and local part of coarse basis.
318629588bSStefano Zampini      Gives back the dense local part of the coarse matrix in column major ordering
328629588bSStefano Zampini   */
3347f4ddc3SStefano Zampini   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
348629588bSStefano Zampini 
358629588bSStefano Zampini   /* Compute total number of coarse nodes and setup coarse solver */
368629588bSStefano Zampini   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
378629588bSStefano Zampini 
388629588bSStefano Zampini   /* free */
398629588bSStefano Zampini   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
40c8587f34SStefano Zampini   PetscFunctionReturn(0);
41c8587f34SStefano Zampini }
42c8587f34SStefano Zampini 
43c8587f34SStefano Zampini #undef __FUNCT__
44674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetCustomization"
45674ae819SStefano Zampini PetscErrorCode PCBDDCResetCustomization(PC pc)
46674ae819SStefano Zampini {
47674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
48674ae819SStefano Zampini   PetscInt       i;
49674ae819SStefano Zampini   PetscErrorCode ierr;
50674ae819SStefano Zampini 
51674ae819SStefano Zampini   PetscFunctionBegin;
52674ae819SStefano Zampini   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
53674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
54674ae819SStefano Zampini   ierr = MatNullSpaceDestroy(&pcbddc->NullSpace);CHKERRQ(ierr);
55674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
56674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
57674ae819SStefano Zampini   for (i=0;i<pcbddc->n_ISForDofs;i++) {
58674ae819SStefano Zampini     ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
59674ae819SStefano Zampini   }
60674ae819SStefano Zampini   ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
619577ea80SStefano Zampini   pcbddc->n_ISForDofs = 0;
62674ae819SStefano Zampini   PetscFunctionReturn(0);
63674ae819SStefano Zampini }
64674ae819SStefano Zampini 
65674ae819SStefano Zampini #undef __FUNCT__
66674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetTopography"
67674ae819SStefano Zampini PetscErrorCode PCBDDCResetTopography(PC pc)
68674ae819SStefano Zampini {
69674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
70674ae819SStefano Zampini   PetscErrorCode ierr;
71674ae819SStefano Zampini 
72674ae819SStefano Zampini   PetscFunctionBegin;
73674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
74674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
75674ae819SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
76674ae819SStefano Zampini   PetscFunctionReturn(0);
77674ae819SStefano Zampini }
78674ae819SStefano Zampini 
79674ae819SStefano Zampini #undef __FUNCT__
80674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetSolvers"
81674ae819SStefano Zampini PetscErrorCode PCBDDCResetSolvers(PC pc)
82674ae819SStefano Zampini {
83674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
84674ae819SStefano Zampini   PetscErrorCode ierr;
85674ae819SStefano Zampini 
86674ae819SStefano Zampini   PetscFunctionBegin;
87674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
88674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_rhs);CHKERRQ(ierr);
89674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
90674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
9115aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
9215aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
93*e7b262bdSStefano Zampini /*
94674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
95674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
96*e7b262bdSStefano Zampini */
97674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
98674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
99*e7b262bdSStefano Zampini /*
100674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
101674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
102*e7b262bdSStefano Zampini */
1038ce42a96SStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
104674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
105674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
106674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
107674ae819SStefano Zampini   PetscFunctionReturn(0);
108674ae819SStefano Zampini }
109674ae819SStefano Zampini 
110674ae819SStefano Zampini #undef __FUNCT__
111*e7b262bdSStefano Zampini #define __FUNCT__ "PCBDDCSetUpWorkVectors"
112*e7b262bdSStefano Zampini PetscErrorCode PCBDDCSetUpWorkVectors(PC pc)
1136bfb1811SStefano Zampini {
1146bfb1811SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1156bfb1811SStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
1166bfb1811SStefano Zampini   VecType        impVecType;
117*e7b262bdSStefano Zampini   PetscInt       n_vertices,n_constraints,local_primal_size,n_R,old_size;
1186bfb1811SStefano Zampini   PetscErrorCode ierr;
1196bfb1811SStefano Zampini 
1206bfb1811SStefano Zampini   PetscFunctionBegin;
121*e7b262bdSStefano Zampini   /* get sizes */
1226bfb1811SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,NULL);CHKERRQ(ierr);
123*e7b262bdSStefano Zampini   ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,NULL);CHKERRQ(ierr);
124*e7b262bdSStefano Zampini   n_constraints = local_primal_size - n_vertices;
1256bfb1811SStefano Zampini   n_R = pcis->n-n_vertices;
1266bfb1811SStefano Zampini   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
127*e7b262bdSStefano Zampini   /* local work vectors (try to avoid unneeded work)*/
128*e7b262bdSStefano Zampini   /* R nodes */
129*e7b262bdSStefano Zampini   old_size = -1;
130*e7b262bdSStefano Zampini   if (pcbddc->vec1_R) {
131*e7b262bdSStefano Zampini     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
132*e7b262bdSStefano Zampini   }
133*e7b262bdSStefano Zampini   if (n_R != old_size) {
134*e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
135*e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
1366bfb1811SStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
1376bfb1811SStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
1386bfb1811SStefano Zampini     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
1396bfb1811SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
140*e7b262bdSStefano Zampini   }
141*e7b262bdSStefano Zampini   /* local primal dofs */
142*e7b262bdSStefano Zampini   old_size = -1;
143*e7b262bdSStefano Zampini   if (pcbddc->vec1_P) {
144*e7b262bdSStefano Zampini     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
145*e7b262bdSStefano Zampini   }
146*e7b262bdSStefano Zampini   if (local_primal_size != old_size) {
147*e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
14883b7ccabSStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
1496bfb1811SStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,local_primal_size);CHKERRQ(ierr);
1506bfb1811SStefano Zampini     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
151*e7b262bdSStefano Zampini   }
152*e7b262bdSStefano Zampini   /* local explicit constraints */
153*e7b262bdSStefano Zampini   old_size = -1;
154*e7b262bdSStefano Zampini   if (pcbddc->vec1_C) {
155*e7b262bdSStefano Zampini     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
156*e7b262bdSStefano Zampini   }
157*e7b262bdSStefano Zampini   if (n_constraints && n_constraints != old_size) {
158*e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
15983b7ccabSStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
16083b7ccabSStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
16183b7ccabSStefano Zampini     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
16283b7ccabSStefano Zampini   }
1636bfb1811SStefano Zampini   PetscFunctionReturn(0);
1646bfb1811SStefano Zampini }
1656bfb1811SStefano Zampini 
1666bfb1811SStefano Zampini #undef __FUNCT__
16747f4ddc3SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCorrection"
16847f4ddc3SStefano Zampini PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
16988ebb749SStefano Zampini {
17025084f0cSStefano Zampini   PetscErrorCode         ierr;
17125084f0cSStefano Zampini   /* pointers to pcis and pcbddc */
17288ebb749SStefano Zampini   PC_IS*                 pcis = (PC_IS*)pc->data;
17388ebb749SStefano Zampini   PC_BDDC*               pcbddc = (PC_BDDC*)pc->data;
17425084f0cSStefano Zampini   /* submatrices of local problem */
17588ebb749SStefano Zampini   Mat                    A_RV,A_VR,A_VV;
17625084f0cSStefano Zampini   /* working matrices */
17725084f0cSStefano Zampini   Mat                    M1,M2,M3,C_CR;
17825084f0cSStefano Zampini   /* working vectors */
17925084f0cSStefano Zampini   Vec                    vec1_C,vec2_C,vec1_V,vec2_V;
18025084f0cSStefano Zampini   /* additional working stuff */
18125084f0cSStefano Zampini   IS                     is_aux;
18288ebb749SStefano Zampini   ISLocalToGlobalMapping BtoNmap;
18325084f0cSStefano Zampini   PetscScalar            *coarse_submat_vals; /* TODO: use a PETSc matrix */
18425084f0cSStefano Zampini   const PetscScalar      *array,*row_cmat_values;
18525084f0cSStefano Zampini   const PetscInt         *row_cmat_indices,*idx_R_local;
18625084f0cSStefano Zampini   PetscInt               *vertices,*idx_V_B,*auxindices;
18725084f0cSStefano Zampini   PetscInt               n_vertices,n_constraints,size_of_constraint;
18825084f0cSStefano Zampini   PetscInt               i,j,n_R,n_D,n_B;
18988ebb749SStefano Zampini   PetscBool              setsym=PETSC_FALSE,issym=PETSC_FALSE;
19045a1bb75SStefano Zampini   /* matrix type (vector type propagated downstream from vec1_C and local matrix type) */
19188ebb749SStefano Zampini   MatType                impMatType;
19225084f0cSStefano Zampini   /* some shortcuts to scalars */
19325084f0cSStefano Zampini   PetscScalar            zero=0.0,one=1.0,m_one=-1.0;
19425084f0cSStefano Zampini   /* for debugging purposes */
19588ebb749SStefano Zampini   PetscReal              *coarsefunctions_errors,*constraints_errors;
19688ebb749SStefano Zampini 
19788ebb749SStefano Zampini   PetscFunctionBegin;
19825084f0cSStefano Zampini   /* get number of vertices and their local indices */
19925084f0cSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
20088ebb749SStefano Zampini   n_constraints = pcbddc->local_primal_size-n_vertices;
20188ebb749SStefano Zampini   /* Set Non-overlapping dimensions */
20288ebb749SStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
20388ebb749SStefano Zampini   n_R = pcis->n-n_vertices;
20488ebb749SStefano Zampini 
20588ebb749SStefano Zampini   /* Set types for local objects needed by BDDC precondtioner */
20688ebb749SStefano Zampini   impMatType = MATSEQDENSE;
20788ebb749SStefano Zampini 
20888ebb749SStefano Zampini   /* Allocating some extra storage just to be safe */
20988ebb749SStefano Zampini   ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&auxindices);CHKERRQ(ierr);
21088ebb749SStefano Zampini   for (i=0;i<pcis->n;i++) auxindices[i]=i;
21188ebb749SStefano Zampini 
21288ebb749SStefano Zampini   /* vertices in boundary numbering */
21388ebb749SStefano Zampini   ierr = PetscMalloc(n_vertices*sizeof(PetscInt),&idx_V_B);CHKERRQ(ierr);
21488ebb749SStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(pcis->is_B_local,&BtoNmap);CHKERRQ(ierr);
21588ebb749SStefano Zampini   ierr = ISGlobalToLocalMappingApply(BtoNmap,IS_GTOLM_DROP,n_vertices,vertices,&i,idx_V_B);CHKERRQ(ierr);
21688ebb749SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&BtoNmap);CHKERRQ(ierr);
21788ebb749SStefano Zampini   if (i != n_vertices) {
21888ebb749SStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %d != %d\n",n_vertices,i);
21988ebb749SStefano Zampini   }
22088ebb749SStefano Zampini 
22188ebb749SStefano Zampini   /* Precompute stuffs needed for preprocessing and application of BDDC*/
22288ebb749SStefano Zampini   if (n_constraints) {
22345a1bb75SStefano Zampini     /* work vectors */
22445a1bb75SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec1_C);CHKERRQ(ierr);
22545a1bb75SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_C,&vec2_C);CHKERRQ(ierr);
22645a1bb75SStefano Zampini     /* auxiliary matrices */
22788ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->local_auxmat2);CHKERRQ(ierr);
22825084f0cSStefano Zampini     ierr = MatSetSizes(pcbddc->local_auxmat2,n_R,n_constraints,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
22988ebb749SStefano Zampini     ierr = MatSetType(pcbddc->local_auxmat2,impMatType);CHKERRQ(ierr);
23025084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->local_auxmat2);CHKERRQ(ierr);
23188ebb749SStefano Zampini 
23225084f0cSStefano Zampini     /* Extract constraints on R nodes: C_{CR}  */
23325084f0cSStefano Zampini     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
2348ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
23525084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
23688ebb749SStefano Zampini 
23788ebb749SStefano Zampini     /* Assemble local_auxmat2 = - A_{RR}^{-1} C^T_{CR} needed by BDDC application */
23888ebb749SStefano Zampini     for (i=0;i<n_constraints;i++) {
23988ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
24088ebb749SStefano Zampini       /* Get row of constraint matrix in R numbering */
24125084f0cSStefano Zampini       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
24225084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_R,size_of_constraint,row_cmat_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
24325084f0cSStefano Zampini       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
24425084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_R);CHKERRQ(ierr);
24525084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_R);CHKERRQ(ierr);
24688ebb749SStefano Zampini       /* Solve for row of constraint matrix in R numbering */
24788ebb749SStefano Zampini       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
24825084f0cSStefano Zampini       /* Set values in local_auxmat2 */
24925084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
25088ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->local_auxmat2,n_R,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
25125084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec2_R,&array);CHKERRQ(ierr);
25288ebb749SStefano Zampini     }
25388ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
25488ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
25525084f0cSStefano Zampini     ierr = MatScale(pcbddc->local_auxmat2,m_one);CHKERRQ(ierr);
25688ebb749SStefano Zampini 
25788ebb749SStefano Zampini     /* Assemble explicitly M1 = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1} needed in preproc  */
25825084f0cSStefano Zampini     ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
25925084f0cSStefano Zampini     ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
26088ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&M1);CHKERRQ(ierr);
26188ebb749SStefano Zampini     ierr = MatSetSizes(M1,n_constraints,n_constraints,n_constraints,n_constraints);CHKERRQ(ierr);
26288ebb749SStefano Zampini     ierr = MatSetType(M1,impMatType);CHKERRQ(ierr);
26325084f0cSStefano Zampini     ierr = MatSetUp(M1);CHKERRQ(ierr);
26425084f0cSStefano Zampini     ierr = MatDuplicate(M1,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
26525084f0cSStefano Zampini     ierr = MatZeroEntries(M2);CHKERRQ(ierr);
26625084f0cSStefano Zampini     ierr = VecSet(vec1_C,m_one);CHKERRQ(ierr);
26725084f0cSStefano Zampini     ierr = MatDiagonalSet(M2,vec1_C,INSERT_VALUES);CHKERRQ(ierr);
26825084f0cSStefano Zampini     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
26925084f0cSStefano Zampini     ierr = MatDestroy(&M2);CHKERRQ(ierr);
27025084f0cSStefano Zampini     ierr = MatDestroy(&M3);CHKERRQ(ierr);
27188ebb749SStefano Zampini     /* Assemble local_auxmat1 = M1*C_{CR} needed by BDDC application in KSP and in preproc */
27288ebb749SStefano Zampini     ierr = MatMatMult(M1,C_CR,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
27388ebb749SStefano Zampini   }
27488ebb749SStefano Zampini 
27588ebb749SStefano Zampini   /* Get submatrices from subdomain matrix */
27688ebb749SStefano Zampini   if (n_vertices) {
2773a50541eSStefano Zampini     PetscInt ibs,mbs;
2783a50541eSStefano Zampini     PetscBool issbaij;
279af732b37SStefano Zampini     Mat newmat;
2803a50541eSStefano Zampini 
2813a50541eSStefano Zampini     ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
2829577ea80SStefano Zampini     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
2839577ea80SStefano Zampini     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
2843a50541eSStefano Zampini     if (ibs != mbs) { /* need to convert to SEQAIJ */
2859577ea80SStefano Zampini       ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
2869577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
2879577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
2889577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
2899577ea80SStefano Zampini       ierr = MatDestroy(&newmat);CHKERRQ(ierr);
2909577ea80SStefano Zampini     } else {
2913a50541eSStefano Zampini       /* this is safe */
2929577ea80SStefano Zampini       ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
2933a50541eSStefano Zampini       ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
2943a50541eSStefano Zampini       if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
2953a50541eSStefano Zampini         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
29645a1bb75SStefano Zampini         /* which of the two approaches is faster? */
2973a50541eSStefano Zampini         /* ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
2983a50541eSStefano Zampini         ierr = MatCreateTranspose(A_RV,&A_VR);CHKERRQ(ierr);*/
2993a50541eSStefano Zampini         ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3003a50541eSStefano Zampini         ierr = MatCreateTranspose(A_VR,&A_RV);CHKERRQ(ierr);
3013a50541eSStefano Zampini         ierr = MatDestroy(&newmat);CHKERRQ(ierr);
3023a50541eSStefano Zampini       } else {
3039577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3049577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3059577ea80SStefano Zampini       }
3063a50541eSStefano Zampini     }
30745a1bb75SStefano Zampini     ierr = MatGetVecs(A_RV,&vec1_V,NULL);CHKERRQ(ierr);
30845a1bb75SStefano Zampini     ierr = VecDuplicate(vec1_V,&vec2_V);CHKERRQ(ierr);
30925084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
31088ebb749SStefano Zampini   }
31188ebb749SStefano Zampini 
31288ebb749SStefano Zampini   /* Matrix of coarse basis functions (local) */
31388ebb749SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
31488ebb749SStefano Zampini   ierr = MatSetSizes(pcbddc->coarse_phi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
31588ebb749SStefano Zampini   ierr = MatSetType(pcbddc->coarse_phi_B,impMatType);CHKERRQ(ierr);
31625084f0cSStefano Zampini   ierr = MatSetUp(pcbddc->coarse_phi_B);CHKERRQ(ierr);
3178eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
31888ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
31988ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_phi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
32088ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_phi_D,impMatType);CHKERRQ(ierr);
32125084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_phi_D);CHKERRQ(ierr);
32288ebb749SStefano Zampini   }
32388ebb749SStefano Zampini 
32425084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
3258ce42a96SStefano Zampini     ierr = ISGetIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
32688ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*coarsefunctions_errors),&coarsefunctions_errors);CHKERRQ(ierr);
32788ebb749SStefano Zampini     ierr = PetscMalloc(2*pcbddc->local_primal_size*sizeof(*constraints_errors),&constraints_errors);CHKERRQ(ierr);
32888ebb749SStefano Zampini   }
32988ebb749SStefano Zampini   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
33088ebb749SStefano Zampini   ierr = PetscMalloc((pcbddc->local_primal_size)*(pcbddc->local_primal_size)*sizeof(PetscScalar),&coarse_submat_vals);CHKERRQ(ierr);
33188ebb749SStefano Zampini 
33288ebb749SStefano Zampini   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
33325084f0cSStefano Zampini 
33425084f0cSStefano Zampini   /* vertices */
33588ebb749SStefano Zampini   for (i=0;i<n_vertices;i++) {
33645a1bb75SStefano Zampini     /* this should not be needed, but MatMult_BAIJ is broken when using compressed row routines */
33745a1bb75SStefano Zampini     ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
33888ebb749SStefano Zampini     ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
33988ebb749SStefano Zampini     ierr = VecSetValue(vec1_V,i,one,INSERT_VALUES);CHKERRQ(ierr);
34088ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
34188ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
34225084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on constraints multipliers */
34388ebb749SStefano Zampini     ierr = MatMult(A_RV,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
34488ebb749SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
34588ebb749SStefano Zampini     ierr = VecScale(pcbddc->vec1_R,m_one);CHKERRQ(ierr);
34688ebb749SStefano Zampini     if (n_constraints) {
34788ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec1_R,vec1_C);CHKERRQ(ierr);
34888ebb749SStefano Zampini       ierr = MatMultAdd(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
34988ebb749SStefano Zampini       ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
35088ebb749SStefano Zampini     }
35188ebb749SStefano Zampini     ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
35288ebb749SStefano Zampini     ierr = MatMultAdd(A_VV,vec1_V,vec2_V,vec2_V);CHKERRQ(ierr);
35388ebb749SStefano Zampini 
35488ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
35588ebb749SStefano Zampini     /* coarse basis functions */
35688ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
35788ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
35888ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
35925084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
36088ebb749SStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
36125084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
36288ebb749SStefano Zampini     ierr = MatSetValue(pcbddc->coarse_phi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
3638eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
36488ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
36588ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
36625084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
36788ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
36825084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
36988ebb749SStefano Zampini     }
37025084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
37125084f0cSStefano Zampini     ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
37225084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
37325084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
37488ebb749SStefano Zampini     if (n_constraints) {
37525084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
37625084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[i*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
37725084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
37888ebb749SStefano Zampini     }
37988ebb749SStefano Zampini 
38025084f0cSStefano Zampini     /* check */
38125084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
38225084f0cSStefano Zampini       /* assemble subdomain vector on local nodes */
38388ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
38425084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
38525084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
38625084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
38725084f0cSStefano Zampini       ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
38825084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
38925084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
39088ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers (i.e. primal nodes) */
39188ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
39225084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
39325084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
39425084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
39588ebb749SStefano Zampini       if (n_constraints) {
39625084f0cSStefano Zampini         ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
39725084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
39825084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
39988ebb749SStefano Zampini       }
40025084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
40125084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
40288ebb749SStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
40388ebb749SStefano Zampini       /* check saddle point solution */
40488ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
40588ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
40688ebb749SStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i]);CHKERRQ(ierr);
40788ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
40825084f0cSStefano Zampini       /* shift by the identity matrix */
40925084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
41025084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
41125084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
41288ebb749SStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i]);CHKERRQ(ierr);
41388ebb749SStefano Zampini     }
41488ebb749SStefano Zampini   }
41588ebb749SStefano Zampini 
41625084f0cSStefano Zampini   /* constraints */
41788ebb749SStefano Zampini   for (i=0;i<n_constraints;i++) {
41888ebb749SStefano Zampini     ierr = VecSet(vec2_C,zero);CHKERRQ(ierr);
41988ebb749SStefano Zampini     ierr = VecSetValue(vec2_C,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
42088ebb749SStefano Zampini     ierr = VecAssemblyBegin(vec2_C);CHKERRQ(ierr);
42188ebb749SStefano Zampini     ierr = VecAssemblyEnd(vec2_C);CHKERRQ(ierr);
42225084f0cSStefano Zampini     /* simplified solution of saddle point problem with null rhs on vertices multipliers */
42388ebb749SStefano Zampini     ierr = MatMult(M1,vec2_C,vec1_C);CHKERRQ(ierr);
42488ebb749SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
42588ebb749SStefano Zampini     ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr);
42625084f0cSStefano Zampini     if (n_vertices) {
42725084f0cSStefano Zampini       ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr);
42825084f0cSStefano Zampini     }
42988ebb749SStefano Zampini     /* Set values in coarse basis function and subdomain part of coarse_mat */
43088ebb749SStefano Zampini     /* coarse basis functions */
43125084f0cSStefano Zampini     j = i+n_vertices; /* don't touch this! */
43288ebb749SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
43388ebb749SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
43488ebb749SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
43525084f0cSStefano Zampini     ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
43625084f0cSStefano Zampini     ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
43725084f0cSStefano Zampini     ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
4388eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
43988ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
44088ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
44125084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
44225084f0cSStefano Zampini       ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&j,array,INSERT_VALUES);CHKERRQ(ierr);
44325084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
44488ebb749SStefano Zampini     }
44525084f0cSStefano Zampini     /* subdomain contribution to coarse matrix. WARNING -> column major ordering */
44688ebb749SStefano Zampini     if (n_vertices) {
44725084f0cSStefano Zampini       ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
44825084f0cSStefano Zampini       ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size],array,n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
44925084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
45088ebb749SStefano Zampini     }
45125084f0cSStefano Zampini     ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
45225084f0cSStefano Zampini     ierr = PetscMemcpy(&coarse_submat_vals[j*pcbddc->local_primal_size+n_vertices],array,n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
45325084f0cSStefano Zampini     ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
45488ebb749SStefano Zampini 
45525084f0cSStefano Zampini     if (pcbddc->dbg_flag) {
45688ebb749SStefano Zampini       /* assemble subdomain vector on nodes */
45788ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
45825084f0cSStefano Zampini       ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
45925084f0cSStefano Zampini       ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
46025084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
46125084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
46225084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
46388ebb749SStefano Zampini       /* assemble subdomain vector of lagrange multipliers */
46488ebb749SStefano Zampini       ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
46588ebb749SStefano Zampini       if (n_vertices) {
46625084f0cSStefano Zampini         ierr = VecGetArrayRead(vec2_V,&array);CHKERRQ(ierr);
46725084f0cSStefano Zampini         ierr = VecSetValues(pcbddc->vec1_P,n_vertices,auxindices,array,INSERT_VALUES);CHKERRQ(ierr);
46825084f0cSStefano Zampini         ierr = VecRestoreArrayRead(vec2_V,&array);CHKERRQ(ierr);
46988ebb749SStefano Zampini       }
47025084f0cSStefano Zampini       ierr = VecGetArrayRead(vec1_C,&array);CHKERRQ(ierr);
47125084f0cSStefano Zampini       ierr = VecSetValues(pcbddc->vec1_P,n_constraints,&auxindices[n_vertices],array,INSERT_VALUES);CHKERRQ(ierr);
47225084f0cSStefano Zampini       ierr = VecRestoreArrayRead(vec1_C,&array);CHKERRQ(ierr);
47325084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
47425084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
47525084f0cSStefano Zampini       ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr);
47688ebb749SStefano Zampini       /* check saddle point solution */
47788ebb749SStefano Zampini       ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
47888ebb749SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
47925084f0cSStefano Zampini       ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[j]);CHKERRQ(ierr);
48088ebb749SStefano Zampini       ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
48125084f0cSStefano Zampini       /* shift by the identity matrix */
48225084f0cSStefano Zampini       ierr = VecSetValue(pcbddc->vec1_P,j,m_one,ADD_VALUES);CHKERRQ(ierr);
48325084f0cSStefano Zampini       ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
48425084f0cSStefano Zampini       ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
48525084f0cSStefano Zampini       ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[j]);CHKERRQ(ierr);
48688ebb749SStefano Zampini     }
48788ebb749SStefano Zampini   }
48825084f0cSStefano Zampini   /* call assembling routines for local coarse basis */
48988ebb749SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
49088ebb749SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4918eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
49288ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
49388ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
49488ebb749SStefano Zampini   }
49525084f0cSStefano Zampini 
49688ebb749SStefano Zampini   /* compute other basis functions for non-symmetric problems */
49788ebb749SStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
49888ebb749SStefano Zampini   if (!setsym || (setsym && !issym)) {
49988ebb749SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
50088ebb749SStefano Zampini     ierr = MatSetSizes(pcbddc->coarse_psi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr);
50188ebb749SStefano Zampini     ierr = MatSetType(pcbddc->coarse_psi_B,impMatType);CHKERRQ(ierr);
50225084f0cSStefano Zampini     ierr = MatSetUp(pcbddc->coarse_psi_B);CHKERRQ(ierr);
5038eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
50488ebb749SStefano Zampini       ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
50588ebb749SStefano Zampini       ierr = MatSetSizes(pcbddc->coarse_psi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr);
50688ebb749SStefano Zampini       ierr = MatSetType(pcbddc->coarse_psi_D,impMatType);CHKERRQ(ierr);
50725084f0cSStefano Zampini       ierr = MatSetUp(pcbddc->coarse_psi_D);CHKERRQ(ierr);
50888ebb749SStefano Zampini     }
50988ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
51088ebb749SStefano Zampini       if (n_constraints) {
51188ebb749SStefano Zampini         ierr = VecSet(vec1_C,zero);CHKERRQ(ierr);
51288ebb749SStefano Zampini         for (j=0;j<n_constraints;j++) {
51325084f0cSStefano Zampini           ierr = VecSetValue(vec1_C,j,coarse_submat_vals[(j+n_vertices)*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
51488ebb749SStefano Zampini         }
51525084f0cSStefano Zampini         ierr = VecAssemblyBegin(vec1_C);CHKERRQ(ierr);
51625084f0cSStefano Zampini         ierr = VecAssemblyEnd(vec1_C);CHKERRQ(ierr);
51788ebb749SStefano Zampini       }
51888ebb749SStefano Zampini       if (i<n_vertices) {
51988ebb749SStefano Zampini         ierr = VecSet(vec1_V,zero);CHKERRQ(ierr);
52088ebb749SStefano Zampini         ierr = VecSetValue(vec1_V,i,m_one,INSERT_VALUES);CHKERRQ(ierr);
52188ebb749SStefano Zampini         ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr);
52288ebb749SStefano Zampini         ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr);
52388ebb749SStefano Zampini         ierr = MatMultTranspose(A_VR,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr);
52488ebb749SStefano Zampini         if (n_constraints) {
52588ebb749SStefano Zampini           ierr = MatMultTransposeAdd(C_CR,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
52688ebb749SStefano Zampini         }
52788ebb749SStefano Zampini       } else {
52888ebb749SStefano Zampini         ierr = MatMultTranspose(C_CR,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr);
52988ebb749SStefano Zampini       }
53088ebb749SStefano Zampini       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
53188ebb749SStefano Zampini       ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
53288ebb749SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
53388ebb749SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
53425084f0cSStefano Zampini       ierr = VecGetArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
53588ebb749SStefano Zampini       ierr = MatSetValues(pcbddc->coarse_psi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
53625084f0cSStefano Zampini       ierr = VecRestoreArrayRead(pcis->vec1_B,&array);CHKERRQ(ierr);
53788ebb749SStefano Zampini       if (i<n_vertices) {
53888ebb749SStefano Zampini         ierr = MatSetValue(pcbddc->coarse_psi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr);
53988ebb749SStefano Zampini       }
5408eeda7d8SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
54188ebb749SStefano Zampini         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
54288ebb749SStefano Zampini         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
54325084f0cSStefano Zampini         ierr = VecGetArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
54488ebb749SStefano Zampini         ierr = MatSetValues(pcbddc->coarse_psi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
54525084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcis->vec1_D,&array);CHKERRQ(ierr);
54688ebb749SStefano Zampini       }
54788ebb749SStefano Zampini 
54825084f0cSStefano Zampini       if (pcbddc->dbg_flag) {
54988ebb749SStefano Zampini         /* assemble subdomain vector on nodes */
55088ebb749SStefano Zampini         ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr);
55125084f0cSStefano Zampini         ierr = VecGetArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
55225084f0cSStefano Zampini         ierr = VecSetValues(pcis->vec1_N,n_R,idx_R_local,array,INSERT_VALUES);CHKERRQ(ierr);
55325084f0cSStefano Zampini         ierr = VecRestoreArrayRead(pcbddc->vec1_R,&array);CHKERRQ(ierr);
55425084f0cSStefano Zampini         if (i<n_vertices) {
55525084f0cSStefano Zampini           ierr = VecSetValue(pcis->vec1_N,vertices[i],one,INSERT_VALUES);CHKERRQ(ierr);
55688ebb749SStefano Zampini         }
55725084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
55825084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
55925084f0cSStefano Zampini         /* assemble subdomain vector of lagrange multipliers */
56025084f0cSStefano Zampini         for (j=0;j<pcbddc->local_primal_size;j++) {
56125084f0cSStefano Zampini           ierr = VecSetValue(pcbddc->vec1_P,j,-coarse_submat_vals[j*pcbddc->local_primal_size+i],INSERT_VALUES);CHKERRQ(ierr);
56225084f0cSStefano Zampini         }
56325084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
56425084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
56588ebb749SStefano Zampini         /* check saddle point solution */
56688ebb749SStefano Zampini         ierr = MatMultTranspose(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
56788ebb749SStefano Zampini         ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr);
56888ebb749SStefano Zampini         ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
56988ebb749SStefano Zampini         ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr);
57025084f0cSStefano Zampini         /* shift by the identity matrix */
57125084f0cSStefano Zampini         ierr = VecSetValue(pcbddc->vec1_P,i,m_one,ADD_VALUES);CHKERRQ(ierr);
57225084f0cSStefano Zampini         ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
57325084f0cSStefano Zampini         ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
57488ebb749SStefano Zampini         ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i+pcbddc->local_primal_size]);CHKERRQ(ierr);
57588ebb749SStefano Zampini       }
57688ebb749SStefano Zampini     }
57788ebb749SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
57888ebb749SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->coarse_psi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5798eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
58088ebb749SStefano Zampini       ierr = MatAssemblyBegin(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
58188ebb749SStefano Zampini       ierr = MatAssemblyEnd(pcbddc->coarse_psi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
58288ebb749SStefano Zampini     }
58388ebb749SStefano Zampini   }
58488ebb749SStefano Zampini   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
58588ebb749SStefano Zampini   /* Checking coarse_sub_mat and coarse basis functios */
58688ebb749SStefano Zampini   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
58788ebb749SStefano Zampini   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
58825084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
58988ebb749SStefano Zampini     Mat         coarse_sub_mat;
59025084f0cSStefano Zampini     Mat         AUXMAT,TM1,TM2,TM3,TM4;
59188ebb749SStefano Zampini     Mat         coarse_phi_D,coarse_phi_B;
59288ebb749SStefano Zampini     Mat         coarse_psi_D,coarse_psi_B;
59388ebb749SStefano Zampini     Mat         A_II,A_BB,A_IB,A_BI;
59488ebb749SStefano Zampini     MatType     checkmattype=MATSEQAIJ;
59588ebb749SStefano Zampini     PetscReal   real_value;
59688ebb749SStefano Zampini 
59788ebb749SStefano Zampini     ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
59888ebb749SStefano Zampini     ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
59988ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
60088ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
60188ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
60288ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
60388ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
60488ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
60588ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
60688ebb749SStefano Zampini     }
60788ebb749SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
60888ebb749SStefano Zampini 
60925084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
61025084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat and local basis functions\n");CHKERRQ(ierr);
61125084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
61288ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
61388ebb749SStefano Zampini       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
61488ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
61588ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
61688ebb749SStefano Zampini       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
61788ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
61888ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
61988ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
62088ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
62188ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
62288ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
62388ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
62488ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
62588ebb749SStefano Zampini     } else {
62688ebb749SStefano Zampini       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
62788ebb749SStefano Zampini       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
62888ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
62988ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
63088ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
63188ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
63288ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
63388ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
63488ebb749SStefano Zampini     }
63588ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
63688ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
63788ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
63888ebb749SStefano Zampini     ierr = MatConvert(TM1,MATSEQDENSE,MAT_REUSE_MATRIX,&TM1);CHKERRQ(ierr);
63988ebb749SStefano Zampini     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
64088ebb749SStefano Zampini     ierr = MatNorm(TM1,NORM_INFINITY,&real_value);CHKERRQ(ierr);
64125084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"----------------------------------\n");CHKERRQ(ierr);
64225084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d \n",PetscGlobalRank);CHKERRQ(ierr);
64325084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"matrix error = % 1.14e\n",real_value);CHKERRQ(ierr);
64425084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (phi) errors\n");CHKERRQ(ierr);
64588ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
64625084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,coarsefunctions_errors[i]);CHKERRQ(ierr);
64788ebb749SStefano Zampini     }
64825084f0cSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (phi) errors\n");CHKERRQ(ierr);
64988ebb749SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
65025084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i,constraints_errors[i]);CHKERRQ(ierr);
65188ebb749SStefano Zampini     }
65288ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
65325084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"coarse functions (psi) errors\n");CHKERRQ(ierr);
65488ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
65525084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,coarsefunctions_errors[i]);CHKERRQ(ierr);
65688ebb749SStefano Zampini       }
65725084f0cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"constraints (psi) errors\n");CHKERRQ(ierr);
65888ebb749SStefano Zampini       for (i=pcbddc->local_primal_size;i<2*pcbddc->local_primal_size;i++) {
65925084f0cSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local %02d-th function error = % 1.14e\n",i-pcbddc->local_primal_size,constraints_errors[i]);CHKERRQ(ierr);
66088ebb749SStefano Zampini       }
66188ebb749SStefano Zampini     }
66225084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
66388ebb749SStefano Zampini     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
66488ebb749SStefano Zampini     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
66588ebb749SStefano Zampini     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
66688ebb749SStefano Zampini     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
66788ebb749SStefano Zampini     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
66888ebb749SStefano Zampini     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
66988ebb749SStefano Zampini     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
67088ebb749SStefano Zampini     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
67188ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
67288ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
67388ebb749SStefano Zampini     if (pcbddc->coarse_psi_B) {
67488ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
67588ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
67688ebb749SStefano Zampini     }
67788ebb749SStefano Zampini     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
6788ce42a96SStefano Zampini     ierr = ISRestoreIndices(pcbddc->is_R_local,&idx_R_local);CHKERRQ(ierr);
67988ebb749SStefano Zampini     ierr = PetscFree(coarsefunctions_errors);CHKERRQ(ierr);
68088ebb749SStefano Zampini     ierr = PetscFree(constraints_errors);CHKERRQ(ierr);
68188ebb749SStefano Zampini   }
68288ebb749SStefano Zampini   /* free memory */
68388ebb749SStefano Zampini   if (n_vertices) {
68488ebb749SStefano Zampini     ierr = PetscFree(vertices);CHKERRQ(ierr);
68588ebb749SStefano Zampini     ierr = VecDestroy(&vec1_V);CHKERRQ(ierr);
68688ebb749SStefano Zampini     ierr = VecDestroy(&vec2_V);CHKERRQ(ierr);
68788ebb749SStefano Zampini     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
68888ebb749SStefano Zampini     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
68988ebb749SStefano Zampini     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
69088ebb749SStefano Zampini   }
69188ebb749SStefano Zampini   if (n_constraints) {
69288ebb749SStefano Zampini     ierr = VecDestroy(&vec1_C);CHKERRQ(ierr);
69388ebb749SStefano Zampini     ierr = VecDestroy(&vec2_C);CHKERRQ(ierr);
69488ebb749SStefano Zampini     ierr = MatDestroy(&M1);CHKERRQ(ierr);
69588ebb749SStefano Zampini     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
69688ebb749SStefano Zampini   }
69788ebb749SStefano Zampini   ierr = PetscFree(auxindices);CHKERRQ(ierr);
6988629588bSStefano Zampini   /* get back data */
6998629588bSStefano Zampini   *coarse_submat_vals_n = coarse_submat_vals;
70088ebb749SStefano Zampini   PetscFunctionReturn(0);
70188ebb749SStefano Zampini }
70288ebb749SStefano Zampini 
70388ebb749SStefano Zampini #undef __FUNCT__
704aa0d41d4SStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalMatrices"
705aa0d41d4SStefano Zampini PetscErrorCode PCBDDCSetUpLocalMatrices(PC pc)
706aa0d41d4SStefano Zampini {
707aa0d41d4SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
708aa0d41d4SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
709aa0d41d4SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
7109577ea80SStefano Zampini   PetscBool         issbaij,isbaij;
711aa0d41d4SStefano Zampini   /* manage repeated solves */
712aa0d41d4SStefano Zampini   MatReuse          reuse;
713aa0d41d4SStefano Zampini   MatStructure      matstruct;
714aa0d41d4SStefano Zampini   PetscErrorCode    ierr;
715aa0d41d4SStefano Zampini 
716aa0d41d4SStefano Zampini   PetscFunctionBegin;
717aa0d41d4SStefano Zampini   /* get mat flags */
718aa0d41d4SStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
719aa0d41d4SStefano Zampini   reuse = MAT_INITIAL_MATRIX;
720aa0d41d4SStefano Zampini   if (pc->setupcalled) {
721aa0d41d4SStefano Zampini     /* when matstruct is SAME_PRECONDITIONER, we shouldn't be here */
722aa0d41d4SStefano Zampini     if (matstruct == SAME_PRECONDITIONER) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen");
723aa0d41d4SStefano Zampini     if (matstruct == SAME_NONZERO_PATTERN) {
724aa0d41d4SStefano Zampini       reuse = MAT_REUSE_MATRIX;
725aa0d41d4SStefano Zampini     } else {
726aa0d41d4SStefano Zampini       reuse = MAT_INITIAL_MATRIX;
727aa0d41d4SStefano Zampini     }
728aa0d41d4SStefano Zampini   }
729aa0d41d4SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
730aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
731aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
732aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
733aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcis->A_BB);CHKERRQ(ierr);
734aa0d41d4SStefano Zampini     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
735aa0d41d4SStefano Zampini   }
736aa0d41d4SStefano Zampini 
737aa0d41d4SStefano Zampini   /* transform local matrices if needed */
738aa0d41d4SStefano Zampini   if (pcbddc->use_change_of_basis) {
739aa0d41d4SStefano Zampini     Mat         change_mat_all;
740aa0d41d4SStefano Zampini     PetscScalar *row_cmat_values;
741aa0d41d4SStefano Zampini     PetscInt    *row_cmat_indices;
742aa0d41d4SStefano Zampini     PetscInt    *nnz,*is_indices,*temp_indices;
743aa0d41d4SStefano Zampini     PetscInt    i,j,k,n_D,n_B;
744aa0d41d4SStefano Zampini 
745aa0d41d4SStefano Zampini     /* Get Non-overlapping dimensions */
746aa0d41d4SStefano Zampini     n_B = pcis->n_B;
747aa0d41d4SStefano Zampini     n_D = pcis->n-n_B;
748aa0d41d4SStefano Zampini 
749aa0d41d4SStefano Zampini     /* compute nonzero structure of change of basis on all local nodes */
750aa0d41d4SStefano Zampini     ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
751aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
752aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) nnz[is_indices[i]] = 1;
753aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
754aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
755aa0d41d4SStefano Zampini     k=1;
756aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
757aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
758aa0d41d4SStefano Zampini       nnz[is_indices[i]]=j;
759aa0d41d4SStefano Zampini       if (k < j) k = j;
760aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,NULL,NULL);CHKERRQ(ierr);
761aa0d41d4SStefano Zampini     }
762aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
763aa0d41d4SStefano Zampini     /* assemble change of basis matrix on the whole set of local dofs */
764aa0d41d4SStefano Zampini     ierr = PetscMalloc(k*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
765aa0d41d4SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&change_mat_all);CHKERRQ(ierr);
766aa0d41d4SStefano Zampini     ierr = MatSetSizes(change_mat_all,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
767aa0d41d4SStefano Zampini     ierr = MatSetType(change_mat_all,MATSEQAIJ);CHKERRQ(ierr);
768aa0d41d4SStefano Zampini     ierr = MatSeqAIJSetPreallocation(change_mat_all,0,nnz);CHKERRQ(ierr);
769aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
770aa0d41d4SStefano Zampini     for (i=0;i<n_D;i++) {
771aa0d41d4SStefano Zampini       ierr = MatSetValue(change_mat_all,is_indices[i],is_indices[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
772aa0d41d4SStefano Zampini     }
773aa0d41d4SStefano Zampini     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
774aa0d41d4SStefano Zampini     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
775aa0d41d4SStefano Zampini     for (i=0;i<n_B;i++) {
776aa0d41d4SStefano Zampini       ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
777aa0d41d4SStefano Zampini       for (k=0; k<j; k++) temp_indices[k]=is_indices[row_cmat_indices[k]];
778aa0d41d4SStefano Zampini       ierr = MatSetValues(change_mat_all,1,&is_indices[i],j,temp_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr);
779aa0d41d4SStefano Zampini       ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr);
780aa0d41d4SStefano Zampini     }
781aa0d41d4SStefano Zampini     ierr = MatAssemblyBegin(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
782aa0d41d4SStefano Zampini     ierr = MatAssemblyEnd(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7839577ea80SStefano Zampini     /* TODO: HOW TO WORK WITH BAIJ and SBAIJ? PtAP not provided */
7849577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
7859577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQBAIJ,&isbaij);CHKERRQ(ierr);
7869577ea80SStefano Zampini     if (!issbaij && !isbaij) {
787aa0d41d4SStefano Zampini       ierr = MatPtAP(matis->A,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
788aa0d41d4SStefano Zampini     } else {
789aa0d41d4SStefano Zampini       Mat work_mat;
790aa0d41d4SStefano Zampini       ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
791aa0d41d4SStefano Zampini       ierr = MatPtAP(work_mat,change_mat_all,reuse,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
792aa0d41d4SStefano Zampini       ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
793aa0d41d4SStefano Zampini     }
79445a1bb75SStefano Zampini     /*
79545a1bb75SStefano Zampini     ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
79645a1bb75SStefano Zampini     ierr = MatView(change_mat_all,(PetscViewer)0);CHKERRQ(ierr);
79745a1bb75SStefano Zampini     */
798aa0d41d4SStefano Zampini     ierr = MatDestroy(&change_mat_all);CHKERRQ(ierr);
799aa0d41d4SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
800aa0d41d4SStefano Zampini     ierr = PetscFree(temp_indices);CHKERRQ(ierr);
801aa0d41d4SStefano Zampini   } else {
802aa0d41d4SStefano Zampini     /* without change of basis, the local matrix is unchanged */
803aa0d41d4SStefano Zampini     if (!pcbddc->local_mat) {
804aa0d41d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)matis->A);CHKERRQ(ierr);
805aa0d41d4SStefano Zampini       pcbddc->local_mat = matis->A;
806aa0d41d4SStefano Zampini     }
807aa0d41d4SStefano Zampini   }
808aa0d41d4SStefano Zampini 
809aa0d41d4SStefano Zampini   /* get submatrices */
810aa0d41d4SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_I_local,reuse,&pcis->A_II);CHKERRQ(ierr);
8119577ea80SStefano Zampini   ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_B_local,reuse,&pcis->A_BB);CHKERRQ(ierr);
8129577ea80SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
8139577ea80SStefano Zampini   if (!issbaij) {
814aa0d41d4SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
815aa0d41d4SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
8169577ea80SStefano Zampini   } else {
8179577ea80SStefano Zampini     Mat newmat;
8189577ea80SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
8199577ea80SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcis->is_I_local,pcis->is_B_local,reuse,&pcis->A_IB);CHKERRQ(ierr);
8209577ea80SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcis->is_B_local,pcis->is_I_local,reuse,&pcis->A_BI);CHKERRQ(ierr);
8219577ea80SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
8229577ea80SStefano Zampini   }
823aa0d41d4SStefano Zampini   PetscFunctionReturn(0);
824aa0d41d4SStefano Zampini }
825aa0d41d4SStefano Zampini 
826aa0d41d4SStefano Zampini #undef __FUNCT__
827a64d13efSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalScatters"
8288ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
829a64d13efSStefano Zampini {
830a64d13efSStefano Zampini   PC_IS*         pcis = (PC_IS*)(pc->data);
831a64d13efSStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8328ce42a96SStefano Zampini   IS             is_aux1,is_aux2;
833a64d13efSStefano Zampini   PetscInt       *vertices,*aux_array1,*aux_array2,*is_indices,*idx_R_local;
8343a50541eSStefano Zampini   PetscInt       n_vertices,i,j,n_R,n_D,n_B;
8353a50541eSStefano Zampini   PetscInt       vbs,bs;
8364641a718SStefano Zampini   PetscBT        bitmask;
837a64d13efSStefano Zampini   PetscErrorCode ierr;
838a64d13efSStefano Zampini 
839a64d13efSStefano Zampini   PetscFunctionBegin;
840a64d13efSStefano Zampini   /* Set Non-overlapping dimensions */
841a64d13efSStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
842a64d13efSStefano Zampini   /* get vertex indices from constraint matrix */
843a64d13efSStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&n_vertices,&vertices);CHKERRQ(ierr);
8443a50541eSStefano Zampini 
8454641a718SStefano Zampini   /* create auxiliary bitmask */
8464641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
8474641a718SStefano Zampini   for (i=0;i<n_vertices;i++) {
8484641a718SStefano Zampini     ierr = PetscBTSet(bitmask,vertices[i]);CHKERRQ(ierr);
8494641a718SStefano Zampini   }
8503a50541eSStefano Zampini 
851a64d13efSStefano Zampini   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
852a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n-n_vertices)*sizeof(PetscInt),&idx_R_local);CHKERRQ(ierr);
853a64d13efSStefano Zampini   for (i=0, n_R=0; i<pcis->n; i++) {
8544641a718SStefano Zampini     if (!PetscBTLookup(bitmask,i)) {
855a64d13efSStefano Zampini       idx_R_local[n_R] = i;
856a64d13efSStefano Zampini       n_R++;
857a64d13efSStefano Zampini     }
858a64d13efSStefano Zampini   }
8593a50541eSStefano Zampini 
8603a50541eSStefano Zampini   /* Block code */
8613a50541eSStefano Zampini   vbs = 1;
8623a50541eSStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
8633a50541eSStefano Zampini   if (bs>1 && !(n_vertices%bs)) {
8643a50541eSStefano Zampini     PetscBool is_blocked = PETSC_TRUE;
8653a50541eSStefano Zampini     PetscInt  *vary;
8663a50541eSStefano Zampini     /* Verify if the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
8673a50541eSStefano Zampini     ierr = PetscMalloc(pcis->n/bs*sizeof(PetscInt),&vary);CHKERRQ(ierr);
8683a50541eSStefano Zampini     ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
8693a50541eSStefano Zampini     for (i=0; i<n_vertices; i++) vary[vertices[i]/bs]++;
8703a50541eSStefano Zampini     for (i=0; i<n_vertices; i++) {
8713a50541eSStefano Zampini       if (vary[i]!=0 && vary[i]!=bs) {
8723a50541eSStefano Zampini         is_blocked = PETSC_FALSE;
8733a50541eSStefano Zampini         break;
8743a50541eSStefano Zampini       }
8753a50541eSStefano Zampini     }
8763a50541eSStefano Zampini     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
8773a50541eSStefano Zampini       vbs = bs;
8783a50541eSStefano Zampini       for (i=0;i<n_R/vbs;i++) {
8793a50541eSStefano Zampini         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
8803a50541eSStefano Zampini       }
8813a50541eSStefano Zampini     }
8823a50541eSStefano Zampini     ierr = PetscFree(vary);CHKERRQ(ierr);
8833a50541eSStefano Zampini   }
884a64d13efSStefano Zampini   ierr = PetscFree(vertices);CHKERRQ(ierr);
8853a50541eSStefano Zampini   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
8863a50541eSStefano Zampini   ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
887a64d13efSStefano Zampini 
888a64d13efSStefano Zampini   /* print some info if requested */
889a64d13efSStefano Zampini   if (pcbddc->dbg_flag) {
890a64d13efSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
891a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
892a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
893a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
8943a50541eSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"r_size = %d, v_size = %d, constraints = %d, local_primal_size = %d\n",n_R,n_vertices,pcbddc->local_primal_size-n_vertices,pcbddc->local_primal_size);CHKERRQ(ierr);
895a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr);
896a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
897a64d13efSStefano Zampini   }
898a64d13efSStefano Zampini 
899a64d13efSStefano Zampini   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
9003a50541eSStefano Zampini   ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
901a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
902a64d13efSStefano Zampini   ierr = PetscMalloc((pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array2);CHKERRQ(ierr);
903a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
9044641a718SStefano Zampini   for (i=0; i<n_D; i++) {
9054641a718SStefano Zampini     ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
9064641a718SStefano Zampini   }
907a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
908a64d13efSStefano Zampini   for (i=0, j=0; i<n_R; i++) {
9094641a718SStefano Zampini     if (!PetscBTLookup(bitmask,idx_R_local[i])) {
9104641a718SStefano Zampini       aux_array1[j++] = i;
911a64d13efSStefano Zampini     }
912a64d13efSStefano Zampini   }
913a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
914a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
915a64d13efSStefano Zampini   for (i=0, j=0; i<n_B; i++) {
9164641a718SStefano Zampini     if (!PetscBTLookup(bitmask,is_indices[i])) {
9174641a718SStefano Zampini       aux_array2[j++] = i;
918a64d13efSStefano Zampini     }
919a64d13efSStefano Zampini   }
920a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
921a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
922a64d13efSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
923a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
924a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
925a64d13efSStefano Zampini 
9268eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
927a64d13efSStefano Zampini     ierr = PetscMalloc(n_D*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr);
928a64d13efSStefano Zampini     for (i=0, j=0; i<n_R; i++) {
9294641a718SStefano Zampini       if (PetscBTLookup(bitmask,idx_R_local[i])) {
9304641a718SStefano Zampini         aux_array1[j++] = i;
931a64d13efSStefano Zampini       }
932a64d13efSStefano Zampini     }
933a64d13efSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
934a64d13efSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
935a64d13efSStefano Zampini     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
936a64d13efSStefano Zampini   }
9374641a718SStefano Zampini   ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
9383a50541eSStefano Zampini   ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
939a64d13efSStefano Zampini   PetscFunctionReturn(0);
940a64d13efSStefano Zampini }
941a64d13efSStefano Zampini 
942304d26faSStefano Zampini 
943304d26faSStefano Zampini #undef __FUNCT__
944304d26faSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
9458ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc)
946304d26faSStefano Zampini {
947304d26faSStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
948304d26faSStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
949304d26faSStefano Zampini   PC             pc_temp;
950304d26faSStefano Zampini   Mat            A_RR;
951304d26faSStefano Zampini   Vec            vec1,vec2,vec3;
952304d26faSStefano Zampini   MatStructure   matstruct;
953304d26faSStefano Zampini   PetscScalar    m_one = -1.0;
954304d26faSStefano Zampini   PetscReal      value;
955af732b37SStefano Zampini   PetscInt       n_D,n_R,ibs,mbs;
9569577ea80SStefano Zampini   PetscBool      use_exact,use_exact_reduced,issbaij;
957304d26faSStefano Zampini   PetscErrorCode ierr;
958e604994aSStefano Zampini   /* prefixes stuff */
959e604994aSStefano Zampini   char           dir_prefix[256],neu_prefix[256],str_level[3];
960e604994aSStefano Zampini   size_t         len;
961304d26faSStefano Zampini 
962304d26faSStefano Zampini   PetscFunctionBegin;
963304d26faSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
964304d26faSStefano Zampini 
965e604994aSStefano Zampini   /* compute prefixes */
966e604994aSStefano Zampini   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
967e604994aSStefano Zampini   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
968e604994aSStefano Zampini   if (!pcbddc->current_level) {
969e604994aSStefano Zampini     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
970e604994aSStefano Zampini     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
971e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
972e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
973e604994aSStefano Zampini   } else {
974e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
975e604994aSStefano Zampini     sprintf(str_level,"%d_",(int)(pcbddc->current_level));
976e604994aSStefano Zampini     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
977e604994aSStefano Zampini     len -= 15; /* remove "pc_bddc_coarse_" */
978e604994aSStefano Zampini     if (pcbddc->current_level>1) len -= 2; /* remove "X_" with X level number (works with 9 levels max) */
979e604994aSStefano Zampini     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
980e604994aSStefano Zampini     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
981e604994aSStefano Zampini     *(dir_prefix+len)='\0';
982e604994aSStefano Zampini     *(neu_prefix+len)='\0';
983e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
984e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
985e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
986e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
987e604994aSStefano Zampini   }
988e604994aSStefano Zampini 
989304d26faSStefano Zampini   /* DIRICHLET PROBLEM */
990ac78edfcSStefano Zampini   /* Matrix for Dirichlet problem is pcis->A_II */
9918ce42a96SStefano Zampini   ierr = ISGetSize(pcis->is_I_local,&n_D);CHKERRQ(ierr);
992304d26faSStefano Zampini   if (!pcbddc->ksp_D) { /* create object if not yet build */
993304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
994304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
995304d26faSStefano Zampini     /* default */
996304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
997e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
9989577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
999304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
10009577ea80SStefano Zampini     if (issbaij) {
10019577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
10029577ea80SStefano Zampini     } else {
1003304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
10049577ea80SStefano Zampini     }
1005304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1006304d26faSStefano Zampini   }
1007304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II,matstruct);CHKERRQ(ierr);
1008304d26faSStefano Zampini   /* Allow user's customization */
1009304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
1010304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1011304d26faSStefano Zampini   if (!n_D) {
1012304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
1013304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1014304d26faSStefano Zampini   }
1015304d26faSStefano Zampini   /* Set Up KSP for Dirichlet problem of BDDC */
1016304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
1017304d26faSStefano Zampini   /* set ksp_D into pcis data */
1018304d26faSStefano Zampini   ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
1019304d26faSStefano Zampini   ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
1020304d26faSStefano Zampini   pcis->ksp_D = pcbddc->ksp_D;
1021304d26faSStefano Zampini 
1022304d26faSStefano Zampini   /* NEUMANN PROBLEM */
1023304d26faSStefano Zampini   /* Matrix for Neumann problem is A_RR -> we need to create it */
10248ce42a96SStefano Zampini   ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
1025af732b37SStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
1026af732b37SStefano Zampini   ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
10273a50541eSStefano Zampini   if (ibs != mbs) {
1028af732b37SStefano Zampini     Mat newmat;
1029af732b37SStefano Zampini     ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
1030af732b37SStefano Zampini     ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
1031af732b37SStefano Zampini     ierr = MatDestroy(&newmat);CHKERRQ(ierr);
1032af732b37SStefano Zampini   } else {
10338ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
1034af732b37SStefano Zampini   }
1035304d26faSStefano Zampini   if (!pcbddc->ksp_R) { /* create object if not yet build */
1036304d26faSStefano Zampini     ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
1037304d26faSStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
1038304d26faSStefano Zampini     /* default */
1039304d26faSStefano Zampini     ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
1040e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
1041304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
10429577ea80SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
10439577ea80SStefano Zampini     if (issbaij) {
10449577ea80SStefano Zampini       ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
10459577ea80SStefano Zampini     } else {
1046304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
10479577ea80SStefano Zampini     }
1048304d26faSStefano Zampini     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1049304d26faSStefano Zampini   }
1050304d26faSStefano Zampini   ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR,matstruct);CHKERRQ(ierr);
1051304d26faSStefano Zampini   /* Allow user's customization */
1052304d26faSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
1053304d26faSStefano Zampini   /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1054304d26faSStefano Zampini   if (!n_R) {
1055304d26faSStefano Zampini     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
1056304d26faSStefano Zampini     ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1057304d26faSStefano Zampini   }
1058304d26faSStefano Zampini   /* Set Up KSP for Neumann problem of BDDC */
1059304d26faSStefano Zampini   ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
1060304d26faSStefano Zampini 
1061304d26faSStefano Zampini   /* check Dirichlet and Neumann solvers and adapt them if a nullspace correction is needed */
1062304d26faSStefano Zampini 
1063304d26faSStefano Zampini   /* Dirichlet */
1064304d26faSStefano Zampini   ierr = MatGetVecs(pcis->A_II,&vec1,&vec2);CHKERRQ(ierr);
1065304d26faSStefano Zampini   ierr = VecDuplicate(vec1,&vec3);CHKERRQ(ierr);
1066304d26faSStefano Zampini   ierr = VecSetRandom(vec1,NULL);CHKERRQ(ierr);
1067304d26faSStefano Zampini   ierr = MatMult(pcis->A_II,vec1,vec2);CHKERRQ(ierr);
1068304d26faSStefano Zampini   ierr = KSPSolve(pcbddc->ksp_D,vec2,vec3);CHKERRQ(ierr);
1069304d26faSStefano Zampini   ierr = VecAXPY(vec3,m_one,vec1);CHKERRQ(ierr);
1070304d26faSStefano Zampini   ierr = VecNorm(vec3,NORM_INFINITY,&value);CHKERRQ(ierr);
1071304d26faSStefano Zampini   ierr = VecDestroy(&vec1);CHKERRQ(ierr);
1072304d26faSStefano Zampini   ierr = VecDestroy(&vec2);CHKERRQ(ierr);
1073304d26faSStefano Zampini   ierr = VecDestroy(&vec3);CHKERRQ(ierr);
1074304d26faSStefano Zampini   /* need to be adapted? */
1075b8ffe317SStefano Zampini   use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1076b8ffe317SStefano Zampini   ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1077b8ffe317SStefano Zampini   ierr = PCBDDCSetUseExactDirichlet(pc,use_exact_reduced);CHKERRQ(ierr);
1078304d26faSStefano Zampini   /* print info */
1079304d26faSStefano Zampini   if (pcbddc->dbg_flag) {
1080304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1081304d26faSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
1082304d26faSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Checking solution of Dirichlet and Neumann problems\n");CHKERRQ(ierr);
1083e604994aSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Dirichlet solve (%s) = % 1.14e \n",PetscGlobalRank,((PetscObject)(pcbddc->ksp_D))->prefix,value);CHKERRQ(ierr);
1084304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1085304d26faSStefano Zampini   }
1086b8ffe317SStefano Zampini   if (pcbddc->NullSpace && !use_exact_reduced && !pcbddc->switch_static) {
10878ce42a96SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcis->is_I_local);CHKERRQ(ierr);
1088304d26faSStefano Zampini   }
1089304d26faSStefano Zampini 
1090304d26faSStefano Zampini   /* Neumann */
1091304d26faSStefano Zampini   ierr = MatGetVecs(A_RR,&vec1,&vec2);CHKERRQ(ierr);
1092304d26faSStefano Zampini   ierr = VecDuplicate(vec1,&vec3);CHKERRQ(ierr);
1093304d26faSStefano Zampini   ierr = VecSetRandom(vec1,NULL);CHKERRQ(ierr);
1094304d26faSStefano Zampini   ierr = MatMult(A_RR,vec1,vec2);CHKERRQ(ierr);
1095304d26faSStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,vec2,vec3);CHKERRQ(ierr);
1096304d26faSStefano Zampini   ierr = VecAXPY(vec3,m_one,vec1);CHKERRQ(ierr);
1097304d26faSStefano Zampini   ierr = VecNorm(vec3,NORM_INFINITY,&value);CHKERRQ(ierr);
1098304d26faSStefano Zampini   ierr = VecDestroy(&vec1);CHKERRQ(ierr);
1099304d26faSStefano Zampini   ierr = VecDestroy(&vec2);CHKERRQ(ierr);
1100304d26faSStefano Zampini   ierr = VecDestroy(&vec3);CHKERRQ(ierr);
1101304d26faSStefano Zampini   /* need to be adapted? */
1102b8ffe317SStefano Zampini   use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1103b8ffe317SStefano Zampini   ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1104304d26faSStefano Zampini   /* print info */
1105304d26faSStefano Zampini   if (pcbddc->dbg_flag) {
1106e604994aSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Neumann solve (%s) = % 1.14e \n",PetscGlobalRank,((PetscObject)(pcbddc->ksp_R))->prefix,value);CHKERRQ(ierr);
1107304d26faSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1108304d26faSStefano Zampini   }
1109b8ffe317SStefano Zampini   if (pcbddc->NullSpace && !use_exact_reduced) { /* is it the right logic? */
11108ce42a96SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcbddc->is_R_local);CHKERRQ(ierr);
1111304d26faSStefano Zampini   }
1112304d26faSStefano Zampini   /* free Neumann problem's matrix */
1113304d26faSStefano Zampini   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1114304d26faSStefano Zampini   PetscFunctionReturn(0);
1115304d26faSStefano Zampini }
1116304d26faSStefano Zampini 
1117304d26faSStefano Zampini #undef __FUNCT__
1118674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSolveSaddlePoint"
1119674ae819SStefano Zampini static PetscErrorCode  PCBDDCSolveSaddlePoint(PC pc)
1120674ae819SStefano Zampini {
1121674ae819SStefano Zampini   PetscErrorCode ierr;
1122674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1123674ae819SStefano Zampini 
1124674ae819SStefano Zampini   PetscFunctionBegin;
1125674ae819SStefano Zampini   ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
1126674ae819SStefano Zampini   if (pcbddc->local_auxmat1) {
1127674ae819SStefano Zampini     ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec2_R,pcbddc->vec1_C);CHKERRQ(ierr);
1128674ae819SStefano Zampini     ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
1129674ae819SStefano Zampini   }
1130674ae819SStefano Zampini   PetscFunctionReturn(0);
1131674ae819SStefano Zampini }
1132674ae819SStefano Zampini 
1133674ae819SStefano Zampini #undef __FUNCT__
1134674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
1135674ae819SStefano Zampini PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc)
1136674ae819SStefano Zampini {
1137674ae819SStefano Zampini   PetscErrorCode ierr;
1138674ae819SStefano Zampini   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
1139674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)  (pc->data);
1140674ae819SStefano Zampini   const PetscScalar zero = 0.0;
1141674ae819SStefano Zampini 
1142674ae819SStefano Zampini   PetscFunctionBegin;
114315aaf578SStefano Zampini   /* Application of PHI^T (or PSI^T)  */
114415aaf578SStefano Zampini   if (pcbddc->coarse_psi_B) {
114515aaf578SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
11468eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
114715aaf578SStefano Zampini   } else {
1148674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
11498eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
115015aaf578SStefano Zampini   }
1151674ae819SStefano Zampini   /* Scatter data of coarse_rhs */
1152674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { ierr = VecSet(pcbddc->coarse_rhs,zero);CHKERRQ(ierr); }
1153674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1154674ae819SStefano Zampini 
1155674ae819SStefano Zampini   /* Local solution on R nodes */
1156674ae819SStefano Zampini   ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
1157674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1158674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
11598eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1160674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1161674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1162674ae819SStefano Zampini   }
1163674ae819SStefano Zampini   ierr = PCBDDCSolveSaddlePoint(pc);CHKERRQ(ierr);
1164674ae819SStefano Zampini   ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1165674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1166674ae819SStefano Zampini   ierr = VecScatterEnd  (pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
11678eeda7d8SStefano Zampini   if (pcbddc->switch_static) {
1168674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1169674ae819SStefano Zampini     ierr = VecScatterEnd  (pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1170674ae819SStefano Zampini   }
1171674ae819SStefano Zampini 
1172674ae819SStefano Zampini   /* Coarse solution */
1173674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1174674ae819SStefano Zampini   if (pcbddc->coarse_rhs) { /* TODO remove null space when doing multilevel */
1175674ae819SStefano Zampini     ierr = KSPSolve(pcbddc->coarse_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
1176674ae819SStefano Zampini   }
1177674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1178674ae819SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd  (pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1179674ae819SStefano Zampini 
1180674ae819SStefano Zampini   /* Sum contributions from two levels */
1181674ae819SStefano Zampini   ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
11828eeda7d8SStefano Zampini   if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1183674ae819SStefano Zampini   PetscFunctionReturn(0);
1184674ae819SStefano Zampini }
1185674ae819SStefano Zampini 
1186674ae819SStefano Zampini #undef __FUNCT__
1187674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
1188674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1189674ae819SStefano Zampini {
1190674ae819SStefano Zampini   PetscErrorCode ierr;
1191674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1192674ae819SStefano Zampini 
1193674ae819SStefano Zampini   PetscFunctionBegin;
1194674ae819SStefano Zampini   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1195674ae819SStefano Zampini   PetscFunctionReturn(0);
1196674ae819SStefano Zampini }
1197674ae819SStefano Zampini 
1198674ae819SStefano Zampini #undef __FUNCT__
1199674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
1200674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode)
1201674ae819SStefano Zampini {
1202674ae819SStefano Zampini   PetscErrorCode ierr;
1203674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1204674ae819SStefano Zampini 
1205674ae819SStefano Zampini   PetscFunctionBegin;
1206674ae819SStefano Zampini   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr);
1207674ae819SStefano Zampini   PetscFunctionReturn(0);
1208674ae819SStefano Zampini }
1209674ae819SStefano Zampini 
1210984c4197SStefano Zampini /* uncomment for testing purposes */
1211984c4197SStefano Zampini /* #define PETSC_MISSING_LAPACK_GESVD 1 */
1212674ae819SStefano Zampini #undef __FUNCT__
1213674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp"
1214674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
1215674ae819SStefano Zampini {
1216674ae819SStefano Zampini   PetscErrorCode    ierr;
1217674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
1218674ae819SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
1219674ae819SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
1220984c4197SStefano Zampini   /* constraint and (optionally) change of basis matrix implemented as SeqAIJ */
1221674ae819SStefano Zampini   MatType           impMatType=MATSEQAIJ;
1222984c4197SStefano Zampini   /* one and zero */
1223984c4197SStefano Zampini   PetscScalar       one=1.0,zero=0.0;
1224984c4197SStefano Zampini   /* space to store constraints and their local indices */
1225984c4197SStefano Zampini   PetscScalar       *temp_quadrature_constraint;
1226984c4197SStefano Zampini   PetscInt          *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B;
1227984c4197SStefano Zampini   /* iterators */
1228984c4197SStefano Zampini   PetscInt          i,j,k,total_counts,temp_start_ptr;
1229984c4197SStefano Zampini   /* stuff to store connected components stored in pcbddc->mat_graph */
1230984c4197SStefano Zampini   IS                ISForVertices,*ISForFaces,*ISForEdges,*used_IS;
1231984c4197SStefano Zampini   PetscInt          n_ISForFaces,n_ISForEdges;
1232984c4197SStefano Zampini   /* near null space stuff */
1233674ae819SStefano Zampini   MatNullSpace      nearnullsp;
1234674ae819SStefano Zampini   const Vec         *nearnullvecs;
1235674ae819SStefano Zampini   Vec               *localnearnullsp;
1236984c4197SStefano Zampini   PetscBool         nnsp_has_cnst;
1237984c4197SStefano Zampini   PetscInt          nnsp_size;
1238984c4197SStefano Zampini   PetscScalar       *array;
1239984c4197SStefano Zampini   /* BLAS integers */
1240e310c8b4SStefano Zampini   PetscBLASInt      lwork,lierr;
1241e310c8b4SStefano Zampini   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
1242c4303822SStefano Zampini   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
1243984c4197SStefano Zampini   /* LAPACK working arrays for SVD or POD */
1244242a89d7SStefano Zampini   PetscBool         skip_lapack;
1245984c4197SStefano Zampini   PetscScalar       *work;
1246984c4197SStefano Zampini   PetscReal         *singular_vals;
1247984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1248984c4197SStefano Zampini   PetscReal         *rwork;
1249674ae819SStefano Zampini #endif
1250984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1251e310c8b4SStefano Zampini   PetscBLASInt      Blas_one_2=1;
1252984c4197SStefano Zampini   PetscScalar       *temp_basis,*correlation_mat;
1253b7d8b9f8SStefano Zampini #else
1254b7d8b9f8SStefano Zampini   PetscBLASInt      dummy_int_1=1,dummy_int_2=1;
1255b7d8b9f8SStefano Zampini   PetscScalar       dummy_scalar_1=0.0,dummy_scalar_2=0.0;
1256984c4197SStefano Zampini #endif
1257984c4197SStefano Zampini   /* change of basis */
1258984c4197SStefano Zampini   PetscInt          *aux_primal_numbering,*aux_primal_minloc,*global_indices;
1259a717540cSStefano Zampini   PetscBool         boolforchange,qr_needed;
1260a717540cSStefano Zampini   PetscBT           touched,change_basis,qr_needed_idx;
1261984c4197SStefano Zampini   /* auxiliary stuff */
1262984c4197SStefano Zampini   PetscInt          *nnz,*is_indices,*local_to_B;
1263984c4197SStefano Zampini   /* some quantities */
126445a1bb75SStefano Zampini   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
1265984c4197SStefano Zampini   PetscInt          size_of_constraint,max_size_of_constraint,max_constraints,temp_constraints;
1266984c4197SStefano Zampini 
1267674ae819SStefano Zampini 
1268674ae819SStefano Zampini   PetscFunctionBegin;
12698e61c736SStefano Zampini   /* Destroy Mat objects computed previously */
12708e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
12718e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1272674ae819SStefano Zampini   /* Get index sets for faces, edges and vertices from graph */
12738eeda7d8SStefano Zampini   if (!pcbddc->use_faces && !pcbddc->use_edges && !pcbddc->use_vertices) {
12748eeda7d8SStefano Zampini     pcbddc->use_vertices = PETSC_TRUE;
1275674ae819SStefano Zampini   }
12768eeda7d8SStefano Zampini   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,pcbddc->use_faces,pcbddc->use_edges,pcbddc->use_vertices,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);
1277b8ffe317SStefano Zampini   /* HACK: provide functions to set change of basis */
1278b8ffe317SStefano Zampini   if (!ISForVertices && pcbddc->NullSpace) {
1279b8ffe317SStefano Zampini     pcbddc->use_change_of_basis = PETSC_TRUE;
1280b8ffe317SStefano Zampini     pcbddc->use_change_on_faces = PETSC_FALSE;
1281b8ffe317SStefano Zampini   }
1282984c4197SStefano Zampini   /* print some info */
1283674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
1284674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1285674ae819SStefano Zampini     i = 0;
1286674ae819SStefano Zampini     if (ISForVertices) {
1287674ae819SStefano Zampini       ierr = ISGetSize(ISForVertices,&i);CHKERRQ(ierr);
1288674ae819SStefano Zampini     }
1289674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices\n",PetscGlobalRank,i);CHKERRQ(ierr);
1290674ae819SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges\n",PetscGlobalRank,n_ISForEdges);CHKERRQ(ierr);
129115aaf578SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces\n",PetscGlobalRank,n_ISForFaces);CHKERRQ(ierr);
1292674ae819SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1293674ae819SStefano Zampini   }
1294674ae819SStefano Zampini   /* check if near null space is attached to global mat */
1295674ae819SStefano Zampini   ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
1296674ae819SStefano Zampini   if (nearnullsp) {
1297674ae819SStefano Zampini     ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
1298984c4197SStefano Zampini   } else { /* if near null space is not provided BDDC uses constants by default */
1299984c4197SStefano Zampini     nnsp_size = 0;
1300674ae819SStefano Zampini     nnsp_has_cnst = PETSC_TRUE;
1301674ae819SStefano Zampini   }
1302984c4197SStefano Zampini   /* get max number of constraints on a single cc */
1303984c4197SStefano Zampini   max_constraints = nnsp_size;
1304984c4197SStefano Zampini   if (nnsp_has_cnst) max_constraints++;
1305984c4197SStefano Zampini 
1306674ae819SStefano Zampini   /*
1307674ae819SStefano Zampini        Evaluate maximum storage size needed by the procedure
1308674ae819SStefano Zampini        - temp_indices will contain start index of each constraint stored as follows
1309674ae819SStefano 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
1310674ae819SStefano 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
1311674ae819SStefano Zampini        - temp_quadrature_constraint  [temp_indices[i],...,temp[indices[i+1]-1] will contain the scalars representing the constraint itself
1312674ae819SStefano Zampini                                                                                                                                                          */
1313674ae819SStefano Zampini   total_counts = n_ISForFaces+n_ISForEdges;
1314984c4197SStefano Zampini   total_counts *= max_constraints;
1315674ae819SStefano Zampini   n_vertices = 0;
1316674ae819SStefano Zampini   if (ISForVertices) {
1317674ae819SStefano Zampini     ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
1318674ae819SStefano Zampini   }
1319674ae819SStefano Zampini   total_counts += n_vertices;
1320674ae819SStefano Zampini   ierr = PetscMalloc((total_counts+1)*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr);
13214641a718SStefano Zampini   ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
1322674ae819SStefano Zampini   total_counts = 0;
1323674ae819SStefano Zampini   max_size_of_constraint = 0;
1324674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1325674ae819SStefano Zampini     if (i<n_ISForEdges) {
1326674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1327674ae819SStefano Zampini     } else {
1328674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1329674ae819SStefano Zampini     }
1330674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
1331674ae819SStefano Zampini     total_counts += j;
1332674ae819SStefano Zampini     max_size_of_constraint = PetscMax(j,max_size_of_constraint);
1333674ae819SStefano Zampini   }
1334984c4197SStefano Zampini   total_counts *= max_constraints;
1335674ae819SStefano Zampini   total_counts += n_vertices;
1336674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&temp_quadrature_constraint);CHKERRQ(ierr);
1337674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint);CHKERRQ(ierr);
1338674ae819SStefano Zampini   ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint_B);CHKERRQ(ierr);
1339984c4197SStefano Zampini   /* local to boundary numbering */
1340674ae819SStefano Zampini   ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&local_to_B);CHKERRQ(ierr);
1341674ae819SStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1342984c4197SStefano Zampini   for (i=0;i<pcis->n;i++) local_to_B[i]=-1;
1343984c4197SStefano Zampini   for (i=0;i<pcis->n_B;i++) local_to_B[is_indices[i]]=i;
1344674ae819SStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1345984c4197SStefano Zampini   /* get local part of global near null space vectors */
1346984c4197SStefano Zampini   ierr = PetscMalloc(nnsp_size*sizeof(Vec),&localnearnullsp);CHKERRQ(ierr);
1347984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1348984c4197SStefano Zampini     ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
1349984c4197SStefano Zampini     ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1350984c4197SStefano Zampini     ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1351984c4197SStefano Zampini   }
1352674ae819SStefano Zampini 
1353242a89d7SStefano Zampini   /* whether or not to skip lapack calls */
1354242a89d7SStefano Zampini   skip_lapack = PETSC_TRUE;
1355242a89d7SStefano Zampini   if (n_ISForFaces+n_ISForEdges) skip_lapack = PETSC_FALSE;
1356242a89d7SStefano Zampini 
1357984c4197SStefano Zampini   /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
1358242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1359674ae819SStefano Zampini     PetscScalar temp_work;
1360674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1361984c4197SStefano Zampini     /* Proper Orthogonal Decomposition (POD) using the snapshot method */
1362984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*max_constraints*sizeof(PetscScalar),&correlation_mat);CHKERRQ(ierr);
1363984c4197SStefano Zampini     ierr = PetscMalloc(max_constraints*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1364984c4197SStefano Zampini     ierr = PetscMalloc(max_size_of_constraint*max_constraints*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr);
1365674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1366984c4197SStefano Zampini     ierr = PetscMalloc(3*max_constraints*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1367674ae819SStefano Zampini #endif
1368674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1369c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
1370c8244a33SStefano Zampini     ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
1371674ae819SStefano Zampini     lwork = -1;
1372674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1373674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1374c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
1375674ae819SStefano Zampini #else
1376c8244a33SStefano Zampini     PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
1377674ae819SStefano Zampini #endif
1378674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1379984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
1380674ae819SStefano Zampini #else /* on missing GESVD */
1381674ae819SStefano Zampini     /* SVD */
1382674ae819SStefano Zampini     PetscInt max_n,min_n;
1383674ae819SStefano Zampini     max_n = max_size_of_constraint;
1384984c4197SStefano Zampini     min_n = max_constraints;
1385984c4197SStefano Zampini     if (max_size_of_constraint < max_constraints) {
1386674ae819SStefano Zampini       min_n = max_size_of_constraint;
1387984c4197SStefano Zampini       max_n = max_constraints;
1388674ae819SStefano Zampini     }
1389674ae819SStefano Zampini     ierr = PetscMalloc(min_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr);
1390674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1391674ae819SStefano Zampini     ierr = PetscMalloc(5*min_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
1392674ae819SStefano Zampini #endif
1393674ae819SStefano Zampini     /* now we evaluate the optimal workspace using query with lwork=-1 */
1394674ae819SStefano Zampini     lwork = -1;
1395e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
1396e310c8b4SStefano Zampini     ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
1397b7d8b9f8SStefano Zampini     ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
1398674ae819SStefano Zampini     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1399674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1400e310c8b4SStefano 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));
1401674ae819SStefano Zampini #else
1402e310c8b4SStefano 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));
1403674ae819SStefano Zampini #endif
1404674ae819SStefano Zampini     ierr = PetscFPTrapPop();CHKERRQ(ierr);
1405984c4197SStefano Zampini     if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
1406984c4197SStefano Zampini #endif /* on missing GESVD */
1407674ae819SStefano Zampini     /* Allocate optimal workspace */
1408674ae819SStefano Zampini     ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
1409984c4197SStefano Zampini     ierr = PetscMalloc((PetscInt)lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
1410674ae819SStefano Zampini   }
1411674ae819SStefano Zampini   /* Now we can loop on constraining sets */
1412674ae819SStefano Zampini   total_counts = 0;
1413674ae819SStefano Zampini   temp_indices[0] = 0;
1414674ae819SStefano Zampini   /* vertices */
1415674ae819SStefano Zampini   if (ISForVertices) {
1416674ae819SStefano Zampini     ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1417674ae819SStefano Zampini     if (nnsp_has_cnst) { /* consider all vertices */
1418674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1419674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1420674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
1421674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1422674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1423674ae819SStefano Zampini         total_counts++;
1424674ae819SStefano Zampini       }
1425674ae819SStefano Zampini     } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
1426984c4197SStefano Zampini       PetscBool used_vertex;
1427674ae819SStefano Zampini       for (i=0;i<n_vertices;i++) {
1428674ae819SStefano Zampini         used_vertex = PETSC_FALSE;
1429674ae819SStefano Zampini         k = 0;
1430674ae819SStefano Zampini         while (!used_vertex && k<nnsp_size) {
1431984c4197SStefano Zampini           ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1432984c4197SStefano Zampini           if (PetscAbsScalar(array[is_indices[i]])>0.0) {
1433674ae819SStefano Zampini             temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1434674ae819SStefano Zampini             temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]];
1435674ae819SStefano Zampini             temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1436674ae819SStefano Zampini             temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1437674ae819SStefano Zampini             total_counts++;
1438674ae819SStefano Zampini             used_vertex = PETSC_TRUE;
1439674ae819SStefano Zampini           }
1440984c4197SStefano Zampini           ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1441674ae819SStefano Zampini           k++;
1442674ae819SStefano Zampini         }
1443674ae819SStefano Zampini       }
1444674ae819SStefano Zampini     }
1445674ae819SStefano Zampini     ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1446674ae819SStefano Zampini     n_vertices = total_counts;
1447674ae819SStefano Zampini   }
1448984c4197SStefano Zampini 
1449674ae819SStefano Zampini   /* edges and faces */
1450674ae819SStefano Zampini   for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1451674ae819SStefano Zampini     if (i<n_ISForEdges) {
1452674ae819SStefano Zampini       used_IS = &ISForEdges[i];
1453984c4197SStefano Zampini       boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
1454674ae819SStefano Zampini     } else {
1455674ae819SStefano Zampini       used_IS = &ISForFaces[i-n_ISForEdges];
1456984c4197SStefano Zampini       boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
1457674ae819SStefano Zampini     }
1458674ae819SStefano Zampini     temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
1459674ae819SStefano Zampini     temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
1460674ae819SStefano Zampini     ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
1461674ae819SStefano Zampini     ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1462984c4197SStefano Zampini     /* change of basis should not be performed on local periodic nodes */
1463984c4197SStefano Zampini     if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
1464674ae819SStefano Zampini     if (nnsp_has_cnst) {
14655b08dc53SStefano Zampini       PetscScalar quad_value;
1466674ae819SStefano Zampini       temp_constraints++;
1467674ae819SStefano Zampini       quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
1468674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1469674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
1470674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
1471674ae819SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
1472674ae819SStefano Zampini       }
1473674ae819SStefano Zampini       temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
1474674ae819SStefano Zampini       total_counts++;
1475674ae819SStefano Zampini     }
1476674ae819SStefano Zampini     for (k=0;k<nnsp_size;k++) {
1477984c4197SStefano Zampini       PetscReal real_value;
1478984c4197SStefano Zampini       ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1479674ae819SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
1480674ae819SStefano Zampini         temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j];
1481674ae819SStefano Zampini         temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]];
1482984c4197SStefano Zampini         temp_quadrature_constraint[temp_indices[total_counts]+j]=array[is_indices[j]];
1483674ae819SStefano Zampini       }
1484984c4197SStefano Zampini       ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1485984c4197SStefano Zampini       /* check if array is null on the connected component */
1486e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1487e310c8b4SStefano Zampini       PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_one));
14885b08dc53SStefano Zampini       if (real_value > 0.0) { /* keep indices and values */
1489674ae819SStefano Zampini         temp_constraints++;
1490674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
1491674ae819SStefano Zampini         total_counts++;
1492674ae819SStefano Zampini       }
1493674ae819SStefano Zampini     }
1494674ae819SStefano Zampini     ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
149545a1bb75SStefano Zampini     valid_constraints = temp_constraints;
1496eb97c9d2SStefano Zampini     /* perform SVD on the constraints if use_nnsp_true has not be requested by the user and there are non-null constraints on the cc */
1497eb97c9d2SStefano Zampini     if (!pcbddc->use_nnsp_true && temp_constraints) {
1498984c4197SStefano Zampini       PetscReal tol = 1.0e-8; /* tolerance for retaining eigenmodes */
1499674ae819SStefano Zampini 
1500674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1501984c4197SStefano Zampini       /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
1502984c4197SStefano Zampini          POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
1503984c4197SStefano Zampini          -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
1504984c4197SStefano Zampini             the constraints basis will differ (by a complex factor with absolute value equal to 1)
1505984c4197SStefano Zampini             from that computed using LAPACKgesvd
1506984c4197SStefano Zampini          -> This is due to a different computation of eigenvectors in LAPACKheev
1507984c4197SStefano Zampini          -> The quality of the POD-computed basis will be the same */
1508984c4197SStefano Zampini       ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
1509674ae819SStefano Zampini       /* Store upper triangular part of correlation matrix */
1510e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1511984c4197SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1512674ae819SStefano Zampini       for (j=0;j<temp_constraints;j++) {
1513674ae819SStefano Zampini         for (k=0;k<j+1;k++) {
1514e310c8b4SStefano 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));
1515674ae819SStefano Zampini         }
1516674ae819SStefano Zampini       }
1517e310c8b4SStefano Zampini       /* compute eigenvalues and eigenvectors of correlation matrix */
1518e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1519e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
1520674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1521c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
1522674ae819SStefano Zampini #else
1523c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
1524674ae819SStefano Zampini #endif
1525674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1526984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
1527984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
1528674ae819SStefano Zampini       j=0;
1529984c4197SStefano Zampini       while (j < temp_constraints && singular_vals[j] < tol) j++;
1530674ae819SStefano Zampini       total_counts=total_counts-j;
153145a1bb75SStefano Zampini       valid_constraints = temp_constraints-j;
1532e310c8b4SStefano Zampini       /* scale and copy POD basis into used quadrature memory */
1533c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1534c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1535c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
1536c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1537c4303822SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
1538c4303822SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1539674ae819SStefano Zampini       if (j<temp_constraints) {
1540984c4197SStefano Zampini         PetscInt ii;
1541984c4197SStefano Zampini         for (k=j;k<temp_constraints;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]);
1542674ae819SStefano Zampini         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1543c4303822SStefano 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));
1544674ae819SStefano Zampini         ierr = PetscFPTrapPop();CHKERRQ(ierr);
1545984c4197SStefano Zampini         for (k=0;k<temp_constraints-j;k++) {
1546674ae819SStefano Zampini           for (ii=0;ii<size_of_constraint;ii++) {
1547984c4197SStefano 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];
1548674ae819SStefano Zampini           }
1549674ae819SStefano Zampini         }
1550674ae819SStefano Zampini       }
1551674ae819SStefano Zampini #else  /* on missing GESVD */
1552e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
1553e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
1554b7d8b9f8SStefano Zampini       ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1555674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1556674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1557e310c8b4SStefano 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));
1558674ae819SStefano Zampini #else
1559e310c8b4SStefano 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));
1560674ae819SStefano Zampini #endif
1561984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
1562674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1563984c4197SStefano Zampini       /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
1564e310c8b4SStefano Zampini       k = temp_constraints;
1565e310c8b4SStefano Zampini       if (k > size_of_constraint) k = size_of_constraint;
1566674ae819SStefano Zampini       j = 0;
1567e310c8b4SStefano Zampini       while (j < k && singular_vals[k-j-1] < tol) j++;
1568e310c8b4SStefano Zampini       total_counts = total_counts-temp_constraints+k-j;
156945a1bb75SStefano Zampini       valid_constraints = k-j;
1570984c4197SStefano Zampini #endif /* on missing GESVD */
1571674ae819SStefano Zampini     }
157245a1bb75SStefano Zampini     /* setting change_of_basis flag is safe now */
157345a1bb75SStefano Zampini     if (boolforchange) {
157445a1bb75SStefano Zampini       for (j=0;j<valid_constraints;j++) {
157545a1bb75SStefano Zampini         PetscBTSet(change_basis,total_counts-j-1);
157645a1bb75SStefano Zampini       }
157745a1bb75SStefano Zampini     }
1578674ae819SStefano Zampini   }
1579674ae819SStefano Zampini   /* free index sets of faces, edges and vertices */
1580674ae819SStefano Zampini   for (i=0;i<n_ISForFaces;i++) {
1581674ae819SStefano Zampini     ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
1582674ae819SStefano Zampini   }
1583674ae819SStefano Zampini   ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
1584674ae819SStefano Zampini   for (i=0;i<n_ISForEdges;i++) {
1585674ae819SStefano Zampini     ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
1586674ae819SStefano Zampini   }
1587674ae819SStefano Zampini   ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
1588674ae819SStefano Zampini   ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
1589674ae819SStefano Zampini 
1590984c4197SStefano Zampini   /* free workspace */
1591242a89d7SStefano Zampini   if (!pcbddc->use_nnsp_true && !skip_lapack) {
1592984c4197SStefano Zampini     ierr = PetscFree(work);CHKERRQ(ierr);
1593984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1594984c4197SStefano Zampini     ierr = PetscFree(rwork);CHKERRQ(ierr);
1595984c4197SStefano Zampini #endif
1596984c4197SStefano Zampini     ierr = PetscFree(singular_vals);CHKERRQ(ierr);
1597984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1598984c4197SStefano Zampini     ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
1599984c4197SStefano Zampini     ierr = PetscFree(temp_basis);CHKERRQ(ierr);
1600984c4197SStefano Zampini #endif
1601984c4197SStefano Zampini   }
1602984c4197SStefano Zampini   for (k=0;k<nnsp_size;k++) {
1603984c4197SStefano Zampini     ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
1604984c4197SStefano Zampini   }
1605984c4197SStefano Zampini   ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
1606984c4197SStefano Zampini 
1607674ae819SStefano Zampini   /* set quantities in pcbddc data structure */
1608984c4197SStefano Zampini   /* n_vertices defines the number of subdomain corners in the primal space */
1609674ae819SStefano Zampini   /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */
1610984c4197SStefano Zampini   pcbddc->local_primal_size = total_counts;
1611674ae819SStefano Zampini   pcbddc->n_vertices = n_vertices;
1612984c4197SStefano Zampini   pcbddc->n_constraints = pcbddc->local_primal_size-pcbddc->n_vertices;
1613674ae819SStefano Zampini 
1614674ae819SStefano Zampini   /* Create constraint matrix */
1615674ae819SStefano Zampini   /* The constraint matrix is used to compute the l2g map of primal dofs */
1616674ae819SStefano Zampini   /* so we need to set it up properly either with or without change of basis */
1617674ae819SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1618674ae819SStefano Zampini   ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr);
1619984c4197SStefano Zampini   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
1620984c4197SStefano Zampini   /* array to compute a local numbering of constraints : vertices first then constraints */
1621984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_numbering);CHKERRQ(ierr);
1622984c4197SStefano Zampini   /* array to select the proper local node (of minimum index with respect to global ordering) when changing the basis */
1623984c4197SStefano 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 */
1624984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_minloc);CHKERRQ(ierr);
1625984c4197SStefano Zampini   /* auxiliary stuff for basis change */
1626984c4197SStefano Zampini   ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&global_indices);CHKERRQ(ierr);
16274641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n_B,&touched);CHKERRQ(ierr);
1628984c4197SStefano Zampini 
1629984c4197SStefano Zampini   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
1630984c4197SStefano Zampini   total_primal_vertices=0;
1631984c4197SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
1632674ae819SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
1633984c4197SStefano Zampini     if (size_of_constraint == 1) {
16344641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]]);CHKERRQ(ierr);
1635984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]];
1636984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=0;
1637984c4197SStefano Zampini       total_primal_vertices++;
16384641a718SStefano Zampini     } else if (PetscBTLookup(change_basis,i)) { /* Same procedure used in PCBDDCGetPrimalConstraintsLocalIdx */
1639984c4197SStefano Zampini       PetscInt min_loc,min_index;
1640984c4197SStefano Zampini       ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],global_indices);CHKERRQ(ierr);
1641984c4197SStefano Zampini       /* find first untouched local node */
1642674ae819SStefano Zampini       k = 0;
16434641a718SStefano Zampini       while (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) k++;
1644984c4197SStefano Zampini       min_index = global_indices[k];
1645984c4197SStefano Zampini       min_loc = k;
1646984c4197SStefano Zampini       /* search the minimum among global nodes already untouched on the cc */
1647984c4197SStefano Zampini       for (k=1;k<size_of_constraint;k++) {
1648984c4197SStefano Zampini         /* there can be more than one constraint on a single connected component */
16494641a718SStefano Zampini         if (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k]) && min_index > global_indices[k]) {
1650984c4197SStefano Zampini           min_index = global_indices[k];
1651984c4197SStefano Zampini           min_loc = k;
1652674ae819SStefano Zampini         }
1653674ae819SStefano Zampini       }
16544641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]+min_loc]);CHKERRQ(ierr);
1655984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]+min_loc];
1656984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=min_loc;
1657984c4197SStefano Zampini       total_primal_vertices++;
1658984c4197SStefano Zampini     }
1659984c4197SStefano Zampini   }
1660a717540cSStefano Zampini   /* determine if a QR strategy is needed for change of basis */
1661a717540cSStefano Zampini   qr_needed = PETSC_FALSE;
1662a717540cSStefano Zampini   ierr = PetscBTCreate(pcbddc->local_primal_size,&qr_needed_idx);CHKERRQ(ierr);
1663a717540cSStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1664a717540cSStefano Zampini     if (PetscBTLookup(change_basis,i)) {
1665a717540cSStefano Zampini       size_of_constraint = temp_indices[i+1]-temp_indices[i];
1666a717540cSStefano Zampini       j = 0;
1667a717540cSStefano Zampini       for (k=0;k<size_of_constraint;k++) {
1668a717540cSStefano Zampini         if (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) {
1669a717540cSStefano Zampini           j++;
1670a717540cSStefano Zampini         }
1671a717540cSStefano Zampini       }
1672a717540cSStefano Zampini       /* found more than one primal dof on the cc */
1673a717540cSStefano Zampini       if (j > 1) {
1674a717540cSStefano Zampini         PetscBTSet(qr_needed_idx,i);
1675a717540cSStefano Zampini         qr_needed = PETSC_TRUE;
1676a717540cSStefano Zampini       }
1677a717540cSStefano Zampini     }
1678a717540cSStefano Zampini   }
1679984c4197SStefano Zampini   /* free workspace */
1680984c4197SStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
168145a1bb75SStefano Zampini 
1682674ae819SStefano Zampini   /* permute indices in order to have a sorted set of vertices */
1683a717540cSStefano Zampini   ierr = PetscSortInt(total_primal_vertices,aux_primal_numbering);CHKERRQ(ierr);
1684984c4197SStefano Zampini 
1685984c4197SStefano Zampini   /* nonzero structure of constraint matrix */
1686984c4197SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1687984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) nnz[i]=1;
1688984c4197SStefano Zampini   j=total_primal_vertices;
1689984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
16904641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1691674ae819SStefano Zampini       nnz[j]=temp_indices[i+1]-temp_indices[i];
1692674ae819SStefano Zampini       j++;
1693674ae819SStefano Zampini     }
1694674ae819SStefano Zampini   }
1695674ae819SStefano Zampini   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
1696674ae819SStefano Zampini   ierr = PetscFree(nnz);CHKERRQ(ierr);
1697674ae819SStefano Zampini   /* set values in constraint matrix */
1698984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) {
1699984c4197SStefano Zampini     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,aux_primal_numbering[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
1700674ae819SStefano Zampini   }
1701984c4197SStefano Zampini   total_counts = total_primal_vertices;
1702984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
17034641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
1704674ae819SStefano Zampini       size_of_constraint=temp_indices[i+1]-temp_indices[i];
1705674ae819SStefano 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);
1706674ae819SStefano Zampini       total_counts++;
1707674ae819SStefano Zampini     }
1708674ae819SStefano Zampini   }
1709674ae819SStefano Zampini   /* assembling */
1710674ae819SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1711674ae819SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1712984c4197SStefano Zampini   /*
171345a1bb75SStefano Zampini   ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
1714984c4197SStefano Zampini   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
1715984c4197SStefano Zampini   */
1716674ae819SStefano Zampini   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
1717674ae819SStefano Zampini   if (pcbddc->use_change_of_basis) {
1718026de310SStefano Zampini     /* dual and primal dofs on a single cc */
1719984c4197SStefano Zampini     PetscInt     dual_dofs,primal_dofs;
1720026de310SStefano Zampini     /* iterator on aux_primal_minloc (ordered as read from nearnullspace: vertices, edges and then constraints) */
1721026de310SStefano Zampini     PetscInt     primal_counter;
1722984c4197SStefano Zampini     /* working stuff for GEQRF */
1723984c4197SStefano Zampini     PetscScalar  *qr_basis,*qr_tau,*qr_work,lqr_work_t;
1724984c4197SStefano Zampini     PetscBLASInt lqr_work;
1725984c4197SStefano Zampini     /* working stuff for UNGQR */
1726984c4197SStefano Zampini     PetscScalar  *gqr_work,lgqr_work_t;
1727984c4197SStefano Zampini     PetscBLASInt lgqr_work;
1728984c4197SStefano Zampini     /* working stuff for TRTRS */
1729984c4197SStefano Zampini     PetscScalar  *trs_rhs;
17303f08241aSStefano Zampini     PetscBLASInt Blas_NRHS;
1731984c4197SStefano Zampini     /* pointers for values insertion into change of basis matrix */
1732984c4197SStefano Zampini     PetscInt     *start_rows,*start_cols;
1733984c4197SStefano Zampini     PetscScalar  *start_vals;
1734984c4197SStefano Zampini     /* working stuff for values insertion */
17354641a718SStefano Zampini     PetscBT      is_primal;
1736984c4197SStefano Zampini 
1737a717540cSStefano Zampini     /* change of basis acts on local interfaces -> dimension is n_B x n_B */
1738a717540cSStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
1739a717540cSStefano Zampini     ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr);
1740a717540cSStefano Zampini     ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr);
1741a717540cSStefano Zampini     /* work arrays */
1742a717540cSStefano Zampini     ierr = PetscMalloc(pcis->n_B*sizeof(PetscInt),&nnz);CHKERRQ(ierr);
1743a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) nnz[i]=1;
1744a717540cSStefano Zampini     /* nonzeros per row */
1745a717540cSStefano Zampini     for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
1746a717540cSStefano Zampini       if (PetscBTLookup(change_basis,i)) {
1747a717540cSStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
1748a717540cSStefano Zampini         if (PetscBTLookup(qr_needed_idx,i)) {
1749a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1750a717540cSStefano Zampini         } else {
1751a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = 2;
1752a717540cSStefano Zampini           /* get local primal index on the cc */
1753a717540cSStefano Zampini           j = 0;
1754a717540cSStefano Zampini           while (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+j])) j++;
1755a717540cSStefano Zampini           nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint;
1756a717540cSStefano Zampini         }
1757a717540cSStefano Zampini       }
1758a717540cSStefano Zampini     }
1759a717540cSStefano Zampini     ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
1760a717540cSStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
1761a717540cSStefano Zampini     /* Set initial identity in the matrix */
1762a717540cSStefano Zampini     for (i=0;i<pcis->n_B;i++) {
1763a717540cSStefano Zampini       ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
1764a717540cSStefano Zampini     }
1765a717540cSStefano Zampini 
1766a717540cSStefano Zampini     if (pcbddc->dbg_flag) {
1767a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1768a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
1769a717540cSStefano Zampini     }
1770a717540cSStefano Zampini 
1771a717540cSStefano Zampini 
1772a717540cSStefano Zampini     /* Now we loop on the constraints which need a change of basis */
1773a717540cSStefano Zampini     /*
1774a717540cSStefano Zampini        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
1775a717540cSStefano Zampini        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
1776a717540cSStefano Zampini 
1777a717540cSStefano Zampini        Basic blocks of change of basis matrix T computed
1778a717540cSStefano Zampini 
1779a717540cSStefano Zampini           - Using the following block transformation if there is only a primal dof on the cc
1780a717540cSStefano Zampini             (in the example, primal dof is the last one of the edge in LOCAL ordering
1781a717540cSStefano Zampini              in this code, primal dof is the first one of the edge in GLOBAL ordering)
1782a717540cSStefano Zampini             | 1        0   ...        0     1 |
1783a717540cSStefano Zampini             | 0        1   ...        0     1 |
1784a717540cSStefano Zampini             |              ...                |
1785a717540cSStefano Zampini             | 0        ...            1     1 |
1786a717540cSStefano Zampini             | -s_1/s_n ...    -s_{n-1}/-s_n 1 |
1787a717540cSStefano Zampini 
1788a717540cSStefano Zampini           - via QR decomposition of constraints otherwise
1789a717540cSStefano Zampini     */
1790a717540cSStefano Zampini     if (qr_needed) {
1791984c4197SStefano Zampini       /* space to store Q */
1792984c4197SStefano Zampini       ierr = PetscMalloc((max_size_of_constraint)*(max_size_of_constraint)*sizeof(PetscScalar),&qr_basis);CHKERRQ(ierr);
1793984c4197SStefano Zampini       /* first we issue queries for optimal work */
17943f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
17953f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
17963f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1797984c4197SStefano Zampini       lqr_work = -1;
17983f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
1799984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
1800984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
1801984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lqr_work_t)*sizeof(*qr_work),&qr_work);CHKERRQ(ierr);
1802984c4197SStefano Zampini       lgqr_work = -1;
18033f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
18043f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
18053f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
18063f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
18073f08241aSStefano Zampini       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
18083f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
1809984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
1810984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
1811984c4197SStefano Zampini       ierr = PetscMalloc((PetscInt)PetscRealPart(lgqr_work_t)*sizeof(*gqr_work),&gqr_work);CHKERRQ(ierr);
1812984c4197SStefano Zampini       /* array to store scaling factors for reflectors */
1813984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*sizeof(*qr_tau),&qr_tau);CHKERRQ(ierr);
1814984c4197SStefano Zampini       /* array to store rhs and solution of triangular solver */
1815984c4197SStefano Zampini       ierr = PetscMalloc(max_constraints*max_constraints*sizeof(*trs_rhs),&trs_rhs);CHKERRQ(ierr);
1816a717540cSStefano Zampini       /* allocating workspace for check */
1817a717540cSStefano Zampini       if (pcbddc->dbg_flag) {
1818a717540cSStefano Zampini         ierr = PetscMalloc(max_size_of_constraint*(max_constraints+max_size_of_constraint)*sizeof(*work),&work);CHKERRQ(ierr);
1819a717540cSStefano Zampini       }
1820a717540cSStefano Zampini     }
1821984c4197SStefano Zampini     /* array to store whether a node is primal or not */
18224641a718SStefano Zampini     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
18234641a718SStefano Zampini     for (i=0;i<total_primal_vertices;i++) {
18244641a718SStefano Zampini       ierr = PetscBTSet(is_primal,local_to_B[aux_primal_numbering[i]]);CHKERRQ(ierr);
18254641a718SStefano Zampini     }
1826984c4197SStefano Zampini 
1827a717540cSStefano Zampini     /* loop on constraints and see whether or not they need a change of basis and compute it */
1828026de310SStefano Zampini     /* -> using implicit ordering contained in temp_indices data */
1829026de310SStefano Zampini     total_counts = pcbddc->n_vertices;
1830026de310SStefano Zampini     primal_counter = total_counts;
1831026de310SStefano Zampini     while (total_counts<pcbddc->local_primal_size) {
1832026de310SStefano Zampini       primal_dofs = 1;
18334641a718SStefano Zampini       if (PetscBTLookup(change_basis,total_counts)) {
1834026de310SStefano Zampini         /* get all constraints with same support: if more then one constraint is present on the cc then surely indices are stored contiguosly */
1835026de310SStefano 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]]) {
1836026de310SStefano Zampini           primal_dofs++;
1837674ae819SStefano Zampini         }
1838984c4197SStefano Zampini         /* get constraint info */
1839026de310SStefano Zampini         size_of_constraint = temp_indices[total_counts+1]-temp_indices[total_counts];
1840984c4197SStefano Zampini         dual_dofs = size_of_constraint-primal_dofs;
1841984c4197SStefano Zampini 
1842984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
1843a717540cSStefano Zampini           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraints %d to %d (incl) need a change of basis (size %d)\n",total_counts,total_counts+primal_dofs-1,size_of_constraint);CHKERRQ(ierr);
1844674ae819SStefano Zampini         }
1845984c4197SStefano Zampini 
1846a717540cSStefano Zampini         if (primal_dofs > 1) { /* QR */
1847a717540cSStefano Zampini 
1848a717540cSStefano Zampini           /* copy quadrature constraints for change of basis check */
1849a717540cSStefano Zampini           if (pcbddc->dbg_flag) {
1850a717540cSStefano Zampini             ierr = PetscMemcpy(work,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1851a717540cSStefano Zampini           }
1852984c4197SStefano Zampini           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
1853026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1854984c4197SStefano Zampini 
1855984c4197SStefano Zampini           /* compute QR decomposition of constraints */
18563f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
18573f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
18583f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1859674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
18603f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
1861984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
1862674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1863984c4197SStefano Zampini 
1864984c4197SStefano Zampini           /* explictly compute R^-T */
1865984c4197SStefano Zampini           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
1866984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
18673f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
18683f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
18693f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
18703f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
1871984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
18723f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
1873984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
1874984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1875984c4197SStefano Zampini 
1876a717540cSStefano Zampini           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
18773f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
18783f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
18793f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
18803f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1881984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
18823f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
1883984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
1884984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1885984c4197SStefano Zampini 
1886984c4197SStefano Zampini           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
1887984c4197SStefano Zampini              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
1888984c4197SStefano Zampini              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
18893f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
18903f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
18913f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
18923f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
18933f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
18943f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
1895984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1896c4303822SStefano 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));
1897984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1898026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
1899984c4197SStefano Zampini 
1900984c4197SStefano Zampini           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
1901026de310SStefano Zampini           start_rows = &temp_indices_to_constraint_B[temp_indices[total_counts]];
1902984c4197SStefano Zampini           /* insert cols for primal dofs */
1903984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) {
1904984c4197SStefano Zampini             start_vals = &qr_basis[j*size_of_constraint];
1905026de310SStefano Zampini             start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter+j]];
1906984c4197SStefano Zampini             ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1907984c4197SStefano Zampini           }
1908984c4197SStefano Zampini           /* insert cols for dual dofs */
1909984c4197SStefano Zampini           for (j=0,k=0;j<dual_dofs;k++) {
19104641a718SStefano Zampini             if (!PetscBTLookup(is_primal,temp_indices_to_constraint_B[temp_indices[total_counts]+k])) {
1911984c4197SStefano Zampini               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
1912026de310SStefano Zampini               start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+k];
1913984c4197SStefano Zampini               ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
1914984c4197SStefano Zampini               j++;
1915674ae819SStefano Zampini             }
1916674ae819SStefano Zampini           }
1917984c4197SStefano Zampini 
1918984c4197SStefano Zampini           /* check change of basis */
1919984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
1920984c4197SStefano Zampini             PetscInt   ii,jj;
1921984c4197SStefano Zampini             PetscBool valid_qr=PETSC_TRUE;
1922c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
1923c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
1924c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
1925c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
1926c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
1927c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
1928984c4197SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1929c4303822SStefano 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));
1930984c4197SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
1931984c4197SStefano Zampini             for (jj=0;jj<size_of_constraint;jj++) {
1932984c4197SStefano Zampini               for (ii=0;ii<primal_dofs;ii++) {
1933984c4197SStefano Zampini                 if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
1934984c4197SStefano Zampini                 if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
1935674ae819SStefano Zampini               }
1936674ae819SStefano Zampini             }
1937984c4197SStefano Zampini             if (!valid_qr) {
1938984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
1939984c4197SStefano Zampini               for (jj=0;jj<size_of_constraint;jj++) {
1940984c4197SStefano Zampini                 for (ii=0;ii<primal_dofs;ii++) {
1941984c4197SStefano Zampini                   if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
1942984c4197SStefano 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]));
1943674ae819SStefano Zampini                   }
1944984c4197SStefano Zampini                   if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
1945984c4197SStefano 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]));
1946984c4197SStefano Zampini                   }
1947984c4197SStefano Zampini                 }
1948984c4197SStefano Zampini               }
1949674ae819SStefano Zampini             } else {
1950984c4197SStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n",PetscGlobalRank);CHKERRQ(ierr);
1951674ae819SStefano Zampini             }
1952674ae819SStefano Zampini           }
1953a717540cSStefano Zampini         } else { /* simple transformation block */
1954a717540cSStefano Zampini           PetscInt row,col;
1955a717540cSStefano Zampini           PetscScalar val;
1956a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) {
1957a717540cSStefano Zampini             row = temp_indices_to_constraint_B[temp_indices[total_counts]+j];
1958a717540cSStefano Zampini             if (!PetscBTLookup(is_primal,row)) {
1959a717540cSStefano Zampini               col = temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
1960a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
1961a717540cSStefano Zampini               ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,1.0,INSERT_VALUES);CHKERRQ(ierr);
1962a717540cSStefano Zampini             } else {
1963a717540cSStefano Zampini               for (k=0;k<size_of_constraint;k++) {
1964a717540cSStefano Zampini                 col = temp_indices_to_constraint_B[temp_indices[total_counts]+k];
1965a717540cSStefano Zampini                 if (row != col) {
1966a717540cSStefano Zampini                   val = -temp_quadrature_constraint[temp_indices[total_counts]+k]/temp_quadrature_constraint[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
1967a717540cSStefano Zampini                 } else {
1968a717540cSStefano Zampini                   val = 1.0;
1969a717540cSStefano Zampini                 }
1970a717540cSStefano Zampini                 ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
1971a717540cSStefano Zampini               }
1972a717540cSStefano Zampini             }
1973a717540cSStefano Zampini           }
1974a717540cSStefano Zampini         }
1975026de310SStefano Zampini         /* increment primal counter */
1976026de310SStefano Zampini         primal_counter += primal_dofs;
1977984c4197SStefano Zampini       } else {
1978984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
1979026de310SStefano 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);
1980674ae819SStefano Zampini         }
1981674ae819SStefano Zampini       }
1982026de310SStefano Zampini       /* increment constraint counter total_counts */
1983026de310SStefano Zampini       total_counts += primal_dofs;
1984674ae819SStefano Zampini     }
1985a717540cSStefano Zampini 
1986a717540cSStefano Zampini     /* free workspace */
1987a717540cSStefano Zampini     if (qr_needed) {
1988984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
1989984c4197SStefano Zampini         ierr = PetscFree(work);CHKERRQ(ierr);
1990984c4197SStefano Zampini       }
1991984c4197SStefano Zampini       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
1992984c4197SStefano Zampini       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
1993984c4197SStefano Zampini       ierr = PetscFree(qr_work);CHKERRQ(ierr);
1994984c4197SStefano Zampini       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
1995984c4197SStefano Zampini       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
1996674ae819SStefano Zampini     }
1997a717540cSStefano Zampini     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
1998674ae819SStefano Zampini     /* assembling */
1999674ae819SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2000674ae819SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2001984c4197SStefano Zampini     /*
200245a1bb75SStefano Zampini     ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
2003984c4197SStefano Zampini     ierr = MatView(pcbddc->ChangeOfBasisMatrix,(PetscViewer)0);CHKERRQ(ierr);
2004984c4197SStefano Zampini     */
2005674ae819SStefano Zampini   }
2006a717540cSStefano Zampini 
2007a717540cSStefano Zampini   /* flush dbg viewer */
2008b8ffe317SStefano Zampini   if (pcbddc->dbg_flag) {
2009b8ffe317SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2010b8ffe317SStefano Zampini   }
2011a717540cSStefano Zampini 
2012e310c8b4SStefano Zampini   /* free workspace */
2013a717540cSStefano Zampini   ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2014a717540cSStefano Zampini   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
2015984c4197SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2016984c4197SStefano Zampini   ierr = PetscFree(aux_primal_minloc);CHKERRQ(ierr);
2017674ae819SStefano Zampini   ierr = PetscFree(temp_indices);CHKERRQ(ierr);
20184641a718SStefano Zampini   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
2019674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr);
2020674ae819SStefano Zampini   ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
2021674ae819SStefano Zampini   ierr = PetscFree(local_to_B);CHKERRQ(ierr);
2022674ae819SStefano Zampini   ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr);
2023674ae819SStefano Zampini   PetscFunctionReturn(0);
2024674ae819SStefano Zampini }
2025674ae819SStefano Zampini 
2026674ae819SStefano Zampini #undef __FUNCT__
2027674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
2028674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
2029674ae819SStefano Zampini {
2030674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
2031674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
2032674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
2033674ae819SStefano Zampini   PetscInt    bs,ierr,i,vertex_size;
2034674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
2035674ae819SStefano Zampini 
2036674ae819SStefano Zampini   PetscFunctionBegin;
20378e61c736SStefano Zampini   /* Reset previously computed graph */
20388e61c736SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
2039674ae819SStefano Zampini   /* Init local Graph struct */
2040674ae819SStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr);
2041674ae819SStefano Zampini 
2042575ad6abSStefano Zampini   /* Check validity of the csr graph passed in by the user */
2043575ad6abSStefano Zampini   if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) {
2044575ad6abSStefano Zampini     ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
2045575ad6abSStefano Zampini   }
20469577ea80SStefano Zampini 
2047674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
2048674ae819SStefano Zampini   if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) {
2049674ae819SStefano Zampini     Mat mat_adj;
2050674ae819SStefano Zampini     const PetscInt *xadj,*adjncy;
2051674ae819SStefano Zampini     PetscBool flg_row=PETSC_TRUE;
2052674ae819SStefano Zampini 
2053674ae819SStefano Zampini     ierr = MatConvert(matis->A,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr);
2054674ae819SStefano Zampini     ierr = MatGetRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2055674ae819SStefano Zampini     if (!flg_row) {
2056674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ called in %s\n",__FUNCT__);
2057674ae819SStefano Zampini     }
2058674ae819SStefano Zampini     ierr = PCBDDCSetLocalAdjacencyGraph(pc,i,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
2059674ae819SStefano Zampini     ierr = MatRestoreRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2060674ae819SStefano Zampini     if (!flg_row) {
2061674ae819SStefano Zampini       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__);
2062674ae819SStefano Zampini     }
2063674ae819SStefano Zampini     ierr = MatDestroy(&mat_adj);CHKERRQ(ierr);
2064674ae819SStefano Zampini   }
2065674ae819SStefano Zampini 
2066674ae819SStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting */
2067674ae819SStefano Zampini   vertex_size = 1;
20689577ea80SStefano Zampini   if (!pcbddc->user_provided_isfordofs) {
2069674ae819SStefano Zampini     if (!pcbddc->n_ISForDofs) {
2070674ae819SStefano Zampini       IS *custom_ISForDofs;
2071674ae819SStefano Zampini 
2072674ae819SStefano Zampini       ierr = MatGetBlockSize(matis->A,&bs);CHKERRQ(ierr);
2073674ae819SStefano Zampini       ierr = PetscMalloc(bs*sizeof(IS),&custom_ISForDofs);CHKERRQ(ierr);
2074674ae819SStefano Zampini       for (i=0;i<bs;i++) {
2075674ae819SStefano Zampini         ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n/bs,i,bs,&custom_ISForDofs[i]);CHKERRQ(ierr);
2076674ae819SStefano Zampini       }
2077674ae819SStefano Zampini       ierr = PCBDDCSetDofsSplitting(pc,bs,custom_ISForDofs);CHKERRQ(ierr);
20789577ea80SStefano Zampini       pcbddc->user_provided_isfordofs = PETSC_FALSE;
2079674ae819SStefano Zampini       /* remove my references to IS objects */
2080674ae819SStefano Zampini       for (i=0;i<bs;i++) {
2081674ae819SStefano Zampini         ierr = ISDestroy(&custom_ISForDofs[i]);CHKERRQ(ierr);
2082674ae819SStefano Zampini       }
2083674ae819SStefano Zampini       ierr = PetscFree(custom_ISForDofs);CHKERRQ(ierr);
20849577ea80SStefano Zampini     }
20859577ea80SStefano Zampini   } else { /* mat block size as vertex size (used for elasticity with rigid body modes as nearnullspace) */
2086674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
2087674ae819SStefano Zampini   }
2088674ae819SStefano Zampini 
2089674ae819SStefano Zampini   /* Setup of Graph */
2090674ae819SStefano Zampini   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundaries,pcbddc->DirichletBoundaries,pcbddc->n_ISForDofs,pcbddc->ISForDofs,pcbddc->user_primal_vertices);
2091674ae819SStefano Zampini 
2092674ae819SStefano Zampini   /* Graph's connected components analysis */
2093674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
2094674ae819SStefano Zampini 
2095674ae819SStefano Zampini   /* print some info to stdout */
2096674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
2097e49050b4SStefano Zampini     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer);
2098674ae819SStefano Zampini   }
2099674ae819SStefano Zampini   PetscFunctionReturn(0);
2100674ae819SStefano Zampini }
2101674ae819SStefano Zampini 
2102674ae819SStefano Zampini #undef __FUNCT__
2103674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx"
2104f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt **vertices_idx)
2105674ae819SStefano Zampini {
2106674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2107674ae819SStefano Zampini   PetscInt       *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size;
2108674ae819SStefano Zampini   PetscErrorCode ierr;
2109674ae819SStefano Zampini 
2110674ae819SStefano Zampini   PetscFunctionBegin;
2111674ae819SStefano Zampini   n = 0;
2112674ae819SStefano Zampini   vertices = 0;
2113674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2114674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr);
2115b120a5c6SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2116b120a5c6SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2117b120a5c6SStefano Zampini       if (size_of_constraint == 1) n++;
2118b120a5c6SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2119b120a5c6SStefano Zampini     }
2120811e8ca2SStefano Zampini     if (vertices_idx) {
2121b120a5c6SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&vertices);CHKERRQ(ierr);
2122b120a5c6SStefano Zampini       n = 0;
2123674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2124674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2125674ae819SStefano Zampini         if (size_of_constraint == 1) {
2126674ae819SStefano Zampini           vertices[n++]=row_cmat_indices[0];
2127674ae819SStefano Zampini         }
2128674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2129674ae819SStefano Zampini       }
2130674ae819SStefano Zampini     }
2131811e8ca2SStefano Zampini   }
2132674ae819SStefano Zampini   *n_vertices = n;
2133811e8ca2SStefano Zampini   if (vertices_idx) *vertices_idx = vertices;
2134674ae819SStefano Zampini   PetscFunctionReturn(0);
2135674ae819SStefano Zampini }
2136674ae819SStefano Zampini 
2137674ae819SStefano Zampini #undef __FUNCT__
2138674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx"
2139f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt **constraints_idx)
2140674ae819SStefano Zampini {
2141674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
2142674ae819SStefano Zampini   PetscInt       *constraints_index,*row_cmat_indices,*row_cmat_global_indices;
2143674ae819SStefano Zampini   PetscInt       n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc;
21444641a718SStefano Zampini   PetscBT        touched;
2145674ae819SStefano Zampini   PetscErrorCode ierr;
2146674ae819SStefano Zampini 
2147f34684f1SStefano Zampini     /* This function assumes that the number of local constraints per connected component
2148f34684f1SStefano Zampini        is not greater than the number of nodes defined for the connected component
2149f34684f1SStefano Zampini        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
2150674ae819SStefano Zampini   PetscFunctionBegin;
2151674ae819SStefano Zampini   n = 0;
2152674ae819SStefano Zampini   constraints_index = 0;
2153674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
2154674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr);
2155674ae819SStefano Zampini     max_size_of_constraint = 0;
2156674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
2157674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2158674ae819SStefano Zampini       if (size_of_constraint > 1) {
2159674ae819SStefano Zampini         n++;
2160674ae819SStefano Zampini       }
2161674ae819SStefano Zampini       max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint);
2162674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
2163674ae819SStefano Zampini     }
2164811e8ca2SStefano Zampini     if (constraints_idx) {
2165674ae819SStefano Zampini       ierr = PetscMalloc(n*sizeof(PetscInt),&constraints_index);CHKERRQ(ierr);
2166674ae819SStefano Zampini       ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&row_cmat_global_indices);CHKERRQ(ierr);
21674641a718SStefano Zampini       ierr = PetscBTCreate(local_size,&touched);CHKERRQ(ierr);
2168674ae819SStefano Zampini       n = 0;
2169674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
2170674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2171674ae819SStefano Zampini         if (size_of_constraint > 1) {
2172674ae819SStefano Zampini           ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr);
217382d3d8afSStefano Zampini           /* find first untouched local node */
217482d3d8afSStefano Zampini           j = 0;
21754641a718SStefano Zampini           while (PetscBTLookup(touched,row_cmat_indices[j])) j++;
217682d3d8afSStefano Zampini           min_index = row_cmat_global_indices[j];
217782d3d8afSStefano Zampini           min_loc = j;
217882d3d8afSStefano Zampini           /* search the minimum among nodes not yet touched on the connected component
217982d3d8afSStefano Zampini              since there can be more than one constraint on a single cc */
2180674ae819SStefano Zampini           for (j=1;j<size_of_constraint;j++) {
21814641a718SStefano Zampini             if (!PetscBTLookup(touched,row_cmat_indices[j]) && min_index > row_cmat_global_indices[j]) {
2182674ae819SStefano Zampini               min_index = row_cmat_global_indices[j];
2183674ae819SStefano Zampini               min_loc = j;
2184674ae819SStefano Zampini             }
2185674ae819SStefano Zampini           }
21864641a718SStefano Zampini           ierr = PetscBTSet(touched,row_cmat_indices[min_loc]);CHKERRQ(ierr);
2187674ae819SStefano Zampini           constraints_index[n++] = row_cmat_indices[min_loc];
2188674ae819SStefano Zampini         }
2189674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
2190674ae819SStefano Zampini       }
21914641a718SStefano Zampini       ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2192674ae819SStefano Zampini       ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr);
2193811e8ca2SStefano Zampini     }
2194811e8ca2SStefano Zampini   }
2195674ae819SStefano Zampini   *n_constraints = n;
2196811e8ca2SStefano Zampini   if (constraints_idx) *constraints_idx = constraints_index;
2197674ae819SStefano Zampini   PetscFunctionReturn(0);
2198674ae819SStefano Zampini }
2199674ae819SStefano Zampini 
2200674ae819SStefano Zampini /* the next two functions has been adapted from pcis.c */
2201674ae819SStefano Zampini #undef __FUNCT__
2202674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchur"
2203674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchur(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2204674ae819SStefano Zampini {
2205674ae819SStefano Zampini   PetscErrorCode ierr;
2206674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2207674ae819SStefano Zampini 
2208674ae819SStefano Zampini   PetscFunctionBegin;
2209674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2210674ae819SStefano Zampini   ierr = MatMult(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2211674ae819SStefano Zampini   ierr = MatMult(pcis->A_IB,v,vec1_D);CHKERRQ(ierr);
2212674ae819SStefano Zampini   ierr = KSPSolve(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2213674ae819SStefano Zampini   ierr = MatMult(pcis->A_BI,vec2_D,vec2_B);CHKERRQ(ierr);
2214674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2215674ae819SStefano Zampini   PetscFunctionReturn(0);
2216674ae819SStefano Zampini }
2217674ae819SStefano Zampini 
2218674ae819SStefano Zampini #undef __FUNCT__
2219674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchurTranspose"
2220674ae819SStefano Zampini PetscErrorCode  PCBDDCApplySchurTranspose(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
2221674ae819SStefano Zampini {
2222674ae819SStefano Zampini   PetscErrorCode ierr;
2223674ae819SStefano Zampini   PC_IS          *pcis = (PC_IS*)(pc->data);
2224674ae819SStefano Zampini 
2225674ae819SStefano Zampini   PetscFunctionBegin;
2226674ae819SStefano Zampini   if (!vec2_B) { vec2_B = v; }
2227674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BB,v,vec1_B);CHKERRQ(ierr);
2228674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_BI,v,vec1_D);CHKERRQ(ierr);
2229674ae819SStefano Zampini   ierr = KSPSolveTranspose(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr);
2230674ae819SStefano Zampini   ierr = MatMultTranspose(pcis->A_IB,vec2_D,vec2_B);CHKERRQ(ierr);
2231674ae819SStefano Zampini   ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr);
2232674ae819SStefano Zampini   PetscFunctionReturn(0);
2233674ae819SStefano Zampini }
2234674ae819SStefano Zampini 
2235674ae819SStefano Zampini #undef __FUNCT__
2236674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
2237674ae819SStefano 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[])
2238674ae819SStefano Zampini {
2239674ae819SStefano Zampini   Vec            local_vec,global_vec;
2240674ae819SStefano Zampini   IS             seqis,paris;
2241674ae819SStefano Zampini   VecScatter     scatter_ctx;
2242674ae819SStefano Zampini   PetscScalar    *array;
2243674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
2244674ae819SStefano Zampini   PetscScalar    globalsum;
2245674ae819SStefano Zampini   PetscInt       i,j,s;
2246674ae819SStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local;
2247674ae819SStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm,max_global;
2248674ae819SStefano Zampini   PetscMPIInt    *dof_sizes,*dof_displs;
2249674ae819SStefano Zampini   PetscBool      first_found;
2250674ae819SStefano Zampini   PetscErrorCode ierr;
2251674ae819SStefano Zampini 
2252674ae819SStefano Zampini   PetscFunctionBegin;
2253674ae819SStefano Zampini   /* mpi buffers */
2254674ae819SStefano Zampini   MPI_Comm_size(comm,&size_prec_comm);
2255674ae819SStefano Zampini   MPI_Comm_rank(comm,&rank_prec_comm);
2256674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
2257674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_sizes),&dof_sizes);CHKERRQ(ierr);
2258674ae819SStefano Zampini   ierr = PetscMalloc(j*sizeof(*dof_displs),&dof_displs);CHKERRQ(ierr);
2259674ae819SStefano Zampini   /* get maximum size of subset */
2260674ae819SStefano Zampini   ierr = PetscMalloc(n_local_dofs*sizeof(PetscInt),&temp_global_dofs);CHKERRQ(ierr);
2261674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
2262674ae819SStefano Zampini   max_local = 0;
2263674ae819SStefano Zampini   if (n_local_dofs) {
2264674ae819SStefano Zampini     max_local = temp_global_dofs[0];
2265674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2266674ae819SStefano Zampini       if (max_local < temp_global_dofs[i] ) {
2267674ae819SStefano Zampini         max_local = temp_global_dofs[i];
2268674ae819SStefano Zampini       }
2269674ae819SStefano Zampini     }
2270674ae819SStefano Zampini   }
2271674ae819SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);
2272674ae819SStefano Zampini   max_global++;
2273674ae819SStefano Zampini   max_local = 0;
2274674ae819SStefano Zampini   if (n_local_dofs) {
2275674ae819SStefano Zampini     max_local = local_dofs[0];
2276674ae819SStefano Zampini     for (i=1;i<n_local_dofs;i++) {
2277674ae819SStefano Zampini       if (max_local < local_dofs[i] ) {
2278674ae819SStefano Zampini         max_local = local_dofs[i];
2279674ae819SStefano Zampini       }
2280674ae819SStefano Zampini     }
2281674ae819SStefano Zampini   }
2282674ae819SStefano Zampini   max_local++;
2283674ae819SStefano Zampini   /* allocate workspace */
2284674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
2285674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
2286674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
2287674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
2288674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
2289674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
2290674ae819SStefano Zampini   /* create scatter */
2291674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
2292674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
2293674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
2294674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
2295674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
2296674ae819SStefano Zampini   /* init array */
2297674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
2298674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2299674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2300674ae819SStefano Zampini   if (local_dofs_mult) {
2301674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2302674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
2303674ae819SStefano Zampini     }
2304674ae819SStefano Zampini   } else {
2305674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
2306674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
2307674ae819SStefano Zampini     }
2308674ae819SStefano Zampini   }
2309674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2310674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
2311674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2312674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2313674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
23145b08dc53SStefano Zampini   *n_global_subset = (PetscInt)PetscRealPart(globalsum);
2315674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
2316674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
2317674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
2318674ae819SStefano Zampini   nlocals = 0;
2319674ae819SStefano Zampini   first_index = -1;
2320674ae819SStefano Zampini   first_found = PETSC_FALSE;
2321674ae819SStefano Zampini   for (i=0;i<s;i++) {
23225b08dc53SStefano Zampini     if (!first_found && PetscRealPart(array[i]) > 0.0) {
2323674ae819SStefano Zampini       first_found = PETSC_TRUE;
2324674ae819SStefano Zampini       first_index = i;
2325674ae819SStefano Zampini     }
23265b08dc53SStefano Zampini     nlocals += (PetscInt)PetscRealPart(array[i]);
2327674ae819SStefano Zampini   }
2328674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2329674ae819SStefano Zampini   if (!rank_prec_comm) {
2330674ae819SStefano Zampini     dof_displs[0]=0;
2331674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
2332674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
2333674ae819SStefano Zampini     }
2334674ae819SStefano Zampini   }
2335674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
2336674ae819SStefano Zampini   if (first_found) {
2337674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
2338674ae819SStefano Zampini     old_index = first_index;
2339674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
23405b08dc53SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) {
2341674ae819SStefano Zampini         array[i] += array[old_index];
2342674ae819SStefano Zampini         old_index = i;
2343674ae819SStefano Zampini       }
2344674ae819SStefano Zampini     }
2345674ae819SStefano Zampini   }
2346674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
2347674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
2348674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2349674ae819SStefano Zampini   ierr = VecScatterEnd  (scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2350674ae819SStefano Zampini   /* get global ordering of local dofs */
2351674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
2352674ae819SStefano Zampini   if (local_dofs_mult) {
2353674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
23545b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i];
2355674ae819SStefano Zampini     }
2356674ae819SStefano Zampini   } else {
2357674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
23585b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1;
2359674ae819SStefano Zampini     }
2360674ae819SStefano Zampini   }
2361674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
2362674ae819SStefano Zampini   /* free workspace */
2363674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
2364674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
2365674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
2366674ae819SStefano Zampini   ierr = PetscFree(dof_sizes);CHKERRQ(ierr);
2367674ae819SStefano Zampini   ierr = PetscFree(dof_displs);CHKERRQ(ierr);
2368674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
2369674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
2370674ae819SStefano Zampini   PetscFunctionReturn(0);
2371674ae819SStefano Zampini }
23729a7d3425SStefano Zampini 
23739a7d3425SStefano Zampini #undef __FUNCT__
23749a7d3425SStefano Zampini #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
23759a7d3425SStefano Zampini PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
23769a7d3425SStefano Zampini {
23779a7d3425SStefano Zampini   PetscInt       i,j;
23789a7d3425SStefano Zampini   PetscScalar    *alphas;
23799a7d3425SStefano Zampini   PetscErrorCode ierr;
23809a7d3425SStefano Zampini 
23819a7d3425SStefano Zampini   PetscFunctionBegin;
23829a7d3425SStefano Zampini   /* this implements stabilized Gram-Schmidt */
23839a7d3425SStefano Zampini   ierr = PetscMalloc(n*sizeof(PetscScalar),&alphas);CHKERRQ(ierr);
23849a7d3425SStefano Zampini   for (i=0;i<n;i++) {
23859a7d3425SStefano Zampini     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
23869a7d3425SStefano Zampini     if (i<n) { ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],&alphas[i+1]);CHKERRQ(ierr); }
23879a7d3425SStefano Zampini     for (j=i+1;j<n;j++) { ierr = VecAXPY(vecs[j],PetscConj(-alphas[j]),vecs[i]);CHKERRQ(ierr); }
23889a7d3425SStefano Zampini   }
23899a7d3425SStefano Zampini   ierr = PetscFree(alphas);CHKERRQ(ierr);
23909a7d3425SStefano Zampini   PetscFunctionReturn(0);
23919a7d3425SStefano Zampini }
23929a7d3425SStefano Zampini 
2393a57a6d2fSStefano Zampini /* Currently support MAT_INITIAL_MATRIX only, with partial support to block matrices */
2394c8587f34SStefano Zampini #undef __FUNCT__
2395a57a6d2fSStefano Zampini #define __FUNCT__ "MatConvert_IS_AIJ"
2396a57a6d2fSStefano Zampini static PetscErrorCode MatConvert_IS_AIJ(Mat mat, MatType newtype,MatReuse reuse,Mat *M)
2397c8587f34SStefano Zampini {
2398a57a6d2fSStefano Zampini   Mat new_mat;
2399a57a6d2fSStefano Zampini   Mat_IS *matis = (Mat_IS*)(mat->data);
2400a57a6d2fSStefano Zampini   /* info on mat */
2401a57a6d2fSStefano Zampini   PetscInt bs,rows,cols;
2402a57a6d2fSStefano Zampini   PetscInt lrows,lcols;
2403a57a6d2fSStefano Zampini   PetscInt local_rows,local_cols;
2404e7931f94SStefano Zampini   PetscMPIInt nsubdomains;
2405c8587f34SStefano Zampini   /* preallocation */
2406c8587f34SStefano Zampini   Vec vec_dnz,vec_onz;
2407c8587f34SStefano Zampini   PetscScalar *my_dnz,*my_onz,*array;
2408a57a6d2fSStefano Zampini   PetscInt *dnz,*onz,*mat_ranges,*row_ownership;
2409a57a6d2fSStefano Zampini   PetscInt  index_row,index_col,owner;
2410a57a6d2fSStefano Zampini   PetscInt  *local_indices,*global_indices;
2411a57a6d2fSStefano Zampini   /* work */
2412a57a6d2fSStefano Zampini   PetscInt i,j;
2413a57a6d2fSStefano Zampini   PetscErrorCode ierr;
2414c8587f34SStefano Zampini 
2415a57a6d2fSStefano Zampini   PetscFunctionBegin;
2416a57a6d2fSStefano Zampini   /* CHECKS */
2417a57a6d2fSStefano Zampini   /* get info from mat */
2418a57a6d2fSStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
2419a57a6d2fSStefano Zampini   ierr = MatGetBlockSize(mat,&bs);CHKERRQ(ierr);
2420a57a6d2fSStefano Zampini   ierr = MatGetSize(matis->A,&local_rows,&local_cols);CHKERRQ(ierr);
2421a57a6d2fSStefano Zampini   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&nsubdomains);CHKERRQ(ierr);
2422a57a6d2fSStefano Zampini 
2423a57a6d2fSStefano Zampini   /* MAT_INITIAL_MATRIX */
2424a57a6d2fSStefano Zampini   ierr = MatCreate(PetscObjectComm((PetscObject)mat),&new_mat);CHKERRQ(ierr);
2425a57a6d2fSStefano Zampini   ierr = MatSetSizes(new_mat,PETSC_DECIDE,PETSC_DECIDE,rows,cols);CHKERRQ(ierr);
2426a57a6d2fSStefano Zampini   ierr = MatSetBlockSize(new_mat,bs);CHKERRQ(ierr);
2427a57a6d2fSStefano Zampini   ierr = MatSetType(new_mat,newtype);CHKERRQ(ierr);
2428a57a6d2fSStefano Zampini   ierr = MatSetUp(new_mat);CHKERRQ(ierr);
2429a57a6d2fSStefano Zampini   ierr = MatGetLocalSize(new_mat,&lrows,&lcols);CHKERRQ(ierr);
2430a57a6d2fSStefano Zampini 
2431a57a6d2fSStefano Zampini   /*
2432a57a6d2fSStefano Zampini     preallocation
2433a57a6d2fSStefano Zampini   */
2434a57a6d2fSStefano Zampini 
2435a57a6d2fSStefano Zampini   ierr = MatPreallocateInitialize(PetscObjectComm((PetscObject)new_mat),lrows,lcols,dnz,onz);CHKERRQ(ierr);
2436a57a6d2fSStefano Zampini   /*
2437a57a6d2fSStefano Zampini      Some vectors are needed to sum up properly on shared interface dofs.
2438a57a6d2fSStefano Zampini      Note that preallocation is not exact, since it overestimates nonzeros
2439a57a6d2fSStefano Zampini   */
2440a57a6d2fSStefano Zampini /*
2441a57a6d2fSStefano Zampini   ierr = VecCreate(PetscObjectComm((PetscObject)mat),&vec_dnz);CHKERRQ(ierr);
2442c8587f34SStefano Zampini   ierr = VecSetBlockSize(vec_dnz,bs);CHKERRQ(ierr);
2443a57a6d2fSStefano Zampini   ierr = VecSetSizes(vec_dnz,PETSC_DECIDE,rows);CHKERRQ(ierr);
2444a57a6d2fSStefano Zampini   ierr = VecSetType(vec_dnz,VECSTANDARD);CHKERRQ(ierr);
2445a57a6d2fSStefano Zampini */
2446a57a6d2fSStefano Zampini   ierr = MatGetVecs(new_mat,NULL,&vec_dnz);CHKERRQ(ierr);
2447c8587f34SStefano Zampini   ierr = VecDuplicate(vec_dnz,&vec_onz);CHKERRQ(ierr);
2448e7931f94SStefano Zampini   /* All processes need to compute entire row ownership */
2449a57a6d2fSStefano Zampini   ierr = PetscMalloc(rows*sizeof(*row_ownership),&row_ownership);CHKERRQ(ierr);
2450a57a6d2fSStefano Zampini   ierr = MatGetOwnershipRanges(new_mat,(const PetscInt**)&mat_ranges);CHKERRQ(ierr);
2451a57a6d2fSStefano Zampini   for (i=0;i<nsubdomains;i++) {
2452c8587f34SStefano Zampini     for (j=mat_ranges[i];j<mat_ranges[i+1];j++) {
2453c8587f34SStefano Zampini       row_ownership[j]=i;
2454c8587f34SStefano Zampini     }
2455c8587f34SStefano Zampini   }
2456a57a6d2fSStefano Zampini   /* map indices of local mat to global values */
2457a57a6d2fSStefano Zampini   ierr = PetscMalloc(PetscMax(local_cols,local_rows)*sizeof(*global_indices),&global_indices);CHKERRQ(ierr);
2458a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*local_indices),&local_indices);CHKERRQ(ierr);
2459a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) local_indices[i]=i;
2460a57a6d2fSStefano Zampini   ierr = ISLocalToGlobalMappingApply(matis->mapping,local_rows,local_indices,global_indices);CHKERRQ(ierr);
2461a57a6d2fSStefano Zampini   ierr = PetscFree(local_indices);CHKERRQ(ierr);
2462c8587f34SStefano Zampini 
2463e7931f94SStefano Zampini   /*
2464e7931f94SStefano Zampini      my_dnz and my_onz contains exact contribution to preallocation from each local mat
2465e7931f94SStefano Zampini      then, they will be summed up properly. This way, preallocation is always sufficient
2466e7931f94SStefano Zampini   */
2467a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*my_dnz),&my_dnz);CHKERRQ(ierr);
2468a57a6d2fSStefano Zampini   ierr = PetscMalloc(local_rows*sizeof(*my_onz),&my_onz);CHKERRQ(ierr);
2469a57a6d2fSStefano Zampini   ierr = PetscMemzero(my_dnz,local_rows*sizeof(*my_dnz));CHKERRQ(ierr);
2470a57a6d2fSStefano Zampini   ierr = PetscMemzero(my_onz,local_rows*sizeof(*my_onz));CHKERRQ(ierr);
2471a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) {
2472a57a6d2fSStefano Zampini     index_row = global_indices[i];
2473a57a6d2fSStefano Zampini     for (j=i;j<local_rows;j++) {
2474a57a6d2fSStefano Zampini       owner = row_ownership[index_row];
2475a57a6d2fSStefano Zampini       index_col = global_indices[j];
2476a57a6d2fSStefano Zampini       if (index_col > mat_ranges[owner]-1 && index_col < mat_ranges[owner+1] ) { /* diag block */
2477c8587f34SStefano Zampini         my_dnz[i] += 1.0;
2478a57a6d2fSStefano Zampini       } else { /* offdiag block */
2479c8587f34SStefano Zampini         my_onz[i] += 1.0;
2480c8587f34SStefano Zampini       }
2481a57a6d2fSStefano Zampini       /* same as before, interchanging rows and cols */
2482c8587f34SStefano Zampini       if (i != j) {
2483a57a6d2fSStefano Zampini         owner = row_ownership[index_col];
2484a57a6d2fSStefano Zampini         if (index_row > mat_ranges[owner]-1 && index_row < mat_ranges[owner+1] ) {
2485c8587f34SStefano Zampini           my_dnz[j] += 1.0;
2486c8587f34SStefano Zampini         } else {
2487c8587f34SStefano Zampini           my_onz[j] += 1.0;
2488c8587f34SStefano Zampini         }
2489c8587f34SStefano Zampini       }
2490c8587f34SStefano Zampini     }
2491c8587f34SStefano Zampini   }
2492c8587f34SStefano Zampini   ierr = VecSet(vec_dnz,0.0);CHKERRQ(ierr);
2493c8587f34SStefano Zampini   ierr = VecSet(vec_onz,0.0);CHKERRQ(ierr);
249420a2ab83SStefano Zampini   if (local_rows) { /* multilevel guard */
2495a57a6d2fSStefano Zampini     ierr = VecSetValues(vec_dnz,local_rows,global_indices,my_dnz,ADD_VALUES);CHKERRQ(ierr);
2496a57a6d2fSStefano Zampini     ierr = VecSetValues(vec_onz,local_rows,global_indices,my_onz,ADD_VALUES);CHKERRQ(ierr);
2497c8587f34SStefano Zampini   }
2498c8587f34SStefano Zampini   ierr = VecAssemblyBegin(vec_dnz);CHKERRQ(ierr);
2499c8587f34SStefano Zampini   ierr = VecAssemblyBegin(vec_onz);CHKERRQ(ierr);
2500c8587f34SStefano Zampini   ierr = VecAssemblyEnd(vec_dnz);CHKERRQ(ierr);
2501c8587f34SStefano Zampini   ierr = VecAssemblyEnd(vec_onz);CHKERRQ(ierr);
2502c8587f34SStefano Zampini   ierr = PetscFree(my_dnz);CHKERRQ(ierr);
2503c8587f34SStefano Zampini   ierr = PetscFree(my_onz);CHKERRQ(ierr);
2504c8587f34SStefano Zampini   ierr = PetscFree(row_ownership);CHKERRQ(ierr);
2505a57a6d2fSStefano Zampini 
2506a57a6d2fSStefano Zampini   /* set computed preallocation in dnz and onz */
2507a57a6d2fSStefano Zampini   ierr = VecGetArray(vec_dnz,&array);CHKERRQ(ierr);
2508a57a6d2fSStefano Zampini   for (i=0; i<lrows; i++) dnz[i] = (PetscInt)PetscRealPart(array[i]);
2509a57a6d2fSStefano Zampini   ierr = VecRestoreArray(vec_dnz,&array);CHKERRQ(ierr);
2510a57a6d2fSStefano Zampini   ierr = VecGetArray(vec_onz,&array);CHKERRQ(ierr);
2511a57a6d2fSStefano Zampini   for (i=0;i<lrows;i++) onz[i] = (PetscInt)PetscRealPart(array[i]);
2512a57a6d2fSStefano Zampini   ierr = VecRestoreArray(vec_onz,&array);CHKERRQ(ierr);
2513c8587f34SStefano Zampini   ierr = VecDestroy(&vec_dnz);CHKERRQ(ierr);
2514c8587f34SStefano Zampini   ierr = VecDestroy(&vec_onz);CHKERRQ(ierr);
2515c8587f34SStefano Zampini 
2516e7931f94SStefano Zampini   /* Resize preallocation if overestimated */
2517c8587f34SStefano Zampini   for (i=0;i<lrows;i++) {
2518a57a6d2fSStefano Zampini     dnz[i] = PetscMin(dnz[i],lcols);
2519a57a6d2fSStefano Zampini     onz[i] = PetscMin(onz[i],cols-lcols);
2520c8587f34SStefano Zampini   }
2521a57a6d2fSStefano Zampini   ierr = MatMPIAIJSetPreallocation(new_mat,0,dnz,0,onz);CHKERRQ(ierr);
2522c8587f34SStefano Zampini   ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
2523a57a6d2fSStefano Zampini 
2524a57a6d2fSStefano Zampini   /*
2525e7931f94SStefano Zampini     Set values. Very Basic.
2526a57a6d2fSStefano Zampini   */
2527a57a6d2fSStefano Zampini   for (i=0;i<local_rows;i++) {
2528a57a6d2fSStefano Zampini     ierr = MatGetRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2529a57a6d2fSStefano Zampini     ierr = ISLocalToGlobalMappingApply(matis->mapping,j,local_indices,global_indices);CHKERRQ(ierr);
2530a57a6d2fSStefano Zampini     ierr = ISLocalToGlobalMappingApply(matis->mapping,1,&i,&index_row);CHKERRQ(ierr);
2531a57a6d2fSStefano Zampini     ierr = MatSetValues(new_mat,1,&index_row,j,global_indices,array,ADD_VALUES);CHKERRQ(ierr);
2532a57a6d2fSStefano Zampini     ierr = MatRestoreRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr);
2533a57a6d2fSStefano Zampini   }
253420a2ab83SStefano Zampini   ierr = MatAssemblyBegin(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2535a57a6d2fSStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
253620a2ab83SStefano Zampini   ierr = MatAssemblyEnd(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2537a57a6d2fSStefano Zampini 
2538a57a6d2fSStefano Zampini   /* get back mat */
2539a57a6d2fSStefano Zampini   *M = new_mat;
2540a57a6d2fSStefano Zampini   PetscFunctionReturn(0);
2541a57a6d2fSStefano Zampini }
2542a57a6d2fSStefano Zampini 
2543e7931f94SStefano Zampini #undef __FUNCT__
2544e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble_Private"
2545e7931f94SStefano Zampini PetscErrorCode MatISSubassemble_Private(Mat mat, PetscInt coarsening_ratio, IS* is_sends)
2546e7931f94SStefano Zampini {
2547e7931f94SStefano Zampini   Mat             subdomain_adj;
2548e7931f94SStefano Zampini   IS              new_ranks,ranks_send_to;
2549e7931f94SStefano Zampini   MatPartitioning partitioner;
2550e7931f94SStefano Zampini   Mat_IS          *matis;
2551e7931f94SStefano Zampini   PetscInt        n_neighs,*neighs,*n_shared,**shared;
2552e7931f94SStefano Zampini   PetscInt        prank;
2553e7931f94SStefano Zampini   PetscMPIInt     size,rank,color;
2554e7931f94SStefano Zampini   PetscInt        *xadj,*adjncy,*oldranks;
2555e7931f94SStefano Zampini   PetscInt        *adjncy_wgt,*v_wgt,*is_indices,*ranks_send_to_idx;
2556e7931f94SStefano Zampini   PetscInt        i,j,n_subdomains,local_size,threshold=0;
2557e7931f94SStefano Zampini   PetscErrorCode  ierr;
25582b510759SStefano Zampini   PetscBool       use_vwgt=PETSC_FALSE,use_square=PETSC_FALSE;
2559e7931f94SStefano Zampini   PetscSubcomm    subcomm;
2560a57a6d2fSStefano Zampini 
2561e7931f94SStefano Zampini   PetscFunctionBegin;
25622b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_square",&use_square,NULL);CHKERRQ(ierr);
25632b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
25642b510759SStefano Zampini   ierr = PetscOptionsGetInt(NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
2565e7931f94SStefano Zampini 
2566e7931f94SStefano Zampini   /* Get info on mapping */
2567e7931f94SStefano Zampini   matis = (Mat_IS*)(mat->data);
2568e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&local_size);CHKERRQ(ierr);
2569e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2570e7931f94SStefano Zampini 
2571e7931f94SStefano Zampini   /* build local CSR graph of subdomains' connectivity */
2572e7931f94SStefano Zampini   ierr = PetscMalloc(2*sizeof(*xadj),&xadj);CHKERRQ(ierr);
2573e7931f94SStefano Zampini   xadj[0] = 0;
2574e7931f94SStefano Zampini   xadj[1] = PetscMax(n_neighs-1,0);
2575e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy),&adjncy);CHKERRQ(ierr);
2576e7931f94SStefano Zampini   ierr = PetscMalloc(xadj[1]*sizeof(*adjncy_wgt),&adjncy_wgt);CHKERRQ(ierr);
2577e7931f94SStefano Zampini 
25782b510759SStefano Zampini   if (threshold) {
25792b510759SStefano Zampini     PetscInt* count,min_threshold;
2580e7931f94SStefano Zampini     ierr = PetscMalloc(local_size*sizeof(PetscInt),&count);CHKERRQ(ierr);
2581e7931f94SStefano Zampini     ierr = PetscMemzero(count,local_size*sizeof(PetscInt));CHKERRQ(ierr);
2582e7931f94SStefano Zampini     for (i=1;i<n_neighs;i++) {/* i=1 so I don't count myself -> faces nodes counts to 1 */
2583e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2584e7931f94SStefano Zampini         count[shared[i][j]] += 1;
2585e7931f94SStefano Zampini       }
2586e7931f94SStefano Zampini     }
25872b510759SStefano Zampini     /* adapt threshold since we dont want to lose significant connections */
25882b510759SStefano Zampini     min_threshold = n_neighs;
25892b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
25902b510759SStefano Zampini       for (j=0;j<n_shared[i];j++) {
25912b510759SStefano Zampini         min_threshold = PetscMin(count[shared[i][j]],min_threshold);
25922b510759SStefano Zampini       }
25932b510759SStefano Zampini     }
25942b510759SStefano Zampini     PetscPrintf(PETSC_COMM_SELF,"PASSED THRESHOLD %d\n",threshold);
25952b510759SStefano Zampini     threshold = PetscMax(min_threshold+1,threshold);
25962b510759SStefano Zampini     PetscPrintf(PETSC_COMM_SELF,"USING THRESHOLD %d (min %d)\n",threshold,min_threshold);
2597e7931f94SStefano Zampini     xadj[1] = 0;
25982b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
2599e7931f94SStefano Zampini       for (j=0;j<n_shared[i];j++) {
2600e7931f94SStefano Zampini         if (count[shared[i][j]] < threshold) {
2601e7931f94SStefano Zampini           adjncy[xadj[1]] = neighs[i];
2602e7931f94SStefano Zampini           adjncy_wgt[xadj[1]] = n_shared[i];
2603e7931f94SStefano Zampini           xadj[1]++;
2604e7931f94SStefano Zampini           break;
2605e7931f94SStefano Zampini         }
2606e7931f94SStefano Zampini       }
2607e7931f94SStefano Zampini     }
2608e7931f94SStefano Zampini     ierr = PetscFree(count);CHKERRQ(ierr);
2609c8587f34SStefano Zampini   } else {
2610e7931f94SStefano Zampini     if (xadj[1]) {
2611e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy,&neighs[1],xadj[1]*sizeof(*adjncy));CHKERRQ(ierr);
2612e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy_wgt,&n_shared[1],xadj[1]*sizeof(*adjncy_wgt));CHKERRQ(ierr);
2613c8587f34SStefano Zampini     }
2614e7931f94SStefano Zampini   }
2615e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingRestoreInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
2616e7931f94SStefano Zampini   if (use_square) {
2617e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2618e7931f94SStefano Zampini       adjncy_wgt[i] = adjncy_wgt[i]*adjncy_wgt[i];
2619e7931f94SStefano Zampini     }
2620e7931f94SStefano Zampini   }
2621e7931f94SStefano Zampini   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2622e7931f94SStefano Zampini 
2623e7931f94SStefano Zampini   ierr = PetscMalloc(sizeof(PetscInt),&ranks_send_to_idx);CHKERRQ(ierr);
2624e7931f94SStefano Zampini 
2625e7931f94SStefano Zampini   /*
2626e7931f94SStefano Zampini     Restrict work on active processes only.
2627e7931f94SStefano Zampini   */
2628e7931f94SStefano Zampini   ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&subcomm);CHKERRQ(ierr);
2629e7931f94SStefano Zampini   ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
2630e7931f94SStefano Zampini   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
26312b510759SStefano Zampini   ierr = PetscMPIIntCast(!local_size,&color);CHKERRQ(ierr);
2632d3531aaaSJed Brown   ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
2633e7931f94SStefano Zampini   if (color) {
2634e7931f94SStefano Zampini     ierr = PetscFree(xadj);CHKERRQ(ierr);
2635e7931f94SStefano Zampini     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2636e7931f94SStefano Zampini     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
2637c8587f34SStefano Zampini   } else {
2638e7931f94SStefano Zampini     ierr = MPI_Comm_size(subcomm->comm,&size);CHKERRQ(ierr);
2639e7931f94SStefano Zampini     ierr = PetscMalloc(size*sizeof(*oldranks),&oldranks);CHKERRQ(ierr);
2640e7931f94SStefano Zampini     prank = rank;
2641e7931f94SStefano Zampini     ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm->comm);CHKERRQ(ierr);
2642e7931f94SStefano Zampini     for (i=0;i<size;i++) {
2643e7931f94SStefano Zampini       PetscPrintf(subcomm->comm,"oldranks[%d] = %d\n",i,oldranks[i]);
2644c8587f34SStefano Zampini     }
2645e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
2646e7931f94SStefano Zampini       ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
2647c8587f34SStefano Zampini     }
2648e7931f94SStefano Zampini     ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
2649e7931f94SStefano Zampini     ierr = MatCreateMPIAdj(subcomm->comm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
2650e7931f94SStefano Zampini     n_subdomains = (PetscInt)size;
2651e7931f94SStefano Zampini     ierr = MatView(subdomain_adj,0);CHKERRQ(ierr);
2652e7931f94SStefano Zampini 
2653e7931f94SStefano Zampini     /* Partition */
2654e7931f94SStefano Zampini     ierr = MatPartitioningCreate(subcomm->comm,&partitioner);CHKERRQ(ierr);
2655e7931f94SStefano Zampini     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
2656e7931f94SStefano Zampini     if (use_vwgt) {
2657e7931f94SStefano Zampini       ierr = PetscMalloc(sizeof(*v_wgt),&v_wgt);CHKERRQ(ierr);
2658e7931f94SStefano Zampini       v_wgt[0] = local_size;
2659e7931f94SStefano Zampini       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
2660c8587f34SStefano Zampini     }
2661e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)partitioner),"NPARTS %d\n",n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2662e7931f94SStefano Zampini     ierr = MatPartitioningSetNParts(partitioner,n_subdomains/coarsening_ratio);CHKERRQ(ierr);
2663e7931f94SStefano Zampini     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
2664e7931f94SStefano Zampini     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
2665e7931f94SStefano Zampini     ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr);
2666e7931f94SStefano Zampini 
2667e7931f94SStefano Zampini     ierr = ISGetIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2668e7931f94SStefano Zampini     ranks_send_to_idx[0] = oldranks[is_indices[0]];
2669e7931f94SStefano Zampini     ierr = ISRestoreIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2670e7931f94SStefano Zampini     /* clean up */
2671e7931f94SStefano Zampini     ierr = PetscFree(oldranks);CHKERRQ(ierr);
2672e7931f94SStefano Zampini     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
2673e7931f94SStefano Zampini     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
2674e7931f94SStefano Zampini     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
2675e7931f94SStefano Zampini   }
2676e7931f94SStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
2677e7931f94SStefano Zampini 
2678e7931f94SStefano Zampini   /* assemble parallel IS for sends */
2679e7931f94SStefano Zampini   i = 1;
2680e7931f94SStefano Zampini   if (color) i=0;
2681e7931f94SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,&ranks_send_to);CHKERRQ(ierr);
2682e7931f94SStefano Zampini   ierr = ISView(ranks_send_to,0);CHKERRQ(ierr);
2683e7931f94SStefano Zampini 
2684e7931f94SStefano Zampini   /* get back IS */
2685e7931f94SStefano Zampini   *is_sends = ranks_send_to;
2686e7931f94SStefano Zampini   PetscFunctionReturn(0);
2687e7931f94SStefano Zampini }
2688e7931f94SStefano Zampini 
2689e7931f94SStefano Zampini typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
2690e7931f94SStefano Zampini 
2691e7931f94SStefano Zampini #undef __FUNCT__
2692e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble"
2693e7931f94SStefano Zampini PetscErrorCode MatISSubassemble(Mat mat, IS is_sends, PetscInt coarsening_ratio, Mat *mat_n)
2694e7931f94SStefano Zampini {
2695e7931f94SStefano Zampini   Mat                    local_mat,new_mat;
2696e7931f94SStefano Zampini   Mat_IS                 *matis;
2697e7931f94SStefano Zampini   IS                     is_sends_internal;
2698e7931f94SStefano Zampini   PetscInt               rows,cols;
2699e7931f94SStefano Zampini   PetscInt               i,bs,buf_size_idxs,buf_size_vals;
2700e7931f94SStefano Zampini   PetscBool              ismatis,isdense;
2701e7931f94SStefano Zampini   ISLocalToGlobalMapping l2gmap;
2702e7931f94SStefano Zampini   PetscInt*              l2gmap_indices;
2703e7931f94SStefano Zampini   const PetscInt*        is_indices;
2704e7931f94SStefano Zampini   MatType                new_local_type;
2705e7931f94SStefano Zampini   MatTypePrivate         new_local_type_private;
2706e7931f94SStefano Zampini   /* buffers */
2707e7931f94SStefano Zampini   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
2708e7931f94SStefano Zampini   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
2709e7931f94SStefano Zampini   /* MPI */
2710e7931f94SStefano Zampini   MPI_Comm               comm;
2711e7931f94SStefano Zampini   PetscMPIInt            n_sends,n_recvs,commsize;
2712e7931f94SStefano Zampini   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals;
2713e7931f94SStefano Zampini   PetscMPIInt            *onodes,*olengths_idxs,*olengths_vals;
2714e7931f94SStefano Zampini   PetscMPIInt            len,tag_idxs,tag_vals,source_dest;
2715e7931f94SStefano Zampini   MPI_Request            *send_req_idxs,*send_req_vals,*recv_req_idxs,*recv_req_vals;
2716e7931f94SStefano Zampini   PetscErrorCode         ierr;
2717e7931f94SStefano Zampini 
2718e7931f94SStefano Zampini   PetscFunctionBegin;
2719e7931f94SStefano Zampini   /* checks */
2720e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
2721e7931f94SStefano Zampini   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on an matrix object which is not of type MATIS",__FUNCT__);
2722e7931f94SStefano Zampini   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2723e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
2724e7931f94SStefano Zampini   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
2725e7931f94SStefano Zampini   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
2726e7931f94SStefano Zampini   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
2727e7931f94SStefano Zampini   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
2728e7931f94SStefano Zampini   PetscValidLogicalCollectiveInt(mat,bs,0);
2729e7931f94SStefano Zampini   /* prepare IS for sending if not provided */
2730e7931f94SStefano Zampini   if (!is_sends) {
2731e7931f94SStefano Zampini     if (!coarsening_ratio) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a coarsening ratio");
2732e7931f94SStefano Zampini     ierr = MatISSubassemble_Private(mat,coarsening_ratio,&is_sends_internal);CHKERRQ(ierr);
2733c8587f34SStefano Zampini   } else {
2734e7931f94SStefano Zampini     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
2735e7931f94SStefano Zampini     is_sends_internal = is_sends;
2736c8587f34SStefano Zampini   }
2737e7931f94SStefano Zampini 
2738e7931f94SStefano Zampini   /* get pointer of MATIS data */
2739e7931f94SStefano Zampini   matis = (Mat_IS*)mat->data;
2740e7931f94SStefano Zampini 
2741e7931f94SStefano Zampini   /* get comm */
2742e7931f94SStefano Zampini   comm = PetscObjectComm((PetscObject)mat);
2743e7931f94SStefano Zampini 
2744e7931f94SStefano Zampini   /* compute number of sends */
2745e7931f94SStefano Zampini   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
2746e7931f94SStefano Zampini   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
2747e7931f94SStefano Zampini 
2748e7931f94SStefano Zampini   /* compute number of receives */
2749e7931f94SStefano Zampini   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
2750e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*iflags),&iflags);CHKERRQ(ierr);
2751e7931f94SStefano Zampini   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
2752e7931f94SStefano Zampini   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2753e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
2754e7931f94SStefano Zampini   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
2755e7931f94SStefano Zampini   ierr = PetscFree(iflags);CHKERRQ(ierr);
2756e7931f94SStefano Zampini 
2757e7931f94SStefano Zampini   /* prepare send/receive buffers */
2758e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_idxs),&ilengths_idxs);CHKERRQ(ierr);
2759e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
2760e7931f94SStefano Zampini   ierr = PetscMalloc(commsize*sizeof(*ilengths_vals),&ilengths_vals);CHKERRQ(ierr);
2761e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
2762e7931f94SStefano Zampini 
2763e7931f94SStefano Zampini   /* Get data from local mat */
2764e7931f94SStefano Zampini   if (!isdense) {
2765e7931f94SStefano Zampini     /* TODO: See below some guidelines on how to prepare the local buffers */
2766e7931f94SStefano Zampini     /*
2767e7931f94SStefano Zampini        send_buffer_vals should contain the raw values of the local matrix
2768e7931f94SStefano Zampini        send_buffer_idxs should contain:
2769e7931f94SStefano Zampini        - MatType_PRIVATE type
2770e7931f94SStefano Zampini        - PetscInt        size_of_l2gmap
2771e7931f94SStefano Zampini        - PetscInt        global_row_indices[size_of_l2gmap]
2772e7931f94SStefano Zampini        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
2773e7931f94SStefano Zampini     */
2774e7931f94SStefano Zampini   } else {
2775e7931f94SStefano Zampini     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
2776e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&i);CHKERRQ(ierr);
2777e7931f94SStefano Zampini     ierr = PetscMalloc((i+2)*sizeof(PetscInt),&send_buffer_idxs);CHKERRQ(ierr);
2778e7931f94SStefano Zampini     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
2779e7931f94SStefano Zampini     send_buffer_idxs[1] = i;
2780e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2781e7931f94SStefano Zampini     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
2782e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingRestoreIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
2783e7931f94SStefano Zampini     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
2784e7931f94SStefano Zampini     for (i=0;i<n_sends;i++) {
2785e7931f94SStefano Zampini       ilengths_vals[is_indices[i]] = len*len;
2786e7931f94SStefano Zampini       ilengths_idxs[is_indices[i]] = len+2;
2787c8587f34SStefano Zampini     }
2788c8587f34SStefano Zampini   }
2789e7931f94SStefano Zampini   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
2790e7931f94SStefano Zampini   buf_size_idxs = 0;
2791e7931f94SStefano Zampini   buf_size_vals = 0;
2792e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2793e7931f94SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
2794e7931f94SStefano Zampini     buf_size_vals += (PetscInt)olengths_vals[i];
2795e7931f94SStefano Zampini   }
2796e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&recv_buffer_idxs);CHKERRQ(ierr);
2797e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_vals*sizeof(PetscScalar),&recv_buffer_vals);CHKERRQ(ierr);
2798e7931f94SStefano Zampini 
2799e7931f94SStefano Zampini   /* get new tags for clean communications */
2800e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
2801e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
2802e7931f94SStefano Zampini 
2803e7931f94SStefano Zampini   /* allocate for requests */
2804e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_idxs);CHKERRQ(ierr);
2805e7931f94SStefano Zampini   ierr = PetscMalloc(n_sends*sizeof(MPI_Request),&send_req_vals);CHKERRQ(ierr);
2806e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_idxs);CHKERRQ(ierr);
2807e7931f94SStefano Zampini   ierr = PetscMalloc(n_recvs*sizeof(MPI_Request),&recv_req_vals);CHKERRQ(ierr);
2808e7931f94SStefano Zampini 
2809e7931f94SStefano Zampini   /* communications */
2810e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2811e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
2812e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2813e7931f94SStefano Zampini     source_dest = onodes[i];
2814e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
2815e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
2816e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2817e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
2818e7931f94SStefano Zampini   }
2819e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) {
2820e7931f94SStefano Zampini     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
2821e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
2822e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
2823e7931f94SStefano Zampini   }
2824e7931f94SStefano Zampini   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
2825e7931f94SStefano Zampini   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
2826e7931f94SStefano Zampini 
2827e7931f94SStefano Zampini   /* assemble new l2g map */
2828e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2829e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2830e7931f94SStefano Zampini   buf_size_idxs = 0;
2831e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2832e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
2833e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2834e7931f94SStefano Zampini   }
2835e7931f94SStefano Zampini   ierr = PetscMalloc(buf_size_idxs*sizeof(PetscInt),&l2gmap_indices);CHKERRQ(ierr);
2836e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2837e7931f94SStefano Zampini   buf_size_idxs = 0;
2838e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2839e7931f94SStefano Zampini     ierr = PetscMemcpy(&l2gmap_indices[buf_size_idxs],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
2840e7931f94SStefano Zampini     buf_size_idxs += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
2841e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2842e7931f94SStefano Zampini   }
2843e7931f94SStefano Zampini   ierr = PetscSortRemoveDupsInt(&buf_size_idxs,l2gmap_indices);CHKERRQ(ierr);
2844e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingCreate(comm,buf_size_idxs,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
2845e7931f94SStefano Zampini   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
2846e7931f94SStefano Zampini 
2847e7931f94SStefano Zampini   /* infer new local matrix type from received local matrices type */
2848e7931f94SStefano Zampini   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
2849e7931f94SStefano Zampini   /* it also assumes that if the block size is set, than it is the same among all local matrices (see checks at the beginning of the function) */
2850e7931f94SStefano Zampini   new_local_type_private = MATAIJ_PRIVATE;
2851e7931f94SStefano Zampini   new_local_type = MATSEQAIJ;
2852e7931f94SStefano Zampini   if (n_recvs) {
2853be4bc593SStefano Zampini     new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
2854e7931f94SStefano Zampini     ptr_idxs = recv_buffer_idxs;
2855e7931f94SStefano Zampini     for (i=0;i<n_recvs;i++) {
2856e7931f94SStefano Zampini       if ((PetscInt)new_local_type_private != *ptr_idxs) {
2857e7931f94SStefano Zampini         new_local_type_private = MATAIJ_PRIVATE;
2858e7931f94SStefano Zampini         break;
2859e7931f94SStefano Zampini       }
2860e7931f94SStefano Zampini       ptr_idxs += olengths_idxs[i];
2861e7931f94SStefano Zampini     }
2862e7931f94SStefano Zampini     switch (new_local_type_private) {
2863e7931f94SStefano Zampini       case MATDENSE_PRIVATE: /* subassembling of dense matrices does not give a dense matrix! */
2864e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
2865e7931f94SStefano Zampini         bs = 1;
2866e7931f94SStefano Zampini         break;
2867e7931f94SStefano Zampini       case MATAIJ_PRIVATE:
2868e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
2869e7931f94SStefano Zampini         bs = 1;
2870e7931f94SStefano Zampini         break;
2871e7931f94SStefano Zampini       case MATBAIJ_PRIVATE:
2872e7931f94SStefano Zampini         new_local_type = MATSEQBAIJ;
2873e7931f94SStefano Zampini         break;
2874e7931f94SStefano Zampini       case MATSBAIJ_PRIVATE:
2875e7931f94SStefano Zampini         new_local_type = MATSEQSBAIJ;
2876e7931f94SStefano Zampini         break;
2877e7931f94SStefano Zampini       default:
2878e7931f94SStefano Zampini         SETERRQ2(comm,PETSC_ERR_LIB,"Unkwown private type %d in %s",new_local_type_private,__FUNCT__);
2879e7931f94SStefano Zampini         break;
2880e7931f94SStefano Zampini     }
2881e7931f94SStefano Zampini   }
2882e7931f94SStefano Zampini 
2883e7931f94SStefano Zampini   /* create MATIS object */
2884e7931f94SStefano Zampini   ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
2885e7931f94SStefano Zampini   ierr = MatCreateIS(comm,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,&new_mat);CHKERRQ(ierr);
2886e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
2887e7931f94SStefano Zampini   ierr = MatISGetLocalMat(new_mat,&local_mat);CHKERRQ(ierr);
2888e7931f94SStefano Zampini   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
2889e7931f94SStefano Zampini   ierr = MatSetUp(local_mat);CHKERRQ(ierr); /* WARNING -> no preallocation yet */
2890e7931f94SStefano Zampini 
2891e7931f94SStefano Zampini   /* set values */
2892e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2893e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
2894e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
2895e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
2896e7931f94SStefano Zampini     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
2897e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
2898e7931f94SStefano Zampini       ierr = MatSetValues(new_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
2899e7931f94SStefano Zampini       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
2900e7931f94SStefano Zampini       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
2901e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
2902e7931f94SStefano Zampini     }
2903e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
2904e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
2905e7931f94SStefano Zampini   }
2906e7931f94SStefano Zampini   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2907e7931f94SStefano Zampini   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2908e7931f94SStefano Zampini   ierr = MatAssemblyBegin(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2909e7931f94SStefano Zampini   ierr = MatAssemblyEnd(new_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2910e7931f94SStefano Zampini 
2911e7931f94SStefano Zampini   { /* check */
2912e7931f94SStefano Zampini     Vec       lvec,rvec;
2913e7931f94SStefano Zampini     PetscReal infty_error;
2914e7931f94SStefano Zampini 
2915e7931f94SStefano Zampini     ierr = MatGetVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
2916e7931f94SStefano Zampini     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
2917e7931f94SStefano Zampini     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
2918e7931f94SStefano Zampini     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
2919e7931f94SStefano Zampini     ierr = MatMultAdd(new_mat,rvec,lvec,lvec);CHKERRQ(ierr);
2920e7931f94SStefano Zampini     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
2921e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
2922e7931f94SStefano Zampini     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
2923e7931f94SStefano Zampini     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
2924e7931f94SStefano Zampini   }
2925e7931f94SStefano Zampini 
2926e7931f94SStefano Zampini   /* free workspace */
2927e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
2928e7931f94SStefano Zampini   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
2929e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2930e7931f94SStefano Zampini   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
2931e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
2932e7931f94SStefano Zampini   if (isdense) {
2933e7931f94SStefano Zampini     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
2934e7931f94SStefano Zampini     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
2935e7931f94SStefano Zampini   } else {
2936e7931f94SStefano Zampini     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
2937e7931f94SStefano Zampini   }
2938e7931f94SStefano Zampini   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
2939e7931f94SStefano Zampini   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
2940e7931f94SStefano Zampini   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
2941e7931f94SStefano Zampini   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
2942e7931f94SStefano Zampini   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
2943e7931f94SStefano Zampini   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
2944e7931f94SStefano Zampini   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
2945e7931f94SStefano Zampini   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
2946e7931f94SStefano Zampini   ierr = PetscFree(onodes);CHKERRQ(ierr);
2947e7931f94SStefano Zampini   /* get back new mat */
2948e7931f94SStefano Zampini   *mat_n = new_mat;
2949e7931f94SStefano Zampini   PetscFunctionReturn(0);
2950e7931f94SStefano Zampini }
2951a57a6d2fSStefano Zampini 
2952c8587f34SStefano Zampini #undef __FUNCT__
2953c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
2954c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
2955c8587f34SStefano Zampini {
2956c8587f34SStefano Zampini   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
2957c8587f34SStefano Zampini   PC_IS                  *pcis = (PC_IS*)pc->data;
295820a2ab83SStefano Zampini   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
29599881197aSStefano Zampini   MatNullSpace           CoarseNullSpace=NULL;
296020a2ab83SStefano Zampini   ISLocalToGlobalMapping coarse_islg;
296120a2ab83SStefano Zampini   IS                     coarse_is;
2962f9eb5b7dSStefano Zampini   PetscInt               max_it,coarse_size,*local_primal_indices=NULL;
2963f9eb5b7dSStefano Zampini   PetscInt               im_active=-1,active_procs=-1;
2964f9eb5b7dSStefano Zampini   PC                     pc_temp;
2965c8587f34SStefano Zampini   PCType                 coarse_pc_type;
2966c8587f34SStefano Zampini   KSPType                coarse_ksp_type;
2967f9eb5b7dSStefano Zampini   PetscBool              multilevel_requested,multilevel_allowed;
2968f9eb5b7dSStefano Zampini   PetscBool              setsym,issym,isbddc,isnn;
2969f9eb5b7dSStefano Zampini   MatStructure           matstruct;
29709881197aSStefano Zampini   PetscErrorCode         ierr;
2971fdc09c96SStefano Zampini 
2972c8587f34SStefano Zampini   PetscFunctionBegin;
2973c8587f34SStefano Zampini   /* Assign global numbering to coarse dofs */
2974f34684f1SStefano Zampini   ierr = PCBDDCComputePrimalNumbering(pc,&coarse_size,&local_primal_indices);CHKERRQ(ierr);
2975c8587f34SStefano Zampini 
2976f9eb5b7dSStefano Zampini   /* infer some info from user */
2977f9eb5b7dSStefano Zampini   issym = PETSC_FALSE;
2978f9eb5b7dSStefano Zampini   ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
2979f9eb5b7dSStefano Zampini   multilevel_allowed = PETSC_FALSE;
2980f9eb5b7dSStefano Zampini   multilevel_requested = PETSC_FALSE;
2981f9eb5b7dSStefano Zampini   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
2982f9eb5b7dSStefano Zampini   if (multilevel_requested) {
29832b510759SStefano Zampini     /* count "active processes" */
29842b510759SStefano Zampini     im_active = !!(pcis->n);
29852b510759SStefano Zampini     ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
29862b510759SStefano Zampini     if (active_procs/pcbddc->coarsening_ratio < 2) {
2987f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_FALSE;
29882b510759SStefano Zampini     } else {
2989f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_TRUE;
2990c8587f34SStefano Zampini     }
2991c8587f34SStefano Zampini   }
2992e7931f94SStefano Zampini 
2993f9eb5b7dSStefano Zampini   /* set defaults for coarse KSP and PC */
2994f9eb5b7dSStefano Zampini   if (multilevel_allowed) {
2995c8587f34SStefano Zampini     if (issym) {
2996f9eb5b7dSStefano Zampini       coarse_ksp_type = KSPRICHARDSON;
2997f9eb5b7dSStefano Zampini     } else {
2998f9eb5b7dSStefano Zampini       coarse_ksp_type = KSPCHEBYSHEV;
2999c8587f34SStefano Zampini     }
3000f9eb5b7dSStefano Zampini     coarse_pc_type = PCBDDC;
3001f9eb5b7dSStefano Zampini   } else {
3002f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPPREONLY;
3003f9eb5b7dSStefano Zampini     coarse_pc_type = PCREDUNDANT;
3004c8587f34SStefano Zampini   }
3005c8587f34SStefano Zampini 
3006f9eb5b7dSStefano Zampini   /* create the coarse KSP object only once with defaults */
3007f9eb5b7dSStefano Zampini   if (!pcbddc->coarse_ksp) {
3008e604994aSStefano Zampini     char prefix[256],str_level[3];
3009e604994aSStefano Zampini     size_t len;
3010f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_ksp);CHKERRQ(ierr);
3011c8587f34SStefano Zampini     ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
3012f9eb5b7dSStefano Zampini     ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
3013c8587f34SStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
3014c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3015c8587f34SStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
3016e604994aSStefano Zampini     /* prefix */
3017e604994aSStefano Zampini     ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
3018e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
3019e604994aSStefano Zampini     if (!pcbddc->current_level) {
3020e604994aSStefano Zampini       ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
3021e604994aSStefano Zampini       ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
3022c8587f34SStefano Zampini     } else {
3023e604994aSStefano Zampini       ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
3024e604994aSStefano Zampini       if (pcbddc->current_level>1) len -= 2;
3025e604994aSStefano Zampini       ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len);CHKERRQ(ierr);
3026e604994aSStefano Zampini       *(prefix+len)='\0';
3027e604994aSStefano Zampini       sprintf(str_level,"%d_",(int)(pcbddc->current_level));
3028e604994aSStefano Zampini       ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
3029e604994aSStefano Zampini     }
3030e604994aSStefano Zampini     ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
3031f9eb5b7dSStefano Zampini   }
3032f9eb5b7dSStefano Zampini   /* allow user customization */
303385c4d303SStefano Zampini   /* ierr = PetscPrintf(PETSC_COMM_WORLD,"Type of %s before setting from options %s\n",((PetscObject)pcbddc->coarse_ksp)->prefix,((PetscObject)pcbddc->coarse_ksp)->type_name);CHKERRQ(ierr); */
3034f9eb5b7dSStefano Zampini   ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
303585c4d303SStefano Zampini   /* ierr = PetscPrintf(PETSC_COMM_WORLD,"Type of %s after setting from options %s\n",((PetscObject)pcbddc->coarse_ksp)->prefix,((PetscObject)pcbddc->coarse_ksp)->type_name);CHKERRQ(ierr); */
3036f9eb5b7dSStefano Zampini 
3037f9eb5b7dSStefano Zampini   /* get some info after set from options */
3038f9eb5b7dSStefano Zampini   ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
3039f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
3040f9eb5b7dSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
3041f9eb5b7dSStefano Zampini   if (isbddc && !multilevel_allowed) { /* prevent from infinite loop if user as requested bddc pc for coarse solver */
3042f9eb5b7dSStefano Zampini     ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
3043f9eb5b7dSStefano Zampini     ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
3044f9eb5b7dSStefano Zampini     isbddc = PETSC_FALSE;
3045f9eb5b7dSStefano Zampini   }
3046f9eb5b7dSStefano Zampini 
3047f9eb5b7dSStefano Zampini   /* propagate BDDC info to the next level */
3048f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
3049f9eb5b7dSStefano Zampini   ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
3050f9eb5b7dSStefano Zampini   ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
3051f9eb5b7dSStefano Zampini 
3052f9eb5b7dSStefano Zampini   /* creates temporary MATIS object for coarse matrix */
3053a57a6d2fSStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,local_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
3054a57a6d2fSStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
3055a57a6d2fSStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
3056a57a6d2fSStefano Zampini   ierr = MatCreateIS(PetscObjectComm((PetscObject)pc),1,PETSC_DECIDE,PETSC_DECIDE,coarse_size,coarse_size,coarse_islg,&coarse_mat_is);CHKERRQ(ierr);
3057a57a6d2fSStefano Zampini   ierr = MatISSetLocalMat(coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
3058e7931f94SStefano Zampini   ierr = MatAssemblyBegin(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3059e7931f94SStefano Zampini   ierr = MatAssemblyEnd(coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
306020a2ab83SStefano Zampini   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
306120a2ab83SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
306220a2ab83SStefano Zampini   ierr = PetscFree(local_primal_indices);CHKERRQ(ierr);
3063fdc09c96SStefano Zampini 
3064f9eb5b7dSStefano Zampini   /* assemble coarse matrix */
3065f9eb5b7dSStefano Zampini   if (isbddc || isnn) {
3066f9eb5b7dSStefano Zampini     ierr = MatISSubassemble(coarse_mat_is,NULL,pcbddc->coarsening_ratio,&coarse_mat);CHKERRQ(ierr);
3067f9eb5b7dSStefano Zampini   } else {
30682b510759SStefano Zampini     ierr = MatConvert_IS_AIJ(coarse_mat_is,MATAIJ,MAT_INITIAL_MATRIX,&coarse_mat);CHKERRQ(ierr);
3069c8587f34SStefano Zampini   }
30702b510759SStefano Zampini   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
30719881197aSStefano Zampini 
3072f9eb5b7dSStefano Zampini   /* create local to global scatters for coarse problem */
3073f9eb5b7dSStefano Zampini   ierr = MatGetVecs(coarse_mat,&pcbddc->coarse_vec,&pcbddc->coarse_rhs);CHKERRQ(ierr);
3074f9eb5b7dSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3075f9eb5b7dSStefano Zampini   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
3076f9eb5b7dSStefano Zampini 
3077f9eb5b7dSStefano Zampini   /* propagate symmetry info to coarse matrix */
3078f9eb5b7dSStefano Zampini   ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,issym);CHKERRQ(ierr);
3079f9eb5b7dSStefano Zampini 
3080b8ffe317SStefano Zampini   /* Compute coarse null space (special handling by BDDC only) */
3081b8ffe317SStefano Zampini   if (pcbddc->NullSpace) {
3082b8ffe317SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCoarse(pc,coarse_mat,&CoarseNullSpace);CHKERRQ(ierr);
3083b8ffe317SStefano Zampini     if (isbddc) {
3084b8ffe317SStefano Zampini       ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
3085b8ffe317SStefano Zampini     } else {
3086c8587f34SStefano Zampini       ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
3087c8587f34SStefano Zampini     }
3088c8587f34SStefano Zampini   }
3089c8587f34SStefano Zampini 
3090f9eb5b7dSStefano Zampini   /* set operators */
3091f9eb5b7dSStefano Zampini   ierr = PCGetOperators(pc,NULL,NULL,&matstruct);CHKERRQ(ierr);
3092f9eb5b7dSStefano Zampini   ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat,matstruct);CHKERRQ(ierr);
3093f9eb5b7dSStefano Zampini 
3094f9eb5b7dSStefano Zampini   /* additional KSP customization */
3095f9eb5b7dSStefano Zampini   ierr = KSPGetTolerances(pcbddc->coarse_ksp,NULL,NULL,NULL,&max_it);CHKERRQ(ierr);
3096f9eb5b7dSStefano Zampini   if (max_it < 5) {
3097c8587f34SStefano Zampini     ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
3098f9eb5b7dSStefano Zampini   }
3099b8ffe317SStefano Zampini   /* ierr = KSPChebyshevSetEstimateEigenvalues(pcbddc->coarse_ksp,1.0,0.0,0.0,1.1);CHKERRQ(ierr); */
3100f9eb5b7dSStefano Zampini 
3101f9eb5b7dSStefano Zampini 
3102f9eb5b7dSStefano Zampini   /* print some info if requested */
3103f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
3104f9eb5b7dSStefano Zampini     ierr = KSPGetType(pcbddc->coarse_ksp,&coarse_ksp_type);CHKERRQ(ierr);
3105f9eb5b7dSStefano Zampini     ierr = PCGetType(pc_temp,&coarse_pc_type);CHKERRQ(ierr);
3106f9eb5b7dSStefano Zampini     if (!multilevel_allowed) {
3107f9eb5b7dSStefano Zampini       if (multilevel_requested) {
3108f9eb5b7dSStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Not enough active processes on level %d (active processes %d, coarsening ratio %d)\n",pcbddc->current_level,active_procs,pcbddc->coarsening_ratio);CHKERRQ(ierr);
3109f9eb5b7dSStefano Zampini       } else if (pcbddc->max_levels) {
3110f9eb5b7dSStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
3111c8587f34SStefano Zampini       }
3112c8587f34SStefano Zampini     }
3113e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Calling %s/%s setup at level %d for coarse solver (%s)\n",coarse_ksp_type,coarse_pc_type,pcbddc->current_level,((PetscObject)pcbddc->coarse_ksp)->prefix);CHKERRQ(ierr);
3114f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3115c8587f34SStefano Zampini   }
3116f9eb5b7dSStefano Zampini 
3117f9eb5b7dSStefano Zampini   /* setup coarse ksp */
3118f9eb5b7dSStefano Zampini   ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
3119f9eb5b7dSStefano Zampini   if (pcbddc->dbg_flag) {
3120f9eb5b7dSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
3121f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3122f9eb5b7dSStefano Zampini     ierr = KSPView(pcbddc->coarse_ksp,pcbddc->dbg_viewer);CHKERRQ(ierr);
3123f9eb5b7dSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3124f9eb5b7dSStefano Zampini   }
3125f9eb5b7dSStefano Zampini 
3126c8587f34SStefano Zampini   /* Check coarse problem if requested */
312720a2ab83SStefano Zampini   if (pcbddc->dbg_flag) {
3128c8587f34SStefano Zampini     KSP       check_ksp;
31292b510759SStefano Zampini     KSPType   check_ksp_type;
3130c8587f34SStefano Zampini     PC        check_pc;
3131c8587f34SStefano Zampini     Vec       check_vec;
3132c8587f34SStefano Zampini     PetscReal abs_infty_error,infty_error,lambda_min,lambda_max;
31332b510759SStefano Zampini     PetscInt  its;
3134f9eb5b7dSStefano Zampini     PetscBool ispreonly,compute;
3135c8587f34SStefano Zampini 
31362b510759SStefano Zampini     /* Create ksp object suitable for estimation of extreme eigenvalues */
3137f9eb5b7dSStefano Zampini     ierr = KSPCreate(PetscObjectComm((PetscObject)pc),&check_ksp);CHKERRQ(ierr);
3138fdc635d7SStefano Zampini     ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr);
3139983f5fd7SStefano Zampini     ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,coarse_size);CHKERRQ(ierr);
31402b510759SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
31412b510759SStefano Zampini     if (ispreonly) {
31422b510759SStefano Zampini       check_ksp_type = KSPPREONLY;
3143f9eb5b7dSStefano Zampini       compute = PETSC_FALSE;
31442b510759SStefano Zampini     } else {
3145c8587f34SStefano Zampini       if (issym) check_ksp_type = KSPCG;
3146c8587f34SStefano Zampini       else check_ksp_type = KSPGMRES;
3147f9eb5b7dSStefano Zampini       compute = PETSC_TRUE;
3148c8587f34SStefano Zampini     }
3149c8587f34SStefano Zampini     ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
3150f9eb5b7dSStefano Zampini     ierr = KSPSetComputeSingularValues(check_ksp,compute);CHKERRQ(ierr);
3151c8587f34SStefano Zampini     ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
3152c8587f34SStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
3153c8587f34SStefano Zampini     ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
3154c8587f34SStefano Zampini     /* create random vec */
3155c8587f34SStefano Zampini     ierr = VecDuplicate(pcbddc->coarse_vec,&check_vec);CHKERRQ(ierr);
3156c8587f34SStefano Zampini     ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
3157c8587f34SStefano Zampini     if (CoarseNullSpace) {
3158c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec);CHKERRQ(ierr);
3159c8587f34SStefano Zampini     }
3160fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3161c8587f34SStefano Zampini     /* solve coarse problem */
3162c8587f34SStefano Zampini     ierr = KSPSolve(check_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr);
3163c8587f34SStefano Zampini     if (CoarseNullSpace) {
3164c8587f34SStefano Zampini       ierr = MatNullSpaceRemove(CoarseNullSpace,pcbddc->coarse_vec);CHKERRQ(ierr);
3165c8587f34SStefano Zampini     }
3166c8587f34SStefano Zampini     /* check coarse problem residual error */
3167c8587f34SStefano Zampini     ierr = VecAXPY(check_vec,-1.0,pcbddc->coarse_vec);CHKERRQ(ierr);
3168c8587f34SStefano Zampini     ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3169fdc635d7SStefano Zampini     ierr = MatMult(coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr);
3170c8587f34SStefano Zampini     ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
3171c8587f34SStefano Zampini     ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
3172e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem (%s) details\n",((PetscObject)(pcbddc->coarse_ksp))->prefix);CHKERRQ(ierr);
3173e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
3174e604994aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
3175f9eb5b7dSStefano Zampini     /* get eigenvalue estimation if preonly has not been requested */
31762b510759SStefano Zampini     if (!ispreonly) {
3177c8587f34SStefano Zampini       ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
317820a2ab83SStefano Zampini       ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
3179f9eb5b7dSStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse problem eigenvalues (estimated with %d iterations of %s): %1.6e %1.6e\n",its,check_ksp_type,lambda_min,lambda_max);CHKERRQ(ierr);
3180c8587f34SStefano Zampini     }
31812b510759SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3182c8587f34SStefano Zampini     ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
3183c8587f34SStefano Zampini   }
31842b510759SStefano Zampini   /* free memory */
3185c8587f34SStefano Zampini   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
3186fdc635d7SStefano Zampini   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
3187c8587f34SStefano Zampini   PetscFunctionReturn(0);
3188c8587f34SStefano Zampini }
3189674ae819SStefano Zampini 
3190f34684f1SStefano Zampini #undef __FUNCT__
3191f34684f1SStefano Zampini #define __FUNCT__ "PCBDDCComputePrimalNumbering"
3192f34684f1SStefano Zampini PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
3193f34684f1SStefano Zampini {
3194f34684f1SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3195f34684f1SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
3196f34684f1SStefano Zampini   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
3197f34684f1SStefano Zampini   PetscInt       i,j,coarse_size;
3198f34684f1SStefano Zampini   PetscInt       *local_primal_indices,*auxlocal_primal,*aux_idx;
3199f34684f1SStefano Zampini   PetscErrorCode ierr;
3200f34684f1SStefano Zampini 
3201f34684f1SStefano Zampini   PetscFunctionBegin;
3202f34684f1SStefano Zampini   /* get indices in local ordering for vertices and constraints */
3203f34684f1SStefano Zampini   ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&auxlocal_primal);CHKERRQ(ierr);
3204f34684f1SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&i,&aux_idx);CHKERRQ(ierr);
3205f34684f1SStefano Zampini   ierr = PetscMemcpy(auxlocal_primal,aux_idx,i*sizeof(PetscInt));CHKERRQ(ierr);
3206f34684f1SStefano Zampini   ierr = PetscFree(aux_idx);CHKERRQ(ierr);
3207f34684f1SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&j,&aux_idx);CHKERRQ(ierr);
3208f34684f1SStefano Zampini   ierr = PetscMemcpy(&auxlocal_primal[i],aux_idx,j*sizeof(PetscInt));CHKERRQ(ierr);
3209f34684f1SStefano Zampini   ierr = PetscFree(aux_idx);CHKERRQ(ierr);
3210f34684f1SStefano Zampini 
3211f34684f1SStefano Zampini   /* Compute global number of coarse dofs */
3212f34684f1SStefano Zampini   ierr = PCBDDCSubsetNumbering(PetscObjectComm((PetscObject)(pc->pmat)),matis->mapping,pcbddc->local_primal_size,auxlocal_primal,NULL,&coarse_size,&local_primal_indices);CHKERRQ(ierr);
3213f34684f1SStefano Zampini 
3214f34684f1SStefano Zampini   /* check numbering */
3215f34684f1SStefano Zampini   if (pcbddc->dbg_flag) {
3216f34684f1SStefano Zampini     PetscScalar coarsesum,*array;
3217f34684f1SStefano Zampini 
3218f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3219f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3220f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
3221f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
3222f34684f1SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
3223f34684f1SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,auxlocal_primal[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
3224f34684f1SStefano Zampini     }
3225f34684f1SStefano Zampini     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
3226f34684f1SStefano Zampini     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
3227f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3228f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3229f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3230f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3231f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3232f34684f1SStefano Zampini     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3233f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3234f34684f1SStefano Zampini       if (array[i] == 1.0) {
3235f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %d owned by a single process!\n",PetscGlobalRank,i);CHKERRQ(ierr);
3236f34684f1SStefano Zampini       }
3237f34684f1SStefano Zampini     }
3238f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3239f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
3240f34684f1SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
3241f34684f1SStefano Zampini     }
3242f34684f1SStefano Zampini     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
3243f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
3244f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3245f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3246f34684f1SStefano Zampini     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
3247f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
3248f34684f1SStefano Zampini     if (pcbddc->dbg_flag > 1) {
3249f34684f1SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
3250f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3251f34684f1SStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
3252f34684f1SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
325345a1bb75SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_primal_indices[%d]=%d (%d)\n",i,local_primal_indices[i],auxlocal_primal[i]);
3254f34684f1SStefano Zampini       }
3255f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3256f34684f1SStefano Zampini     }
3257f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3258f34684f1SStefano Zampini   }
3259f34684f1SStefano Zampini   ierr = PetscFree(auxlocal_primal);CHKERRQ(ierr);
3260f34684f1SStefano Zampini   /* get back data */
3261f34684f1SStefano Zampini   *coarse_size_n = coarse_size;
3262f34684f1SStefano Zampini   *local_primal_indices_n = local_primal_indices;
3263674ae819SStefano Zampini   PetscFunctionReturn(0);
3264674ae819SStefano Zampini }
3265674ae819SStefano Zampini 
3266