1674ae819SStefano Zampini #include "bddc.h" 2674ae819SStefano Zampini #include "bddcprivate.h" 3674ae819SStefano Zampini #include <petscblaslapack.h> 4674ae819SStefano Zampini 5674ae819SStefano Zampini #undef __FUNCT__ 6674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetCustomization" 7674ae819SStefano Zampini PetscErrorCode PCBDDCResetCustomization(PC pc) 8674ae819SStefano Zampini { 9674ae819SStefano Zampini PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 10674ae819SStefano Zampini PetscInt i; 11674ae819SStefano Zampini PetscErrorCode ierr; 12674ae819SStefano Zampini 13674ae819SStefano Zampini PetscFunctionBegin; 14674ae819SStefano Zampini ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr); 15674ae819SStefano Zampini ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr); 16674ae819SStefano Zampini ierr = MatNullSpaceDestroy(&pcbddc->NullSpace);CHKERRQ(ierr); 17674ae819SStefano Zampini ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr); 18674ae819SStefano Zampini ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr); 19674ae819SStefano Zampini for (i=0;i<pcbddc->n_ISForDofs;i++) { 20674ae819SStefano Zampini ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr); 21674ae819SStefano Zampini } 22674ae819SStefano Zampini ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr); 23674ae819SStefano Zampini PetscFunctionReturn(0); 24674ae819SStefano Zampini } 25674ae819SStefano Zampini 26674ae819SStefano Zampini #undef __FUNCT__ 27674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetTopography" 28674ae819SStefano Zampini PetscErrorCode PCBDDCResetTopography(PC pc) 29674ae819SStefano Zampini { 30674ae819SStefano Zampini PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 31674ae819SStefano Zampini PetscErrorCode ierr; 32674ae819SStefano Zampini 33674ae819SStefano Zampini PetscFunctionBegin; 34674ae819SStefano Zampini ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr); 35674ae819SStefano Zampini ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr); 36674ae819SStefano Zampini ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr); 37674ae819SStefano Zampini PetscFunctionReturn(0); 38674ae819SStefano Zampini } 39674ae819SStefano Zampini 40674ae819SStefano Zampini #undef __FUNCT__ 41674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetSolvers" 42674ae819SStefano Zampini PetscErrorCode PCBDDCResetSolvers(PC pc) 43674ae819SStefano Zampini { 44674ae819SStefano Zampini PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 45674ae819SStefano Zampini PetscErrorCode ierr; 46674ae819SStefano Zampini 47674ae819SStefano Zampini PetscFunctionBegin; 48674ae819SStefano Zampini ierr = VecDestroy(&pcbddc->temp_solution);CHKERRQ(ierr); 49674ae819SStefano Zampini ierr = VecDestroy(&pcbddc->original_rhs);CHKERRQ(ierr); 50674ae819SStefano Zampini ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr); 51674ae819SStefano Zampini ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr); 52674ae819SStefano Zampini ierr = VecDestroy(&pcbddc->coarse_rhs);CHKERRQ(ierr); 53674ae819SStefano Zampini ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr); 54674ae819SStefano Zampini ierr = MatDestroy(&pcbddc->coarse_mat);CHKERRQ(ierr); 55674ae819SStefano Zampini ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr); 56674ae819SStefano Zampini ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr); 5715aaf578SStefano Zampini ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr); 5815aaf578SStefano Zampini ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr); 59674ae819SStefano Zampini ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr); 60674ae819SStefano Zampini ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr); 61674ae819SStefano Zampini ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr); 62674ae819SStefano Zampini ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr); 63674ae819SStefano Zampini ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr); 64674ae819SStefano Zampini ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr); 65674ae819SStefano Zampini ierr = VecDestroy(&pcbddc->vec4_D);CHKERRQ(ierr); 66674ae819SStefano Zampini ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr); 67674ae819SStefano Zampini ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr); 68674ae819SStefano Zampini ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr); 69674ae819SStefano Zampini ierr = KSPDestroy(&pcbddc->ksp_D);CHKERRQ(ierr); 70674ae819SStefano Zampini ierr = KSPDestroy(&pcbddc->ksp_R);CHKERRQ(ierr); 71674ae819SStefano Zampini ierr = PetscFree(pcbddc->local_primal_indices);CHKERRQ(ierr); 72674ae819SStefano Zampini ierr = PetscFree(pcbddc->replicated_local_primal_indices);CHKERRQ(ierr); 73674ae819SStefano Zampini ierr = PetscFree(pcbddc->replicated_local_primal_values);CHKERRQ(ierr); 74674ae819SStefano Zampini ierr = PetscFree(pcbddc->local_primal_displacements);CHKERRQ(ierr); 75674ae819SStefano Zampini ierr = PetscFree(pcbddc->local_primal_sizes);CHKERRQ(ierr); 76674ae819SStefano Zampini PetscFunctionReturn(0); 77674ae819SStefano Zampini } 78674ae819SStefano Zampini 79674ae819SStefano Zampini #undef __FUNCT__ 80674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSolveSaddlePoint" 81674ae819SStefano Zampini static PetscErrorCode PCBDDCSolveSaddlePoint(PC pc) 82674ae819SStefano Zampini { 83674ae819SStefano Zampini PetscErrorCode ierr; 84674ae819SStefano Zampini PC_BDDC* pcbddc = (PC_BDDC*)(pc->data); 85674ae819SStefano Zampini 86674ae819SStefano Zampini PetscFunctionBegin; 87674ae819SStefano Zampini ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr); 88674ae819SStefano Zampini if (pcbddc->local_auxmat1) { 89674ae819SStefano Zampini ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec2_R,pcbddc->vec1_C);CHKERRQ(ierr); 90674ae819SStefano Zampini ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr); 91674ae819SStefano Zampini } 92674ae819SStefano Zampini PetscFunctionReturn(0); 93674ae819SStefano Zampini } 94674ae819SStefano Zampini 95674ae819SStefano Zampini #undef __FUNCT__ 96674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner" 97674ae819SStefano Zampini PetscErrorCode PCBDDCApplyInterfacePreconditioner(PC pc) 98674ae819SStefano Zampini { 99674ae819SStefano Zampini PetscErrorCode ierr; 100674ae819SStefano Zampini PC_BDDC* pcbddc = (PC_BDDC*)(pc->data); 101674ae819SStefano Zampini PC_IS* pcis = (PC_IS*) (pc->data); 102674ae819SStefano Zampini const PetscScalar zero = 0.0; 103674ae819SStefano Zampini 104674ae819SStefano Zampini PetscFunctionBegin; 10515aaf578SStefano Zampini /* Application of PHI^T (or PSI^T) */ 10615aaf578SStefano Zampini if (pcbddc->coarse_psi_B) { 10715aaf578SStefano Zampini ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr); 10815aaf578SStefano Zampini if (pcbddc->inexact_prec_type) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); } 10915aaf578SStefano Zampini } else { 110674ae819SStefano Zampini ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr); 111674ae819SStefano Zampini if (pcbddc->inexact_prec_type) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); } 11215aaf578SStefano Zampini } 113674ae819SStefano Zampini /* Scatter data of coarse_rhs */ 114674ae819SStefano Zampini if (pcbddc->coarse_rhs) { ierr = VecSet(pcbddc->coarse_rhs,zero);CHKERRQ(ierr); } 115674ae819SStefano Zampini ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 116674ae819SStefano Zampini 117674ae819SStefano Zampini /* Local solution on R nodes */ 118674ae819SStefano Zampini ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr); 119674ae819SStefano Zampini ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 120674ae819SStefano Zampini ierr = VecScatterEnd (pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 121674ae819SStefano Zampini if (pcbddc->inexact_prec_type) { 122674ae819SStefano Zampini ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 123674ae819SStefano Zampini ierr = VecScatterEnd (pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 124674ae819SStefano Zampini } 125674ae819SStefano Zampini ierr = PCBDDCSolveSaddlePoint(pc);CHKERRQ(ierr); 126674ae819SStefano Zampini ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr); 127674ae819SStefano Zampini ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 128674ae819SStefano Zampini ierr = VecScatterEnd (pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 129674ae819SStefano Zampini if (pcbddc->inexact_prec_type) { 130674ae819SStefano Zampini ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 131674ae819SStefano Zampini ierr = VecScatterEnd (pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 132674ae819SStefano Zampini } 133674ae819SStefano Zampini 134674ae819SStefano Zampini /* Coarse solution */ 135674ae819SStefano Zampini ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 136674ae819SStefano Zampini if (pcbddc->coarse_rhs) { /* TODO remove null space when doing multilevel */ 137674ae819SStefano Zampini ierr = KSPSolve(pcbddc->coarse_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr); 138674ae819SStefano Zampini } 139674ae819SStefano Zampini ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 140674ae819SStefano Zampini ierr = PCBDDCScatterCoarseDataEnd (pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 141674ae819SStefano Zampini 142674ae819SStefano Zampini /* Sum contributions from two levels */ 143674ae819SStefano Zampini ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr); 144674ae819SStefano Zampini if (pcbddc->inexact_prec_type) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); } 145674ae819SStefano Zampini PetscFunctionReturn(0); 146674ae819SStefano Zampini } 147674ae819SStefano Zampini 148674ae819SStefano Zampini #undef __FUNCT__ 149674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin" 150674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode) 151674ae819SStefano Zampini { 152674ae819SStefano Zampini PetscErrorCode ierr; 153674ae819SStefano Zampini PC_BDDC* pcbddc = (PC_BDDC*)(pc->data); 154674ae819SStefano Zampini 155674ae819SStefano Zampini PetscFunctionBegin; 156674ae819SStefano Zampini switch (pcbddc->coarse_communications_type) { 157674ae819SStefano Zampini case SCATTERS_BDDC: 158674ae819SStefano Zampini ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr); 159674ae819SStefano Zampini break; 160674ae819SStefano Zampini case GATHERS_BDDC: 161674ae819SStefano Zampini break; 162674ae819SStefano Zampini } 163674ae819SStefano Zampini PetscFunctionReturn(0); 164674ae819SStefano Zampini } 165674ae819SStefano Zampini 166674ae819SStefano Zampini #undef __FUNCT__ 167674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd" 168674ae819SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode) 169674ae819SStefano Zampini { 170674ae819SStefano Zampini PetscErrorCode ierr; 171674ae819SStefano Zampini PC_BDDC* pcbddc = (PC_BDDC*)(pc->data); 172674ae819SStefano Zampini PetscScalar* array_to; 173674ae819SStefano Zampini PetscScalar* array_from; 174674ae819SStefano Zampini MPI_Comm comm; 175674ae819SStefano Zampini PetscInt i; 176674ae819SStefano Zampini 177674ae819SStefano Zampini PetscFunctionBegin; 178674ae819SStefano Zampini ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr); 179674ae819SStefano Zampini switch (pcbddc->coarse_communications_type) { 180674ae819SStefano Zampini case SCATTERS_BDDC: 181674ae819SStefano Zampini ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr); 182674ae819SStefano Zampini break; 183674ae819SStefano Zampini case GATHERS_BDDC: 184674ae819SStefano Zampini if (vec_from) { 185674ae819SStefano Zampini ierr = VecGetArray(vec_from,&array_from);CHKERRQ(ierr); 186674ae819SStefano Zampini } 187674ae819SStefano Zampini if (vec_to) { 188674ae819SStefano Zampini ierr = VecGetArray(vec_to,&array_to);CHKERRQ(ierr); 189674ae819SStefano Zampini } 190674ae819SStefano Zampini switch(pcbddc->coarse_problem_type){ 191674ae819SStefano Zampini case SEQUENTIAL_BDDC: 192674ae819SStefano Zampini if (smode == SCATTER_FORWARD) { 193674ae819SStefano 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); 194674ae819SStefano Zampini if (vec_to) { 195674ae819SStefano Zampini if (imode == ADD_VALUES) { 196674ae819SStefano Zampini for (i=0;i<pcbddc->replicated_primal_size;i++) { 197674ae819SStefano Zampini array_to[pcbddc->replicated_local_primal_indices[i]]+=pcbddc->replicated_local_primal_values[i]; 198674ae819SStefano Zampini } 199674ae819SStefano Zampini } else { 200674ae819SStefano Zampini for (i=0;i<pcbddc->replicated_primal_size;i++) { 201674ae819SStefano Zampini array_to[pcbddc->replicated_local_primal_indices[i]]=pcbddc->replicated_local_primal_values[i]; 202674ae819SStefano Zampini } 203674ae819SStefano Zampini } 204674ae819SStefano Zampini } 205674ae819SStefano Zampini } else { 206674ae819SStefano Zampini if (vec_from) { 207674ae819SStefano Zampini if (imode == ADD_VALUES) { 208674ae819SStefano Zampini MPI_Comm vec_from_comm; 209674ae819SStefano Zampini ierr = PetscObjectGetComm((PetscObject)(vec_from),&vec_from_comm);CHKERRQ(ierr); 210674ae819SStefano 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); 211674ae819SStefano Zampini } 212674ae819SStefano Zampini for (i=0;i<pcbddc->replicated_primal_size;i++) { 213674ae819SStefano Zampini pcbddc->replicated_local_primal_values[i]=array_from[pcbddc->replicated_local_primal_indices[i]]; 214674ae819SStefano Zampini } 215674ae819SStefano Zampini } 216674ae819SStefano 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); 217674ae819SStefano Zampini } 218674ae819SStefano Zampini break; 219674ae819SStefano Zampini case REPLICATED_BDDC: 220674ae819SStefano Zampini if (smode == SCATTER_FORWARD) { 221674ae819SStefano 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); 222674ae819SStefano Zampini if (imode == ADD_VALUES) { 223674ae819SStefano Zampini for (i=0;i<pcbddc->replicated_primal_size;i++) { 224674ae819SStefano Zampini array_to[pcbddc->replicated_local_primal_indices[i]]+=pcbddc->replicated_local_primal_values[i]; 225674ae819SStefano Zampini } 226674ae819SStefano Zampini } else { 227674ae819SStefano Zampini for (i=0;i<pcbddc->replicated_primal_size;i++) { 228674ae819SStefano Zampini array_to[pcbddc->replicated_local_primal_indices[i]]=pcbddc->replicated_local_primal_values[i]; 229674ae819SStefano Zampini } 230674ae819SStefano Zampini } 231674ae819SStefano Zampini } else { /* no communications needed for SCATTER_REVERSE since needed data is already present */ 232674ae819SStefano Zampini if (imode == ADD_VALUES) { 233674ae819SStefano Zampini for (i=0;i<pcbddc->local_primal_size;i++) { 234674ae819SStefano Zampini array_to[i]+=array_from[pcbddc->local_primal_indices[i]]; 235674ae819SStefano Zampini } 236674ae819SStefano Zampini } else { 237674ae819SStefano Zampini for (i=0;i<pcbddc->local_primal_size;i++) { 238674ae819SStefano Zampini array_to[i]=array_from[pcbddc->local_primal_indices[i]]; 239674ae819SStefano Zampini } 240674ae819SStefano Zampini } 241674ae819SStefano Zampini } 242674ae819SStefano Zampini break; 243674ae819SStefano Zampini case MULTILEVEL_BDDC: 244674ae819SStefano Zampini break; 245674ae819SStefano Zampini case PARALLEL_BDDC: 246674ae819SStefano Zampini break; 247674ae819SStefano Zampini } 248674ae819SStefano Zampini if (vec_from) { 249674ae819SStefano Zampini ierr = VecRestoreArray(vec_from,&array_from);CHKERRQ(ierr); 250674ae819SStefano Zampini } 251674ae819SStefano Zampini if (vec_to) { 252674ae819SStefano Zampini ierr = VecRestoreArray(vec_to,&array_to);CHKERRQ(ierr); 253674ae819SStefano Zampini } 254674ae819SStefano Zampini break; 255674ae819SStefano Zampini } 256674ae819SStefano Zampini PetscFunctionReturn(0); 257674ae819SStefano Zampini } 258674ae819SStefano Zampini 259984c4197SStefano Zampini /* uncomment for testing purposes */ 260984c4197SStefano Zampini /* #define PETSC_MISSING_LAPACK_GESVD 1 */ 261674ae819SStefano Zampini #undef __FUNCT__ 262674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp" 263674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc) 264674ae819SStefano Zampini { 265674ae819SStefano Zampini PetscErrorCode ierr; 266674ae819SStefano Zampini PC_IS* pcis = (PC_IS*)(pc->data); 267674ae819SStefano Zampini PC_BDDC* pcbddc = (PC_BDDC*)pc->data; 268674ae819SStefano Zampini Mat_IS* matis = (Mat_IS*)pc->pmat->data; 269984c4197SStefano Zampini /* constraint and (optionally) change of basis matrix implemented as SeqAIJ */ 270674ae819SStefano Zampini MatType impMatType=MATSEQAIJ; 271984c4197SStefano Zampini /* one and zero */ 272984c4197SStefano Zampini PetscScalar one=1.0,zero=0.0; 273984c4197SStefano Zampini /* space to store constraints and their local indices */ 274984c4197SStefano Zampini PetscScalar *temp_quadrature_constraint; 275984c4197SStefano Zampini PetscInt *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B; 276984c4197SStefano Zampini /* iterators */ 277984c4197SStefano Zampini PetscInt i,j,k,total_counts,temp_start_ptr; 278984c4197SStefano Zampini /* stuff to store connected components stored in pcbddc->mat_graph */ 279984c4197SStefano Zampini IS ISForVertices,*ISForFaces,*ISForEdges,*used_IS; 280984c4197SStefano Zampini PetscInt n_ISForFaces,n_ISForEdges; 281984c4197SStefano Zampini PetscBool get_faces,get_edges,get_vertices; 282984c4197SStefano Zampini /* near null space stuff */ 283674ae819SStefano Zampini MatNullSpace nearnullsp; 284674ae819SStefano Zampini const Vec *nearnullvecs; 285674ae819SStefano Zampini Vec *localnearnullsp; 286984c4197SStefano Zampini PetscBool nnsp_has_cnst; 287984c4197SStefano Zampini PetscInt nnsp_size; 288984c4197SStefano Zampini PetscScalar *array; 289984c4197SStefano Zampini /* BLAS integers */ 290*e310c8b4SStefano Zampini PetscBLASInt lwork,lierr; 291*e310c8b4SStefano Zampini PetscBLASInt Blas_N,Blas_M,Blas_K,Blas_one=1; 292c4303822SStefano Zampini PetscBLASInt Blas_LDA,Blas_LDB,Blas_LDC; 293984c4197SStefano Zampini /* LAPACK working arrays for SVD or POD */ 294242a89d7SStefano Zampini PetscBool skip_lapack; 295984c4197SStefano Zampini PetscScalar *work; 296984c4197SStefano Zampini PetscReal *singular_vals; 297984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX) 298984c4197SStefano Zampini PetscReal *rwork; 299674ae819SStefano Zampini #endif 300984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD) 301*e310c8b4SStefano Zampini PetscBLASInt Blas_one_2=1; 302984c4197SStefano Zampini PetscScalar *temp_basis,*correlation_mat; 303b7d8b9f8SStefano Zampini #else 304b7d8b9f8SStefano Zampini PetscBLASInt dummy_int_1=1,dummy_int_2=1; 305b7d8b9f8SStefano Zampini PetscScalar dummy_scalar_1=0.0,dummy_scalar_2=0.0; 306984c4197SStefano Zampini #endif 307984c4197SStefano Zampini /* change of basis */ 308984c4197SStefano Zampini PetscInt *aux_primal_numbering,*aux_primal_minloc,*global_indices; 309984c4197SStefano Zampini PetscBool boolforchange,*change_basis,*touched; 310984c4197SStefano Zampini /* auxiliary stuff */ 311984c4197SStefano Zampini PetscInt *nnz,*is_indices,*local_to_B; 312984c4197SStefano Zampini /* some quantities */ 313984c4197SStefano Zampini PetscInt n_vertices,total_primal_vertices; 314984c4197SStefano Zampini PetscInt size_of_constraint,max_size_of_constraint,max_constraints,temp_constraints; 315984c4197SStefano Zampini 316674ae819SStefano Zampini 317674ae819SStefano Zampini PetscFunctionBegin; 318674ae819SStefano Zampini /* Get index sets for faces, edges and vertices from graph */ 319674ae819SStefano Zampini get_faces = PETSC_TRUE; 320674ae819SStefano Zampini get_edges = PETSC_TRUE; 321674ae819SStefano Zampini get_vertices = PETSC_TRUE; 322674ae819SStefano Zampini if (pcbddc->vertices_flag) { 323674ae819SStefano Zampini get_faces = PETSC_FALSE; 324674ae819SStefano Zampini get_edges = PETSC_FALSE; 325674ae819SStefano Zampini } 326674ae819SStefano Zampini if (pcbddc->constraints_flag) { 327674ae819SStefano Zampini get_vertices = PETSC_FALSE; 328674ae819SStefano Zampini } 329674ae819SStefano Zampini if (pcbddc->faces_flag) { 330674ae819SStefano Zampini get_edges = PETSC_FALSE; 331674ae819SStefano Zampini } 332674ae819SStefano Zampini if (pcbddc->edges_flag) { 333674ae819SStefano Zampini get_faces = PETSC_FALSE; 334674ae819SStefano Zampini } 335674ae819SStefano Zampini /* default */ 336674ae819SStefano Zampini if (!get_faces && !get_edges && !get_vertices) { 337674ae819SStefano Zampini get_vertices = PETSC_TRUE; 338674ae819SStefano Zampini } 339674ae819SStefano Zampini ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,get_faces,get_edges,get_vertices,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices); 340984c4197SStefano Zampini /* print some info */ 341674ae819SStefano Zampini if (pcbddc->dbg_flag) { 342674ae819SStefano Zampini ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr); 343674ae819SStefano Zampini i = 0; 344674ae819SStefano Zampini if (ISForVertices) { 345674ae819SStefano Zampini ierr = ISGetSize(ISForVertices,&i);CHKERRQ(ierr); 346674ae819SStefano Zampini } 347674ae819SStefano Zampini ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices\n",PetscGlobalRank,i);CHKERRQ(ierr); 348674ae819SStefano Zampini ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges\n",PetscGlobalRank,n_ISForEdges);CHKERRQ(ierr); 34915aaf578SStefano Zampini ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces\n",PetscGlobalRank,n_ISForFaces);CHKERRQ(ierr); 350674ae819SStefano Zampini ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 351674ae819SStefano Zampini } 352674ae819SStefano Zampini /* check if near null space is attached to global mat */ 353674ae819SStefano Zampini ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr); 354674ae819SStefano Zampini if (nearnullsp) { 355674ae819SStefano Zampini ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr); 356984c4197SStefano Zampini } else { /* if near null space is not provided BDDC uses constants by default */ 357984c4197SStefano Zampini nnsp_size = 0; 358674ae819SStefano Zampini nnsp_has_cnst = PETSC_TRUE; 359674ae819SStefano Zampini } 360984c4197SStefano Zampini /* get max number of constraints on a single cc */ 361984c4197SStefano Zampini max_constraints = nnsp_size; 362984c4197SStefano Zampini if (nnsp_has_cnst) max_constraints++; 363984c4197SStefano Zampini 364674ae819SStefano Zampini /* 365674ae819SStefano Zampini Evaluate maximum storage size needed by the procedure 366674ae819SStefano Zampini - temp_indices will contain start index of each constraint stored as follows 367674ae819SStefano 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 368674ae819SStefano 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 369674ae819SStefano Zampini - temp_quadrature_constraint [temp_indices[i],...,temp[indices[i+1]-1] will contain the scalars representing the constraint itself 370674ae819SStefano Zampini */ 371674ae819SStefano Zampini total_counts = n_ISForFaces+n_ISForEdges; 372984c4197SStefano Zampini total_counts *= max_constraints; 373674ae819SStefano Zampini n_vertices = 0; 374674ae819SStefano Zampini if (ISForVertices) { 375674ae819SStefano Zampini ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr); 376674ae819SStefano Zampini } 377674ae819SStefano Zampini total_counts += n_vertices; 378674ae819SStefano Zampini ierr = PetscMalloc((total_counts+1)*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr); 379674ae819SStefano Zampini ierr = PetscMalloc((total_counts+1)*sizeof(PetscBool),&change_basis);CHKERRQ(ierr); 380674ae819SStefano Zampini total_counts = 0; 381674ae819SStefano Zampini max_size_of_constraint = 0; 382674ae819SStefano Zampini for (i=0;i<n_ISForEdges+n_ISForFaces;i++) { 383674ae819SStefano Zampini if (i<n_ISForEdges) { 384674ae819SStefano Zampini used_IS = &ISForEdges[i]; 385674ae819SStefano Zampini } else { 386674ae819SStefano Zampini used_IS = &ISForFaces[i-n_ISForEdges]; 387674ae819SStefano Zampini } 388674ae819SStefano Zampini ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr); 389674ae819SStefano Zampini total_counts += j; 390674ae819SStefano Zampini max_size_of_constraint = PetscMax(j,max_size_of_constraint); 391674ae819SStefano Zampini } 392984c4197SStefano Zampini total_counts *= max_constraints; 393674ae819SStefano Zampini total_counts += n_vertices; 394674ae819SStefano Zampini ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&temp_quadrature_constraint);CHKERRQ(ierr); 395674ae819SStefano Zampini ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint);CHKERRQ(ierr); 396674ae819SStefano Zampini ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint_B);CHKERRQ(ierr); 397984c4197SStefano Zampini /* local to boundary numbering */ 398674ae819SStefano Zampini ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&local_to_B);CHKERRQ(ierr); 399674ae819SStefano Zampini ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 400984c4197SStefano Zampini for (i=0;i<pcis->n;i++) local_to_B[i]=-1; 401984c4197SStefano Zampini for (i=0;i<pcis->n_B;i++) local_to_B[is_indices[i]]=i; 402674ae819SStefano Zampini ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 403984c4197SStefano Zampini /* get local part of global near null space vectors */ 404984c4197SStefano Zampini ierr = PetscMalloc(nnsp_size*sizeof(Vec),&localnearnullsp);CHKERRQ(ierr); 405984c4197SStefano Zampini for (k=0;k<nnsp_size;k++) { 406984c4197SStefano Zampini ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr); 407984c4197SStefano Zampini ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 408984c4197SStefano Zampini ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 409984c4197SStefano Zampini } 410674ae819SStefano Zampini 411242a89d7SStefano Zampini /* whether or not to skip lapack calls */ 412242a89d7SStefano Zampini skip_lapack = PETSC_TRUE; 413242a89d7SStefano Zampini if (n_ISForFaces+n_ISForEdges) skip_lapack = PETSC_FALSE; 414242a89d7SStefano Zampini 415984c4197SStefano Zampini /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */ 416242a89d7SStefano Zampini if (!pcbddc->use_nnsp_true && !skip_lapack) { 417674ae819SStefano Zampini PetscScalar temp_work; 418674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD) 419984c4197SStefano Zampini /* Proper Orthogonal Decomposition (POD) using the snapshot method */ 420984c4197SStefano Zampini ierr = PetscMalloc(max_constraints*max_constraints*sizeof(PetscScalar),&correlation_mat);CHKERRQ(ierr); 421984c4197SStefano Zampini ierr = PetscMalloc(max_constraints*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr); 422984c4197SStefano Zampini ierr = PetscMalloc(max_size_of_constraint*max_constraints*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr); 423674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX) 424984c4197SStefano Zampini ierr = PetscMalloc(3*max_constraints*sizeof(PetscReal),&rwork);CHKERRQ(ierr); 425674ae819SStefano Zampini #endif 426674ae819SStefano Zampini /* now we evaluate the optimal workspace using query with lwork=-1 */ 427c8244a33SStefano Zampini ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr); 428c8244a33SStefano Zampini ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr); 429674ae819SStefano Zampini lwork = -1; 430674ae819SStefano Zampini ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 431674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX) 432c8244a33SStefano Zampini PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr)); 433674ae819SStefano Zampini #else 434c8244a33SStefano Zampini PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr)); 435674ae819SStefano Zampini #endif 436674ae819SStefano Zampini ierr = PetscFPTrapPop();CHKERRQ(ierr); 437984c4197SStefano Zampini if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr); 438674ae819SStefano Zampini #else /* on missing GESVD */ 439674ae819SStefano Zampini /* SVD */ 440674ae819SStefano Zampini PetscInt max_n,min_n; 441674ae819SStefano Zampini max_n = max_size_of_constraint; 442984c4197SStefano Zampini min_n = max_constraints; 443984c4197SStefano Zampini if (max_size_of_constraint < max_constraints) { 444674ae819SStefano Zampini min_n = max_size_of_constraint; 445984c4197SStefano Zampini max_n = max_constraints; 446674ae819SStefano Zampini } 447674ae819SStefano Zampini ierr = PetscMalloc(min_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr); 448674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX) 449674ae819SStefano Zampini ierr = PetscMalloc(5*min_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr); 450674ae819SStefano Zampini #endif 451674ae819SStefano Zampini /* now we evaluate the optimal workspace using query with lwork=-1 */ 452674ae819SStefano Zampini lwork = -1; 453*e310c8b4SStefano Zampini ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr); 454*e310c8b4SStefano Zampini ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr); 455b7d8b9f8SStefano Zampini ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr); 456674ae819SStefano Zampini ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 457674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX) 458*e310c8b4SStefano 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)); 459674ae819SStefano Zampini #else 460*e310c8b4SStefano 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)); 461674ae819SStefano Zampini #endif 462674ae819SStefano Zampini ierr = PetscFPTrapPop();CHKERRQ(ierr); 463984c4197SStefano Zampini if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr); 464984c4197SStefano Zampini #endif /* on missing GESVD */ 465674ae819SStefano Zampini /* Allocate optimal workspace */ 466674ae819SStefano Zampini ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr); 467984c4197SStefano Zampini ierr = PetscMalloc((PetscInt)lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr); 468674ae819SStefano Zampini } 469674ae819SStefano Zampini /* Now we can loop on constraining sets */ 470674ae819SStefano Zampini total_counts = 0; 471674ae819SStefano Zampini temp_indices[0] = 0; 472674ae819SStefano Zampini /* vertices */ 473674ae819SStefano Zampini if (ISForVertices) { 474674ae819SStefano Zampini ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr); 475674ae819SStefano Zampini if (nnsp_has_cnst) { /* consider all vertices */ 476674ae819SStefano Zampini for (i=0;i<n_vertices;i++) { 477674ae819SStefano Zampini temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i]; 478674ae819SStefano Zampini temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]]; 479674ae819SStefano Zampini temp_quadrature_constraint[temp_indices[total_counts]]=1.0; 480674ae819SStefano Zampini temp_indices[total_counts+1]=temp_indices[total_counts]+1; 481674ae819SStefano Zampini change_basis[total_counts]=PETSC_FALSE; 482674ae819SStefano Zampini total_counts++; 483674ae819SStefano Zampini } 484674ae819SStefano Zampini } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */ 485984c4197SStefano Zampini PetscBool used_vertex; 486674ae819SStefano Zampini for (i=0;i<n_vertices;i++) { 487674ae819SStefano Zampini used_vertex = PETSC_FALSE; 488674ae819SStefano Zampini k = 0; 489674ae819SStefano Zampini while (!used_vertex && k<nnsp_size) { 490984c4197SStefano Zampini ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr); 491984c4197SStefano Zampini if (PetscAbsScalar(array[is_indices[i]])>0.0) { 492674ae819SStefano Zampini temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i]; 493674ae819SStefano Zampini temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]]; 494674ae819SStefano Zampini temp_quadrature_constraint[temp_indices[total_counts]]=1.0; 495674ae819SStefano Zampini temp_indices[total_counts+1]=temp_indices[total_counts]+1; 496674ae819SStefano Zampini change_basis[total_counts]=PETSC_FALSE; 497674ae819SStefano Zampini total_counts++; 498674ae819SStefano Zampini used_vertex = PETSC_TRUE; 499674ae819SStefano Zampini } 500984c4197SStefano Zampini ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr); 501674ae819SStefano Zampini k++; 502674ae819SStefano Zampini } 503674ae819SStefano Zampini } 504674ae819SStefano Zampini } 505674ae819SStefano Zampini ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr); 506674ae819SStefano Zampini n_vertices = total_counts; 507674ae819SStefano Zampini } 508984c4197SStefano Zampini 509674ae819SStefano Zampini /* edges and faces */ 510674ae819SStefano Zampini for (i=0;i<n_ISForEdges+n_ISForFaces;i++) { 511674ae819SStefano Zampini if (i<n_ISForEdges) { 512674ae819SStefano Zampini used_IS = &ISForEdges[i]; 513984c4197SStefano Zampini boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */ 514674ae819SStefano Zampini } else { 515674ae819SStefano Zampini used_IS = &ISForFaces[i-n_ISForEdges]; 516984c4197SStefano Zampini boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */ 517674ae819SStefano Zampini } 518674ae819SStefano Zampini temp_constraints = 0; /* zero the number of constraints I have on this conn comp */ 519674ae819SStefano Zampini temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */ 520674ae819SStefano Zampini ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr); 521674ae819SStefano Zampini ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr); 522984c4197SStefano Zampini /* change of basis should not be performed on local periodic nodes */ 523984c4197SStefano Zampini if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE; 524674ae819SStefano Zampini if (nnsp_has_cnst) { 5255b08dc53SStefano Zampini PetscScalar quad_value; 526674ae819SStefano Zampini temp_constraints++; 527674ae819SStefano Zampini quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint)); 528674ae819SStefano Zampini for (j=0;j<size_of_constraint;j++) { 529674ae819SStefano Zampini temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j]; 530674ae819SStefano Zampini temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]]; 531674ae819SStefano Zampini temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value; 532674ae819SStefano Zampini } 533674ae819SStefano Zampini temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint; /* store new starting point */ 53451b0f6cfSStefano Zampini change_basis[total_counts]=boolforchange; 535674ae819SStefano Zampini total_counts++; 536674ae819SStefano Zampini } 537674ae819SStefano Zampini for (k=0;k<nnsp_size;k++) { 538984c4197SStefano Zampini PetscReal real_value; 539984c4197SStefano Zampini ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr); 540674ae819SStefano Zampini for (j=0;j<size_of_constraint;j++) { 541674ae819SStefano Zampini temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j]; 542674ae819SStefano Zampini temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]]; 543984c4197SStefano Zampini temp_quadrature_constraint[temp_indices[total_counts]+j]=array[is_indices[j]]; 544674ae819SStefano Zampini } 545984c4197SStefano Zampini ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr); 546984c4197SStefano Zampini /* check if array is null on the connected component */ 547*e310c8b4SStefano Zampini ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr); 548*e310c8b4SStefano Zampini PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_one)); 5495b08dc53SStefano Zampini if (real_value > 0.0) { /* keep indices and values */ 550674ae819SStefano Zampini temp_constraints++; 551674ae819SStefano Zampini temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint; /* store new starting point */ 55251b0f6cfSStefano Zampini change_basis[total_counts]=boolforchange; 553674ae819SStefano Zampini total_counts++; 554674ae819SStefano Zampini } 555674ae819SStefano Zampini } 556674ae819SStefano Zampini ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr); 557984c4197SStefano Zampini /* perform SVD on the constraints if use_nnsp_true has not be requested by the user */ 558984c4197SStefano Zampini if (!pcbddc->use_nnsp_true) { 559984c4197SStefano Zampini PetscReal tol = 1.0e-8; /* tolerance for retaining eigenmodes */ 560984c4197SStefano Zampini 561674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD) 562984c4197SStefano Zampini /* SVD: Y = U*S*V^H -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag 563984c4197SStefano Zampini POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2) 564984c4197SStefano Zampini -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined 565984c4197SStefano Zampini the constraints basis will differ (by a complex factor with absolute value equal to 1) 566984c4197SStefano Zampini from that computed using LAPACKgesvd 567984c4197SStefano Zampini -> This is due to a different computation of eigenvectors in LAPACKheev 568984c4197SStefano Zampini -> The quality of the POD-computed basis will be the same */ 569984c4197SStefano Zampini ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr); 570674ae819SStefano Zampini /* Store upper triangular part of correlation matrix */ 571*e310c8b4SStefano Zampini ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr); 572984c4197SStefano Zampini ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 573674ae819SStefano Zampini for (j=0;j<temp_constraints;j++) { 574674ae819SStefano Zampini for (k=0;k<j+1;k++) { 575*e310c8b4SStefano 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)); 576674ae819SStefano Zampini } 577674ae819SStefano Zampini } 578*e310c8b4SStefano Zampini /* compute eigenvalues and eigenvectors of correlation matrix */ 579*e310c8b4SStefano Zampini ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr); 580*e310c8b4SStefano Zampini ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr); 581674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX) 582c8244a33SStefano Zampini PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr)); 583674ae819SStefano Zampini #else 584c8244a33SStefano Zampini PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr)); 585674ae819SStefano Zampini #endif 586674ae819SStefano Zampini ierr = PetscFPTrapPop();CHKERRQ(ierr); 587984c4197SStefano Zampini if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr); 588984c4197SStefano Zampini /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */ 589674ae819SStefano Zampini j=0; 590984c4197SStefano Zampini while (j < temp_constraints && singular_vals[j] < tol) j++; 591674ae819SStefano Zampini total_counts=total_counts-j; 592*e310c8b4SStefano Zampini /* scale and copy POD basis into used quadrature memory */ 593c4303822SStefano Zampini ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr); 594c4303822SStefano Zampini ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr); 595c4303822SStefano Zampini ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr); 596c4303822SStefano Zampini ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr); 597c4303822SStefano Zampini ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr); 598c4303822SStefano Zampini ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr); 599674ae819SStefano Zampini if (j<temp_constraints) { 600984c4197SStefano Zampini PetscInt ii; 601984c4197SStefano Zampini for (k=j;k<temp_constraints;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]); 602674ae819SStefano Zampini ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 603c4303822SStefano 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)); 604674ae819SStefano Zampini ierr = PetscFPTrapPop();CHKERRQ(ierr); 605984c4197SStefano Zampini for (k=0;k<temp_constraints-j;k++) { 606674ae819SStefano Zampini for (ii=0;ii<size_of_constraint;ii++) { 607984c4197SStefano 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]; 608674ae819SStefano Zampini } 609674ae819SStefano Zampini } 610674ae819SStefano Zampini } 611674ae819SStefano Zampini #else /* on missing GESVD */ 612*e310c8b4SStefano Zampini ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr); 613*e310c8b4SStefano Zampini ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr); 614b7d8b9f8SStefano Zampini ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr); 615674ae819SStefano Zampini ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 616674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX) 617*e310c8b4SStefano 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)); 618674ae819SStefano Zampini #else 619*e310c8b4SStefano 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)); 620674ae819SStefano Zampini #endif 621984c4197SStefano Zampini if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr); 622674ae819SStefano Zampini ierr = PetscFPTrapPop();CHKERRQ(ierr); 623984c4197SStefano Zampini /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */ 624*e310c8b4SStefano Zampini k = temp_constraints; 625*e310c8b4SStefano Zampini if (k > size_of_constraint) k = size_of_constraint; 626674ae819SStefano Zampini j = 0; 627*e310c8b4SStefano Zampini while (j < k && singular_vals[k-j-1] < tol) j++; 628*e310c8b4SStefano Zampini total_counts = total_counts-temp_constraints+k-j; 629984c4197SStefano Zampini #endif /* on missing GESVD */ 630674ae819SStefano Zampini } 631674ae819SStefano Zampini } 632674ae819SStefano Zampini /* free index sets of faces, edges and vertices */ 633674ae819SStefano Zampini for (i=0;i<n_ISForFaces;i++) { 634674ae819SStefano Zampini ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr); 635674ae819SStefano Zampini } 636674ae819SStefano Zampini ierr = PetscFree(ISForFaces);CHKERRQ(ierr); 637674ae819SStefano Zampini for (i=0;i<n_ISForEdges;i++) { 638674ae819SStefano Zampini ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr); 639674ae819SStefano Zampini } 640674ae819SStefano Zampini ierr = PetscFree(ISForEdges);CHKERRQ(ierr); 641674ae819SStefano Zampini ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr); 642674ae819SStefano Zampini 643984c4197SStefano Zampini /* free workspace */ 644242a89d7SStefano Zampini if (!pcbddc->use_nnsp_true && !skip_lapack) { 645984c4197SStefano Zampini ierr = PetscFree(work);CHKERRQ(ierr); 646984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX) 647984c4197SStefano Zampini ierr = PetscFree(rwork);CHKERRQ(ierr); 648984c4197SStefano Zampini #endif 649984c4197SStefano Zampini ierr = PetscFree(singular_vals);CHKERRQ(ierr); 650984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD) 651984c4197SStefano Zampini ierr = PetscFree(correlation_mat);CHKERRQ(ierr); 652984c4197SStefano Zampini ierr = PetscFree(temp_basis);CHKERRQ(ierr); 653984c4197SStefano Zampini #endif 654984c4197SStefano Zampini } 655984c4197SStefano Zampini for (k=0;k<nnsp_size;k++) { 656984c4197SStefano Zampini ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr); 657984c4197SStefano Zampini } 658984c4197SStefano Zampini ierr = PetscFree(localnearnullsp);CHKERRQ(ierr); 659984c4197SStefano Zampini 660674ae819SStefano Zampini /* set quantities in pcbddc data structure */ 661984c4197SStefano Zampini /* n_vertices defines the number of subdomain corners in the primal space */ 662674ae819SStefano Zampini /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */ 663984c4197SStefano Zampini pcbddc->local_primal_size = total_counts; 664674ae819SStefano Zampini pcbddc->n_vertices = n_vertices; 665984c4197SStefano Zampini pcbddc->n_constraints = pcbddc->local_primal_size-pcbddc->n_vertices; 666674ae819SStefano Zampini 667674ae819SStefano Zampini /* Create constraint matrix */ 668674ae819SStefano Zampini /* The constraint matrix is used to compute the l2g map of primal dofs */ 669674ae819SStefano Zampini /* so we need to set it up properly either with or without change of basis */ 670674ae819SStefano Zampini ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr); 671674ae819SStefano Zampini ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr); 672984c4197SStefano Zampini ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr); 673984c4197SStefano Zampini /* array to compute a local numbering of constraints : vertices first then constraints */ 674984c4197SStefano Zampini ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_numbering);CHKERRQ(ierr); 675984c4197SStefano Zampini /* array to select the proper local node (of minimum index with respect to global ordering) when changing the basis */ 676984c4197SStefano 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 */ 677984c4197SStefano Zampini ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&aux_primal_minloc);CHKERRQ(ierr); 678984c4197SStefano Zampini /* auxiliary stuff for basis change */ 679984c4197SStefano Zampini ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&global_indices);CHKERRQ(ierr); 680984c4197SStefano Zampini ierr = PetscMalloc(pcis->n_B*sizeof(PetscBool),&touched);CHKERRQ(ierr); 681984c4197SStefano Zampini ierr = PetscMemzero(touched,pcis->n_B*sizeof(PetscBool));CHKERRQ(ierr); 682984c4197SStefano Zampini 683984c4197SStefano Zampini /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */ 684984c4197SStefano Zampini total_primal_vertices=0; 685984c4197SStefano Zampini for (i=0;i<pcbddc->local_primal_size;i++) { 686674ae819SStefano Zampini size_of_constraint=temp_indices[i+1]-temp_indices[i]; 687984c4197SStefano Zampini if (size_of_constraint == 1) { 688984c4197SStefano Zampini touched[temp_indices_to_constraint_B[temp_indices[i]]]=PETSC_TRUE; 689984c4197SStefano Zampini aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]]; 690984c4197SStefano Zampini aux_primal_minloc[total_primal_vertices]=0; 691984c4197SStefano Zampini total_primal_vertices++; 692984c4197SStefano Zampini } else if (change_basis[i]) { /* Same procedure used in PCBDDCGetPrimalConstraintsLocalIdx */ 693984c4197SStefano Zampini PetscInt min_loc,min_index; 694984c4197SStefano Zampini ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],global_indices);CHKERRQ(ierr); 695984c4197SStefano Zampini /* find first untouched local node */ 696674ae819SStefano Zampini k = 0; 697984c4197SStefano Zampini while (touched[temp_indices_to_constraint_B[temp_indices[i]+k]]) k++; 698984c4197SStefano Zampini min_index = global_indices[k]; 699984c4197SStefano Zampini min_loc = k; 700984c4197SStefano Zampini /* search the minimum among global nodes already untouched on the cc */ 701984c4197SStefano Zampini for (k=1;k<size_of_constraint;k++) { 702984c4197SStefano Zampini /* there can be more than one constraint on a single connected component */ 703984c4197SStefano Zampini if (min_index > global_indices[k] && !touched[temp_indices_to_constraint_B[temp_indices[i]+k]]) { 704984c4197SStefano Zampini min_index = global_indices[k]; 705984c4197SStefano Zampini min_loc = k; 706674ae819SStefano Zampini } 707674ae819SStefano Zampini } 708984c4197SStefano Zampini touched[temp_indices_to_constraint_B[temp_indices[i]+min_loc]] = PETSC_TRUE; 709984c4197SStefano Zampini aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]+min_loc]; 710984c4197SStefano Zampini aux_primal_minloc[total_primal_vertices]=min_loc; 711984c4197SStefano Zampini total_primal_vertices++; 712984c4197SStefano Zampini } 713984c4197SStefano Zampini } 714984c4197SStefano Zampini /* free workspace */ 715984c4197SStefano Zampini ierr = PetscFree(global_indices);CHKERRQ(ierr); 716984c4197SStefano Zampini ierr = PetscFree(touched);CHKERRQ(ierr); 717674ae819SStefano Zampini /* permute indices in order to have a sorted set of vertices */ 718984c4197SStefano Zampini ierr = PetscSortInt(total_primal_vertices,aux_primal_numbering); 719984c4197SStefano Zampini 720984c4197SStefano Zampini /* nonzero structure of constraint matrix */ 721984c4197SStefano Zampini ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&nnz);CHKERRQ(ierr); 722984c4197SStefano Zampini for (i=0;i<total_primal_vertices;i++) nnz[i]=1; 723984c4197SStefano Zampini j=total_primal_vertices; 724984c4197SStefano Zampini for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) { 725674ae819SStefano Zampini if (!change_basis[i]) { 726674ae819SStefano Zampini nnz[j]=temp_indices[i+1]-temp_indices[i]; 727674ae819SStefano Zampini j++; 728674ae819SStefano Zampini } 729674ae819SStefano Zampini } 730674ae819SStefano Zampini ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr); 731674ae819SStefano Zampini ierr = PetscFree(nnz);CHKERRQ(ierr); 732674ae819SStefano Zampini /* set values in constraint matrix */ 733984c4197SStefano Zampini for (i=0;i<total_primal_vertices;i++) { 734984c4197SStefano Zampini ierr = MatSetValue(pcbddc->ConstraintMatrix,i,aux_primal_numbering[i],1.0,INSERT_VALUES);CHKERRQ(ierr); 735674ae819SStefano Zampini } 736984c4197SStefano Zampini total_counts = total_primal_vertices; 737984c4197SStefano Zampini for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) { 738674ae819SStefano Zampini if (!change_basis[i]) { 739674ae819SStefano Zampini size_of_constraint=temp_indices[i+1]-temp_indices[i]; 740674ae819SStefano 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); 741674ae819SStefano Zampini total_counts++; 742674ae819SStefano Zampini } 743674ae819SStefano Zampini } 744674ae819SStefano Zampini /* assembling */ 745674ae819SStefano Zampini ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 746674ae819SStefano Zampini ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 747984c4197SStefano Zampini /* 748984c4197SStefano Zampini ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr); 749984c4197SStefano Zampini */ 750674ae819SStefano Zampini /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */ 751674ae819SStefano Zampini if (pcbddc->use_change_of_basis) { 752984c4197SStefano Zampini PetscBool qr_needed = PETSC_FALSE; 753984c4197SStefano Zampini /* change of basis acts on local interfaces -> dimension is n_B x n_B */ 754674ae819SStefano Zampini ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr); 755674ae819SStefano Zampini ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr); 756674ae819SStefano Zampini ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr); 757674ae819SStefano Zampini /* work arrays */ 758674ae819SStefano Zampini ierr = PetscMalloc(pcis->n_B*sizeof(PetscInt),&nnz);CHKERRQ(ierr); 759984c4197SStefano Zampini for (i=0;i<pcis->n_B;i++) nnz[i]=1; 760984c4197SStefano Zampini /* nonzeros per row */ 761984c4197SStefano Zampini for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) { 762674ae819SStefano Zampini if (change_basis[i]) { 763984c4197SStefano Zampini qr_needed = PETSC_TRUE; 764674ae819SStefano Zampini size_of_constraint = temp_indices[i+1]-temp_indices[i]; 765984c4197SStefano Zampini for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint; 766674ae819SStefano Zampini } 767674ae819SStefano Zampini } 768674ae819SStefano Zampini ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr); 769674ae819SStefano Zampini ierr = PetscFree(nnz);CHKERRQ(ierr); 770674ae819SStefano Zampini /* Set initial identity in the matrix */ 771674ae819SStefano Zampini for (i=0;i<pcis->n_B;i++) { 772674ae819SStefano Zampini ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr); 773674ae819SStefano Zampini } 774984c4197SStefano Zampini 775674ae819SStefano Zampini /* Now we loop on the constraints which need a change of basis */ 776674ae819SStefano Zampini /* Change of basis matrix is evaluated as the FIRST APPROACH in */ 777984c4197SStefano Zampini /* Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1) */ 778984c4197SStefano Zampini /* Change of basis matrix T computed via QR decomposition of constraints */ 779984c4197SStefano Zampini if (qr_needed) { 780026de310SStefano Zampini /* dual and primal dofs on a single cc */ 781984c4197SStefano Zampini PetscInt dual_dofs,primal_dofs; 782026de310SStefano Zampini /* iterator on aux_primal_minloc (ordered as read from nearnullspace: vertices, edges and then constraints) */ 783026de310SStefano Zampini PetscInt primal_counter; 784984c4197SStefano Zampini /* working stuff for GEQRF */ 785984c4197SStefano Zampini PetscScalar *qr_basis,*qr_tau,*qr_work,lqr_work_t; 786984c4197SStefano Zampini PetscBLASInt lqr_work; 787984c4197SStefano Zampini /* working stuff for UNGQR */ 788984c4197SStefano Zampini PetscScalar *gqr_work,lgqr_work_t; 789984c4197SStefano Zampini PetscBLASInt lgqr_work; 790984c4197SStefano Zampini /* working stuff for TRTRS */ 791984c4197SStefano Zampini PetscScalar *trs_rhs; 7923f08241aSStefano Zampini PetscBLASInt Blas_NRHS; 793984c4197SStefano Zampini /* pointers for values insertion into change of basis matrix */ 794984c4197SStefano Zampini PetscInt *start_rows,*start_cols; 795984c4197SStefano Zampini PetscScalar *start_vals; 796984c4197SStefano Zampini /* working stuff for values insertion */ 797984c4197SStefano Zampini PetscBool *is_primal; 798984c4197SStefano Zampini 799984c4197SStefano Zampini /* space to store Q */ 800984c4197SStefano Zampini ierr = PetscMalloc((max_size_of_constraint)*(max_size_of_constraint)*sizeof(PetscScalar),&qr_basis);CHKERRQ(ierr); 801984c4197SStefano Zampini /* first we issue queries for optimal work */ 8023f08241aSStefano Zampini ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr); 8033f08241aSStefano Zampini ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr); 8043f08241aSStefano Zampini ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr); 805984c4197SStefano Zampini lqr_work = -1; 8063f08241aSStefano Zampini PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr)); 807984c4197SStefano Zampini if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr); 808984c4197SStefano Zampini ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr); 809984c4197SStefano Zampini ierr = PetscMalloc((PetscInt)PetscRealPart(lqr_work_t)*sizeof(*qr_work),&qr_work);CHKERRQ(ierr); 810984c4197SStefano Zampini lgqr_work = -1; 8113f08241aSStefano Zampini ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr); 8123f08241aSStefano Zampini ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr); 8133f08241aSStefano Zampini ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr); 8143f08241aSStefano Zampini ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr); 8153f08241aSStefano Zampini if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */ 8163f08241aSStefano Zampini PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr)); 817984c4197SStefano Zampini if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr); 818984c4197SStefano Zampini ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr); 819984c4197SStefano Zampini ierr = PetscMalloc((PetscInt)PetscRealPart(lgqr_work_t)*sizeof(*gqr_work),&gqr_work);CHKERRQ(ierr); 820984c4197SStefano Zampini /* array to store scaling factors for reflectors */ 821984c4197SStefano Zampini ierr = PetscMalloc(max_constraints*sizeof(*qr_tau),&qr_tau);CHKERRQ(ierr); 822984c4197SStefano Zampini /* array to store rhs and solution of triangular solver */ 823984c4197SStefano Zampini ierr = PetscMalloc(max_constraints*max_constraints*sizeof(*trs_rhs),&trs_rhs);CHKERRQ(ierr); 824984c4197SStefano Zampini /* array to store whether a node is primal or not */ 825984c4197SStefano Zampini ierr = PetscMalloc(pcis->n_B*sizeof(*is_primal),&is_primal);CHKERRQ(ierr); 826984c4197SStefano Zampini ierr = PetscMemzero(is_primal,pcis->n_B*sizeof(*is_primal));CHKERRQ(ierr); 827984c4197SStefano Zampini for (i=0;i<total_primal_vertices;i++) is_primal[local_to_B[aux_primal_numbering[i]]] = PETSC_TRUE; 828984c4197SStefano Zampini 829984c4197SStefano Zampini /* allocating workspace for check */ 830984c4197SStefano Zampini if (pcbddc->dbg_flag) { 831984c4197SStefano Zampini ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr); 832984c4197SStefano Zampini ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr); 833984c4197SStefano Zampini ierr = PetscMalloc(max_size_of_constraint*(max_constraints+max_size_of_constraint)*sizeof(*work),&work);CHKERRQ(ierr); 834674ae819SStefano Zampini } 835984c4197SStefano Zampini 836026de310SStefano Zampini /* loop on constraints and see whether or not they need a change of basis */ 837026de310SStefano Zampini /* -> using implicit ordering contained in temp_indices data */ 838026de310SStefano Zampini total_counts = pcbddc->n_vertices; 839026de310SStefano Zampini primal_counter = total_counts; 840026de310SStefano Zampini while (total_counts<pcbddc->local_primal_size) { 841026de310SStefano Zampini primal_dofs = 1; 842026de310SStefano Zampini if (change_basis[total_counts]) { 843026de310SStefano Zampini /* get all constraints with same support: if more then one constraint is present on the cc then surely indices are stored contiguosly */ 844026de310SStefano 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]]) { 845026de310SStefano Zampini primal_dofs++; 846674ae819SStefano Zampini } 847984c4197SStefano Zampini /* get constraint info */ 848026de310SStefano Zampini size_of_constraint = temp_indices[total_counts+1]-temp_indices[total_counts]; 849984c4197SStefano Zampini dual_dofs = size_of_constraint-primal_dofs; 850984c4197SStefano Zampini 851984c4197SStefano Zampini /* copy quadrature constraints for change of basis check */ 852984c4197SStefano Zampini if (pcbddc->dbg_flag) { 853026de310SStefano Zampini ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d to %d need a change of basis (size %d)\n",total_counts,total_counts+primal_dofs,size_of_constraint);CHKERRQ(ierr); 854026de310SStefano Zampini ierr = PetscMemcpy(work,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr); 855674ae819SStefano Zampini } 856984c4197SStefano Zampini 857984c4197SStefano Zampini /* copy temporary constraints into larger work vector (in order to store all columns of Q) */ 858026de310SStefano Zampini ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr); 859984c4197SStefano Zampini 860984c4197SStefano Zampini /* compute QR decomposition of constraints */ 8613f08241aSStefano Zampini ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr); 8623f08241aSStefano Zampini ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr); 8633f08241aSStefano Zampini ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr); 864674ae819SStefano Zampini ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 8653f08241aSStefano Zampini PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr)); 866984c4197SStefano Zampini if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr); 867674ae819SStefano Zampini ierr = PetscFPTrapPop();CHKERRQ(ierr); 868984c4197SStefano Zampini 869984c4197SStefano Zampini /* explictly compute R^-T */ 870984c4197SStefano Zampini ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr); 871984c4197SStefano Zampini for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0; 8723f08241aSStefano Zampini ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr); 8733f08241aSStefano Zampini ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr); 8743f08241aSStefano Zampini ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr); 8753f08241aSStefano Zampini ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr); 876984c4197SStefano Zampini ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 8773f08241aSStefano Zampini PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr)); 878984c4197SStefano Zampini if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr); 879984c4197SStefano Zampini ierr = PetscFPTrapPop();CHKERRQ(ierr); 880984c4197SStefano Zampini 881984c4197SStefano Zampini /* explcitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */ 8823f08241aSStefano Zampini ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr); 8833f08241aSStefano Zampini ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr); 8843f08241aSStefano Zampini ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr); 8853f08241aSStefano Zampini ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr); 886984c4197SStefano Zampini ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 8873f08241aSStefano Zampini PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr)); 888984c4197SStefano Zampini if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr); 889984c4197SStefano Zampini ierr = PetscFPTrapPop();CHKERRQ(ierr); 890984c4197SStefano Zampini 891984c4197SStefano Zampini /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints 892984c4197SStefano Zampini i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below) 893984c4197SStefano Zampini where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */ 8943f08241aSStefano Zampini ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr); 8953f08241aSStefano Zampini ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr); 8963f08241aSStefano Zampini ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr); 8973f08241aSStefano Zampini ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr); 8983f08241aSStefano Zampini ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr); 8993f08241aSStefano Zampini ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr); 900984c4197SStefano Zampini ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 901c4303822SStefano 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)); 902984c4197SStefano Zampini ierr = PetscFPTrapPop();CHKERRQ(ierr); 903026de310SStefano Zampini ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr); 904984c4197SStefano Zampini 905984c4197SStefano Zampini /* insert values in change of basis matrix respecting global ordering of new primal dofs */ 906026de310SStefano Zampini start_rows = &temp_indices_to_constraint_B[temp_indices[total_counts]]; 907984c4197SStefano Zampini /* insert cols for primal dofs */ 908984c4197SStefano Zampini for (j=0;j<primal_dofs;j++) { 909984c4197SStefano Zampini start_vals = &qr_basis[j*size_of_constraint]; 910026de310SStefano Zampini start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+aux_primal_minloc[primal_counter+j]]; 911984c4197SStefano Zampini ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr); 912984c4197SStefano Zampini } 913984c4197SStefano Zampini /* insert cols for dual dofs */ 914984c4197SStefano Zampini for (j=0,k=0;j<dual_dofs;k++) { 915026de310SStefano Zampini if (!is_primal[temp_indices_to_constraint_B[temp_indices[total_counts]+k]]) { 916984c4197SStefano Zampini start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint]; 917026de310SStefano Zampini start_cols = &temp_indices_to_constraint_B[temp_indices[total_counts]+k]; 918984c4197SStefano Zampini ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr); 919984c4197SStefano Zampini j++; 920674ae819SStefano Zampini } 921674ae819SStefano Zampini } 922984c4197SStefano Zampini 923984c4197SStefano Zampini /* check change of basis */ 924984c4197SStefano Zampini if (pcbddc->dbg_flag) { 925984c4197SStefano Zampini PetscInt ii,jj; 926984c4197SStefano Zampini PetscBool valid_qr=PETSC_TRUE; 927c4303822SStefano Zampini ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr); 928c4303822SStefano Zampini ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr); 929c4303822SStefano Zampini ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr); 930c4303822SStefano Zampini ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr); 931c4303822SStefano Zampini ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr); 932c4303822SStefano Zampini ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr); 933984c4197SStefano Zampini ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 934c4303822SStefano 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)); 935984c4197SStefano Zampini ierr = PetscFPTrapPop();CHKERRQ(ierr); 936984c4197SStefano Zampini for (jj=0;jj<size_of_constraint;jj++) { 937984c4197SStefano Zampini for (ii=0;ii<primal_dofs;ii++) { 938984c4197SStefano Zampini if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE; 939984c4197SStefano Zampini if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE; 940674ae819SStefano Zampini } 941674ae819SStefano Zampini } 942984c4197SStefano Zampini if (!valid_qr) { 943984c4197SStefano Zampini ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n",PetscGlobalRank);CHKERRQ(ierr); 944984c4197SStefano Zampini for (jj=0;jj<size_of_constraint;jj++) { 945984c4197SStefano Zampini for (ii=0;ii<primal_dofs;ii++) { 946984c4197SStefano Zampini if (ii != jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) { 947984c4197SStefano 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])); 948674ae819SStefano Zampini } 949984c4197SStefano Zampini if (ii == jj && PetscAbsScalar(work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) { 950984c4197SStefano 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])); 951984c4197SStefano Zampini } 952984c4197SStefano Zampini } 953984c4197SStefano Zampini } 954674ae819SStefano Zampini } else { 955984c4197SStefano Zampini ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n",PetscGlobalRank);CHKERRQ(ierr); 956674ae819SStefano Zampini } 957674ae819SStefano Zampini } 958026de310SStefano Zampini /* increment primal counter */ 959026de310SStefano Zampini primal_counter += primal_dofs; 960984c4197SStefano Zampini } else { 961984c4197SStefano Zampini if (pcbddc->dbg_flag) { 962026de310SStefano 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); 963674ae819SStefano Zampini } 964674ae819SStefano Zampini } 965026de310SStefano Zampini /* increment constraint counter total_counts */ 966026de310SStefano Zampini total_counts += primal_dofs; 967674ae819SStefano Zampini } 968984c4197SStefano Zampini if (pcbddc->dbg_flag) { 969984c4197SStefano Zampini ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 970984c4197SStefano Zampini ierr = PetscFree(work);CHKERRQ(ierr); 971984c4197SStefano Zampini } 972984c4197SStefano Zampini /* free workspace */ 973984c4197SStefano Zampini ierr = PetscFree(trs_rhs);CHKERRQ(ierr); 974984c4197SStefano Zampini ierr = PetscFree(qr_tau);CHKERRQ(ierr); 975984c4197SStefano Zampini ierr = PetscFree(qr_work);CHKERRQ(ierr); 976984c4197SStefano Zampini ierr = PetscFree(gqr_work);CHKERRQ(ierr); 977984c4197SStefano Zampini ierr = PetscFree(is_primal);CHKERRQ(ierr); 978984c4197SStefano Zampini ierr = PetscFree(qr_basis);CHKERRQ(ierr); 979674ae819SStefano Zampini } 980674ae819SStefano Zampini /* assembling */ 981674ae819SStefano Zampini ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 982674ae819SStefano Zampini ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 983984c4197SStefano Zampini /* 984984c4197SStefano Zampini ierr = MatView(pcbddc->ChangeOfBasisMatrix,(PetscViewer)0);CHKERRQ(ierr); 985984c4197SStefano Zampini */ 986674ae819SStefano Zampini } 987*e310c8b4SStefano Zampini /* free workspace */ 988984c4197SStefano Zampini ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr); 989984c4197SStefano Zampini ierr = PetscFree(aux_primal_minloc);CHKERRQ(ierr); 990674ae819SStefano Zampini ierr = PetscFree(temp_indices);CHKERRQ(ierr); 991674ae819SStefano Zampini ierr = PetscFree(change_basis);CHKERRQ(ierr); 992674ae819SStefano Zampini ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr); 993674ae819SStefano Zampini ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr); 994674ae819SStefano Zampini ierr = PetscFree(local_to_B);CHKERRQ(ierr); 995674ae819SStefano Zampini ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr); 996674ae819SStefano Zampini PetscFunctionReturn(0); 997674ae819SStefano Zampini } 998674ae819SStefano Zampini 999674ae819SStefano Zampini #undef __FUNCT__ 1000674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface" 1001674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc) 1002674ae819SStefano Zampini { 1003674ae819SStefano Zampini PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 1004674ae819SStefano Zampini PC_IS *pcis = (PC_IS*)pc->data; 1005674ae819SStefano Zampini Mat_IS *matis = (Mat_IS*)pc->pmat->data; 1006674ae819SStefano Zampini PetscInt bs,ierr,i,vertex_size; 1007674ae819SStefano Zampini PetscViewer viewer=pcbddc->dbg_viewer; 1008674ae819SStefano Zampini 1009674ae819SStefano Zampini PetscFunctionBegin; 1010674ae819SStefano Zampini /* Init local Graph struct */ 1011674ae819SStefano Zampini ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr); 1012674ae819SStefano Zampini 1013575ad6abSStefano Zampini /* Check validity of the csr graph passed in by the user */ 1014575ad6abSStefano Zampini if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) { 1015575ad6abSStefano Zampini ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr); 1016575ad6abSStefano Zampini } 1017674ae819SStefano Zampini /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */ 1018674ae819SStefano Zampini if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) { 1019674ae819SStefano Zampini Mat mat_adj; 1020674ae819SStefano Zampini const PetscInt *xadj,*adjncy; 1021674ae819SStefano Zampini PetscBool flg_row=PETSC_TRUE; 1022674ae819SStefano Zampini 1023674ae819SStefano Zampini ierr = MatConvert(matis->A,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr); 1024674ae819SStefano Zampini ierr = MatGetRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr); 1025674ae819SStefano Zampini if (!flg_row) { 1026674ae819SStefano Zampini SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ called in %s\n",__FUNCT__); 1027674ae819SStefano Zampini } 1028674ae819SStefano Zampini ierr = PCBDDCSetLocalAdjacencyGraph(pc,i,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr); 1029674ae819SStefano Zampini ierr = MatRestoreRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&i,&xadj,&adjncy,&flg_row);CHKERRQ(ierr); 1030674ae819SStefano Zampini if (!flg_row) { 1031674ae819SStefano Zampini SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__); 1032674ae819SStefano Zampini } 1033674ae819SStefano Zampini ierr = MatDestroy(&mat_adj);CHKERRQ(ierr); 1034674ae819SStefano Zampini } 1035674ae819SStefano Zampini 1036674ae819SStefano Zampini /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting */ 1037674ae819SStefano Zampini vertex_size = 1; 1038674ae819SStefano Zampini if (!pcbddc->n_ISForDofs) { 1039674ae819SStefano Zampini IS *custom_ISForDofs; 1040674ae819SStefano Zampini 1041674ae819SStefano Zampini ierr = MatGetBlockSize(matis->A,&bs);CHKERRQ(ierr); 1042674ae819SStefano Zampini ierr = PetscMalloc(bs*sizeof(IS),&custom_ISForDofs);CHKERRQ(ierr); 1043674ae819SStefano Zampini for (i=0;i<bs;i++) { 1044674ae819SStefano Zampini ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n/bs,i,bs,&custom_ISForDofs[i]);CHKERRQ(ierr); 1045674ae819SStefano Zampini } 1046674ae819SStefano Zampini ierr = PCBDDCSetDofsSplitting(pc,bs,custom_ISForDofs);CHKERRQ(ierr); 1047674ae819SStefano Zampini /* remove my references to IS objects */ 1048674ae819SStefano Zampini for (i=0;i<bs;i++) { 1049674ae819SStefano Zampini ierr = ISDestroy(&custom_ISForDofs[i]);CHKERRQ(ierr); 1050674ae819SStefano Zampini } 1051674ae819SStefano Zampini ierr = PetscFree(custom_ISForDofs);CHKERRQ(ierr); 1052674ae819SStefano Zampini } else { /* mat block size as vertex size (used for elasticity) */ 1053674ae819SStefano Zampini ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr); 1054674ae819SStefano Zampini } 1055674ae819SStefano Zampini 1056674ae819SStefano Zampini /* Setup of Graph */ 1057674ae819SStefano Zampini ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundaries,pcbddc->DirichletBoundaries,pcbddc->n_ISForDofs,pcbddc->ISForDofs,pcbddc->user_primal_vertices); 1058674ae819SStefano Zampini 1059674ae819SStefano Zampini /* Graph's connected components analysis */ 1060674ae819SStefano Zampini ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr); 1061674ae819SStefano Zampini 1062674ae819SStefano Zampini /* print some info to stdout */ 1063674ae819SStefano Zampini if (pcbddc->dbg_flag) { 1064e49050b4SStefano Zampini ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer); 1065674ae819SStefano Zampini } 1066674ae819SStefano Zampini PetscFunctionReturn(0); 1067674ae819SStefano Zampini } 1068674ae819SStefano Zampini 1069674ae819SStefano Zampini #undef __FUNCT__ 1070674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx" 1071674ae819SStefano Zampini PetscErrorCode PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt *vertices_idx[]) 1072674ae819SStefano Zampini { 1073674ae819SStefano Zampini PC_BDDC *pcbddc = (PC_BDDC*)(pc->data); 1074674ae819SStefano Zampini PetscInt *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size; 1075674ae819SStefano Zampini PetscErrorCode ierr; 1076674ae819SStefano Zampini 1077674ae819SStefano Zampini PetscFunctionBegin; 1078674ae819SStefano Zampini n = 0; 1079674ae819SStefano Zampini vertices = 0; 1080674ae819SStefano Zampini if (pcbddc->ConstraintMatrix) { 1081674ae819SStefano Zampini ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr); 1082b120a5c6SStefano Zampini for (i=0;i<local_primal_size;i++) { 1083b120a5c6SStefano Zampini ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr); 1084b120a5c6SStefano Zampini if (size_of_constraint == 1) n++; 1085b120a5c6SStefano Zampini ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr); 1086b120a5c6SStefano Zampini } 1087b120a5c6SStefano Zampini ierr = PetscMalloc(n*sizeof(PetscInt),&vertices);CHKERRQ(ierr); 1088b120a5c6SStefano Zampini n = 0; 1089674ae819SStefano Zampini for (i=0;i<local_primal_size;i++) { 1090674ae819SStefano Zampini ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr); 1091674ae819SStefano Zampini if (size_of_constraint == 1) { 1092674ae819SStefano Zampini vertices[n++]=row_cmat_indices[0]; 1093674ae819SStefano Zampini } 1094674ae819SStefano Zampini ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr); 1095674ae819SStefano Zampini } 1096674ae819SStefano Zampini } 1097674ae819SStefano Zampini *n_vertices = n; 1098674ae819SStefano Zampini *vertices_idx = vertices; 1099674ae819SStefano Zampini PetscFunctionReturn(0); 1100674ae819SStefano Zampini } 1101674ae819SStefano Zampini 1102674ae819SStefano Zampini #undef __FUNCT__ 1103674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx" 1104674ae819SStefano Zampini PetscErrorCode PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt *constraints_idx[]) 1105674ae819SStefano Zampini { 1106674ae819SStefano Zampini PC_BDDC *pcbddc = (PC_BDDC*)(pc->data); 1107674ae819SStefano Zampini PetscInt *constraints_index,*row_cmat_indices,*row_cmat_global_indices; 1108674ae819SStefano Zampini PetscInt n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc; 1109674ae819SStefano Zampini PetscBool *touched; 1110674ae819SStefano Zampini PetscErrorCode ierr; 1111674ae819SStefano Zampini 1112674ae819SStefano Zampini PetscFunctionBegin; 1113674ae819SStefano Zampini n = 0; 1114674ae819SStefano Zampini constraints_index = 0; 1115674ae819SStefano Zampini if (pcbddc->ConstraintMatrix) { 1116674ae819SStefano Zampini ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr); 1117674ae819SStefano Zampini max_size_of_constraint = 0; 1118674ae819SStefano Zampini for (i=0;i<local_primal_size;i++) { 1119674ae819SStefano Zampini ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr); 1120674ae819SStefano Zampini if (size_of_constraint > 1) { 1121674ae819SStefano Zampini n++; 1122674ae819SStefano Zampini } 1123674ae819SStefano Zampini max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint); 1124674ae819SStefano Zampini ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr); 1125674ae819SStefano Zampini } 1126674ae819SStefano Zampini ierr = PetscMalloc(n*sizeof(PetscInt),&constraints_index);CHKERRQ(ierr); 1127674ae819SStefano Zampini ierr = PetscMalloc(max_size_of_constraint*sizeof(PetscInt),&row_cmat_global_indices);CHKERRQ(ierr); 1128674ae819SStefano Zampini ierr = PetscMalloc(local_size*sizeof(PetscBool),&touched);CHKERRQ(ierr); 1129674ae819SStefano Zampini ierr = PetscMemzero(touched,local_size*sizeof(PetscBool));CHKERRQ(ierr); 1130674ae819SStefano Zampini n = 0; 1131674ae819SStefano Zampini for (i=0;i<local_primal_size;i++) { 1132674ae819SStefano Zampini ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr); 1133674ae819SStefano Zampini if (size_of_constraint > 1) { 1134674ae819SStefano Zampini ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr); 1135674ae819SStefano Zampini min_index = row_cmat_global_indices[0]; 1136674ae819SStefano Zampini min_loc = 0; 1137674ae819SStefano Zampini for (j=1;j<size_of_constraint;j++) { 1138674ae819SStefano Zampini /* there can be more than one constraint on a single connected component */ 1139674ae819SStefano Zampini if (min_index > row_cmat_global_indices[j] && !touched[row_cmat_indices[j]]) { 1140674ae819SStefano Zampini min_index = row_cmat_global_indices[j]; 1141674ae819SStefano Zampini min_loc = j; 1142674ae819SStefano Zampini } 1143674ae819SStefano Zampini } 1144674ae819SStefano Zampini touched[row_cmat_indices[min_loc]] = PETSC_TRUE; 1145674ae819SStefano Zampini constraints_index[n++] = row_cmat_indices[min_loc]; 1146674ae819SStefano Zampini } 1147674ae819SStefano Zampini ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr); 1148674ae819SStefano Zampini } 1149674ae819SStefano Zampini } 1150674ae819SStefano Zampini ierr = PetscFree(touched);CHKERRQ(ierr); 1151674ae819SStefano Zampini ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr); 1152674ae819SStefano Zampini *n_constraints = n; 1153674ae819SStefano Zampini *constraints_idx = constraints_index; 1154674ae819SStefano Zampini PetscFunctionReturn(0); 1155674ae819SStefano Zampini } 1156674ae819SStefano Zampini 1157674ae819SStefano Zampini /* the next two functions has been adapted from pcis.c */ 1158674ae819SStefano Zampini #undef __FUNCT__ 1159674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchur" 1160674ae819SStefano Zampini PetscErrorCode PCBDDCApplySchur(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D) 1161674ae819SStefano Zampini { 1162674ae819SStefano Zampini PetscErrorCode ierr; 1163674ae819SStefano Zampini PC_IS *pcis = (PC_IS*)(pc->data); 1164674ae819SStefano Zampini 1165674ae819SStefano Zampini PetscFunctionBegin; 1166674ae819SStefano Zampini if (!vec2_B) { vec2_B = v; } 1167674ae819SStefano Zampini ierr = MatMult(pcis->A_BB,v,vec1_B);CHKERRQ(ierr); 1168674ae819SStefano Zampini ierr = MatMult(pcis->A_IB,v,vec1_D);CHKERRQ(ierr); 1169674ae819SStefano Zampini ierr = KSPSolve(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr); 1170674ae819SStefano Zampini ierr = MatMult(pcis->A_BI,vec2_D,vec2_B);CHKERRQ(ierr); 1171674ae819SStefano Zampini ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr); 1172674ae819SStefano Zampini PetscFunctionReturn(0); 1173674ae819SStefano Zampini } 1174674ae819SStefano Zampini 1175674ae819SStefano Zampini #undef __FUNCT__ 1176674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplySchurTranspose" 1177674ae819SStefano Zampini PetscErrorCode PCBDDCApplySchurTranspose(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D) 1178674ae819SStefano Zampini { 1179674ae819SStefano Zampini PetscErrorCode ierr; 1180674ae819SStefano Zampini PC_IS *pcis = (PC_IS*)(pc->data); 1181674ae819SStefano Zampini 1182674ae819SStefano Zampini PetscFunctionBegin; 1183674ae819SStefano Zampini if (!vec2_B) { vec2_B = v; } 1184674ae819SStefano Zampini ierr = MatMultTranspose(pcis->A_BB,v,vec1_B);CHKERRQ(ierr); 1185674ae819SStefano Zampini ierr = MatMultTranspose(pcis->A_BI,v,vec1_D);CHKERRQ(ierr); 1186674ae819SStefano Zampini ierr = KSPSolveTranspose(pcis->ksp_D,vec1_D,vec2_D);CHKERRQ(ierr); 1187674ae819SStefano Zampini ierr = MatMultTranspose(pcis->A_IB,vec2_D,vec2_B);CHKERRQ(ierr); 1188674ae819SStefano Zampini ierr = VecAXPY(vec1_B,-1.0,vec2_B);CHKERRQ(ierr); 1189674ae819SStefano Zampini PetscFunctionReturn(0); 1190674ae819SStefano Zampini } 1191674ae819SStefano Zampini 1192674ae819SStefano Zampini #undef __FUNCT__ 1193674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering" 1194674ae819SStefano 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[]) 1195674ae819SStefano Zampini { 1196674ae819SStefano Zampini Vec local_vec,global_vec; 1197674ae819SStefano Zampini IS seqis,paris; 1198674ae819SStefano Zampini VecScatter scatter_ctx; 1199674ae819SStefano Zampini PetscScalar *array; 1200674ae819SStefano Zampini PetscInt *temp_global_dofs; 1201674ae819SStefano Zampini PetscScalar globalsum; 1202674ae819SStefano Zampini PetscInt i,j,s; 1203674ae819SStefano Zampini PetscInt nlocals,first_index,old_index,max_local; 1204674ae819SStefano Zampini PetscMPIInt rank_prec_comm,size_prec_comm,max_global; 1205674ae819SStefano Zampini PetscMPIInt *dof_sizes,*dof_displs; 1206674ae819SStefano Zampini PetscBool first_found; 1207674ae819SStefano Zampini PetscErrorCode ierr; 1208674ae819SStefano Zampini 1209674ae819SStefano Zampini PetscFunctionBegin; 1210674ae819SStefano Zampini /* mpi buffers */ 1211674ae819SStefano Zampini MPI_Comm_size(comm,&size_prec_comm); 1212674ae819SStefano Zampini MPI_Comm_rank(comm,&rank_prec_comm); 1213674ae819SStefano Zampini j = ( !rank_prec_comm ? size_prec_comm : 0); 1214674ae819SStefano Zampini ierr = PetscMalloc(j*sizeof(*dof_sizes),&dof_sizes);CHKERRQ(ierr); 1215674ae819SStefano Zampini ierr = PetscMalloc(j*sizeof(*dof_displs),&dof_displs);CHKERRQ(ierr); 1216674ae819SStefano Zampini /* get maximum size of subset */ 1217674ae819SStefano Zampini ierr = PetscMalloc(n_local_dofs*sizeof(PetscInt),&temp_global_dofs);CHKERRQ(ierr); 1218674ae819SStefano Zampini ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr); 1219674ae819SStefano Zampini max_local = 0; 1220674ae819SStefano Zampini if (n_local_dofs) { 1221674ae819SStefano Zampini max_local = temp_global_dofs[0]; 1222674ae819SStefano Zampini for (i=1;i<n_local_dofs;i++) { 1223674ae819SStefano Zampini if (max_local < temp_global_dofs[i] ) { 1224674ae819SStefano Zampini max_local = temp_global_dofs[i]; 1225674ae819SStefano Zampini } 1226674ae819SStefano Zampini } 1227674ae819SStefano Zampini } 1228674ae819SStefano Zampini ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm); 1229674ae819SStefano Zampini max_global++; 1230674ae819SStefano Zampini max_local = 0; 1231674ae819SStefano Zampini if (n_local_dofs) { 1232674ae819SStefano Zampini max_local = local_dofs[0]; 1233674ae819SStefano Zampini for (i=1;i<n_local_dofs;i++) { 1234674ae819SStefano Zampini if (max_local < local_dofs[i] ) { 1235674ae819SStefano Zampini max_local = local_dofs[i]; 1236674ae819SStefano Zampini } 1237674ae819SStefano Zampini } 1238674ae819SStefano Zampini } 1239674ae819SStefano Zampini max_local++; 1240674ae819SStefano Zampini /* allocate workspace */ 1241674ae819SStefano Zampini ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr); 1242674ae819SStefano Zampini ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr); 1243674ae819SStefano Zampini ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr); 1244674ae819SStefano Zampini ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr); 1245674ae819SStefano Zampini ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr); 1246674ae819SStefano Zampini ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr); 1247674ae819SStefano Zampini /* create scatter */ 1248674ae819SStefano Zampini ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr); 1249674ae819SStefano Zampini ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr); 1250674ae819SStefano Zampini ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr); 1251674ae819SStefano Zampini ierr = ISDestroy(&seqis);CHKERRQ(ierr); 1252674ae819SStefano Zampini ierr = ISDestroy(&paris);CHKERRQ(ierr); 1253674ae819SStefano Zampini /* init array */ 1254674ae819SStefano Zampini ierr = VecSet(global_vec,0.0);CHKERRQ(ierr); 1255674ae819SStefano Zampini ierr = VecSet(local_vec,0.0);CHKERRQ(ierr); 1256674ae819SStefano Zampini ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr); 1257674ae819SStefano Zampini if (local_dofs_mult) { 1258674ae819SStefano Zampini for (i=0;i<n_local_dofs;i++) { 1259674ae819SStefano Zampini array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i]; 1260674ae819SStefano Zampini } 1261674ae819SStefano Zampini } else { 1262674ae819SStefano Zampini for (i=0;i<n_local_dofs;i++) { 1263674ae819SStefano Zampini array[local_dofs[i]]=1.0; 1264674ae819SStefano Zampini } 1265674ae819SStefano Zampini } 1266674ae819SStefano Zampini ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr); 1267674ae819SStefano Zampini /* scatter into global vec and get total number of global dofs */ 1268674ae819SStefano Zampini ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1269674ae819SStefano Zampini ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1270674ae819SStefano Zampini ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr); 12715b08dc53SStefano Zampini *n_global_subset = (PetscInt)PetscRealPart(globalsum); 1272674ae819SStefano Zampini /* Fill global_vec with cumulative function for global numbering */ 1273674ae819SStefano Zampini ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr); 1274674ae819SStefano Zampini ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr); 1275674ae819SStefano Zampini nlocals = 0; 1276674ae819SStefano Zampini first_index = -1; 1277674ae819SStefano Zampini first_found = PETSC_FALSE; 1278674ae819SStefano Zampini for (i=0;i<s;i++) { 12795b08dc53SStefano Zampini if (!first_found && PetscRealPart(array[i]) > 0.0) { 1280674ae819SStefano Zampini first_found = PETSC_TRUE; 1281674ae819SStefano Zampini first_index = i; 1282674ae819SStefano Zampini } 12835b08dc53SStefano Zampini nlocals += (PetscInt)PetscRealPart(array[i]); 1284674ae819SStefano Zampini } 1285674ae819SStefano Zampini ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr); 1286674ae819SStefano Zampini if (!rank_prec_comm) { 1287674ae819SStefano Zampini dof_displs[0]=0; 1288674ae819SStefano Zampini for (i=1;i<size_prec_comm;i++) { 1289674ae819SStefano Zampini dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1]; 1290674ae819SStefano Zampini } 1291674ae819SStefano Zampini } 1292674ae819SStefano Zampini ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr); 1293674ae819SStefano Zampini if (first_found) { 1294674ae819SStefano Zampini array[first_index] += (PetscScalar)nlocals; 1295674ae819SStefano Zampini old_index = first_index; 1296674ae819SStefano Zampini for (i=first_index+1;i<s;i++) { 12975b08dc53SStefano Zampini if (PetscRealPart(array[i]) > 0.0) { 1298674ae819SStefano Zampini array[i] += array[old_index]; 1299674ae819SStefano Zampini old_index = i; 1300674ae819SStefano Zampini } 1301674ae819SStefano Zampini } 1302674ae819SStefano Zampini } 1303674ae819SStefano Zampini ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr); 1304674ae819SStefano Zampini ierr = VecSet(local_vec,0.0);CHKERRQ(ierr); 1305674ae819SStefano Zampini ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1306674ae819SStefano Zampini ierr = VecScatterEnd (scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1307674ae819SStefano Zampini /* get global ordering of local dofs */ 1308674ae819SStefano Zampini ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr); 1309674ae819SStefano Zampini if (local_dofs_mult) { 1310674ae819SStefano Zampini for (i=0;i<n_local_dofs;i++) { 13115b08dc53SStefano Zampini temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i]; 1312674ae819SStefano Zampini } 1313674ae819SStefano Zampini } else { 1314674ae819SStefano Zampini for (i=0;i<n_local_dofs;i++) { 13155b08dc53SStefano Zampini temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1; 1316674ae819SStefano Zampini } 1317674ae819SStefano Zampini } 1318674ae819SStefano Zampini ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr); 1319674ae819SStefano Zampini /* free workspace */ 1320674ae819SStefano Zampini ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr); 1321674ae819SStefano Zampini ierr = VecDestroy(&local_vec);CHKERRQ(ierr); 1322674ae819SStefano Zampini ierr = VecDestroy(&global_vec);CHKERRQ(ierr); 1323674ae819SStefano Zampini ierr = PetscFree(dof_sizes);CHKERRQ(ierr); 1324674ae819SStefano Zampini ierr = PetscFree(dof_displs);CHKERRQ(ierr); 1325674ae819SStefano Zampini /* return pointer to global ordering of local dofs */ 1326674ae819SStefano Zampini *global_numbering_subset = temp_global_dofs; 1327674ae819SStefano Zampini PetscFunctionReturn(0); 1328674ae819SStefano Zampini } 1329