1*674ae819SStefano Zampini #include "bddc.h" 2*674ae819SStefano Zampini #include "bddcprivate.h" 3*674ae819SStefano Zampini #include <petscblaslapack.h> 4*674ae819SStefano Zampini 5*674ae819SStefano Zampini #undef __FUNCT__ 6*674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetCustomization" 7*674ae819SStefano Zampini PetscErrorCode PCBDDCResetCustomization(PC pc) 8*674ae819SStefano Zampini { 9*674ae819SStefano Zampini PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 10*674ae819SStefano Zampini PetscInt i; 11*674ae819SStefano Zampini PetscErrorCode ierr; 12*674ae819SStefano Zampini 13*674ae819SStefano Zampini PetscFunctionBegin; 14*674ae819SStefano Zampini ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr); 15*674ae819SStefano Zampini ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr); 16*674ae819SStefano Zampini ierr = MatNullSpaceDestroy(&pcbddc->NullSpace);CHKERRQ(ierr); 17*674ae819SStefano Zampini ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr); 18*674ae819SStefano Zampini ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr); 19*674ae819SStefano Zampini for (i=0;i<pcbddc->n_ISForDofs;i++) { 20*674ae819SStefano Zampini ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr); 21*674ae819SStefano Zampini } 22*674ae819SStefano Zampini ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr); 23*674ae819SStefano Zampini PetscFunctionReturn(0); 24*674ae819SStefano Zampini } 25*674ae819SStefano Zampini 26*674ae819SStefano Zampini #undef __FUNCT__ 27*674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetTopography" 28*674ae819SStefano Zampini PetscErrorCode PCBDDCResetTopography(PC pc) 29*674ae819SStefano Zampini { 30*674ae819SStefano Zampini PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 31*674ae819SStefano Zampini PetscErrorCode ierr; 32*674ae819SStefano Zampini 33*674ae819SStefano Zampini PetscFunctionBegin; 34*674ae819SStefano Zampini ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr); 35*674ae819SStefano Zampini ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr); 36*674ae819SStefano Zampini ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr); 37*674ae819SStefano Zampini PetscFunctionReturn(0); 38*674ae819SStefano Zampini } 39*674ae819SStefano Zampini 40*674ae819SStefano Zampini #undef __FUNCT__ 41*674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetSolvers" 42*674ae819SStefano Zampini PetscErrorCode PCBDDCResetSolvers(PC pc) 43*674ae819SStefano Zampini { 44*674ae819SStefano Zampini PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 45*674ae819SStefano Zampini PetscErrorCode ierr; 46*674ae819SStefano Zampini 47*674ae819SStefano Zampini PetscFunctionBegin; 48*674ae819SStefano Zampini ierr = VecDestroy(&pcbddc->temp_solution);CHKERRQ(ierr); 49*674ae819SStefano Zampini ierr = VecDestroy(&pcbddc->original_rhs);CHKERRQ(ierr); 50*674ae819SStefano Zampini ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr); 51*674ae819SStefano Zampini ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr); 52*674ae819SStefano Zampini ierr = VecDestroy(&pcbddc->coarse_rhs);CHKERRQ(ierr); 53*674ae819SStefano Zampini ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr); 54*674ae819SStefano Zampini ierr = MatDestroy(&pcbddc->coarse_mat);CHKERRQ(ierr); 55*674ae819SStefano Zampini ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr); 56*674ae819SStefano Zampini ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr); 57*674ae819SStefano Zampini ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr); 58*674ae819SStefano Zampini ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr); 59*674ae819SStefano Zampini ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr); 60*674ae819SStefano Zampini ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr); 61*674ae819SStefano Zampini ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr); 62*674ae819SStefano Zampini ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr); 63*674ae819SStefano Zampini ierr = VecDestroy(&pcbddc->vec4_D);CHKERRQ(ierr); 64*674ae819SStefano Zampini ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr); 65*674ae819SStefano Zampini ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr); 66*674ae819SStefano Zampini ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr); 67*674ae819SStefano Zampini ierr = KSPDestroy(&pcbddc->ksp_D);CHKERRQ(ierr); 68*674ae819SStefano Zampini ierr = KSPDestroy(&pcbddc->ksp_R);CHKERRQ(ierr); 69*674ae819SStefano Zampini ierr = PetscFree(pcbddc->local_primal_indices);CHKERRQ(ierr); 70*674ae819SStefano Zampini ierr = PetscFree(pcbddc->replicated_local_primal_indices);CHKERRQ(ierr); 71*674ae819SStefano Zampini ierr = PetscFree(pcbddc->replicated_local_primal_values);CHKERRQ(ierr); 72*674ae819SStefano Zampini ierr = PetscFree(pcbddc->local_primal_displacements);CHKERRQ(ierr); 73*674ae819SStefano Zampini ierr = PetscFree(pcbddc->local_primal_sizes);CHKERRQ(ierr); 74*674ae819SStefano Zampini PetscFunctionReturn(0); 75*674ae819SStefano Zampini } 76*674ae819SStefano Zampini 77*674ae819SStefano Zampini #undef __FUNCT__ 78*674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSolveSaddlePoint" 79*674ae819SStefano Zampini static PetscErrorCode PCBDDCSolveSaddlePoint(PC pc) 80*674ae819SStefano Zampini { 81*674ae819SStefano Zampini PetscErrorCode ierr; 82*674ae819SStefano Zampini PC_BDDC* pcbddc = (PC_BDDC*)(pc->data); 83*674ae819SStefano Zampini 84*674ae819SStefano Zampini PetscFunctionBegin; 85*674ae819SStefano Zampini ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr); 86*674ae819SStefano Zampini if (pcbddc->local_auxmat1) { 87*674ae819SStefano Zampini ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec2_R,pcbddc->vec1_C);CHKERRQ(ierr); 88*674ae819SStefano Zampini ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr); 89*674ae819SStefano Zampini } 90*674ae819SStefano Zampini PetscFunctionReturn(0); 91*674ae819SStefano Zampini } 92*674ae819SStefano Zampini 93*674ae819SStefano Zampini #undef __FUNCT__ 94*674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner" 95*674ae819SStefano Zampini PetscErrorCode PCBDDCApplyInterfacePreconditioner(PC pc) 96*674ae819SStefano Zampini { 97*674ae819SStefano Zampini PetscErrorCode ierr; 98*674ae819SStefano Zampini PC_BDDC* pcbddc = (PC_BDDC*)(pc->data); 99*674ae819SStefano Zampini PC_IS* pcis = (PC_IS*) (pc->data); 100*674ae819SStefano Zampini const PetscScalar zero = 0.0; 101*674ae819SStefano Zampini 102*674ae819SStefano Zampini PetscFunctionBegin; 103*674ae819SStefano Zampini /* Application of PHI^T */ 104*674ae819SStefano Zampini ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr); 105*674ae819SStefano Zampini if (pcbddc->inexact_prec_type) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); } 106*674ae819SStefano Zampini 107*674ae819SStefano Zampini /* Scatter data of coarse_rhs */ 108*674ae819SStefano Zampini if (pcbddc->coarse_rhs) { ierr = VecSet(pcbddc->coarse_rhs,zero);CHKERRQ(ierr); } 109*674ae819SStefano Zampini ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 110*674ae819SStefano Zampini 111*674ae819SStefano Zampini /* Local solution on R nodes */ 112*674ae819SStefano Zampini ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr); 113*674ae819SStefano Zampini ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 114*674ae819SStefano Zampini ierr = VecScatterEnd (pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 115*674ae819SStefano Zampini if (pcbddc->inexact_prec_type) { 116*674ae819SStefano Zampini ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 117*674ae819SStefano Zampini ierr = VecScatterEnd (pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 118*674ae819SStefano Zampini } 119*674ae819SStefano Zampini ierr = PCBDDCSolveSaddlePoint(pc);CHKERRQ(ierr); 120*674ae819SStefano Zampini ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr); 121*674ae819SStefano Zampini ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 122*674ae819SStefano Zampini ierr = VecScatterEnd (pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 123*674ae819SStefano Zampini if (pcbddc->inexact_prec_type) { 124*674ae819SStefano Zampini ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 125*674ae819SStefano Zampini ierr = VecScatterEnd (pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 126*674ae819SStefano Zampini } 127*674ae819SStefano Zampini 128*674ae819SStefano Zampini /* Coarse solution */ 129*674ae819SStefano Zampini ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 130*674ae819SStefano Zampini if (pcbddc->coarse_rhs) { /* TODO remove null space when doing multilevel */ 131*674ae819SStefano Zampini ierr = KSPSolve(pcbddc->coarse_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr); 132*674ae819SStefano Zampini } 133*674ae819SStefano Zampini ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 134*674ae819SStefano Zampini ierr = PCBDDCScatterCoarseDataEnd (pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 135*674ae819SStefano Zampini 136*674ae819SStefano Zampini /* Sum contributions from two levels */ 137*674ae819SStefano Zampini ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr); 138*674ae819SStefano Zampini if (pcbddc->inexact_prec_type) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); } 139*674ae819SStefano Zampini PetscFunctionReturn(0); 140*674ae819SStefano Zampini } 141*674ae819SStefano Zampini 142*674ae819SStefano Zampini #undef __FUNCT__ 143*674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin" 144*674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode) 145*674ae819SStefano Zampini { 146*674ae819SStefano Zampini PetscErrorCode ierr; 147*674ae819SStefano Zampini PC_BDDC* pcbddc = (PC_BDDC*)(pc->data); 148*674ae819SStefano Zampini 149*674ae819SStefano Zampini PetscFunctionBegin; 150*674ae819SStefano Zampini switch (pcbddc->coarse_communications_type) { 151*674ae819SStefano Zampini case SCATTERS_BDDC: 152*674ae819SStefano Zampini ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr); 153*674ae819SStefano Zampini break; 154*674ae819SStefano Zampini case GATHERS_BDDC: 155*674ae819SStefano Zampini break; 156*674ae819SStefano Zampini } 157*674ae819SStefano Zampini PetscFunctionReturn(0); 158*674ae819SStefano Zampini } 159*674ae819SStefano Zampini 160*674ae819SStefano Zampini #undef __FUNCT__ 161*674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd" 162*674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode) 163*674ae819SStefano Zampini { 164*674ae819SStefano Zampini PetscErrorCode ierr; 165*674ae819SStefano Zampini PC_BDDC* pcbddc = (PC_BDDC*)(pc->data); 166*674ae819SStefano Zampini PetscScalar* array_to; 167*674ae819SStefano Zampini PetscScalar* array_from; 168*674ae819SStefano Zampini MPI_Comm comm; 169*674ae819SStefano Zampini PetscInt i; 170*674ae819SStefano Zampini 171*674ae819SStefano Zampini PetscFunctionBegin; 172*674ae819SStefano Zampini ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr); 173*674ae819SStefano Zampini switch (pcbddc->coarse_communications_type) { 174*674ae819SStefano Zampini case SCATTERS_BDDC: 175*674ae819SStefano Zampini ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr); 176*674ae819SStefano Zampini break; 177*674ae819SStefano Zampini case GATHERS_BDDC: 178*674ae819SStefano Zampini if (vec_from) { 179*674ae819SStefano Zampini ierr = VecGetArray(vec_from,&array_from);CHKERRQ(ierr); 180*674ae819SStefano Zampini } 181*674ae819SStefano Zampini if (vec_to) { 182*674ae819SStefano Zampini ierr = VecGetArray(vec_to,&array_to);CHKERRQ(ierr); 183*674ae819SStefano Zampini } 184*674ae819SStefano Zampini switch(pcbddc->coarse_problem_type){ 185*674ae819SStefano Zampini case SEQUENTIAL_BDDC: 186*674ae819SStefano Zampini if (smode == SCATTER_FORWARD) { 187*674ae819SStefano Zampini ierr = MPI_Gatherv(&array_from[0],pcbddc->local_primal_size,MPIU_SCALAR,&pcbddc->replicated_local_primal_values[0],pcbddc->local_primal_sizes,pcbddc->local_primal_displacements,MPIU_SCALAR,0,comm);CHKERRQ(ierr); 188*674ae819SStefano Zampini if (vec_to) { 189*674ae819SStefano Zampini if (imode == ADD_VALUES) { 190*674ae819SStefano Zampini for (i=0;i<pcbddc->replicated_primal_size;i++) { 191*674ae819SStefano Zampini array_to[pcbddc->replicated_local_primal_indices[i]]+=pcbddc->replicated_local_primal_values[i]; 192*674ae819SStefano Zampini } 193*674ae819SStefano Zampini } else { 194*674ae819SStefano Zampini for (i=0;i<pcbddc->replicated_primal_size;i++) { 195*674ae819SStefano Zampini array_to[pcbddc->replicated_local_primal_indices[i]]=pcbddc->replicated_local_primal_values[i]; 196*674ae819SStefano Zampini } 197*674ae819SStefano Zampini } 198*674ae819SStefano Zampini } 199*674ae819SStefano Zampini } else { 200*674ae819SStefano Zampini if (vec_from) { 201*674ae819SStefano Zampini if (imode == ADD_VALUES) { 202*674ae819SStefano Zampini MPI_Comm vec_from_comm; 203*674ae819SStefano Zampini ierr = PetscObjectGetComm((PetscObject)(vec_from),&vec_from_comm);CHKERRQ(ierr); 204*674ae819SStefano Zampini SETERRQ2(vec_from_comm,PETSC_ERR_SUP,"Unsupported insert mode ADD_VALUES for SCATTER_REVERSE in %s for case %d\n",__FUNCT__,pcbddc->coarse_problem_type); 205*674ae819SStefano Zampini } 206*674ae819SStefano Zampini for (i=0;i<pcbddc->replicated_primal_size;i++) { 207*674ae819SStefano Zampini pcbddc->replicated_local_primal_values[i]=array_from[pcbddc->replicated_local_primal_indices[i]]; 208*674ae819SStefano Zampini } 209*674ae819SStefano Zampini } 210*674ae819SStefano Zampini ierr = MPI_Scatterv(&pcbddc->replicated_local_primal_values[0],pcbddc->local_primal_sizes,pcbddc->local_primal_displacements,MPIU_SCALAR,&array_to[0],pcbddc->local_primal_size,MPIU_SCALAR,0,comm);CHKERRQ(ierr); 211*674ae819SStefano Zampini } 212*674ae819SStefano Zampini break; 213*674ae819SStefano Zampini case REPLICATED_BDDC: 214*674ae819SStefano Zampini if (smode == SCATTER_FORWARD) { 215*674ae819SStefano Zampini ierr = MPI_Allgatherv(&array_from[0],pcbddc->local_primal_size,MPIU_SCALAR,&pcbddc->replicated_local_primal_values[0],pcbddc->local_primal_sizes,pcbddc->local_primal_displacements,MPIU_SCALAR,comm);CHKERRQ(ierr); 216*674ae819SStefano Zampini if (imode == ADD_VALUES) { 217*674ae819SStefano Zampini for (i=0;i<pcbddc->replicated_primal_size;i++) { 218*674ae819SStefano Zampini array_to[pcbddc->replicated_local_primal_indices[i]]+=pcbddc->replicated_local_primal_values[i]; 219*674ae819SStefano Zampini } 220*674ae819SStefano Zampini } else { 221*674ae819SStefano Zampini for (i=0;i<pcbddc->replicated_primal_size;i++) { 222*674ae819SStefano Zampini array_to[pcbddc->replicated_local_primal_indices[i]]=pcbddc->replicated_local_primal_values[i]; 223*674ae819SStefano Zampini } 224*674ae819SStefano Zampini } 225*674ae819SStefano Zampini } else { /* no communications needed for SCATTER_REVERSE since needed data is already present */ 226*674ae819SStefano Zampini if (imode == ADD_VALUES) { 227*674ae819SStefano Zampini for (i=0;i<pcbddc->local_primal_size;i++) { 228*674ae819SStefano Zampini array_to[i]+=array_from[pcbddc->local_primal_indices[i]]; 229*674ae819SStefano Zampini } 230*674ae819SStefano Zampini } else { 231*674ae819SStefano Zampini for (i=0;i<pcbddc->local_primal_size;i++) { 232*674ae819SStefano Zampini array_to[i]=array_from[pcbddc->local_primal_indices[i]]; 233*674ae819SStefano Zampini } 234*674ae819SStefano Zampini } 235*674ae819SStefano Zampini } 236*674ae819SStefano Zampini break; 237*674ae819SStefano Zampini case MULTILEVEL_BDDC: 238*674ae819SStefano Zampini break; 239*674ae819SStefano Zampini case PARALLEL_BDDC: 240*674ae819SStefano Zampini break; 241*674ae819SStefano Zampini } 242*674ae819SStefano Zampini if (vec_from) { 243*674ae819SStefano Zampini ierr = VecRestoreArray(vec_from,&array_from);CHKERRQ(ierr); 244*674ae819SStefano Zampini } 245*674ae819SStefano Zampini if (vec_to) { 246*674ae819SStefano Zampini ierr = VecRestoreArray(vec_to,&array_to);CHKERRQ(ierr); 247*674ae819SStefano Zampini } 248*674ae819SStefano Zampini break; 249*674ae819SStefano Zampini } 250*674ae819SStefano Zampini PetscFunctionReturn(0); 251*674ae819SStefano Zampini } 252*674ae819SStefano Zampini 253*674ae819SStefano Zampini #undef __FUNCT__ 254*674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp" 255*674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc) 256*674ae819SStefano Zampini { 257*674ae819SStefano Zampini PetscErrorCode ierr; 258*674ae819SStefano Zampini PC_IS* pcis = (PC_IS*)(pc->data); 259*674ae819SStefano Zampini PC_BDDC* pcbddc = (PC_BDDC*)pc->data; 260*674ae819SStefano Zampini Mat_IS *matis = (Mat_IS*)pc->pmat->data; 261*674ae819SStefano Zampini PetscInt *nnz,*is_indices; 262*674ae819SStefano Zampini PetscScalar *temp_quadrature_constraint; 263*674ae819SStefano Zampini PetscInt *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B,*local_to_B; 264*674ae819SStefano Zampini PetscInt local_primal_size,i,j,k,total_counts,max_size_of_constraint; 265*674ae819SStefano Zampini PetscInt n_vertices,size_of_constraint; 266*674ae819SStefano Zampini PetscScalar quad_value; 267*674ae819SStefano Zampini PetscBool nnsp_has_cnst=PETSC_FALSE,use_nnsp_true=pcbddc->use_nnsp_true; 268*674ae819SStefano Zampini PetscInt nnsp_size=0,nnsp_addone=0,temp_constraints,temp_start_ptr,n_ISForFaces,n_ISForEdges; 269*674ae819SStefano Zampini IS *used_IS,ISForVertices,*ISForFaces,*ISForEdges; 270*674ae819SStefano Zampini MatType impMatType=MATSEQAIJ; 271*674ae819SStefano Zampini PetscBLASInt Bs,Bt,lwork,lierr; 272*674ae819SStefano Zampini PetscReal tol=1.0e-8; 273*674ae819SStefano Zampini MatNullSpace nearnullsp; 274*674ae819SStefano Zampini const Vec *nearnullvecs; 275*674ae819SStefano Zampini Vec *localnearnullsp; 276*674ae819SStefano Zampini PetscScalar *work,*temp_basis,*array_vector,*correlation_mat; 277*674ae819SStefano Zampini PetscReal *rwork,*singular_vals; 278*674ae819SStefano Zampini PetscBLASInt Bone=1,*ipiv; 279*674ae819SStefano Zampini Vec temp_vec; 280*674ae819SStefano Zampini Mat temp_mat; 281*674ae819SStefano Zampini KSP temp_ksp; 282*674ae819SStefano Zampini PC temp_pc; 283*674ae819SStefano Zampini PetscInt s,start_constraint,dual_dofs; 284*674ae819SStefano Zampini PetscBool compute_submatrix,useksp=PETSC_FALSE; 285*674ae819SStefano Zampini PetscInt *aux_primal_permutation,*aux_primal_numbering; 286*674ae819SStefano Zampini PetscBool boolforface,*change_basis; 287*674ae819SStefano Zampini /* some ugly conditional declarations */ 288*674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD) 289*674ae819SStefano Zampini PetscScalar one=1.0,zero=0.0; 290*674ae819SStefano Zampini PetscInt ii; 291*674ae819SStefano Zampini PetscScalar *singular_vectors; 292*674ae819SStefano Zampini PetscBLASInt *iwork,*ifail; 293*674ae819SStefano Zampini PetscReal dummy_real,abs_tol; 294*674ae819SStefano Zampini PetscBLASInt eigs_found; 295*674ae819SStefano Zampini #endif 296*674ae819SStefano Zampini PetscBLASInt dummy_int; 297*674ae819SStefano Zampini PetscScalar dummy_scalar; 298*674ae819SStefano Zampini PetscBool used_vertex,get_faces,get_edges,get_vertices; 299*674ae819SStefano Zampini 300*674ae819SStefano Zampini PetscFunctionBegin; 301*674ae819SStefano Zampini /* Get index sets for faces, edges and vertices from graph */ 302*674ae819SStefano Zampini get_faces = PETSC_TRUE; 303*674ae819SStefano Zampini get_edges = PETSC_TRUE; 304*674ae819SStefano Zampini get_vertices = PETSC_TRUE; 305*674ae819SStefano Zampini if (pcbddc->vertices_flag) { 306*674ae819SStefano Zampini get_faces = PETSC_FALSE; 307*674ae819SStefano Zampini get_edges = PETSC_FALSE; 308*674ae819SStefano Zampini } 309*674ae819SStefano Zampini if (pcbddc->constraints_flag) { 310*674ae819SStefano Zampini get_vertices = PETSC_FALSE; 311*674ae819SStefano Zampini } 312*674ae819SStefano Zampini if (pcbddc->faces_flag) { 313*674ae819SStefano Zampini get_edges = PETSC_FALSE; 314*674ae819SStefano Zampini } 315*674ae819SStefano Zampini if (pcbddc->edges_flag) { 316*674ae819SStefano Zampini get_faces = PETSC_FALSE; 317*674ae819SStefano Zampini } 318*674ae819SStefano Zampini /* default */ 319*674ae819SStefano Zampini if (!get_faces && !get_edges && !get_vertices) { 320*674ae819SStefano Zampini get_vertices = PETSC_TRUE; 321*674ae819SStefano Zampini } 322*674ae819SStefano Zampini ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,get_faces,get_edges,get_vertices,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices); 323*674ae819SStefano Zampini if (pcbddc->dbg_flag) { 324*674ae819SStefano Zampini ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr); 325*674ae819SStefano Zampini i = 0; 326*674ae819SStefano Zampini if (ISForVertices) { 327*674ae819SStefano Zampini ierr = ISGetSize(ISForVertices,&i);CHKERRQ(ierr); 328*674ae819SStefano Zampini } 329*674ae819SStefano Zampini ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices\n",PetscGlobalRank,i);CHKERRQ(ierr); 330*674ae819SStefano Zampini ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces\n",PetscGlobalRank,n_ISForFaces);CHKERRQ(ierr); 331*674ae819SStefano Zampini ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges\n",PetscGlobalRank,n_ISForEdges);CHKERRQ(ierr); 332*674ae819SStefano Zampini ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 333*674ae819SStefano Zampini } 334*674ae819SStefano Zampini /* check if near null space is attached to global mat */ 335*674ae819SStefano Zampini ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr); 336*674ae819SStefano Zampini if (nearnullsp) { 337*674ae819SStefano Zampini ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr); 338*674ae819SStefano Zampini } else { /* if near null space is not provided it uses constants */ 339*674ae819SStefano Zampini nnsp_has_cnst = PETSC_TRUE; 340*674ae819SStefano Zampini use_nnsp_true = PETSC_TRUE; 341*674ae819SStefano Zampini } 342*674ae819SStefano Zampini if (nnsp_has_cnst) { 343*674ae819SStefano Zampini nnsp_addone = 1; 344*674ae819SStefano Zampini } 345*674ae819SStefano Zampini /* 346*674ae819SStefano Zampini Evaluate maximum storage size needed by the procedure 347*674ae819SStefano Zampini - temp_indices will contain start index of each constraint stored as follows 348*674ae819SStefano 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 349*674ae819SStefano 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 350*674ae819SStefano Zampini - temp_quadrature_constraint [temp_indices[i],...,temp[indices[i+1]-1] will contain the scalars representing the constraint itself 351*674ae819SStefano Zampini */ 352*674ae819SStefano Zampini total_counts = n_ISForFaces+n_ISForEdges; 353*674ae819SStefano Zampini total_counts *= (nnsp_addone+nnsp_size); 354*674ae819SStefano Zampini n_vertices = 0; 355*674ae819SStefano Zampini if (ISForVertices) { 356*674ae819SStefano Zampini ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr); 357*674ae819SStefano Zampini } 358*674ae819SStefano Zampini total_counts += n_vertices; 359*674ae819SStefano Zampini ierr = PetscMalloc((total_counts+1)*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr); 360*674ae819SStefano Zampini ierr = PetscMalloc((total_counts+1)*sizeof(PetscBool),&change_basis);CHKERRQ(ierr); 361*674ae819SStefano Zampini total_counts = 0; 362*674ae819SStefano Zampini max_size_of_constraint = 0; 363*674ae819SStefano Zampini for (i=0;i<n_ISForEdges+n_ISForFaces;i++) { 364*674ae819SStefano Zampini if (i<n_ISForEdges) { 365*674ae819SStefano Zampini used_IS = &ISForEdges[i]; 366*674ae819SStefano Zampini } else { 367*674ae819SStefano Zampini used_IS = &ISForFaces[i-n_ISForEdges]; 368*674ae819SStefano Zampini } 369*674ae819SStefano Zampini ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr); 370*674ae819SStefano Zampini total_counts += j; 371*674ae819SStefano Zampini max_size_of_constraint = PetscMax(j,max_size_of_constraint); 372*674ae819SStefano Zampini } 373*674ae819SStefano Zampini total_counts *= (nnsp_addone+nnsp_size); 374*674ae819SStefano Zampini total_counts += n_vertices; 375*674ae819SStefano Zampini ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&temp_quadrature_constraint);CHKERRQ(ierr); 376*674ae819SStefano Zampini ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint);CHKERRQ(ierr); 377*674ae819SStefano Zampini ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint_B);CHKERRQ(ierr); 378*674ae819SStefano Zampini ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&local_to_B);CHKERRQ(ierr); 379*674ae819SStefano Zampini ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 380*674ae819SStefano Zampini for (i=0;i<pcis->n;i++) { 381*674ae819SStefano Zampini local_to_B[i]=-1; 382*674ae819SStefano Zampini } 383*674ae819SStefano Zampini for (i=0;i<pcis->n_B;i++) { 384*674ae819SStefano Zampini local_to_B[is_indices[i]]=i; 385*674ae819SStefano Zampini } 386*674ae819SStefano Zampini ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 387*674ae819SStefano Zampini 388*674ae819SStefano Zampini /* First we issue queries to allocate optimal workspace for LAPACKgesvd or LAPACKsyev/LAPACKheev */ 389*674ae819SStefano Zampini rwork = 0; 390*674ae819SStefano Zampini work = 0; 391*674ae819SStefano Zampini singular_vals = 0; 392*674ae819SStefano Zampini temp_basis = 0; 393*674ae819SStefano Zampini correlation_mat = 0; 394*674ae819SStefano Zampini if (!pcbddc->use_nnsp_true) { 395*674ae819SStefano Zampini PetscScalar temp_work; 396*674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD) 397*674ae819SStefano Zampini /* POD */ 398*674ae819SStefano Zampini PetscInt max_n; 399*674ae819SStefano Zampini max_n = nnsp_addone+nnsp_size; 400*674ae819SStefano Zampini /* using some techniques borrowed from Proper Orthogonal Decomposition */ 401*674ae819SStefano Zampini ierr = PetscMalloc(max_n*max_n*sizeof(PetscScalar),&correlation_mat);CHKERRQ(ierr); 402*674ae819SStefano Zampini ierr = PetscMalloc(max_n*max_n*sizeof(PetscScalar),&singular_vectors);CHKERRQ(ierr); 403*674ae819SStefano Zampini ierr = PetscMalloc(max_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr); 404*674ae819SStefano Zampini ierr = PetscMalloc(max_size_of_constraint*(nnsp_addone+nnsp_size)*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr); 405*674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX) 406*674ae819SStefano Zampini ierr = PetscMalloc(3*max_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr); 407*674ae819SStefano Zampini #endif 408*674ae819SStefano Zampini ierr = PetscMalloc(5*max_n*sizeof(PetscBLASInt),&iwork);CHKERRQ(ierr); 409*674ae819SStefano Zampini ierr = PetscMalloc(max_n*sizeof(PetscBLASInt),&ifail);CHKERRQ(ierr); 410*674ae819SStefano Zampini /* now we evaluate the optimal workspace using query with lwork=-1 */ 411*674ae819SStefano Zampini ierr = PetscBLASIntCast(max_n,&Bt);CHKERRQ(ierr); 412*674ae819SStefano Zampini lwork=-1; 413*674ae819SStefano Zampini ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 414*674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX) 415*674ae819SStefano Zampini abs_tol=1.e-8; 416*674ae819SStefano Zampini /* LAPACKsyev_("V","U",&Bt,correlation_mat,&Bt,singular_vals,&temp_work,&lwork,&lierr); */ 417*674ae819SStefano Zampini LAPACKsyevx_("V","A","U",&Bt,correlation_mat,&Bt,&dummy_real,&dummy_real,&dummy_int,&dummy_int, 418*674ae819SStefano Zampini &abs_tol,&eigs_found,singular_vals,singular_vectors,&Bt,&temp_work,&lwork,iwork,ifail,&lierr); 419*674ae819SStefano Zampini #else 420*674ae819SStefano Zampini /* LAPACKsyev_("V","U",&Bt,correlation_mat,&Bt,singular_vals,&temp_work,&lwork,rwork,&lierr); */ 421*674ae819SStefano Zampini /* LAPACK call is missing here! TODO */ 422*674ae819SStefano Zampini SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Not yet implemented for complexes when PETSC_MISSING_GESVD = 1"); 423*674ae819SStefano Zampini #endif 424*674ae819SStefano Zampini if ( lierr ) { 425*674ae819SStefano Zampini SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEVX Lapack routine %d",(int)lierr); 426*674ae819SStefano Zampini } 427*674ae819SStefano Zampini ierr = PetscFPTrapPop();CHKERRQ(ierr); 428*674ae819SStefano Zampini #else /* on missing GESVD */ 429*674ae819SStefano Zampini /* SVD */ 430*674ae819SStefano Zampini PetscInt max_n,min_n; 431*674ae819SStefano Zampini max_n = max_size_of_constraint; 432*674ae819SStefano Zampini min_n = nnsp_addone+nnsp_size; 433*674ae819SStefano Zampini if (max_size_of_constraint < ( nnsp_addone+nnsp_size ) ) { 434*674ae819SStefano Zampini min_n = max_size_of_constraint; 435*674ae819SStefano Zampini max_n = nnsp_addone+nnsp_size; 436*674ae819SStefano Zampini } 437*674ae819SStefano Zampini ierr = PetscMalloc(min_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr); 438*674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX) 439*674ae819SStefano Zampini ierr = PetscMalloc(5*min_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr); 440*674ae819SStefano Zampini #endif 441*674ae819SStefano Zampini /* now we evaluate the optimal workspace using query with lwork=-1 */ 442*674ae819SStefano Zampini lwork=-1; 443*674ae819SStefano Zampini ierr = PetscBLASIntCast(max_n,&Bs);CHKERRQ(ierr); 444*674ae819SStefano Zampini ierr = PetscBLASIntCast(min_n,&Bt);CHKERRQ(ierr); 445*674ae819SStefano Zampini dummy_int = Bs; 446*674ae819SStefano Zampini ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 447*674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX) 448*674ae819SStefano Zampini LAPACKgesvd_("O","N",&Bs,&Bt,&temp_quadrature_constraint[0],&Bs,singular_vals, 449*674ae819SStefano Zampini &dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,&temp_work,&lwork,&lierr); 450*674ae819SStefano Zampini #else 451*674ae819SStefano Zampini LAPACKgesvd_("O","N",&Bs,&Bt,&temp_quadrature_constraint[0],&Bs,singular_vals, 452*674ae819SStefano Zampini &dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,&temp_work,&lwork,rwork,&lierr); 453*674ae819SStefano Zampini #endif 454*674ae819SStefano Zampini if ( lierr ) { 455*674ae819SStefano Zampini SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SVD Lapack routine %d",(int)lierr); 456*674ae819SStefano Zampini } 457*674ae819SStefano Zampini ierr = PetscFPTrapPop();CHKERRQ(ierr); 458*674ae819SStefano Zampini #endif 459*674ae819SStefano Zampini /* Allocate optimal workspace */ 460*674ae819SStefano Zampini ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr); 461*674ae819SStefano Zampini total_counts = (PetscInt)lwork; 462*674ae819SStefano Zampini ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&work);CHKERRQ(ierr); 463*674ae819SStefano Zampini } 464*674ae819SStefano Zampini /* get local part of global near null space vectors */ 465*674ae819SStefano Zampini ierr = PetscMalloc(nnsp_size*sizeof(Vec),&localnearnullsp);CHKERRQ(ierr); 466*674ae819SStefano Zampini for (k=0;k<nnsp_size;k++) { 467*674ae819SStefano Zampini ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr); 468*674ae819SStefano Zampini ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 469*674ae819SStefano Zampini ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 470*674ae819SStefano Zampini } 471*674ae819SStefano Zampini /* Now we can loop on constraining sets */ 472*674ae819SStefano Zampini total_counts = 0; 473*674ae819SStefano Zampini temp_indices[0] = 0; 474*674ae819SStefano Zampini /* vertices */ 475*674ae819SStefano Zampini if (ISForVertices) { 476*674ae819SStefano Zampini ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr); 477*674ae819SStefano Zampini if (nnsp_has_cnst) { /* consider all vertices */ 478*674ae819SStefano Zampini for (i=0;i<n_vertices;i++) { 479*674ae819SStefano Zampini temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i]; 480*674ae819SStefano Zampini temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]]; 481*674ae819SStefano Zampini temp_quadrature_constraint[temp_indices[total_counts]]=1.0; 482*674ae819SStefano Zampini temp_indices[total_counts+1]=temp_indices[total_counts]+1; 483*674ae819SStefano Zampini change_basis[total_counts]=PETSC_FALSE; 484*674ae819SStefano Zampini total_counts++; 485*674ae819SStefano Zampini } 486*674ae819SStefano Zampini } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */ 487*674ae819SStefano Zampini for (i=0;i<n_vertices;i++) { 488*674ae819SStefano Zampini used_vertex=PETSC_FALSE; 489*674ae819SStefano Zampini k=0; 490*674ae819SStefano Zampini while (!used_vertex && k<nnsp_size) { 491*674ae819SStefano Zampini ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array_vector);CHKERRQ(ierr); 492*674ae819SStefano Zampini if (PetscAbsScalar(array_vector[is_indices[i]])>0.0) { 493*674ae819SStefano Zampini temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i]; 494*674ae819SStefano Zampini temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]]; 495*674ae819SStefano Zampini temp_quadrature_constraint[temp_indices[total_counts]]=1.0; 496*674ae819SStefano Zampini temp_indices[total_counts+1]=temp_indices[total_counts]+1; 497*674ae819SStefano Zampini change_basis[total_counts]=PETSC_FALSE; 498*674ae819SStefano Zampini total_counts++; 499*674ae819SStefano Zampini used_vertex=PETSC_TRUE; 500*674ae819SStefano Zampini } 501*674ae819SStefano Zampini ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array_vector);CHKERRQ(ierr); 502*674ae819SStefano Zampini k++; 503*674ae819SStefano Zampini } 504*674ae819SStefano Zampini } 505*674ae819SStefano Zampini } 506*674ae819SStefano Zampini ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr); 507*674ae819SStefano Zampini n_vertices = total_counts; 508*674ae819SStefano Zampini } 509*674ae819SStefano Zampini /* edges and faces */ 510*674ae819SStefano Zampini for (i=0;i<n_ISForEdges+n_ISForFaces;i++) { 511*674ae819SStefano Zampini if (i<n_ISForEdges) { 512*674ae819SStefano Zampini used_IS = &ISForEdges[i]; 513*674ae819SStefano Zampini boolforface = pcbddc->use_change_of_basis; 514*674ae819SStefano Zampini } else { 515*674ae819SStefano Zampini used_IS = &ISForFaces[i-n_ISForEdges]; 516*674ae819SStefano Zampini boolforface = pcbddc->use_change_on_faces; 517*674ae819SStefano Zampini } 518*674ae819SStefano Zampini temp_constraints = 0; /* zero the number of constraints I have on this conn comp */ 519*674ae819SStefano Zampini temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */ 520*674ae819SStefano Zampini ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr); 521*674ae819SStefano Zampini ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr); 522*674ae819SStefano Zampini if (nnsp_has_cnst) { 523*674ae819SStefano Zampini temp_constraints++; 524*674ae819SStefano Zampini quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint)); 525*674ae819SStefano Zampini for (j=0;j<size_of_constraint;j++) { 526*674ae819SStefano Zampini temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j]; 527*674ae819SStefano Zampini temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]]; 528*674ae819SStefano Zampini temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value; 529*674ae819SStefano Zampini } 530*674ae819SStefano Zampini temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint; /* store new starting point */ 531*674ae819SStefano Zampini change_basis[total_counts]=boolforface; 532*674ae819SStefano Zampini total_counts++; 533*674ae819SStefano Zampini } 534*674ae819SStefano Zampini for (k=0;k<nnsp_size;k++) { 535*674ae819SStefano Zampini ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array_vector);CHKERRQ(ierr); 536*674ae819SStefano Zampini for (j=0;j<size_of_constraint;j++) { 537*674ae819SStefano Zampini temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j]; 538*674ae819SStefano Zampini temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]]; 539*674ae819SStefano Zampini temp_quadrature_constraint[temp_indices[total_counts]+j]=array_vector[is_indices[j]]; 540*674ae819SStefano Zampini } 541*674ae819SStefano Zampini ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array_vector);CHKERRQ(ierr); 542*674ae819SStefano Zampini quad_value = 1.0; 543*674ae819SStefano Zampini if (use_nnsp_true) { /* check if array is null on the connected component in case use_nnsp_true has been requested */ 544*674ae819SStefano Zampini ierr = PetscBLASIntCast(size_of_constraint,&Bs);CHKERRQ(ierr); 545*674ae819SStefano Zampini quad_value = BLASasum_(&Bs,&temp_quadrature_constraint[temp_indices[total_counts]],&Bone); 546*674ae819SStefano Zampini } 547*674ae819SStefano Zampini if (quad_value > 0.0) { /* keep indices and values */ 548*674ae819SStefano Zampini temp_constraints++; 549*674ae819SStefano Zampini temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint; /* store new starting point */ 550*674ae819SStefano Zampini change_basis[total_counts]=boolforface; 551*674ae819SStefano Zampini total_counts++; 552*674ae819SStefano Zampini } 553*674ae819SStefano Zampini } 554*674ae819SStefano Zampini ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr); 555*674ae819SStefano Zampini /* perform SVD on the constraint if use_nnsp_true has not be requested by the user */ 556*674ae819SStefano Zampini if (!use_nnsp_true) { 557*674ae819SStefano Zampini ierr = PetscBLASIntCast(size_of_constraint,&Bs);CHKERRQ(ierr); 558*674ae819SStefano Zampini ierr = PetscBLASIntCast(temp_constraints,&Bt);CHKERRQ(ierr); 559*674ae819SStefano Zampini 560*674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD) 561*674ae819SStefano Zampini ierr = PetscMemzero(correlation_mat,Bt*Bt*sizeof(PetscScalar));CHKERRQ(ierr); 562*674ae819SStefano Zampini /* Store upper triangular part of correlation matrix */ 563*674ae819SStefano Zampini for (j=0;j<temp_constraints;j++) { 564*674ae819SStefano Zampini for (k=0;k<j+1;k++) { 565*674ae819SStefano Zampini correlation_mat[j*temp_constraints+k]=BLASdot_(&Bs,&temp_quadrature_constraint[temp_indices[temp_start_ptr+j]],&Bone, 566*674ae819SStefano Zampini &temp_quadrature_constraint[temp_indices[temp_start_ptr+k]],&Bone); 567*674ae819SStefano Zampini 568*674ae819SStefano Zampini } 569*674ae819SStefano Zampini } 570*674ae819SStefano Zampini ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 571*674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX) 572*674ae819SStefano Zampini /* LAPACKsyev_("V","U",&Bt,correlation_mat,&Bt,singular_vals,work,&lwork,&lierr); */ 573*674ae819SStefano Zampini LAPACKsyevx_("V","A","U",&Bt,correlation_mat,&Bt,&dummy_real,&dummy_real,&dummy_int,&dummy_int, 574*674ae819SStefano Zampini &abs_tol,&eigs_found,singular_vals,singular_vectors,&Bt,work,&lwork,iwork,ifail,&lierr); 575*674ae819SStefano Zampini #else 576*674ae819SStefano Zampini /* LAPACK call is missing here! TODO */ 577*674ae819SStefano Zampini SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Not yet implemented for complexes when PETSC_MISSING_GESVD = 1"); 578*674ae819SStefano Zampini #endif 579*674ae819SStefano Zampini if (lierr) { 580*674ae819SStefano Zampini SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEVX Lapack routine %d",(int)lierr); 581*674ae819SStefano Zampini } 582*674ae819SStefano Zampini ierr = PetscFPTrapPop();CHKERRQ(ierr); 583*674ae819SStefano Zampini /* retain eigenvalues greater than tol: note that lapack SYEV gives eigs in ascending order */ 584*674ae819SStefano Zampini j=0; 585*674ae819SStefano Zampini while (j < Bt && singular_vals[j] < tol) j++; 586*674ae819SStefano Zampini total_counts=total_counts-j; 587*674ae819SStefano Zampini if (j<temp_constraints) { 588*674ae819SStefano Zampini for (k=j;k<Bt;k++) { 589*674ae819SStefano Zampini singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]); 590*674ae819SStefano Zampini } 591*674ae819SStefano Zampini ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 592*674ae819SStefano Zampini BLASgemm_("N","N",&Bs,&Bt,&Bt,&one,&temp_quadrature_constraint[temp_indices[temp_start_ptr]],&Bs,correlation_mat,&Bt,&zero,temp_basis,&Bs); 593*674ae819SStefano Zampini ierr = PetscFPTrapPop();CHKERRQ(ierr); 594*674ae819SStefano Zampini /* copy POD basis into used quadrature memory */ 595*674ae819SStefano Zampini for (k=0;k<Bt-j;k++) { 596*674ae819SStefano Zampini for (ii=0;ii<size_of_constraint;ii++) { 597*674ae819SStefano Zampini temp_quadrature_constraint[temp_indices[temp_start_ptr+k]+ii]=singular_vals[Bt-1-k]*temp_basis[(Bt-1-k)*size_of_constraint+ii]; 598*674ae819SStefano Zampini } 599*674ae819SStefano Zampini } 600*674ae819SStefano Zampini } 601*674ae819SStefano Zampini 602*674ae819SStefano Zampini #else /* on missing GESVD */ 603*674ae819SStefano Zampini PetscInt min_n = temp_constraints; 604*674ae819SStefano Zampini if (min_n > size_of_constraint) min_n = size_of_constraint; 605*674ae819SStefano Zampini dummy_int = Bs; 606*674ae819SStefano Zampini ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 607*674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX) 608*674ae819SStefano Zampini LAPACKgesvd_("O","N",&Bs,&Bt,&temp_quadrature_constraint[temp_indices[temp_start_ptr]],&Bs,singular_vals, 609*674ae819SStefano Zampini &dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,work,&lwork,&lierr); 610*674ae819SStefano Zampini #else 611*674ae819SStefano Zampini LAPACKgesvd_("O","N",&Bs,&Bt,&temp_quadrature_constraint[temp_indices[temp_start_ptr]],&Bs,singular_vals, 612*674ae819SStefano Zampini &dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,work,&lwork,rwork,&lierr); 613*674ae819SStefano Zampini #endif 614*674ae819SStefano Zampini if (lierr) { 615*674ae819SStefano Zampini SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SVD Lapack routine %d",(int)lierr); 616*674ae819SStefano Zampini } 617*674ae819SStefano Zampini ierr = PetscFPTrapPop();CHKERRQ(ierr); 618*674ae819SStefano Zampini /* retain eigenvalues greater than tol: note that lapack SVD gives eigs in descending order */ 619*674ae819SStefano Zampini j = 0; 620*674ae819SStefano Zampini while (j < min_n && singular_vals[min_n-j-1] < tol) j++; 621*674ae819SStefano Zampini total_counts = total_counts-(PetscInt)Bt+(min_n-j); 622*674ae819SStefano Zampini #endif 623*674ae819SStefano Zampini } 624*674ae819SStefano Zampini } 625*674ae819SStefano Zampini /* free index sets of faces, edges and vertices */ 626*674ae819SStefano Zampini for (i=0;i<n_ISForFaces;i++) { 627*674ae819SStefano Zampini ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr); 628*674ae819SStefano Zampini } 629*674ae819SStefano Zampini ierr = PetscFree(ISForFaces);CHKERRQ(ierr); 630*674ae819SStefano Zampini for (i=0;i<n_ISForEdges;i++) { 631*674ae819SStefano Zampini ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr); 632*674ae819SStefano Zampini } 633*674ae819SStefano Zampini ierr = PetscFree(ISForEdges);CHKERRQ(ierr); 634*674ae819SStefano Zampini ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr); 635*674ae819SStefano Zampini 636*674ae819SStefano Zampini /* set quantities in pcbddc data structure */ 637*674ae819SStefano Zampini /* n_vertices defines the number of point primal dofs */ 638*674ae819SStefano Zampini /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */ 639*674ae819SStefano Zampini local_primal_size = total_counts; 640*674ae819SStefano Zampini pcbddc->n_vertices = n_vertices; 641*674ae819SStefano Zampini pcbddc->n_constraints = total_counts-n_vertices; 642*674ae819SStefano Zampini pcbddc->local_primal_size = local_primal_size; 643*674ae819SStefano Zampini 644*674ae819SStefano Zampini /* Create constraint matrix */ 645*674ae819SStefano Zampini /* The constraint matrix is used to compute the l2g map of primal dofs */ 646*674ae819SStefano Zampini /* so we need to set it up properly either with or without change of basis */ 647*674ae819SStefano Zampini ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr); 648*674ae819SStefano Zampini ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr); 649*674ae819SStefano Zampini ierr = MatSetSizes(pcbddc->ConstraintMatrix,local_primal_size,pcis->n,local_primal_size,pcis->n);CHKERRQ(ierr); 650*674ae819SStefano Zampini /* compute a local numbering of constraints : vertices first then constraints */ 651*674ae819SStefano Zampini ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr); 652*674ae819SStefano Zampini ierr = VecGetArray(pcis->vec1_N,&array_vector);CHKERRQ(ierr); 653*674ae819SStefano Zampini ierr = PetscMalloc(local_primal_size*sizeof(PetscInt),&aux_primal_numbering);CHKERRQ(ierr); 654*674ae819SStefano Zampini ierr = PetscMalloc(local_primal_size*sizeof(PetscInt),&aux_primal_permutation);CHKERRQ(ierr); 655*674ae819SStefano Zampini total_counts=0; 656*674ae819SStefano Zampini /* find vertices: subdomain corners plus dofs with basis changed */ 657*674ae819SStefano Zampini for (i=0;i<local_primal_size;i++) { 658*674ae819SStefano Zampini size_of_constraint=temp_indices[i+1]-temp_indices[i]; 659*674ae819SStefano Zampini if (change_basis[i] || size_of_constraint == 1) { 660*674ae819SStefano Zampini k=0; 661*674ae819SStefano Zampini while(k < size_of_constraint && array_vector[temp_indices_to_constraint[temp_indices[i]+size_of_constraint-k-1]] != 0.0) { 662*674ae819SStefano Zampini k=k+1; 663*674ae819SStefano Zampini } 664*674ae819SStefano Zampini j=temp_indices_to_constraint[temp_indices[i]+size_of_constraint-k-1]; 665*674ae819SStefano Zampini array_vector[j] = 1.0; 666*674ae819SStefano Zampini aux_primal_numbering[total_counts]=j; 667*674ae819SStefano Zampini aux_primal_permutation[total_counts]=total_counts; 668*674ae819SStefano Zampini total_counts++; 669*674ae819SStefano Zampini } 670*674ae819SStefano Zampini } 671*674ae819SStefano Zampini ierr = VecRestoreArray(pcis->vec1_N,&array_vector);CHKERRQ(ierr); 672*674ae819SStefano Zampini /* permute indices in order to have a sorted set of vertices */ 673*674ae819SStefano Zampini ierr = PetscSortIntWithPermutation(total_counts,aux_primal_numbering,aux_primal_permutation); 674*674ae819SStefano Zampini /* nonzero structure */ 675*674ae819SStefano Zampini ierr = PetscMalloc(local_primal_size*sizeof(PetscInt),&nnz);CHKERRQ(ierr); 676*674ae819SStefano Zampini for (i=0;i<total_counts;i++) { 677*674ae819SStefano Zampini nnz[i]=1; 678*674ae819SStefano Zampini } 679*674ae819SStefano Zampini j=total_counts; 680*674ae819SStefano Zampini for (i=n_vertices;i<local_primal_size;i++) { 681*674ae819SStefano Zampini if (!change_basis[i]) { 682*674ae819SStefano Zampini nnz[j]=temp_indices[i+1]-temp_indices[i]; 683*674ae819SStefano Zampini j++; 684*674ae819SStefano Zampini } 685*674ae819SStefano Zampini } 686*674ae819SStefano Zampini ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr); 687*674ae819SStefano Zampini ierr = PetscFree(nnz);CHKERRQ(ierr); 688*674ae819SStefano Zampini /* set values in constraint matrix */ 689*674ae819SStefano Zampini for (i=0;i<total_counts;i++) { 690*674ae819SStefano Zampini j = aux_primal_permutation[i]; 691*674ae819SStefano Zampini k = aux_primal_numbering[j]; 692*674ae819SStefano Zampini ierr = MatSetValue(pcbddc->ConstraintMatrix,i,k,1.0,INSERT_VALUES);CHKERRQ(ierr); 693*674ae819SStefano Zampini } 694*674ae819SStefano Zampini for (i=n_vertices;i<local_primal_size;i++) { 695*674ae819SStefano Zampini if (!change_basis[i]) { 696*674ae819SStefano Zampini size_of_constraint=temp_indices[i+1]-temp_indices[i]; 697*674ae819SStefano 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); 698*674ae819SStefano Zampini total_counts++; 699*674ae819SStefano Zampini } 700*674ae819SStefano Zampini } 701*674ae819SStefano Zampini ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr); 702*674ae819SStefano Zampini ierr = PetscFree(aux_primal_permutation);CHKERRQ(ierr); 703*674ae819SStefano Zampini /* assembling */ 704*674ae819SStefano Zampini ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 705*674ae819SStefano Zampini ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 706*674ae819SStefano Zampini 707*674ae819SStefano Zampini /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */ 708*674ae819SStefano Zampini if (pcbddc->use_change_of_basis) { 709*674ae819SStefano Zampini ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr); 710*674ae819SStefano Zampini ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr); 711*674ae819SStefano Zampini ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr); 712*674ae819SStefano Zampini /* work arrays */ 713*674ae819SStefano Zampini /* we need to reuse these arrays, so we free them */ 714*674ae819SStefano Zampini ierr = PetscFree(temp_basis);CHKERRQ(ierr); 715*674ae819SStefano Zampini ierr = PetscFree(work);CHKERRQ(ierr); 716*674ae819SStefano Zampini ierr = PetscMalloc(pcis->n_B*sizeof(PetscInt),&nnz);CHKERRQ(ierr); 717*674ae819SStefano Zampini ierr = PetscMalloc((nnsp_addone+nnsp_size)*(nnsp_addone+nnsp_size)*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr); 718*674ae819SStefano Zampini ierr = PetscMalloc((nnsp_addone+nnsp_size)*sizeof(PetscScalar),&work);CHKERRQ(ierr); 719*674ae819SStefano Zampini ierr = PetscMalloc((nnsp_addone+nnsp_size)*sizeof(PetscBLASInt),&ipiv);CHKERRQ(ierr); 720*674ae819SStefano Zampini for (i=0;i<pcis->n_B;i++) { 721*674ae819SStefano Zampini nnz[i]=1; 722*674ae819SStefano Zampini } 723*674ae819SStefano Zampini /* Overestimated nonzeros per row */ 724*674ae819SStefano Zampini k=1; 725*674ae819SStefano Zampini for (i=pcbddc->n_vertices;i<local_primal_size;i++) { 726*674ae819SStefano Zampini if (change_basis[i]) { 727*674ae819SStefano Zampini size_of_constraint = temp_indices[i+1]-temp_indices[i]; 728*674ae819SStefano Zampini if (k < size_of_constraint) { 729*674ae819SStefano Zampini k = size_of_constraint; 730*674ae819SStefano Zampini } 731*674ae819SStefano Zampini for (j=0;j<size_of_constraint;j++) { 732*674ae819SStefano Zampini nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint; 733*674ae819SStefano Zampini } 734*674ae819SStefano Zampini } 735*674ae819SStefano Zampini } 736*674ae819SStefano Zampini ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr); 737*674ae819SStefano Zampini ierr = PetscFree(nnz);CHKERRQ(ierr); 738*674ae819SStefano Zampini /* Temporary array to store indices */ 739*674ae819SStefano Zampini ierr = PetscMalloc(k*sizeof(PetscInt),&is_indices);CHKERRQ(ierr); 740*674ae819SStefano Zampini /* Set initial identity in the matrix */ 741*674ae819SStefano Zampini for (i=0;i<pcis->n_B;i++) { 742*674ae819SStefano Zampini ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr); 743*674ae819SStefano Zampini } 744*674ae819SStefano Zampini /* Now we loop on the constraints which need a change of basis */ 745*674ae819SStefano Zampini /* Change of basis matrix is evaluated as the FIRST APPROACH in */ 746*674ae819SStefano Zampini /* Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (6.2.1) */ 747*674ae819SStefano Zampini temp_constraints = 0; 748*674ae819SStefano Zampini if (pcbddc->n_vertices < local_primal_size) { 749*674ae819SStefano Zampini temp_start_ptr = temp_indices_to_constraint_B[temp_indices[pcbddc->n_vertices]]; 750*674ae819SStefano Zampini } 751*674ae819SStefano Zampini for (i=pcbddc->n_vertices;i<local_primal_size;i++) { 752*674ae819SStefano Zampini if (change_basis[i]) { 753*674ae819SStefano Zampini compute_submatrix = PETSC_FALSE; 754*674ae819SStefano Zampini useksp = PETSC_FALSE; 755*674ae819SStefano Zampini if (temp_start_ptr == temp_indices_to_constraint_B[temp_indices[i]]) { 756*674ae819SStefano Zampini temp_constraints++; 757*674ae819SStefano Zampini if (i == local_primal_size -1 || temp_start_ptr != temp_indices_to_constraint_B[temp_indices[i+1]]) { 758*674ae819SStefano Zampini compute_submatrix = PETSC_TRUE; 759*674ae819SStefano Zampini } 760*674ae819SStefano Zampini } 761*674ae819SStefano Zampini if (compute_submatrix) { 762*674ae819SStefano Zampini if (temp_constraints > 1 || pcbddc->use_nnsp_true) { 763*674ae819SStefano Zampini useksp = PETSC_TRUE; 764*674ae819SStefano Zampini } 765*674ae819SStefano Zampini size_of_constraint = temp_indices[i+1]-temp_indices[i]; 766*674ae819SStefano Zampini if (useksp) { /* experimental TODO: reuse KSP and MAT instead of creating them each time */ 767*674ae819SStefano Zampini ierr = MatCreate(PETSC_COMM_SELF,&temp_mat);CHKERRQ(ierr); 768*674ae819SStefano Zampini ierr = MatSetType(temp_mat,impMatType);CHKERRQ(ierr); 769*674ae819SStefano Zampini ierr = MatSetSizes(temp_mat,size_of_constraint,size_of_constraint,size_of_constraint,size_of_constraint);CHKERRQ(ierr); 770*674ae819SStefano Zampini ierr = MatSeqAIJSetPreallocation(temp_mat,size_of_constraint,NULL);CHKERRQ(ierr); 771*674ae819SStefano Zampini } 772*674ae819SStefano Zampini /* First _size_of_constraint-temp_constraints_ columns */ 773*674ae819SStefano Zampini dual_dofs = size_of_constraint-temp_constraints; 774*674ae819SStefano Zampini start_constraint = i+1-temp_constraints; 775*674ae819SStefano Zampini for (s=0;s<dual_dofs;s++) { 776*674ae819SStefano Zampini is_indices[0] = s; 777*674ae819SStefano Zampini for (j=0;j<temp_constraints;j++) { 778*674ae819SStefano Zampini for (k=0;k<temp_constraints;k++) { 779*674ae819SStefano Zampini temp_basis[j*temp_constraints+k]=temp_quadrature_constraint[temp_indices[start_constraint+k]+s+j+1]; 780*674ae819SStefano Zampini } 781*674ae819SStefano Zampini work[j]=-temp_quadrature_constraint[temp_indices[start_constraint+j]+s]; 782*674ae819SStefano Zampini is_indices[j+1]=s+j+1; 783*674ae819SStefano Zampini } 784*674ae819SStefano Zampini Bt = temp_constraints; 785*674ae819SStefano Zampini ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 786*674ae819SStefano Zampini LAPACKgesv_(&Bt,&Bone,temp_basis,&Bt,ipiv,work,&Bt,&lierr); 787*674ae819SStefano Zampini if ( lierr ) { 788*674ae819SStefano Zampini SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESV Lapack routine %d",(int)lierr); 789*674ae819SStefano Zampini } 790*674ae819SStefano Zampini ierr = PetscFPTrapPop();CHKERRQ(ierr); 791*674ae819SStefano Zampini j = temp_indices_to_constraint_B[temp_indices[start_constraint]+s]; 792*674ae819SStefano Zampini ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,temp_constraints,&temp_indices_to_constraint_B[temp_indices[start_constraint]+s+1],1,&j,work,INSERT_VALUES);CHKERRQ(ierr); 793*674ae819SStefano Zampini if (useksp) { 794*674ae819SStefano Zampini /* temp mat with transposed rows and columns */ 795*674ae819SStefano Zampini ierr = MatSetValues(temp_mat,1,&s,temp_constraints,&is_indices[1],work,INSERT_VALUES);CHKERRQ(ierr); 796*674ae819SStefano Zampini ierr = MatSetValue(temp_mat,is_indices[0],is_indices[0],1.0,INSERT_VALUES);CHKERRQ(ierr); 797*674ae819SStefano Zampini } 798*674ae819SStefano Zampini } 799*674ae819SStefano Zampini if (useksp) { 800*674ae819SStefano Zampini /* last rows of temp_mat */ 801*674ae819SStefano Zampini for (j=0;j<size_of_constraint;j++) { 802*674ae819SStefano Zampini is_indices[j] = j; 803*674ae819SStefano Zampini } 804*674ae819SStefano Zampini for (s=0;s<temp_constraints;s++) { 805*674ae819SStefano Zampini k = s + dual_dofs; 806*674ae819SStefano Zampini ierr = MatSetValues(temp_mat,1,&k,size_of_constraint,is_indices,&temp_quadrature_constraint[temp_indices[start_constraint+s]],INSERT_VALUES);CHKERRQ(ierr); 807*674ae819SStefano Zampini } 808*674ae819SStefano Zampini ierr = MatAssemblyBegin(temp_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 809*674ae819SStefano Zampini ierr = MatAssemblyEnd(temp_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 810*674ae819SStefano Zampini ierr = MatGetVecs(temp_mat,&temp_vec,NULL);CHKERRQ(ierr); 811*674ae819SStefano Zampini ierr = KSPCreate(PETSC_COMM_SELF,&temp_ksp);CHKERRQ(ierr); 812*674ae819SStefano Zampini ierr = KSPSetOperators(temp_ksp,temp_mat,temp_mat,SAME_PRECONDITIONER);CHKERRQ(ierr); 813*674ae819SStefano Zampini ierr = KSPSetType(temp_ksp,KSPPREONLY);CHKERRQ(ierr); 814*674ae819SStefano Zampini ierr = KSPGetPC(temp_ksp,&temp_pc);CHKERRQ(ierr); 815*674ae819SStefano Zampini ierr = PCSetType(temp_pc,PCLU);CHKERRQ(ierr); 816*674ae819SStefano Zampini ierr = KSPSetUp(temp_ksp);CHKERRQ(ierr); 817*674ae819SStefano Zampini for (s=0;s<temp_constraints;s++) { 818*674ae819SStefano Zampini ierr = VecSet(temp_vec,0.0);CHKERRQ(ierr); 819*674ae819SStefano Zampini ierr = VecSetValue(temp_vec,s+dual_dofs,1.0,INSERT_VALUES);CHKERRQ(ierr); 820*674ae819SStefano Zampini ierr = VecAssemblyBegin(temp_vec);CHKERRQ(ierr); 821*674ae819SStefano Zampini ierr = VecAssemblyEnd(temp_vec);CHKERRQ(ierr); 822*674ae819SStefano Zampini ierr = KSPSolve(temp_ksp,temp_vec,temp_vec);CHKERRQ(ierr); 823*674ae819SStefano Zampini ierr = VecGetArray(temp_vec,&array_vector);CHKERRQ(ierr); 824*674ae819SStefano Zampini j = temp_indices_to_constraint_B[temp_indices[start_constraint+s]+size_of_constraint-s-1]; 825*674ae819SStefano Zampini /* last columns of change of basis matrix associated to new primal dofs */ 826*674ae819SStefano Zampini ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,&temp_indices_to_constraint_B[temp_indices[start_constraint+s]],1,&j,array_vector,INSERT_VALUES);CHKERRQ(ierr); 827*674ae819SStefano Zampini ierr = VecRestoreArray(temp_vec,&array_vector);CHKERRQ(ierr); 828*674ae819SStefano Zampini } 829*674ae819SStefano Zampini ierr = MatDestroy(&temp_mat);CHKERRQ(ierr); 830*674ae819SStefano Zampini ierr = KSPDestroy(&temp_ksp);CHKERRQ(ierr); 831*674ae819SStefano Zampini ierr = VecDestroy(&temp_vec);CHKERRQ(ierr); 832*674ae819SStefano Zampini } else { 833*674ae819SStefano Zampini /* last columns of change of basis matrix associated to new primal dofs */ 834*674ae819SStefano Zampini for (s=0;s<temp_constraints;s++) { 835*674ae819SStefano Zampini j = temp_indices_to_constraint_B[temp_indices[start_constraint+s]+size_of_constraint-s-1]; 836*674ae819SStefano Zampini ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,&temp_indices_to_constraint_B[temp_indices[start_constraint+s]],1,&j,&temp_quadrature_constraint[temp_indices[start_constraint+s]],INSERT_VALUES);CHKERRQ(ierr); 837*674ae819SStefano Zampini } 838*674ae819SStefano Zampini } 839*674ae819SStefano Zampini /* prepare for the next cycle */ 840*674ae819SStefano Zampini temp_constraints = 0; 841*674ae819SStefano Zampini if (i != local_primal_size -1 ) { 842*674ae819SStefano Zampini temp_start_ptr = temp_indices_to_constraint_B[temp_indices[i+1]]; 843*674ae819SStefano Zampini } 844*674ae819SStefano Zampini } 845*674ae819SStefano Zampini } 846*674ae819SStefano Zampini } 847*674ae819SStefano Zampini /* assembling */ 848*674ae819SStefano Zampini ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 849*674ae819SStefano Zampini ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 850*674ae819SStefano Zampini ierr = PetscFree(ipiv);CHKERRQ(ierr); 851*674ae819SStefano Zampini ierr = PetscFree(is_indices);CHKERRQ(ierr); 852*674ae819SStefano Zampini } 853*674ae819SStefano Zampini /* free workspace no longer needed */ 854*674ae819SStefano Zampini ierr = PetscFree(rwork);CHKERRQ(ierr); 855*674ae819SStefano Zampini ierr = PetscFree(work);CHKERRQ(ierr); 856*674ae819SStefano Zampini ierr = PetscFree(temp_basis);CHKERRQ(ierr); 857*674ae819SStefano Zampini ierr = PetscFree(singular_vals);CHKERRQ(ierr); 858*674ae819SStefano Zampini ierr = PetscFree(correlation_mat);CHKERRQ(ierr); 859*674ae819SStefano Zampini ierr = PetscFree(temp_indices);CHKERRQ(ierr); 860*674ae819SStefano Zampini ierr = PetscFree(change_basis);CHKERRQ(ierr); 861*674ae819SStefano Zampini ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr); 862*674ae819SStefano Zampini ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr); 863*674ae819SStefano Zampini ierr = PetscFree(local_to_B);CHKERRQ(ierr); 864*674ae819SStefano Zampini ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr); 865*674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD) 866*674ae819SStefano Zampini ierr = PetscFree(iwork);CHKERRQ(ierr); 867*674ae819SStefano Zampini ierr = PetscFree(ifail);CHKERRQ(ierr); 868*674ae819SStefano Zampini ierr = PetscFree(singular_vectors);CHKERRQ(ierr); 869*674ae819SStefano Zampini #endif 870*674ae819SStefano Zampini for (k=0;k<nnsp_size;k++) { 871*674ae819SStefano Zampini ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr); 872*674ae819SStefano Zampini } 873*674ae819SStefano Zampini ierr = PetscFree(localnearnullsp);CHKERRQ(ierr); 874*674ae819SStefano Zampini PetscFunctionReturn(0); 875*674ae819SStefano Zampini } 876*674ae819SStefano Zampini 877*674ae819SStefano Zampini #undef __FUNCT__ 878*674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface" 879*674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc) 880*674ae819SStefano Zampini { 881*674ae819SStefano Zampini PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 882*674ae819SStefano Zampini PC_IS *pcis = (PC_IS*)pc->data; 883*674ae819SStefano Zampini Mat_IS *matis = (Mat_IS*)pc->pmat->data; 884*674ae819SStefano Zampini PetscInt bs,ierr,i,vertex_size; 885*674ae819SStefano Zampini PetscViewer viewer=pcbddc->dbg_viewer; 886*674ae819SStefano Zampini 887*674ae819SStefano Zampini PetscFunctionBegin; 888*674ae819SStefano Zampini /* Init local Graph struct */ 889*674ae819SStefano Zampini ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr); 890*674ae819SStefano Zampini 891*674ae819SStefano Zampini /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */ 892*674ae819SStefano Zampini if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) { 893*674ae819SStefano Zampini Mat mat_adj; 894*674ae819SStefano Zampini const PetscInt *xadj,*adjncy; 895*674ae819SStefano Zampini PetscBool flg_row=PETSC_TRUE; 896*674ae819SStefano Zampini 897*674ae819SStefano Zampini ierr = MatConvert(matis->A,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr); 898*674ae819SStefano Zampini ierr = MatGetRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr); 899*674ae819SStefano Zampini if (!flg_row) { 900*674ae819SStefano Zampini SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ called in %s\n",__FUNCT__); 901*674ae819SStefano Zampini } 902*674ae819SStefano Zampini ierr = PCBDDCSetLocalAdjacencyGraph(pc,i,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr); 903*674ae819SStefano Zampini ierr = MatRestoreRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr); 904*674ae819SStefano Zampini if (!flg_row) { 905*674ae819SStefano Zampini SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__); 906*674ae819SStefano Zampini } 907*674ae819SStefano Zampini ierr = MatDestroy(&mat_adj);CHKERRQ(ierr); 908*674ae819SStefano Zampini } 909*674ae819SStefano Zampini 910*674ae819SStefano Zampini /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting */ 911*674ae819SStefano Zampini vertex_size = 1; 912*674ae819SStefano Zampini if (!pcbddc->n_ISForDofs) { 913*674ae819SStefano Zampini IS *custom_ISForDofs; 914*674ae819SStefano Zampini 915*674ae819SStefano Zampini ierr = MatGetBlockSize(matis->A,&bs);CHKERRQ(ierr); 916*674ae819SStefano Zampini ierr = PetscMalloc(bs*sizeof(IS),&custom_ISForDofs);CHKERRQ(ierr); 917*674ae819SStefano Zampini for (i=0;i<bs;i++) { 918*674ae819SStefano Zampini ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n/bs,i,bs,&custom_ISForDofs[i]);CHKERRQ(ierr); 919*674ae819SStefano Zampini } 920*674ae819SStefano Zampini ierr = PCBDDCSetDofsSplitting(pc,bs,custom_ISForDofs);CHKERRQ(ierr); 921*674ae819SStefano Zampini /* remove my references to IS objects */ 922*674ae819SStefano Zampini for (i=0;i<bs;i++) { 923*674ae819SStefano Zampini ierr = ISDestroy(&custom_ISForDofs[i]);CHKERRQ(ierr); 924*674ae819SStefano Zampini } 925*674ae819SStefano Zampini ierr = PetscFree(custom_ISForDofs);CHKERRQ(ierr); 926*674ae819SStefano Zampini } else { /* mat block size as vertex size (used for elasticity) */ 927*674ae819SStefano Zampini ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr); 928*674ae819SStefano Zampini } 929*674ae819SStefano Zampini 930*674ae819SStefano Zampini /* Setup of Graph */ 931*674ae819SStefano Zampini ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundaries,pcbddc->DirichletBoundaries,pcbddc->n_ISForDofs,pcbddc->ISForDofs,pcbddc->user_primal_vertices); 932*674ae819SStefano Zampini 933*674ae819SStefano Zampini /* Graph's connected components analysis */ 934*674ae819SStefano Zampini ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr); 935*674ae819SStefano Zampini 936*674ae819SStefano Zampini /* print some info to stdout */ 937*674ae819SStefano Zampini if (pcbddc->dbg_flag) { 938*674ae819SStefano Zampini ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,viewer); 939*674ae819SStefano Zampini } 940*674ae819SStefano Zampini PetscFunctionReturn(0); 941*674ae819SStefano Zampini } 942*674ae819SStefano Zampini 943*674ae819SStefano Zampini #undef __FUNCT__ 944*674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx" 945*674ae819SStefano Zampini PetscErrorCode PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt *vertices_idx[]) 946*674ae819SStefano Zampini { 947*674ae819SStefano Zampini PC_BDDC *pcbddc = (PC_BDDC*)(pc->data); 948*674ae819SStefano Zampini PetscInt *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size; 949*674ae819SStefano Zampini PetscErrorCode ierr; 950*674ae819SStefano Zampini 951*674ae819SStefano Zampini PetscFunctionBegin; 952*674ae819SStefano Zampini n = 0; 953*674ae819SStefano Zampini vertices = 0; 954*674ae819SStefano Zampini if (pcbddc->ConstraintMatrix) { 955*674ae819SStefano Zampini ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr); 956*674ae819SStefano Zampini ierr = PetscMalloc(local_primal_size*sizeof(PetscInt),&vertices);CHKERRQ(ierr); 957*674ae819SStefano Zampini for (i=0;i<local_primal_size;i++) { 958*674ae819SStefano Zampini ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr); 959*674ae819SStefano Zampini if (size_of_constraint == 1) { 960*674ae819SStefano Zampini vertices[n++]=row_cmat_indices[0]; 961*674ae819SStefano Zampini } 962*674ae819SStefano Zampini ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr); 963*674ae819SStefano Zampini } 964*674ae819SStefano Zampini } 965*674ae819SStefano Zampini *n_vertices = n; 966*674ae819SStefano Zampini *vertices_idx = vertices; 967*674ae819SStefano Zampini PetscFunctionReturn(0); 968*674ae819SStefano Zampini } 969*674ae819SStefano Zampini 970*674ae819SStefano Zampini #undef __FUNCT__ 971*674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx" 972*674ae819SStefano Zampini PetscErrorCode PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt *constraints_idx[]) 973*674ae819SStefano Zampini { 974*674ae819SStefano Zampini PC_BDDC *pcbddc = (PC_BDDC*)(pc->data); 975*674ae819SStefano Zampini PetscInt *constraints_index,*row_cmat_indices,*row_cmat_global_indices; 976*674ae819SStefano Zampini PetscInt n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc; 977*674ae819SStefano Zampini PetscBool *touched; 978*674ae819SStefano Zampini PetscErrorCode ierr; 979*674ae819SStefano Zampini 980*674ae819SStefano Zampini PetscFunctionBegin; 981*674ae819SStefano Zampini n = 0; 982*674ae819SStefano Zampini constraints_index = 0; 983*674ae819SStefano Zampini if (pcbddc->ConstraintMatrix) { 984*674ae819SStefano Zampini ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr); 985*674ae819SStefano Zampini max_size_of_constraint = 0; 986*674ae819SStefano Zampini for (i=0;i<local_primal_size;i++) { 987*674ae819SStefano Zampini ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr); 988*674ae819SStefano Zampini if (size_of_constraint > 1) { 989*674ae819SStefano Zampini n++; 990*674ae819SStefano Zampini } 991*674ae819SStefano Zampini max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint); 992*674ae819SStefano Zampini ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr); 993*674ae819SStefano Zampini } 994*674ae819SStefano Zampini ierr = PetscMalloc(n*sizeof(PetscInt),&constraints_index);CHKERRQ(ierr); 995*674ae819SStefano Zampini ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&row_cmat_global_indices);CHKERRQ(ierr); 996*674ae819SStefano Zampini ierr = PetscMalloc(local_size*sizeof(PetscBool),&touched);CHKERRQ(ierr); 997*674ae819SStefano Zampini ierr = PetscMemzero(touched,local_size*sizeof(PetscBool));CHKERRQ(ierr); 998*674ae819SStefano Zampini n = 0; 999*674ae819SStefano Zampini for (i=0;i<local_primal_size;i++) { 1000*674ae819SStefano Zampini ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr); 1001*674ae819SStefano Zampini if (size_of_constraint > 1) { 1002*674ae819SStefano Zampini ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr); 1003*674ae819SStefano Zampini min_index = row_cmat_global_indices[0]; 1004*674ae819SStefano Zampini min_loc = 0; 1005*674ae819SStefano Zampini for (j=1;j<size_of_constraint;j++) { 1006*674ae819SStefano Zampini /* there can be more than one constraint on a single connected component */ 1007*674ae819SStefano Zampini if (min_index > row_cmat_global_indices[j] && !touched[row_cmat_indices[j]]) { 1008*674ae819SStefano Zampini min_index = row_cmat_global_indices[j]; 1009*674ae819SStefano Zampini min_loc = j; 1010*674ae819SStefano Zampini } 1011*674ae819SStefano Zampini } 1012*674ae819SStefano Zampini touched[row_cmat_indices[min_loc]] = PETSC_TRUE; 1013*674ae819SStefano Zampini constraints_index[n++] = row_cmat_indices[min_loc]; 1014*674ae819SStefano Zampini } 1015*674ae819SStefano Zampini ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr); 1016*674ae819SStefano Zampini } 1017*674ae819SStefano Zampini } 1018*674ae819SStefano Zampini ierr = PetscFree(touched);CHKERRQ(ierr); 1019*674ae819SStefano Zampini ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr); 1020*674ae819SStefano Zampini *n_constraints = n; 1021*674ae819SStefano Zampini *constraints_idx = constraints_index; 1022*674ae819SStefano Zampini PetscFunctionReturn(0); 1023*674ae819SStefano Zampini } 1024*674ae819SStefano Zampini 1025*674ae819SStefano Zampini /* the next two functions has been adapted from pcis.c */ 1026*674ae819SStefano Zampini #undef __FUNCT__ 1027*674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchur" 1028*674ae819SStefano Zampini PetscErrorCode PCBDDCApplySchur(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D) 1029*674ae819SStefano Zampini { 1030*674ae819SStefano Zampini PetscErrorCode ierr; 1031*674ae819SStefano Zampini PC_IS *pcis = (PC_IS*)(pc->data); 1032*674ae819SStefano Zampini 1033*674ae819SStefano Zampini PetscFunctionBegin; 1034*674ae819SStefano Zampini if (!vec2_B) { vec2_B = v; } 1035*674ae819SStefano Zampini ierr = MatMult(pcis->A_BB,v,vec1_B);CHKERRQ(ierr); 1036*674ae819SStefano Zampini ierr = MatMult(pcis->A_IB,v,vec1_D);CHKERRQ(ierr); 1037*674ae819SStefano Zampini ierr = KSPSolve(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr); 1038*674ae819SStefano Zampini ierr = MatMult(pcis->A_BI,vec2_D,vec2_B);CHKERRQ(ierr); 1039*674ae819SStefano Zampini ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr); 1040*674ae819SStefano Zampini PetscFunctionReturn(0); 1041*674ae819SStefano Zampini } 1042*674ae819SStefano Zampini 1043*674ae819SStefano Zampini #undef __FUNCT__ 1044*674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchurTranspose" 1045*674ae819SStefano Zampini PetscErrorCode PCBDDCApplySchurTranspose(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D) 1046*674ae819SStefano Zampini { 1047*674ae819SStefano Zampini PetscErrorCode ierr; 1048*674ae819SStefano Zampini PC_IS *pcis = (PC_IS*)(pc->data); 1049*674ae819SStefano Zampini 1050*674ae819SStefano Zampini PetscFunctionBegin; 1051*674ae819SStefano Zampini if (!vec2_B) { vec2_B = v; } 1052*674ae819SStefano Zampini ierr = MatMultTranspose(pcis->A_BB,v,vec1_B);CHKERRQ(ierr); 1053*674ae819SStefano Zampini ierr = MatMultTranspose(pcis->A_BI,v,vec1_D);CHKERRQ(ierr); 1054*674ae819SStefano Zampini ierr = KSPSolveTranspose(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr); 1055*674ae819SStefano Zampini ierr = MatMultTranspose(pcis->A_IB,vec2_D,vec2_B);CHKERRQ(ierr); 1056*674ae819SStefano Zampini ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr); 1057*674ae819SStefano Zampini PetscFunctionReturn(0); 1058*674ae819SStefano Zampini } 1059*674ae819SStefano Zampini 1060*674ae819SStefano Zampini #undef __FUNCT__ 1061*674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering" 1062*674ae819SStefano 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[]) 1063*674ae819SStefano Zampini { 1064*674ae819SStefano Zampini Vec local_vec,global_vec; 1065*674ae819SStefano Zampini IS seqis,paris; 1066*674ae819SStefano Zampini VecScatter scatter_ctx; 1067*674ae819SStefano Zampini PetscScalar *array; 1068*674ae819SStefano Zampini PetscInt *temp_global_dofs; 1069*674ae819SStefano Zampini PetscScalar globalsum; 1070*674ae819SStefano Zampini PetscInt i,j,s; 1071*674ae819SStefano Zampini PetscInt nlocals,first_index,old_index,max_local; 1072*674ae819SStefano Zampini PetscMPIInt rank_prec_comm,size_prec_comm,max_global; 1073*674ae819SStefano Zampini PetscMPIInt *dof_sizes,*dof_displs; 1074*674ae819SStefano Zampini PetscBool first_found; 1075*674ae819SStefano Zampini PetscErrorCode ierr; 1076*674ae819SStefano Zampini 1077*674ae819SStefano Zampini PetscFunctionBegin; 1078*674ae819SStefano Zampini /* mpi buffers */ 1079*674ae819SStefano Zampini MPI_Comm_size(comm,&size_prec_comm); 1080*674ae819SStefano Zampini MPI_Comm_rank(comm,&rank_prec_comm); 1081*674ae819SStefano Zampini j = ( !rank_prec_comm ? size_prec_comm : 0); 1082*674ae819SStefano Zampini ierr = PetscMalloc(j*sizeof(*dof_sizes),&dof_sizes);CHKERRQ(ierr); 1083*674ae819SStefano Zampini ierr = PetscMalloc(j*sizeof(*dof_displs),&dof_displs);CHKERRQ(ierr); 1084*674ae819SStefano Zampini /* get maximum size of subset */ 1085*674ae819SStefano Zampini ierr = PetscMalloc(n_local_dofs*sizeof(PetscInt),&temp_global_dofs);CHKERRQ(ierr); 1086*674ae819SStefano Zampini ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr); 1087*674ae819SStefano Zampini max_local = 0; 1088*674ae819SStefano Zampini if (n_local_dofs) { 1089*674ae819SStefano Zampini max_local = temp_global_dofs[0]; 1090*674ae819SStefano Zampini for (i=1;i<n_local_dofs;i++) { 1091*674ae819SStefano Zampini if (max_local < temp_global_dofs[i] ) { 1092*674ae819SStefano Zampini max_local = temp_global_dofs[i]; 1093*674ae819SStefano Zampini } 1094*674ae819SStefano Zampini } 1095*674ae819SStefano Zampini } 1096*674ae819SStefano Zampini ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm); 1097*674ae819SStefano Zampini max_global++; 1098*674ae819SStefano Zampini max_local = 0; 1099*674ae819SStefano Zampini if (n_local_dofs) { 1100*674ae819SStefano Zampini max_local = local_dofs[0]; 1101*674ae819SStefano Zampini for (i=1;i<n_local_dofs;i++) { 1102*674ae819SStefano Zampini if (max_local < local_dofs[i] ) { 1103*674ae819SStefano Zampini max_local = local_dofs[i]; 1104*674ae819SStefano Zampini } 1105*674ae819SStefano Zampini } 1106*674ae819SStefano Zampini } 1107*674ae819SStefano Zampini max_local++; 1108*674ae819SStefano Zampini /* allocate workspace */ 1109*674ae819SStefano Zampini ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr); 1110*674ae819SStefano Zampini ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr); 1111*674ae819SStefano Zampini ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr); 1112*674ae819SStefano Zampini ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr); 1113*674ae819SStefano Zampini ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr); 1114*674ae819SStefano Zampini ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr); 1115*674ae819SStefano Zampini /* create scatter */ 1116*674ae819SStefano Zampini ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr); 1117*674ae819SStefano Zampini ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr); 1118*674ae819SStefano Zampini ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr); 1119*674ae819SStefano Zampini ierr = ISDestroy(&seqis);CHKERRQ(ierr); 1120*674ae819SStefano Zampini ierr = ISDestroy(&paris);CHKERRQ(ierr); 1121*674ae819SStefano Zampini /* init array */ 1122*674ae819SStefano Zampini ierr = VecSet(global_vec,0.0);CHKERRQ(ierr); 1123*674ae819SStefano Zampini ierr = VecSet(local_vec,0.0);CHKERRQ(ierr); 1124*674ae819SStefano Zampini ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr); 1125*674ae819SStefano Zampini if (local_dofs_mult) { 1126*674ae819SStefano Zampini for (i=0;i<n_local_dofs;i++) { 1127*674ae819SStefano Zampini array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i]; 1128*674ae819SStefano Zampini } 1129*674ae819SStefano Zampini } else { 1130*674ae819SStefano Zampini for (i=0;i<n_local_dofs;i++) { 1131*674ae819SStefano Zampini array[local_dofs[i]]=1.0; 1132*674ae819SStefano Zampini } 1133*674ae819SStefano Zampini } 1134*674ae819SStefano Zampini ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr); 1135*674ae819SStefano Zampini /* scatter into global vec and get total number of global dofs */ 1136*674ae819SStefano Zampini ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1137*674ae819SStefano Zampini ierr = VecScatterEnd (scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1138*674ae819SStefano Zampini ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr); 1139*674ae819SStefano Zampini *n_global_subset = (PetscInt)globalsum; 1140*674ae819SStefano Zampini /* Fill global_vec with cumulative function for global numbering */ 1141*674ae819SStefano Zampini ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr); 1142*674ae819SStefano Zampini ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr); 1143*674ae819SStefano Zampini nlocals = 0; 1144*674ae819SStefano Zampini first_index = -1; 1145*674ae819SStefano Zampini first_found = PETSC_FALSE; 1146*674ae819SStefano Zampini for (i=0;i<s;i++) { 1147*674ae819SStefano Zampini if (!first_found && array[i] > 0.0) { 1148*674ae819SStefano Zampini first_found = PETSC_TRUE; 1149*674ae819SStefano Zampini first_index = i; 1150*674ae819SStefano Zampini } 1151*674ae819SStefano Zampini nlocals += (PetscInt)array[i]; 1152*674ae819SStefano Zampini } 1153*674ae819SStefano Zampini ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr); 1154*674ae819SStefano Zampini if (!rank_prec_comm) { 1155*674ae819SStefano Zampini dof_displs[0]=0; 1156*674ae819SStefano Zampini for (i=1;i<size_prec_comm;i++) { 1157*674ae819SStefano Zampini dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1]; 1158*674ae819SStefano Zampini } 1159*674ae819SStefano Zampini } 1160*674ae819SStefano Zampini ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr); 1161*674ae819SStefano Zampini if (first_found) { 1162*674ae819SStefano Zampini array[first_index] += (PetscScalar)nlocals; 1163*674ae819SStefano Zampini old_index = first_index; 1164*674ae819SStefano Zampini for (i=first_index+1;i<s;i++) { 1165*674ae819SStefano Zampini if (array[i] > 0.0) { 1166*674ae819SStefano Zampini array[i] += array[old_index]; 1167*674ae819SStefano Zampini old_index = i; 1168*674ae819SStefano Zampini } 1169*674ae819SStefano Zampini } 1170*674ae819SStefano Zampini } 1171*674ae819SStefano Zampini ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr); 1172*674ae819SStefano Zampini ierr = VecSet(local_vec,0.0);CHKERRQ(ierr); 1173*674ae819SStefano Zampini ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1174*674ae819SStefano Zampini ierr = VecScatterEnd (scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1175*674ae819SStefano Zampini /* get global ordering of local dofs */ 1176*674ae819SStefano Zampini ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr); 1177*674ae819SStefano Zampini if (local_dofs_mult) { 1178*674ae819SStefano Zampini for (i=0;i<n_local_dofs;i++) { 1179*674ae819SStefano Zampini temp_global_dofs[i] = (PetscInt)array[local_dofs[i]]-local_dofs_mult[i]; 1180*674ae819SStefano Zampini } 1181*674ae819SStefano Zampini } else { 1182*674ae819SStefano Zampini for (i=0;i<n_local_dofs;i++) { 1183*674ae819SStefano Zampini temp_global_dofs[i] = (PetscInt)array[local_dofs[i]]-1; 1184*674ae819SStefano Zampini } 1185*674ae819SStefano Zampini } 1186*674ae819SStefano Zampini ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr); 1187*674ae819SStefano Zampini /* free workspace */ 1188*674ae819SStefano Zampini ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr); 1189*674ae819SStefano Zampini ierr = VecDestroy(&local_vec);CHKERRQ(ierr); 1190*674ae819SStefano Zampini ierr = VecDestroy(&global_vec);CHKERRQ(ierr); 1191*674ae819SStefano Zampini ierr = PetscFree(dof_sizes);CHKERRQ(ierr); 1192*674ae819SStefano Zampini ierr = PetscFree(dof_displs);CHKERRQ(ierr); 1193*674ae819SStefano Zampini /* return pointer to global ordering of local dofs */ 1194*674ae819SStefano Zampini *global_numbering_subset = temp_global_dofs; 1195*674ae819SStefano Zampini PetscFunctionReturn(0); 1196*674ae819SStefano Zampini } 1197