1 /* TODOLIST 2 DofSplitting and DM attached to pc? 3 Change SetNeumannBoundaries to SetNeumannBoundariesLocal and provide new SetNeumannBoundaries (same Dirichlet) 4 - change prec_type to switch_inexact_prec_type 5 Inexact solvers: global preconditioner application is ready, ask to developers (Jed?) on how to best implement Dohrmann's approach (PCSHELL?) 6 change how to deal with the coarse problem (PCBDDCSetCoarseEnvironment): 7 - simplify coarse problem structure -> PCBDDC or PCREDUDANT, nothing else -> same comm for all levels? 8 - remove coarse enums and allow use of PCBDDCGetCoarseKSP 9 - remove metis dependency -> use MatPartitioning for multilevel -> Assemble serial adjacency in ManageLocalBoundaries? 10 code refactoring: 11 - pick up better names for static functions 12 change options structure: 13 - insert BDDC into MG framework? 14 provide other ops? Ask to developers 15 remove all unused printf 16 man pages 17 */ 18 19 /* ---------------------------------------------------------------------------------------------------------------------------------------------- 20 Implementation of BDDC preconditioner based on: 21 C. Dohrmann "An approximate BDDC preconditioner", Numerical Linear Algebra with Applications Volume 14, Issue 2, pages 149-168, March 2007 22 ---------------------------------------------------------------------------------------------------------------------------------------------- */ 23 24 #include "bddc.h" /*I "petscpc.h" I*/ /* includes for fortran wrappers */ 25 #include <petscblaslapack.h> 26 /* -------------------------------------------------------------------------- */ 27 #undef __FUNCT__ 28 #define __FUNCT__ "PCSetFromOptions_BDDC" 29 PetscErrorCode PCSetFromOptions_BDDC(PC pc) 30 { 31 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 32 PetscErrorCode ierr; 33 34 PetscFunctionBegin; 35 ierr = PetscOptionsHead("BDDC options");CHKERRQ(ierr); 36 /* Verbose debugging of main data structures */ 37 ierr = PetscOptionsBool("-pc_bddc_check_all" ,"Verbose (debugging) output for PCBDDC" ,"none",pcbddc->dbg_flag ,&pcbddc->dbg_flag ,PETSC_NULL);CHKERRQ(ierr); 38 /* Some customization for default primal space */ 39 ierr = PetscOptionsBool("-pc_bddc_vertices_only" ,"Use only vertices in coarse space (i.e. discard constraints)","none",pcbddc->vertices_flag ,&pcbddc->vertices_flag ,PETSC_NULL);CHKERRQ(ierr); 40 ierr = PetscOptionsBool("-pc_bddc_constraints_only","Use only constraints in coarse space (i.e. discard vertices)","none",pcbddc->constraints_flag,&pcbddc->constraints_flag,PETSC_NULL);CHKERRQ(ierr); 41 ierr = PetscOptionsBool("-pc_bddc_faces_only" ,"Use only faces among constraints of coarse space (i.e. discard edges)" ,"none",pcbddc->faces_flag ,&pcbddc->faces_flag ,PETSC_NULL);CHKERRQ(ierr); 42 ierr = PetscOptionsBool("-pc_bddc_edges_only" ,"Use only edges among constraints of coarse space (i.e. discard faces)" ,"none",pcbddc->edges_flag ,&pcbddc->edges_flag ,PETSC_NULL);CHKERRQ(ierr); 43 /* Coarse solver context */ 44 static const char * const avail_coarse_problems[] = {"sequential","replicated","parallel","multilevel","CoarseProblemType","PC_BDDC_",0}; /*order of choiches depends on ENUM defined in bddc.h */ 45 ierr = PetscOptionsEnum("-pc_bddc_coarse_problem_type","Set coarse problem type","none",avail_coarse_problems,(PetscEnum)pcbddc->coarse_problem_type,(PetscEnum*)&pcbddc->coarse_problem_type,PETSC_NULL);CHKERRQ(ierr); 46 /* Two different application of BDDC to the whole set of dofs, internal and interface */ 47 ierr = PetscOptionsBool("-pc_bddc_switch_preconditioning_type","Switch between M_2 (default) and M_3 preconditioners (as defined by Dohrmann)","none",pcbddc->prec_type,&pcbddc->prec_type,PETSC_NULL);CHKERRQ(ierr); 48 ierr = PetscOptionsBool("-pc_bddc_use_change_of_basis","Use change of basis approach for primal space","none",pcbddc->usechangeofbasis,&pcbddc->usechangeofbasis,PETSC_NULL);CHKERRQ(ierr); 49 ierr = PetscOptionsBool("-pc_bddc_use_change_on_faces","Use change of basis approach for face constraints","none",pcbddc->usechangeonfaces,&pcbddc->usechangeonfaces,PETSC_NULL);CHKERRQ(ierr); 50 pcbddc->usechangeonfaces = pcbddc->usechangeonfaces && pcbddc->usechangeofbasis; 51 ierr = PetscOptionsInt("-pc_bddc_coarsening_ratio","Set coarsening ratio used in multilevel coarsening","none",pcbddc->coarsening_ratio,&pcbddc->coarsening_ratio,PETSC_NULL);CHKERRQ(ierr); 52 ierr = PetscOptionsInt("-pc_bddc_max_levels","Set maximum number of levels for multilevel","none",pcbddc->max_levels,&pcbddc->max_levels,PETSC_NULL);CHKERRQ(ierr); 53 ierr = PetscOptionsTail();CHKERRQ(ierr); 54 PetscFunctionReturn(0); 55 } 56 /* -------------------------------------------------------------------------- */ 57 EXTERN_C_BEGIN 58 #undef __FUNCT__ 59 #define __FUNCT__ "PCBDDCSetCoarseProblemType_BDDC" 60 static PetscErrorCode PCBDDCSetCoarseProblemType_BDDC(PC pc, CoarseProblemType CPT) 61 { 62 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 63 64 PetscFunctionBegin; 65 pcbddc->coarse_problem_type = CPT; 66 PetscFunctionReturn(0); 67 } 68 EXTERN_C_END 69 #undef __FUNCT__ 70 #define __FUNCT__ "PCBDDCSetCoarseProblemType" 71 /*@ 72 PCBDDCSetCoarseProblemType - Set coarse problem type in PCBDDC. 73 74 Not collective 75 76 Input Parameters: 77 + pc - the preconditioning context 78 - CoarseProblemType - pick a better name and explain what this is 79 80 Level: intermediate 81 82 Notes: 83 Not collective but all procs must call with same arguments. 84 85 .seealso: PCBDDC 86 @*/ 87 PetscErrorCode PCBDDCSetCoarseProblemType(PC pc, CoarseProblemType CPT) 88 { 89 PetscErrorCode ierr; 90 91 PetscFunctionBegin; 92 PetscValidHeaderSpecific(pc,PC_CLASSID,1); 93 ierr = PetscTryMethod(pc,"PCBDDCSetCoarseProblemType_C",(PC,CoarseProblemType),(pc,CPT));CHKERRQ(ierr); 94 PetscFunctionReturn(0); 95 } 96 /* -------------------------------------------------------------------------- */ 97 EXTERN_C_BEGIN 98 #undef __FUNCT__ 99 #define __FUNCT__ "PCBDDCSetCoarseningRatio_BDDC" 100 static PetscErrorCode PCBDDCSetCoarseningRatio_BDDC(PC pc,PetscInt k) 101 { 102 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 103 104 PetscFunctionBegin; 105 pcbddc->coarsening_ratio=k; 106 PetscFunctionReturn(0); 107 } 108 EXTERN_C_END 109 #undef __FUNCT__ 110 #define __FUNCT__ "PCBDDCSetCoarseningRatio" 111 /*@ 112 PCBDDCSetCoarseningRatio - Set coarsening ratio used in multilevel coarsening 113 114 Logically collective on PC 115 116 Input Parameters: 117 + pc - the preconditioning context 118 - k - coarsening ratio 119 120 Approximatively k subdomains at the finer level will be aggregated into a single subdomain at the coarser level. 121 122 Level: intermediate 123 124 Notes: 125 126 .seealso: PCBDDC 127 @*/ 128 PetscErrorCode PCBDDCSetCoarseningRatio(PC pc,PetscInt k) 129 { 130 PetscErrorCode ierr; 131 132 PetscFunctionBegin; 133 PetscValidHeaderSpecific(pc,PC_CLASSID,1); 134 ierr = PetscTryMethod(pc,"PCBDDCSetCoarseningRatio_C",(PC,PetscInt),(pc,k));CHKERRQ(ierr); 135 PetscFunctionReturn(0); 136 } 137 /* -------------------------------------------------------------------------- */ 138 EXTERN_C_BEGIN 139 #undef __FUNCT__ 140 #define __FUNCT__ "PCBDDCSetMaxLevels_BDDC" 141 static PetscErrorCode PCBDDCSetMaxLevels_BDDC(PC pc,PetscInt max_levels) 142 { 143 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 144 145 PetscFunctionBegin; 146 pcbddc->max_levels=max_levels; 147 PetscFunctionReturn(0); 148 } 149 EXTERN_C_END 150 #undef __FUNCT__ 151 #define __FUNCT__ "PCBDDCSetMaxLevels" 152 /*@ 153 PCBDDCSetMaxLevels - Sets the maximum number of levels within the multilevel approach. 154 155 Logically collective on PC 156 157 Input Parameters: 158 + pc - the preconditioning context 159 - max_levels - the maximum number of levels 160 161 Default value is 1, i.e. coarse problem will be solved inexactly with one application 162 of PCBDDC preconditioner if the multilevel approach is requested. 163 164 Level: intermediate 165 166 Notes: 167 168 .seealso: PCBDDC 169 @*/ 170 PetscErrorCode PCBDDCSetMaxLevels(PC pc,PetscInt max_levels) 171 { 172 PetscErrorCode ierr; 173 174 PetscFunctionBegin; 175 PetscValidHeaderSpecific(pc,PC_CLASSID,1); 176 ierr = PetscTryMethod(pc,"PCBDDCSetMaxLevels_C",(PC,PetscInt),(pc,max_levels));CHKERRQ(ierr); 177 PetscFunctionReturn(0); 178 } 179 /* -------------------------------------------------------------------------- */ 180 EXTERN_C_BEGIN 181 #undef __FUNCT__ 182 #define __FUNCT__ "PCBDDCSetNullSpace_BDDC" 183 static PetscErrorCode PCBDDCSetNullSpace_BDDC(PC pc,MatNullSpace NullSpace) 184 { 185 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 186 PetscErrorCode ierr; 187 188 PetscFunctionBegin; 189 ierr = PetscObjectReference((PetscObject)NullSpace);CHKERRQ(ierr); 190 ierr = MatNullSpaceDestroy(&pcbddc->NullSpace);CHKERRQ(ierr); 191 pcbddc->NullSpace=NullSpace; 192 PetscFunctionReturn(0); 193 } 194 EXTERN_C_END 195 #undef __FUNCT__ 196 #define __FUNCT__ "PCBDDCSetNullSpace" 197 /*@ 198 PCBDDCSetNullSpace - Set NullSpace of global operator of BDDC preconditioned mat. 199 200 Logically collective on PC and MatNullSpace 201 202 Input Parameters: 203 + pc - the preconditioning context 204 - NullSpace - Null space of the linear operator to be preconditioned. 205 206 Level: intermediate 207 208 Notes: 209 210 .seealso: PCBDDC 211 @*/ 212 PetscErrorCode PCBDDCSetNullSpace(PC pc,MatNullSpace NullSpace) 213 { 214 PetscErrorCode ierr; 215 216 PetscFunctionBegin; 217 PetscValidHeaderSpecific(pc,PC_CLASSID,1); 218 ierr = PetscTryMethod(pc,"PCBDDCSetNullSpace_C",(PC,MatNullSpace),(pc,NullSpace));CHKERRQ(ierr); 219 PetscFunctionReturn(0); 220 } 221 /* -------------------------------------------------------------------------- */ 222 EXTERN_C_BEGIN 223 #undef __FUNCT__ 224 #define __FUNCT__ "PCBDDCSetDirichletBoundaries_BDDC" 225 static PetscErrorCode PCBDDCSetDirichletBoundaries_BDDC(PC pc,IS DirichletBoundaries) 226 { 227 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 228 PetscErrorCode ierr; 229 230 PetscFunctionBegin; 231 ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr); 232 ierr = PetscObjectReference((PetscObject)DirichletBoundaries);CHKERRQ(ierr); 233 pcbddc->DirichletBoundaries=DirichletBoundaries; 234 PetscFunctionReturn(0); 235 } 236 EXTERN_C_END 237 #undef __FUNCT__ 238 #define __FUNCT__ "PCBDDCSetDirichletBoundaries" 239 /*@ 240 PCBDDCSetDirichletBoundaries - Set index set defining subdomain part (in local ordering) 241 of Dirichlet boundaries for the global problem. 242 243 Not collective 244 245 Input Parameters: 246 + pc - the preconditioning context 247 - DirichletBoundaries - sequential index set defining the subdomain part of Dirichlet boundaries (can be PETSC_NULL) 248 249 Level: intermediate 250 251 Notes: 252 253 .seealso: PCBDDC 254 @*/ 255 PetscErrorCode PCBDDCSetDirichletBoundaries(PC pc,IS DirichletBoundaries) 256 { 257 PetscErrorCode ierr; 258 259 PetscFunctionBegin; 260 PetscValidHeaderSpecific(pc,PC_CLASSID,1); 261 ierr = PetscTryMethod(pc,"PCBDDCSetDirichletBoundaries_C",(PC,IS),(pc,DirichletBoundaries));CHKERRQ(ierr); 262 PetscFunctionReturn(0); 263 } 264 /* -------------------------------------------------------------------------- */ 265 EXTERN_C_BEGIN 266 #undef __FUNCT__ 267 #define __FUNCT__ "PCBDDCSetNeumannBoundaries_BDDC" 268 static PetscErrorCode PCBDDCSetNeumannBoundaries_BDDC(PC pc,IS NeumannBoundaries) 269 { 270 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 271 PetscErrorCode ierr; 272 273 PetscFunctionBegin; 274 ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr); 275 ierr = PetscObjectReference((PetscObject)NeumannBoundaries);CHKERRQ(ierr); 276 pcbddc->NeumannBoundaries=NeumannBoundaries; 277 PetscFunctionReturn(0); 278 } 279 EXTERN_C_END 280 #undef __FUNCT__ 281 #define __FUNCT__ "PCBDDCSetNeumannBoundaries" 282 /*@ 283 PCBDDCSetNeumannBoundaries - Set index set defining subdomain part (in local ordering) 284 of Neumann boundaries for the global problem. 285 286 Not collective 287 288 Input Parameters: 289 + pc - the preconditioning context 290 - NeumannBoundaries - sequential index set defining the subdomain part of Neumann boundaries (can be PETSC_NULL) 291 292 Level: intermediate 293 294 Notes: 295 296 .seealso: PCBDDC 297 @*/ 298 PetscErrorCode PCBDDCSetNeumannBoundaries(PC pc,IS NeumannBoundaries) 299 { 300 PetscErrorCode ierr; 301 302 PetscFunctionBegin; 303 PetscValidHeaderSpecific(pc,PC_CLASSID,1); 304 ierr = PetscTryMethod(pc,"PCBDDCSetNeumannBoundaries_C",(PC,IS),(pc,NeumannBoundaries));CHKERRQ(ierr); 305 PetscFunctionReturn(0); 306 } 307 /* -------------------------------------------------------------------------- */ 308 EXTERN_C_BEGIN 309 #undef __FUNCT__ 310 #define __FUNCT__ "PCBDDCGetDirichletBoundaries_BDDC" 311 static PetscErrorCode PCBDDCGetDirichletBoundaries_BDDC(PC pc,IS *DirichletBoundaries) 312 { 313 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 314 315 PetscFunctionBegin; 316 *DirichletBoundaries = pcbddc->DirichletBoundaries; 317 PetscFunctionReturn(0); 318 } 319 EXTERN_C_END 320 #undef __FUNCT__ 321 #define __FUNCT__ "PCBDDCGetDirichletBoundaries" 322 /*@ 323 PCBDDCGetDirichletBoundaries - Get index set defining subdomain part (in local ordering) 324 of Dirichlet boundaries for the global problem. 325 326 Not collective 327 328 Input Parameters: 329 + pc - the preconditioning context 330 331 Output Parameters: 332 + DirichletBoundaries - index set defining the subdomain part of Dirichlet boundaries 333 334 Level: intermediate 335 336 Notes: 337 338 .seealso: PCBDDC 339 @*/ 340 PetscErrorCode PCBDDCGetDirichletBoundaries(PC pc,IS *DirichletBoundaries) 341 { 342 PetscErrorCode ierr; 343 344 PetscFunctionBegin; 345 PetscValidHeaderSpecific(pc,PC_CLASSID,1); 346 ierr = PetscUseMethod(pc,"PCBDDCGetDirichletBoundaries_C",(PC,IS*),(pc,DirichletBoundaries));CHKERRQ(ierr); 347 PetscFunctionReturn(0); 348 } 349 /* -------------------------------------------------------------------------- */ 350 EXTERN_C_BEGIN 351 #undef __FUNCT__ 352 #define __FUNCT__ "PCBDDCGetNeumannBoundaries_BDDC" 353 static PetscErrorCode PCBDDCGetNeumannBoundaries_BDDC(PC pc,IS *NeumannBoundaries) 354 { 355 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 356 357 PetscFunctionBegin; 358 *NeumannBoundaries = pcbddc->NeumannBoundaries; 359 PetscFunctionReturn(0); 360 } 361 EXTERN_C_END 362 #undef __FUNCT__ 363 #define __FUNCT__ "PCBDDCGetNeumannBoundaries" 364 /*@ 365 PCBDDCGetNeumannBoundaries - Get index set defining subdomain part (in local ordering) 366 of Neumann boundaries for the global problem. 367 368 Not collective 369 370 Input Parameters: 371 + pc - the preconditioning context 372 373 Output Parameters: 374 + NeumannBoundaries - index set defining the subdomain part of Neumann boundaries 375 376 Level: intermediate 377 378 Notes: 379 380 .seealso: PCBDDC 381 @*/ 382 PetscErrorCode PCBDDCGetNeumannBoundaries(PC pc,IS *NeumannBoundaries) 383 { 384 PetscErrorCode ierr; 385 386 PetscFunctionBegin; 387 PetscValidHeaderSpecific(pc,PC_CLASSID,1); 388 ierr = PetscUseMethod(pc,"PCBDDCGetNeumannBoundaries_C",(PC,IS*),(pc,NeumannBoundaries));CHKERRQ(ierr); 389 PetscFunctionReturn(0); 390 } 391 /* -------------------------------------------------------------------------- */ 392 EXTERN_C_BEGIN 393 #undef __FUNCT__ 394 #define __FUNCT__ "PCBDDCSetLocalAdjacencyGraph_BDDC" 395 static PetscErrorCode PCBDDCSetLocalAdjacencyGraph_BDDC(PC pc, PetscInt nvtxs, PetscInt xadj[], PetscInt adjncy[], PetscCopyMode copymode) 396 { 397 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 398 PCBDDCGraph mat_graph=pcbddc->mat_graph; 399 PetscErrorCode ierr; 400 401 PetscFunctionBegin; 402 mat_graph->nvtxs=nvtxs; 403 ierr = PetscFree(mat_graph->xadj);CHKERRQ(ierr); 404 ierr = PetscFree(mat_graph->adjncy);CHKERRQ(ierr); 405 if (copymode == PETSC_COPY_VALUES) { 406 ierr = PetscMalloc((mat_graph->nvtxs+1)*sizeof(PetscInt),&mat_graph->xadj);CHKERRQ(ierr); 407 ierr = PetscMalloc(xadj[mat_graph->nvtxs]*sizeof(PetscInt),&mat_graph->adjncy);CHKERRQ(ierr); 408 ierr = PetscMemcpy(mat_graph->xadj,xadj,(mat_graph->nvtxs+1)*sizeof(PetscInt));CHKERRQ(ierr); 409 ierr = PetscMemcpy(mat_graph->adjncy,adjncy,xadj[mat_graph->nvtxs]*sizeof(PetscInt));CHKERRQ(ierr); 410 } else if (copymode == PETSC_OWN_POINTER) { 411 mat_graph->xadj=xadj; 412 mat_graph->adjncy=adjncy; 413 } else { 414 SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unsupported copy mode %d in %s\n",copymode,__FUNCT__); 415 } 416 PetscFunctionReturn(0); 417 } 418 EXTERN_C_END 419 #undef __FUNCT__ 420 #define __FUNCT__ "PCBDDCSetLocalAdjacencyGraph" 421 /*@ 422 PCBDDCSetLocalAdjacencyGraph - Set CSR graph of local matrix for use of PCBDDC. 423 424 Not collective 425 426 Input Parameters: 427 + pc - the preconditioning context 428 - nvtxs - number of local vertices of the graph 429 - xadj, adjncy - the CSR graph 430 - copymode - either PETSC_COPY_VALUES or PETSC_OWN_POINTER. In the former case the user must free the array passed in; 431 in the latter case, memory must be obtained with PetscMalloc. 432 433 Level: intermediate 434 435 Notes: 436 437 .seealso: PCBDDC 438 @*/ 439 PetscErrorCode PCBDDCSetLocalAdjacencyGraph(PC pc,PetscInt nvtxs,PetscInt xadj[],PetscInt adjncy[], PetscCopyMode copymode) 440 { 441 PetscInt nrows,ncols; 442 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 443 PetscErrorCode ierr; 444 445 PetscFunctionBegin; 446 PetscValidHeaderSpecific(pc,PC_CLASSID,1); 447 ierr = MatGetSize(matis->A,&nrows,&ncols);CHKERRQ(ierr); 448 if (nvtxs != nrows) { 449 SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Local adjacency size %d passed in %s differs from local problem size %d!\n",nvtxs,__FUNCT__,nrows); 450 } else { 451 ierr = PetscTryMethod(pc,"PCBDDCSetLocalAdjacencyGraph_C",(PC,PetscInt,PetscInt[],PetscInt[],PetscCopyMode),(pc,nvtxs,xadj,adjncy,copymode));CHKERRQ(ierr); 452 } 453 PetscFunctionReturn(0); 454 } 455 /* -------------------------------------------------------------------------- */ 456 EXTERN_C_BEGIN 457 #undef __FUNCT__ 458 #define __FUNCT__ "PCBDDCSetDofsSplitting_BDDC" 459 static PetscErrorCode PCBDDCSetDofsSplitting_BDDC(PC pc,PetscInt n_is, IS ISForDofs[]) 460 { 461 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 462 PetscInt i; 463 PetscErrorCode ierr; 464 465 PetscFunctionBegin; 466 /* Destroy ISes if they were already set */ 467 for (i=0;i<pcbddc->n_ISForDofs;i++) { 468 ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr); 469 } 470 ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr); 471 /* allocate space then set */ 472 ierr = PetscMalloc(n_is*sizeof(IS),&pcbddc->ISForDofs);CHKERRQ(ierr); 473 for (i=0;i<n_is;i++) { 474 ierr = PetscObjectReference((PetscObject)ISForDofs[i]);CHKERRQ(ierr); 475 pcbddc->ISForDofs[i]=ISForDofs[i]; 476 } 477 pcbddc->n_ISForDofs=n_is; 478 PetscFunctionReturn(0); 479 } 480 EXTERN_C_END 481 #undef __FUNCT__ 482 #define __FUNCT__ "PCBDDCSetDofsSplitting" 483 /*@ 484 PCBDDCSetDofsSplitting - Set index sets defining fields of local mat. 485 486 Not collective 487 488 Input Parameters: 489 + pc - the preconditioning context 490 - n - number of index sets defining the fields 491 - IS[] - array of IS describing the fields 492 493 Level: intermediate 494 495 Notes: 496 497 .seealso: PCBDDC 498 @*/ 499 PetscErrorCode PCBDDCSetDofsSplitting(PC pc,PetscInt n_is, IS ISForDofs[]) 500 { 501 PetscErrorCode ierr; 502 503 PetscFunctionBegin; 504 PetscValidHeaderSpecific(pc,PC_CLASSID,1); 505 ierr = PetscTryMethod(pc,"PCBDDCSetDofsSplitting_C",(PC,PetscInt,IS[]),(pc,n_is,ISForDofs));CHKERRQ(ierr); 506 PetscFunctionReturn(0); 507 } 508 /* -------------------------------------------------------------------------- */ 509 #undef __FUNCT__ 510 #define __FUNCT__ "PCPreSolve_BDDC" 511 /* -------------------------------------------------------------------------- */ 512 /* 513 PCPreSolve_BDDC - Changes the right hand side and (if necessary) the initial 514 guess if a transformation of basis approach has been selected. 515 516 Input Parameter: 517 + pc - the preconditioner contex 518 519 Application Interface Routine: PCPreSolve() 520 521 Notes: 522 The interface routine PCPreSolve() is not usually called directly by 523 the user, but instead is called by KSPSolve(). 524 */ 525 static PetscErrorCode PCPreSolve_BDDC(PC pc, KSP ksp, Vec rhs, Vec x) 526 { 527 PetscErrorCode ierr; 528 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 529 PC_IS *pcis = (PC_IS*)(pc->data); 530 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 531 Mat temp_mat; 532 IS dirIS; 533 PetscInt dirsize,i,*is_indices; 534 PetscScalar *array_x,*array_diagonal; 535 Vec used_vec; 536 PetscBool guess_nonzero; 537 538 PetscFunctionBegin; 539 if (x) { 540 ierr = PetscObjectReference((PetscObject)x);CHKERRQ(ierr); 541 used_vec = x; 542 } else { 543 ierr = PetscObjectReference((PetscObject)pcbddc->temp_solution);CHKERRQ(ierr); 544 used_vec = pcbddc->temp_solution; 545 ierr = VecSet(used_vec,0.0);CHKERRQ(ierr); 546 } 547 /* hack into ksp data structure PCPreSolve comes earlier in src/ksp/ksp/interface/itfunc.c */ 548 if (ksp) { 549 ierr = KSPGetInitialGuessNonzero(ksp,&guess_nonzero);CHKERRQ(ierr); 550 if ( !guess_nonzero ) { 551 ierr = VecSet(used_vec,0.0);CHKERRQ(ierr); 552 } 553 } 554 /* store the original rhs */ 555 ierr = VecCopy(rhs,pcbddc->original_rhs);CHKERRQ(ierr); 556 557 /* Take into account zeroed rows -> change rhs and store solution removed */ 558 ierr = MatGetDiagonal(pc->pmat,pcis->vec1_global);CHKERRQ(ierr); 559 ierr = VecPointwiseDivide(pcis->vec1_global,rhs,pcis->vec1_global);CHKERRQ(ierr); 560 ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 561 ierr = VecScatterEnd (matis->ctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 562 ierr = VecScatterBegin(matis->ctx,used_vec,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 563 ierr = VecScatterEnd (matis->ctx,used_vec,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 564 ierr = PCBDDCGetDirichletBoundaries(pc,&dirIS);CHKERRQ(ierr); 565 if (dirIS) { 566 ierr = ISGetSize(dirIS,&dirsize);CHKERRQ(ierr); 567 ierr = VecGetArray(pcis->vec1_N,&array_x);CHKERRQ(ierr); 568 ierr = VecGetArray(pcis->vec2_N,&array_diagonal);CHKERRQ(ierr); 569 ierr = ISGetIndices(dirIS,(const PetscInt**)&is_indices);CHKERRQ(ierr); 570 for (i=0;i<dirsize;i++) { 571 array_x[is_indices[i]]=array_diagonal[is_indices[i]]; 572 } 573 ierr = ISRestoreIndices(dirIS,(const PetscInt**)&is_indices);CHKERRQ(ierr); 574 ierr = VecRestoreArray(pcis->vec2_N,&array_diagonal);CHKERRQ(ierr); 575 ierr = VecRestoreArray(pcis->vec1_N,&array_x);CHKERRQ(ierr); 576 } 577 ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,used_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 578 ierr = VecScatterEnd (matis->ctx,pcis->vec1_N,used_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 579 580 /* remove the computed solution from the rhs */ 581 ierr = VecScale(used_vec,-1.0);CHKERRQ(ierr); 582 ierr = MatMultAdd(pc->pmat,used_vec,rhs,rhs);CHKERRQ(ierr); 583 ierr = VecScale(used_vec,-1.0);CHKERRQ(ierr); 584 585 /* store partially computed solution and set initial guess */ 586 if (x) { 587 ierr = VecCopy(used_vec,pcbddc->temp_solution);CHKERRQ(ierr); 588 ierr = VecSet(used_vec,0.0);CHKERRQ(ierr); 589 if (pcbddc->use_exact_dirichlet) { 590 ierr = VecScatterBegin(pcis->global_to_D,rhs,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 591 ierr = VecScatterEnd (pcis->global_to_D,rhs,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 592 ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr); 593 ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,used_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 594 ierr = VecScatterEnd (pcis->global_to_D,pcis->vec2_D,used_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 595 if (ksp) { 596 ierr = KSPSetInitialGuessNonzero(ksp,PETSC_TRUE);CHKERRQ(ierr); 597 } 598 } 599 } 600 601 /* rhs change of basis */ 602 if (pcbddc->usechangeofbasis) { 603 /* swap pointers for local matrices */ 604 temp_mat = matis->A; 605 matis->A = pcbddc->local_mat; 606 pcbddc->local_mat = temp_mat; 607 /* Get local rhs and apply transformation of basis */ 608 ierr = VecScatterBegin(pcis->global_to_B,rhs,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 609 ierr = VecScatterEnd (pcis->global_to_B,rhs,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 610 /* from original basis to modified basis */ 611 ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr); 612 /* put back modified values into the global vec using INSERT_VALUES copy mode */ 613 ierr = VecScatterBegin(pcis->global_to_B,pcis->vec2_B,rhs,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 614 ierr = VecScatterEnd (pcis->global_to_B,pcis->vec2_B,rhs,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 615 if (ksp && pcbddc->NullSpace) { 616 ierr = MatNullSpaceRemove(pcbddc->NullSpace,used_vec,PETSC_NULL);CHKERRQ(ierr); 617 ierr = MatNullSpaceRemove(pcbddc->NullSpace,rhs,PETSC_NULL);CHKERRQ(ierr); 618 } 619 } 620 ierr = VecDestroy(&used_vec);CHKERRQ(ierr); 621 PetscFunctionReturn(0); 622 } 623 /* -------------------------------------------------------------------------- */ 624 #undef __FUNCT__ 625 #define __FUNCT__ "PCPostSolve_BDDC" 626 /* -------------------------------------------------------------------------- */ 627 /* 628 PCPostSolve_BDDC - Changes the computed solution if a transformation of basis 629 approach has been selected. Also, restores rhs to its original state. 630 631 Input Parameter: 632 + pc - the preconditioner contex 633 634 Application Interface Routine: PCPostSolve() 635 636 Notes: 637 The interface routine PCPostSolve() is not usually called directly by 638 the user, but instead is called by KSPSolve(). 639 */ 640 static PetscErrorCode PCPostSolve_BDDC(PC pc, KSP ksp, Vec rhs, Vec x) 641 { 642 PetscErrorCode ierr; 643 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 644 PC_IS *pcis = (PC_IS*)(pc->data); 645 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 646 Mat temp_mat; 647 648 PetscFunctionBegin; 649 if (pcbddc->usechangeofbasis) { 650 /* swap pointers for local matrices */ 651 temp_mat = matis->A; 652 matis->A = pcbddc->local_mat; 653 pcbddc->local_mat = temp_mat; 654 /* restore rhs to its original state */ 655 if (rhs) { 656 ierr = VecCopy(pcbddc->original_rhs,rhs);CHKERRQ(ierr); 657 } 658 /* Get Local boundary and apply transformation of basis to solution vector */ 659 ierr = VecScatterBegin(pcis->global_to_B,x,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 660 ierr = VecScatterEnd (pcis->global_to_B,x,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 661 /* from modified basis to original basis */ 662 ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr); 663 /* put back modified values into the global vec using INSERT_VALUES copy mode */ 664 ierr = VecScatterBegin(pcis->global_to_B,pcis->vec2_B,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 665 ierr = VecScatterEnd (pcis->global_to_B,pcis->vec2_B,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 666 } 667 /* add solution removed in presolve */ 668 if (x) { 669 ierr = VecAXPY(x,1.0,pcbddc->temp_solution);CHKERRQ(ierr); 670 } 671 PetscFunctionReturn(0); 672 } 673 /* -------------------------------------------------------------------------- */ 674 #undef __FUNCT__ 675 #define __FUNCT__ "PCSetUp_BDDC" 676 /* -------------------------------------------------------------------------- */ 677 /* 678 PCSetUp_BDDC - Prepares for the use of the BDDC preconditioner 679 by setting data structures and options. 680 681 Input Parameter: 682 + pc - the preconditioner context 683 684 Application Interface Routine: PCSetUp() 685 686 Notes: 687 The interface routine PCSetUp() is not usually called directly by 688 the user, but instead is called by PCApply() if necessary. 689 */ 690 PetscErrorCode PCSetUp_BDDC(PC pc) 691 { 692 PetscErrorCode ierr; 693 PC_BDDC* pcbddc = (PC_BDDC*)pc->data; 694 695 PetscFunctionBegin; 696 if (!pc->setupcalled) { 697 /* For BDDC we need to define a local "Neumann" problem different to that defined in PCISSetup 698 So, we set to pcnone the Neumann problem of pcis in order to avoid unneeded computation 699 Also, we decide to directly build the (same) Dirichlet problem */ 700 ierr = PetscOptionsSetValue("-is_localN_pc_type","none");CHKERRQ(ierr); 701 ierr = PetscOptionsSetValue("-is_localD_pc_type","none");CHKERRQ(ierr); 702 /* Set up all the "iterative substructuring" common block */ 703 704 ierr = PCISSetUp(pc);CHKERRQ(ierr); 705 /* Get stdout for dbg */ 706 if (pcbddc->dbg_flag) { 707 ierr = PetscViewerASCIIGetStdout(((PetscObject)pc)->comm,&pcbddc->dbg_viewer);CHKERRQ(ierr); 708 ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr); 709 } 710 /* Analyze local interface */ 711 ierr = PCBDDCManageLocalBoundaries(pc);CHKERRQ(ierr); 712 /* Set up local constraint matrix */ 713 ierr = PCBDDCCreateConstraintMatrix(pc);CHKERRQ(ierr); 714 /* Create coarse and local stuffs used for evaluating action of preconditioner */ 715 ierr = PCBDDCCoarseSetUp(pc);CHKERRQ(ierr); 716 } 717 PetscFunctionReturn(0); 718 } 719 720 /* -------------------------------------------------------------------------- */ 721 /* 722 PCApply_BDDC - Applies the BDDC preconditioner to a vector. 723 724 Input Parameters: 725 . pc - the preconditioner context 726 . r - input vector (global) 727 728 Output Parameter: 729 . z - output vector (global) 730 731 Application Interface Routine: PCApply() 732 */ 733 #undef __FUNCT__ 734 #define __FUNCT__ "PCApply_BDDC" 735 PetscErrorCode PCApply_BDDC(PC pc,Vec r,Vec z) 736 { 737 PC_IS *pcis = (PC_IS*)(pc->data); 738 PC_BDDC *pcbddc = (PC_BDDC*)(pc->data); 739 PetscErrorCode ierr; 740 const PetscScalar one = 1.0; 741 const PetscScalar m_one = -1.0; 742 const PetscScalar zero = 0.0; 743 744 /* This code is similar to that provided in nn.c for PCNN 745 NN interface preconditioner changed to BDDC 746 Added support for M_3 preconditioenr in the reference article (code is active if pcbddc->prec_type = PETSC_TRUE) */ 747 748 PetscFunctionBegin; 749 if (!pcbddc->use_exact_dirichlet) { 750 /* First Dirichlet solve */ 751 ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 752 ierr = VecScatterEnd (pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 753 ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr); 754 /* 755 Assembling right hand side for BDDC operator 756 - vec1_D for the Dirichlet part (if needed, i.e. prec_flag=PETSC_TRUE) 757 - the interface part of the global vector z 758 */ 759 ierr = VecScale(pcis->vec2_D,m_one);CHKERRQ(ierr); 760 ierr = MatMult(pcis->A_BI,pcis->vec2_D,pcis->vec1_B);CHKERRQ(ierr); 761 if (pcbddc->prec_type) { ierr = MatMultAdd(pcis->A_II,pcis->vec2_D,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); } 762 ierr = VecScale(pcis->vec2_D,m_one);CHKERRQ(ierr); 763 ierr = VecCopy(r,z);CHKERRQ(ierr); 764 ierr = VecScatterBegin(pcis->global_to_B,pcis->vec1_B,z,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 765 ierr = VecScatterEnd (pcis->global_to_B,pcis->vec1_B,z,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 766 ierr = VecScatterBegin(pcis->global_to_B,z,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 767 ierr = VecScatterEnd (pcis->global_to_B,z,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 768 } else { 769 ierr = VecScatterBegin(pcis->global_to_B,r,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 770 ierr = VecScatterEnd (pcis->global_to_B,r,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 771 ierr = VecSet(pcis->vec1_D,zero);CHKERRQ(ierr); 772 ierr = VecSet(pcis->vec2_D,zero);CHKERRQ(ierr); 773 } 774 775 /* Apply partition of unity */ 776 ierr = VecPointwiseMult(pcis->vec1_B,pcis->D,pcis->vec1_B);CHKERRQ(ierr); 777 778 /* Apply interface preconditioner 779 input/output vecs: pcis->vec1_B and pcis->vec1_D */ 780 ierr = PCBDDCApplyInterfacePreconditioner(pc);CHKERRQ(ierr); 781 782 /* Apply partition of unity and sum boundary values */ 783 ierr = VecPointwiseMult(pcis->vec1_B,pcis->D,pcis->vec1_B);CHKERRQ(ierr); 784 ierr = VecSet(z,zero);CHKERRQ(ierr); 785 ierr = VecScatterBegin(pcis->global_to_B,pcis->vec1_B,z,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 786 ierr = VecScatterEnd (pcis->global_to_B,pcis->vec1_B,z,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 787 788 /* Second Dirichlet solve and assembling of output */ 789 ierr = VecScatterBegin(pcis->global_to_B,z,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 790 ierr = VecScatterEnd (pcis->global_to_B,z,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 791 ierr = MatMult(pcis->A_IB,pcis->vec1_B,pcis->vec3_D);CHKERRQ(ierr); 792 if (pcbddc->prec_type) { ierr = MatMultAdd(pcis->A_II,pcis->vec1_D,pcis->vec3_D,pcis->vec3_D);CHKERRQ(ierr); } 793 ierr = KSPSolve(pcbddc->ksp_D,pcis->vec3_D,pcbddc->vec4_D);CHKERRQ(ierr); 794 ierr = VecScale(pcbddc->vec4_D,m_one);CHKERRQ(ierr); 795 if (pcbddc->prec_type) { ierr = VecAXPY (pcbddc->vec4_D,one,pcis->vec1_D);CHKERRQ(ierr); } 796 ierr = VecAXPY (pcis->vec2_D,one,pcbddc->vec4_D);CHKERRQ(ierr); 797 ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 798 ierr = VecScatterEnd (pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 799 PetscFunctionReturn(0); 800 801 } 802 /* -------------------------------------------------------------------------- */ 803 #undef __FUNCT__ 804 #define __FUNCT__ "PCDestroy_BDDC" 805 PetscErrorCode PCDestroy_BDDC(PC pc) 806 { 807 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 808 PetscInt i; 809 PetscErrorCode ierr; 810 811 PetscFunctionBegin; 812 /* free data created by PCIS */ 813 ierr = PCISDestroy(pc);CHKERRQ(ierr); 814 /* free BDDC data */ 815 ierr = MatNullSpaceDestroy(&pcbddc->CoarseNullSpace);CHKERRQ(ierr); 816 ierr = MatNullSpaceDestroy(&pcbddc->NullSpace);CHKERRQ(ierr); 817 ierr = VecDestroy(&pcbddc->temp_solution);CHKERRQ(ierr); 818 ierr = VecDestroy(&pcbddc->original_rhs);CHKERRQ(ierr); 819 ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr); 820 ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr); 821 ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr); 822 ierr = VecDestroy(&pcbddc->coarse_rhs);CHKERRQ(ierr); 823 ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr); 824 ierr = MatDestroy(&pcbddc->coarse_mat);CHKERRQ(ierr); 825 ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr); 826 ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr); 827 ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr); 828 ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr); 829 ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr); 830 ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr); 831 ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr); 832 ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr); 833 ierr = VecDestroy(&pcbddc->vec4_D);CHKERRQ(ierr); 834 ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr); 835 ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr); 836 ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr); 837 ierr = KSPDestroy(&pcbddc->ksp_D);CHKERRQ(ierr); 838 ierr = KSPDestroy(&pcbddc->ksp_R);CHKERRQ(ierr); 839 ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr); 840 ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr); 841 ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr); 842 ierr = PetscFree(pcbddc->local_primal_indices);CHKERRQ(ierr); 843 ierr = PetscFree(pcbddc->replicated_local_primal_indices);CHKERRQ(ierr); 844 ierr = PetscFree(pcbddc->replicated_local_primal_values);CHKERRQ(ierr); 845 ierr = PetscFree(pcbddc->local_primal_displacements);CHKERRQ(ierr); 846 ierr = PetscFree(pcbddc->local_primal_sizes);CHKERRQ(ierr); 847 for (i=0;i<pcbddc->n_ISForDofs;i++) { ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr); } 848 ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr); 849 for (i=0;i<pcbddc->n_ISForFaces;i++) { ierr = ISDestroy(&pcbddc->ISForFaces[i]);CHKERRQ(ierr); } 850 ierr = PetscFree(pcbddc->ISForFaces);CHKERRQ(ierr); 851 for (i=0;i<pcbddc->n_ISForEdges;i++) { ierr = ISDestroy(&pcbddc->ISForEdges[i]);CHKERRQ(ierr); } 852 ierr = PetscFree(pcbddc->ISForEdges);CHKERRQ(ierr); 853 ierr = ISDestroy(&pcbddc->ISForVertices);CHKERRQ(ierr); 854 /* Free graph structure */ 855 ierr = PetscFree(pcbddc->mat_graph->xadj);CHKERRQ(ierr); 856 ierr = PetscFree(pcbddc->mat_graph->adjncy);CHKERRQ(ierr); 857 if (pcbddc->mat_graph->nvtxs) { 858 ierr = PetscFree(pcbddc->mat_graph->neighbours_set[0]);CHKERRQ(ierr); 859 } 860 ierr = PetscFree(pcbddc->mat_graph->neighbours_set);CHKERRQ(ierr); 861 ierr = PetscFree4(pcbddc->mat_graph->where,pcbddc->mat_graph->count,pcbddc->mat_graph->cptr,pcbddc->mat_graph->queue);CHKERRQ(ierr); 862 ierr = PetscFree2(pcbddc->mat_graph->which_dof,pcbddc->mat_graph->touched);CHKERRQ(ierr); 863 ierr = PetscFree(pcbddc->mat_graph->where_ncmps);CHKERRQ(ierr); 864 ierr = PetscFree(pcbddc->mat_graph);CHKERRQ(ierr); 865 /* remove functions */ 866 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetCoarseningRatio_C","",PETSC_NULL);CHKERRQ(ierr); 867 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetMaxLevels_C","",PETSC_NULL);CHKERRQ(ierr); 868 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetNullSpace_C","",PETSC_NULL);CHKERRQ(ierr); 869 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetDirichletBoundaries_C","",PETSC_NULL);CHKERRQ(ierr); 870 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetNeumannBoundaries_C","",PETSC_NULL);CHKERRQ(ierr); 871 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCGetDirichletBoundaries_C","",PETSC_NULL);CHKERRQ(ierr); 872 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCGetNeumannBoundaries_C","",PETSC_NULL);CHKERRQ(ierr); 873 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetCoarseProblemType_C","",PETSC_NULL);CHKERRQ(ierr); 874 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetDofsSplitting_C","",PETSC_NULL);CHKERRQ(ierr); 875 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetLocalAdjacencyGraph_C","",PETSC_NULL);CHKERRQ(ierr); 876 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCPreSolve_C","",PETSC_NULL);CHKERRQ(ierr); 877 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCPostSolve_C","",PETSC_NULL);CHKERRQ(ierr); 878 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCCreateFETIDPOperators_C","",PETSC_NULL);CHKERRQ(ierr); 879 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCMatFETIDPGetRHS_C","",PETSC_NULL);CHKERRQ(ierr); 880 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCMatFETIDPGetSolution_C","",PETSC_NULL);CHKERRQ(ierr); 881 /* Free the private data structure that was hanging off the PC */ 882 ierr = PetscFree(pcbddc);CHKERRQ(ierr); 883 PetscFunctionReturn(0); 884 } 885 /* -------------------------------------------------------------------------- */ 886 EXTERN_C_BEGIN 887 #undef __FUNCT__ 888 #define __FUNCT__ "PCBDDCMatFETIDPGetRHS_BDDC" 889 static PetscErrorCode PCBDDCMatFETIDPGetRHS_BDDC(Mat fetidp_mat, Vec standard_rhs, Vec fetidp_flux_rhs) 890 { 891 FETIDPMat_ctx *mat_ctx; 892 PC_IS* pcis; 893 PC_BDDC* pcbddc; 894 Mat_IS* matis; 895 PetscErrorCode ierr; 896 897 PetscFunctionBegin; 898 ierr = MatShellGetContext(fetidp_mat,&mat_ctx);CHKERRQ(ierr); 899 pcis = (PC_IS*)mat_ctx->pc->data; 900 pcbddc = (PC_BDDC*)mat_ctx->pc->data; 901 matis = (Mat_IS*)mat_ctx->pc->pmat->data; 902 903 /* change of basis for physical rhs if needed 904 It also changes the rhs in case of dirichlet boundaries */ 905 (*mat_ctx->pc->ops->presolve)(mat_ctx->pc,PETSC_NULL,standard_rhs,PETSC_NULL); 906 /* store vectors for computation of fetidp final solution */ 907 ierr = VecScatterBegin(pcis->global_to_D,standard_rhs,mat_ctx->temp_solution_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 908 ierr = VecScatterEnd (pcis->global_to_D,standard_rhs,mat_ctx->temp_solution_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 909 ierr = VecScatterBegin(pcis->global_to_B,standard_rhs,mat_ctx->temp_solution_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 910 ierr = VecScatterEnd (pcis->global_to_B,standard_rhs,mat_ctx->temp_solution_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 911 /* scale rhs since it should be unassembled */ 912 ierr = VecPointwiseMult(mat_ctx->temp_solution_B,pcis->D,mat_ctx->temp_solution_B);CHKERRQ(ierr); 913 if (!pcbddc->prec_type) { 914 /* compute partially subassembled Schur complement right-hand side */ 915 ierr = KSPSolve(pcbddc->ksp_D,mat_ctx->temp_solution_D,pcis->vec1_D);CHKERRQ(ierr); 916 ierr = MatMult(pcis->A_BI,pcis->vec1_D,pcis->vec1_B);CHKERRQ(ierr); 917 ierr = VecAXPY(mat_ctx->temp_solution_B,-1.0,pcis->vec1_B);CHKERRQ(ierr); 918 ierr = VecSet(standard_rhs,0.0);CHKERRQ(ierr); 919 ierr = VecScatterBegin(pcis->global_to_B,mat_ctx->temp_solution_B,standard_rhs,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 920 ierr = VecScatterEnd (pcis->global_to_B,mat_ctx->temp_solution_B,standard_rhs,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 921 ierr = VecScatterBegin(pcis->global_to_B,standard_rhs,mat_ctx->temp_solution_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 922 ierr = VecScatterEnd (pcis->global_to_B,standard_rhs,mat_ctx->temp_solution_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 923 ierr = VecPointwiseMult(mat_ctx->temp_solution_B,pcis->D,mat_ctx->temp_solution_B);CHKERRQ(ierr); 924 } 925 /* BDDC rhs */ 926 ierr = VecCopy(mat_ctx->temp_solution_B,pcis->vec1_B);CHKERRQ(ierr); 927 if (pcbddc->prec_type) { 928 ierr = VecCopy(mat_ctx->temp_solution_D,pcis->vec1_D);CHKERRQ(ierr); 929 } 930 /* apply BDDC */ 931 ierr = PCBDDCApplyInterfacePreconditioner(mat_ctx->pc);CHKERRQ(ierr); 932 /* Application of B_delta and assembling of rhs for fetidp fluxes */ 933 ierr = VecSet(fetidp_flux_rhs,0.0);CHKERRQ(ierr); 934 ierr = MatMult(mat_ctx->B_delta,pcis->vec1_B,mat_ctx->lambda_local);CHKERRQ(ierr); 935 ierr = VecScatterBegin(mat_ctx->l2g_lambda,mat_ctx->lambda_local,fetidp_flux_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 936 ierr = VecScatterEnd (mat_ctx->l2g_lambda,mat_ctx->lambda_local,fetidp_flux_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 937 /* restore original rhs */ 938 ierr = VecCopy(pcbddc->original_rhs,standard_rhs);CHKERRQ(ierr); 939 PetscFunctionReturn(0); 940 } 941 EXTERN_C_END 942 #undef __FUNCT__ 943 #define __FUNCT__ "PCBDDCMatFETIDPGetRHS" 944 /*@ 945 PCBDDCMatFETIDPGetRHS - Get rhs for FETIDP linear system. 946 947 Collective 948 949 Input Parameters: 950 + fetidp_mat - the FETIDP mat obtained by a call to PCBDDCCreateFETIDPOperators 951 + standard_rhs - the rhs of your linear system 952 953 Output Parameters: 954 + fetidp_flux_rhs - the rhs of the FETIDP linear system 955 956 Level: developer 957 958 Notes: 959 960 .seealso: PCBDDC 961 @*/ 962 PetscErrorCode PCBDDCMatFETIDPGetRHS(Mat fetidp_mat, Vec standard_rhs, Vec fetidp_flux_rhs) 963 { 964 FETIDPMat_ctx *mat_ctx; 965 PetscErrorCode ierr; 966 967 PetscFunctionBegin; 968 ierr = MatShellGetContext(fetidp_mat,&mat_ctx);CHKERRQ(ierr); 969 ierr = PetscTryMethod(mat_ctx->pc,"PCBDDCMatFETIDPGetRHS_C",(Mat,Vec,Vec),(fetidp_mat,standard_rhs,fetidp_flux_rhs));CHKERRQ(ierr); 970 PetscFunctionReturn(0); 971 } 972 /* -------------------------------------------------------------------------- */ 973 EXTERN_C_BEGIN 974 #undef __FUNCT__ 975 #define __FUNCT__ "PCBDDCMatFETIDPGetSolution_BDDC" 976 static PetscErrorCode PCBDDCMatFETIDPGetSolution_BDDC(Mat fetidp_mat, Vec fetidp_flux_sol, Vec standard_sol) 977 { 978 FETIDPMat_ctx *mat_ctx; 979 PC_IS* pcis; 980 PC_BDDC* pcbddc; 981 Mat_IS* matis; 982 PetscErrorCode ierr; 983 984 PetscFunctionBegin; 985 ierr = MatShellGetContext(fetidp_mat,&mat_ctx);CHKERRQ(ierr); 986 pcis = (PC_IS*)mat_ctx->pc->data; 987 pcbddc = (PC_BDDC*)mat_ctx->pc->data; 988 matis = (Mat_IS*)mat_ctx->pc->pmat->data; 989 990 /* apply B_delta^T */ 991 ierr = VecScatterBegin(mat_ctx->l2g_lambda,fetidp_flux_sol,mat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 992 ierr = VecScatterEnd (mat_ctx->l2g_lambda,fetidp_flux_sol,mat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 993 ierr = MatMultTranspose(mat_ctx->B_delta,mat_ctx->lambda_local,pcis->vec1_B);CHKERRQ(ierr); 994 /* compute rhs for BDDC application */ 995 ierr = VecAYPX(pcis->vec1_B,-1.0,mat_ctx->temp_solution_B);CHKERRQ(ierr); 996 if (pcbddc->prec_type) { 997 ierr = VecCopy(mat_ctx->temp_solution_D,pcis->vec1_D);CHKERRQ(ierr); 998 } 999 /* apply BDDC */ 1000 ierr = PCBDDCApplyInterfacePreconditioner(mat_ctx->pc);CHKERRQ(ierr); 1001 /* put values into standard global vector */ 1002 ierr = VecScatterBegin(pcis->global_to_B,pcis->vec1_B,standard_sol,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1003 ierr = VecScatterEnd (pcis->global_to_B,pcis->vec1_B,standard_sol,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1004 if (!pcbddc->prec_type) { 1005 /* compute values into the interior if solved for the partially subassembled Schur complement */ 1006 ierr = MatMult(pcis->A_IB,pcis->vec1_B,pcis->vec1_D);CHKERRQ(ierr); 1007 ierr = VecAXPY(mat_ctx->temp_solution_D,-1.0,pcis->vec1_D);CHKERRQ(ierr); 1008 ierr = KSPSolve(pcbddc->ksp_D,mat_ctx->temp_solution_D,pcis->vec1_D);CHKERRQ(ierr); 1009 } 1010 ierr = VecScatterBegin(pcis->global_to_D,pcis->vec1_D,standard_sol,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1011 ierr = VecScatterEnd (pcis->global_to_D,pcis->vec1_D,standard_sol,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1012 /* final change of basis if needed 1013 Is also sums the dirichlet part removed during RHS assembling */ 1014 (*mat_ctx->pc->ops->postsolve)(mat_ctx->pc,PETSC_NULL,PETSC_NULL,standard_sol); 1015 PetscFunctionReturn(0); 1016 1017 } 1018 EXTERN_C_END 1019 #undef __FUNCT__ 1020 #define __FUNCT__ "PCBDDCMatFETIDPGetSolution" 1021 /*@ 1022 PCBDDCMatFETIDPGetSolution - Get Solution for FETIDP linear system. 1023 1024 Collective 1025 1026 Input Parameters: 1027 + fetidp_mat - the FETIDP mat obtained by a call to PCBDDCCreateFETIDPOperators 1028 + fetidp_flux_sol - the solution of the FETIDP linear system 1029 1030 Output Parameters: 1031 + standard_sol - the solution on the global domain 1032 1033 Level: developer 1034 1035 Notes: 1036 1037 .seealso: PCBDDC 1038 @*/ 1039 PetscErrorCode PCBDDCMatFETIDPGetSolution(Mat fetidp_mat, Vec fetidp_flux_sol, Vec standard_sol) 1040 { 1041 FETIDPMat_ctx *mat_ctx; 1042 PetscErrorCode ierr; 1043 1044 PetscFunctionBegin; 1045 ierr = MatShellGetContext(fetidp_mat,&mat_ctx);CHKERRQ(ierr); 1046 ierr = PetscTryMethod(mat_ctx->pc,"PCBDDCMatFETIDPGetSolution_C",(Mat,Vec,Vec),(fetidp_mat,fetidp_flux_sol,standard_sol));CHKERRQ(ierr); 1047 PetscFunctionReturn(0); 1048 } 1049 /* -------------------------------------------------------------------------- */ 1050 EXTERN_C_BEGIN 1051 #undef __FUNCT__ 1052 #define __FUNCT__ "PCBDDCCreateFETIDPOperators_BDDC" 1053 static PetscErrorCode PCBDDCCreateFETIDPOperators_BDDC(PC pc, Mat *fetidp_mat, PC *fetidp_pc) 1054 { 1055 PETSC_EXTERN PetscErrorCode FETIDPMatMult(Mat,Vec,Vec); 1056 PETSC_EXTERN PetscErrorCode PCBDDCDestroyFETIDPMat(Mat); 1057 PETSC_EXTERN PetscErrorCode FETIDPPCApply(PC,Vec,Vec); 1058 PETSC_EXTERN PetscErrorCode PCBDDCDestroyFETIDPPC(PC); 1059 1060 FETIDPMat_ctx *fetidpmat_ctx; 1061 Mat newmat; 1062 FETIDPPC_ctx *fetidppc_ctx; 1063 PC newpc; 1064 MPI_Comm comm = ((PetscObject)pc)->comm; 1065 PetscErrorCode ierr; 1066 1067 PetscFunctionBegin; 1068 /* FETIDP linear matrix */ 1069 ierr = PCBDDCCreateFETIDPMatContext(pc, &fetidpmat_ctx);CHKERRQ(ierr); 1070 ierr = PCBDDCSetupFETIDPMatContext(fetidpmat_ctx);CHKERRQ(ierr); 1071 ierr = MatCreateShell(comm,PETSC_DECIDE,PETSC_DECIDE,fetidpmat_ctx->n_lambda,fetidpmat_ctx->n_lambda,fetidpmat_ctx,&newmat);CHKERRQ(ierr); 1072 ierr = MatShellSetOperation(newmat,MATOP_MULT,(void (*)(void))FETIDPMatMult);CHKERRQ(ierr); 1073 ierr = MatShellSetOperation(newmat,MATOP_DESTROY,(void (*)(void))PCBDDCDestroyFETIDPMat);CHKERRQ(ierr); 1074 ierr = MatSetUp(newmat);CHKERRQ(ierr); 1075 /* FETIDP preconditioner */ 1076 ierr = PCBDDCCreateFETIDPPCContext(pc, &fetidppc_ctx);CHKERRQ(ierr); 1077 ierr = PCBDDCSetupFETIDPPCContext(newmat,fetidppc_ctx);CHKERRQ(ierr); 1078 ierr = PCCreate(comm,&newpc);CHKERRQ(ierr); 1079 ierr = PCSetType(newpc,PCSHELL);CHKERRQ(ierr); 1080 ierr = PCShellSetContext(newpc,fetidppc_ctx);CHKERRQ(ierr); 1081 ierr = PCShellSetApply(newpc,FETIDPPCApply);CHKERRQ(ierr); 1082 ierr = PCShellSetDestroy(newpc,PCBDDCDestroyFETIDPPC);CHKERRQ(ierr); 1083 ierr = PCSetOperators(newpc,newmat,newmat,SAME_PRECONDITIONER);CHKERRQ(ierr); 1084 ierr = PCSetUp(newpc);CHKERRQ(ierr); 1085 /* return pointers for objects created */ 1086 *fetidp_mat=newmat; 1087 *fetidp_pc=newpc; 1088 1089 PetscFunctionReturn(0); 1090 } 1091 EXTERN_C_END 1092 #undef __FUNCT__ 1093 #define __FUNCT__ "PCBDDCCreateFETIDPOperators" 1094 /*@ 1095 PCBDDCCreateFETIDPOperators - Create operators for FETIDP. 1096 1097 Collective 1098 1099 Input Parameters: 1100 + pc - the BDDC preconditioning context (setup must be already called) 1101 1102 Level: developer 1103 1104 Notes: 1105 1106 .seealso: PCBDDC 1107 @*/ 1108 PetscErrorCode PCBDDCCreateFETIDPOperators(PC pc, Mat *fetidp_mat, PC *fetidp_pc) 1109 { 1110 PetscErrorCode ierr; 1111 1112 PetscFunctionBegin; 1113 PetscValidHeaderSpecific(pc,PC_CLASSID,1); 1114 if (pc->setupcalled) { 1115 ierr = PetscTryMethod(pc,"PCBDDCCreateFETIDPOperators_C",(PC,Mat*,PC*),(pc,fetidp_mat,fetidp_pc));CHKERRQ(ierr); 1116 } else { 1117 SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"You must call PCSetup_BDDC before calling %s\n",__FUNCT__); 1118 } 1119 PetscFunctionReturn(0); 1120 } 1121 /* -------------------------------------------------------------------------- */ 1122 /*MC 1123 PCBDDC - Balancing Domain Decomposition by Constraints. 1124 1125 Options Database Keys: 1126 . -pcbddc ??? - 1127 1128 Level: intermediate 1129 1130 Notes: The matrix used with this preconditioner must be of type MATIS 1131 1132 Unlike more 'conventional' interface preconditioners, this iterates over ALL the 1133 degrees of freedom, NOT just those on the interface (this allows the use of approximate solvers 1134 on the subdomains). 1135 1136 Options for the coarse grid preconditioner can be set with - 1137 Options for the Dirichlet subproblem can be set with - 1138 Options for the Neumann subproblem can be set with - 1139 1140 Contributed by Stefano Zampini 1141 1142 .seealso: PCCreate(), PCSetType(), PCType (for list of available types), PC, MATIS 1143 M*/ 1144 EXTERN_C_BEGIN 1145 #undef __FUNCT__ 1146 #define __FUNCT__ "PCCreate_BDDC" 1147 PetscErrorCode PCCreate_BDDC(PC pc) 1148 { 1149 PetscErrorCode ierr; 1150 PC_BDDC *pcbddc; 1151 PCBDDCGraph mat_graph; 1152 1153 PetscFunctionBegin; 1154 /* Creates the private data structure for this preconditioner and attach it to the PC object. */ 1155 ierr = PetscNewLog(pc,PC_BDDC,&pcbddc);CHKERRQ(ierr); 1156 pc->data = (void*)pcbddc; 1157 1158 /* create PCIS data structure */ 1159 ierr = PCISCreate(pc);CHKERRQ(ierr); 1160 1161 /* BDDC specific */ 1162 pcbddc->CoarseNullSpace = 0; 1163 pcbddc->NullSpace = 0; 1164 pcbddc->temp_solution = 0; 1165 pcbddc->original_rhs = 0; 1166 pcbddc->local_mat = 0; 1167 pcbddc->ChangeOfBasisMatrix = 0; 1168 pcbddc->usechangeofbasis = PETSC_TRUE; 1169 pcbddc->usechangeonfaces = PETSC_FALSE; 1170 pcbddc->coarse_vec = 0; 1171 pcbddc->coarse_rhs = 0; 1172 pcbddc->coarse_ksp = 0; 1173 pcbddc->coarse_phi_B = 0; 1174 pcbddc->coarse_phi_D = 0; 1175 pcbddc->vec1_P = 0; 1176 pcbddc->vec1_R = 0; 1177 pcbddc->vec2_R = 0; 1178 pcbddc->local_auxmat1 = 0; 1179 pcbddc->local_auxmat2 = 0; 1180 pcbddc->R_to_B = 0; 1181 pcbddc->R_to_D = 0; 1182 pcbddc->ksp_D = 0; 1183 pcbddc->ksp_R = 0; 1184 pcbddc->local_primal_indices = 0; 1185 pcbddc->prec_type = PETSC_FALSE; 1186 pcbddc->NeumannBoundaries = 0; 1187 pcbddc->ISForDofs = 0; 1188 pcbddc->ISForVertices = 0; 1189 pcbddc->n_ISForFaces = 0; 1190 pcbddc->n_ISForEdges = 0; 1191 pcbddc->ConstraintMatrix = 0; 1192 pcbddc->use_nnsp_true = PETSC_FALSE; 1193 pcbddc->local_primal_sizes = 0; 1194 pcbddc->local_primal_displacements = 0; 1195 pcbddc->replicated_local_primal_indices = 0; 1196 pcbddc->replicated_local_primal_values = 0; 1197 pcbddc->coarse_loc_to_glob = 0; 1198 pcbddc->dbg_flag = PETSC_FALSE; 1199 pcbddc->coarsening_ratio = 8; 1200 pcbddc->use_exact_dirichlet = PETSC_TRUE; 1201 pcbddc->current_level = 0; 1202 pcbddc->max_levels = 1; 1203 1204 /* allocate and initialize needed graph structure */ 1205 ierr = PetscMalloc(sizeof(*mat_graph),&pcbddc->mat_graph);CHKERRQ(ierr); 1206 pcbddc->mat_graph->xadj = 0; 1207 pcbddc->mat_graph->adjncy = 0; 1208 1209 /* function pointers */ 1210 pc->ops->apply = PCApply_BDDC; 1211 pc->ops->applytranspose = 0; 1212 pc->ops->setup = PCSetUp_BDDC; 1213 pc->ops->destroy = PCDestroy_BDDC; 1214 pc->ops->setfromoptions = PCSetFromOptions_BDDC; 1215 pc->ops->view = 0; 1216 pc->ops->applyrichardson = 0; 1217 pc->ops->applysymmetricleft = 0; 1218 pc->ops->applysymmetricright = 0; 1219 pc->ops->presolve = PCPreSolve_BDDC; 1220 pc->ops->postsolve = PCPostSolve_BDDC; 1221 1222 /* composing function */ 1223 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetCoarseningRatio_C","PCBDDCSetCoarseningRatio_BDDC", 1224 PCBDDCSetCoarseningRatio_BDDC);CHKERRQ(ierr); 1225 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetMaxLevels_C","PCBDDCSetMaxLevels_BDDC", 1226 PCBDDCSetMaxLevels_BDDC);CHKERRQ(ierr); 1227 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetNullSpace_C","PCBDDCSetNullSpace_BDDC", 1228 PCBDDCSetNullSpace_BDDC);CHKERRQ(ierr); 1229 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetDirichletBoundaries_C","PCBDDCSetDirichletBoundaries_BDDC", 1230 PCBDDCSetDirichletBoundaries_BDDC);CHKERRQ(ierr); 1231 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetNeumannBoundaries_C","PCBDDCSetNeumannBoundaries_BDDC", 1232 PCBDDCSetNeumannBoundaries_BDDC);CHKERRQ(ierr); 1233 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCGetDirichletBoundaries_C","PCBDDCGetDirichletBoundaries_BDDC", 1234 PCBDDCGetDirichletBoundaries_BDDC);CHKERRQ(ierr); 1235 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCGetNeumannBoundaries_C","PCBDDCGetNeumannBoundaries_BDDC", 1236 PCBDDCGetNeumannBoundaries_BDDC);CHKERRQ(ierr); 1237 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetCoarseProblemType_C","PCBDDCSetCoarseProblemType_BDDC", 1238 PCBDDCSetCoarseProblemType_BDDC);CHKERRQ(ierr); 1239 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetDofsSplitting_C","PCBDDCSetDofsSplitting_BDDC", 1240 PCBDDCSetDofsSplitting_BDDC);CHKERRQ(ierr); 1241 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCSetLocalAdjacencyGraph_C","PCBDDCSetLocalAdjacencyGraph_BDDC", 1242 PCBDDCSetLocalAdjacencyGraph_BDDC);CHKERRQ(ierr); 1243 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCPreSolve_C","PCPreSolve_BDDC", 1244 PCPreSolve_BDDC);CHKERRQ(ierr); 1245 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCPostSolve_C","PCPostSolve_BDDC", 1246 PCPostSolve_BDDC);CHKERRQ(ierr); 1247 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCCreateFETIDPOperators_C","PCBDDCCreateFETIDPOperators_BDDC", 1248 PCBDDCCreateFETIDPOperators_BDDC);CHKERRQ(ierr); 1249 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCMatFETIDPGetRHS_C","PCBDDCMatFETIDPGetRHS_BDDC", 1250 PCBDDCMatFETIDPGetRHS_BDDC);CHKERRQ(ierr); 1251 ierr = PetscObjectComposeFunctionDynamic((PetscObject)pc,"PCBDDCMatFETIDPGetSolution_C","PCBDDCMatFETIDPGetSolution_BDDC", 1252 PCBDDCMatFETIDPGetSolution_BDDC);CHKERRQ(ierr); 1253 PetscFunctionReturn(0); 1254 } 1255 EXTERN_C_END 1256 1257 /* -------------------------------------------------------------------------- */ 1258 /* All static functions from now on */ 1259 /* -------------------------------------------------------------------------- */ 1260 #undef __FUNCT__ 1261 #define __FUNCT__ "PCBDDCSetUseExactDirichlet" 1262 static PetscErrorCode PCBDDCSetUseExactDirichlet(PC pc,PetscBool use) 1263 { 1264 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 1265 1266 PetscFunctionBegin; 1267 pcbddc->use_exact_dirichlet=use; 1268 PetscFunctionReturn(0); 1269 } 1270 1271 #undef __FUNCT__ 1272 #define __FUNCT__ "PCBDDCSetLevel" 1273 static PetscErrorCode PCBDDCSetLevel(PC pc,PetscInt level) 1274 { 1275 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 1276 1277 PetscFunctionBegin; 1278 pcbddc->current_level=level; 1279 PetscFunctionReturn(0); 1280 } 1281 1282 #undef __FUNCT__ 1283 #define __FUNCT__ "PCBDDCAdaptNullSpace" 1284 static PetscErrorCode PCBDDCAdaptNullSpace(PC pc) 1285 { 1286 PC_IS* pcis = (PC_IS*) (pc->data); 1287 PC_BDDC* pcbddc = (PC_BDDC*)(pc->data); 1288 KSP inv_change; 1289 PC pc_change; 1290 const Vec *nsp_vecs; 1291 Vec *new_nsp_vecs; 1292 PetscInt i,nsp_size,new_nsp_size,start_new; 1293 PetscBool nsp_has_cnst; 1294 MatNullSpace new_nsp; 1295 PetscErrorCode ierr; 1296 1297 PetscFunctionBegin; 1298 ierr = MatNullSpaceGetVecs(pcbddc->NullSpace,&nsp_has_cnst,&nsp_size,&nsp_vecs);CHKERRQ(ierr); 1299 ierr = KSPCreate(PETSC_COMM_SELF,&inv_change);CHKERRQ(ierr); 1300 ierr = KSPSetOperators(inv_change,pcbddc->ChangeOfBasisMatrix,pcbddc->ChangeOfBasisMatrix,SAME_PRECONDITIONER);CHKERRQ(ierr); 1301 ierr = KSPSetType(inv_change,KSPPREONLY);CHKERRQ(ierr); 1302 ierr = KSPGetPC(inv_change,&pc_change);CHKERRQ(ierr); 1303 ierr = PCSetType(pc_change,PCLU);CHKERRQ(ierr); 1304 ierr = KSPSetUp(inv_change);CHKERRQ(ierr); 1305 new_nsp_size = nsp_size; 1306 if (nsp_has_cnst) { new_nsp_size++; } 1307 ierr = PetscMalloc(new_nsp_size*sizeof(Vec),&new_nsp_vecs);CHKERRQ(ierr); 1308 for (i=0;i<new_nsp_size;i++) { ierr = VecDuplicate(pcis->vec1_global,&new_nsp_vecs[i]);CHKERRQ(ierr); } 1309 start_new = 0; 1310 if (nsp_has_cnst) { 1311 start_new = 1; 1312 ierr = VecSet(new_nsp_vecs[0],1.0);CHKERRQ(ierr); 1313 ierr = VecSet(pcis->vec1_B,1.0);CHKERRQ(ierr); 1314 ierr = KSPSolve(inv_change,pcis->vec1_B,pcis->vec1_B); 1315 ierr = VecScatterBegin(pcis->global_to_B,pcis->vec1_B,new_nsp_vecs[0],INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1316 ierr = VecScatterEnd (pcis->global_to_B,pcis->vec1_B,new_nsp_vecs[0],INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1317 } 1318 for (i=0;i<nsp_size;i++) { 1319 ierr = VecCopy(nsp_vecs[i],new_nsp_vecs[i+start_new]);CHKERRQ(ierr); 1320 ierr = VecScatterBegin(pcis->global_to_B,nsp_vecs[i],pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1321 ierr = VecScatterEnd (pcis->global_to_B,nsp_vecs[i],pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1322 ierr = KSPSolve(inv_change,pcis->vec1_B,pcis->vec1_B); 1323 ierr = VecScatterBegin(pcis->global_to_B,pcis->vec1_B,new_nsp_vecs[i+start_new],INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1324 ierr = VecScatterEnd (pcis->global_to_B,pcis->vec1_B,new_nsp_vecs[i+start_new],INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1325 } 1326 ierr = VecNormalize(new_nsp_vecs[0],PETSC_NULL);CHKERRQ(ierr); 1327 /* TODO : Orthonormalize vecs when new_nsp_size > 0! */ 1328 1329 /*PetscBool nsp_t=PETSC_FALSE; 1330 ierr = MatNullSpaceTest(pcbddc->NullSpace,pc->pmat,&nsp_t);CHKERRQ(ierr); 1331 printf("Original Null Space test: %d\n",nsp_t); 1332 Mat temp_mat; 1333 Mat_IS* matis = (Mat_IS*)pc->pmat->data; 1334 temp_mat = matis->A; 1335 matis->A = pcbddc->local_mat; 1336 pcbddc->local_mat = temp_mat; 1337 ierr = MatNullSpaceTest(pcbddc->NullSpace,pc->pmat,&nsp_t);CHKERRQ(ierr); 1338 printf("Original Null Space, mat changed test: %d\n",nsp_t); 1339 { 1340 PetscReal test_norm; 1341 for (i=0;i<new_nsp_size;i++) { 1342 ierr = MatMult(pc->pmat,new_nsp_vecs[i],pcis->vec1_global);CHKERRQ(ierr); 1343 ierr = VecNorm(pcis->vec1_global,NORM_2,&test_norm);CHKERRQ(ierr); 1344 if (test_norm > 1.e-12) { 1345 printf("------------ERROR VEC %d------------------\n",i); 1346 ierr = VecView(pcis->vec1_global,PETSC_VIEWER_STDOUT_WORLD); 1347 printf("------------------------------------------\n"); 1348 } 1349 } 1350 }*/ 1351 1352 ierr = KSPDestroy(&inv_change);CHKERRQ(ierr); 1353 ierr = MatNullSpaceCreate(((PetscObject)pc)->comm,PETSC_FALSE,new_nsp_size,new_nsp_vecs,&new_nsp);CHKERRQ(ierr); 1354 ierr = PCBDDCSetNullSpace(pc,new_nsp);CHKERRQ(ierr); 1355 ierr = MatNullSpaceDestroy(&new_nsp);CHKERRQ(ierr); 1356 /* 1357 ierr = MatNullSpaceTest(pcbddc->NullSpace,pc->pmat,&nsp_t);CHKERRQ(ierr); 1358 printf("New Null Space, mat changed: %d\n",nsp_t); 1359 temp_mat = matis->A; 1360 matis->A = pcbddc->local_mat; 1361 pcbddc->local_mat = temp_mat; 1362 ierr = MatNullSpaceTest(pcbddc->NullSpace,pc->pmat,&nsp_t);CHKERRQ(ierr); 1363 printf("New Null Space, mat original: %d\n",nsp_t);*/ 1364 1365 for (i=0;i<new_nsp_size;i++) { ierr = VecDestroy(&new_nsp_vecs[i]);CHKERRQ(ierr); } 1366 ierr = PetscFree(new_nsp_vecs);CHKERRQ(ierr); 1367 PetscFunctionReturn(0); 1368 } 1369 1370 #undef __FUNCT__ 1371 #define __FUNCT__ "PCBDDCCreateFETIDPMatContext" 1372 static PetscErrorCode PCBDDCCreateFETIDPMatContext(PC pc, FETIDPMat_ctx **fetidpmat_ctx) 1373 { 1374 FETIDPMat_ctx *newctx; 1375 PetscErrorCode ierr; 1376 1377 PetscFunctionBegin; 1378 ierr = PetscMalloc(sizeof(*newctx),&newctx);CHKERRQ(ierr); 1379 newctx->lambda_local = 0; 1380 newctx->temp_solution_B = 0; 1381 newctx->temp_solution_D = 0; 1382 newctx->B_delta = 0; 1383 newctx->B_Ddelta = 0; /* theoretically belongs to the FETIDP preconditioner */ 1384 newctx->l2g_lambda = 0; 1385 /* increase the reference count for BDDC preconditioner */ 1386 ierr = PetscObjectReference((PetscObject)pc);CHKERRQ(ierr); 1387 newctx->pc = pc; 1388 *fetidpmat_ctx = newctx; 1389 PetscFunctionReturn(0); 1390 } 1391 1392 #undef __FUNCT__ 1393 #define __FUNCT__ "PCBDDCCreateFETIDPPCContext" 1394 static PetscErrorCode PCBDDCCreateFETIDPPCContext(PC pc, FETIDPPC_ctx **fetidppc_ctx) 1395 { 1396 FETIDPPC_ctx *newctx; 1397 PetscErrorCode ierr; 1398 1399 PetscFunctionBegin; 1400 ierr = PetscMalloc(sizeof(*newctx),&newctx);CHKERRQ(ierr); 1401 newctx->lambda_local = 0; 1402 newctx->B_Ddelta = 0; 1403 newctx->l2g_lambda = 0; 1404 /* increase the reference count for BDDC preconditioner */ 1405 ierr = PetscObjectReference((PetscObject)pc);CHKERRQ(ierr); 1406 newctx->pc = pc; 1407 *fetidppc_ctx = newctx; 1408 PetscFunctionReturn(0); 1409 } 1410 1411 #undef __FUNCT__ 1412 #define __FUNCT__ "PCBDDCDestroyFETIDPMat" 1413 static PetscErrorCode PCBDDCDestroyFETIDPMat(Mat A) 1414 { 1415 FETIDPMat_ctx *mat_ctx; 1416 PetscErrorCode ierr; 1417 1418 PetscFunctionBegin; 1419 ierr = MatShellGetContext(A,(void**)&mat_ctx);CHKERRQ(ierr); 1420 ierr = VecDestroy(&mat_ctx->lambda_local);CHKERRQ(ierr); 1421 ierr = VecDestroy(&mat_ctx->temp_solution_D);CHKERRQ(ierr); 1422 ierr = VecDestroy(&mat_ctx->temp_solution_B);CHKERRQ(ierr); 1423 ierr = MatDestroy(&mat_ctx->B_delta);CHKERRQ(ierr); 1424 ierr = MatDestroy(&mat_ctx->B_Ddelta);CHKERRQ(ierr); 1425 ierr = VecScatterDestroy(&mat_ctx->l2g_lambda);CHKERRQ(ierr); 1426 ierr = PCDestroy(&mat_ctx->pc);CHKERRQ(ierr); /* actually it does not destroy BDDC, only decrease its reference count */ 1427 ierr = PetscFree(mat_ctx);CHKERRQ(ierr); 1428 PetscFunctionReturn(0); 1429 } 1430 1431 #undef __FUNCT__ 1432 #define __FUNCT__ "PCBDDCDestroyFETIDPPC" 1433 static PetscErrorCode PCBDDCDestroyFETIDPPC(PC pc) 1434 { 1435 FETIDPPC_ctx *pc_ctx; 1436 PetscErrorCode ierr; 1437 1438 PetscFunctionBegin; 1439 ierr = PCShellGetContext(pc,(void**)&pc_ctx);CHKERRQ(ierr); 1440 ierr = VecDestroy(&pc_ctx->lambda_local);CHKERRQ(ierr); 1441 ierr = MatDestroy(&pc_ctx->B_Ddelta);CHKERRQ(ierr); 1442 ierr = VecScatterDestroy(&pc_ctx->l2g_lambda);CHKERRQ(ierr); 1443 ierr = PCDestroy(&pc_ctx->pc);CHKERRQ(ierr); /* actually it does not destroy BDDC, only decrease its reference count */ 1444 ierr = PetscFree(pc_ctx);CHKERRQ(ierr); 1445 PetscFunctionReturn(0); 1446 } 1447 1448 #undef __FUNCT__ 1449 #define __FUNCT__ "PCBDDCSetupFETIDPMatContext" 1450 static PetscErrorCode PCBDDCSetupFETIDPMatContext(FETIDPMat_ctx *fetidpmat_ctx ) 1451 { 1452 PetscErrorCode ierr; 1453 PC_IS *pcis=(PC_IS*)fetidpmat_ctx->pc->data; 1454 PC_BDDC *pcbddc=(PC_BDDC*)fetidpmat_ctx->pc->data; 1455 PCBDDCGraph mat_graph=pcbddc->mat_graph; 1456 Mat_IS *matis = (Mat_IS*)fetidpmat_ctx->pc->pmat->data; 1457 MPI_Comm comm = ((PetscObject)(fetidpmat_ctx->pc))->comm; 1458 1459 Mat ScalingMat; 1460 Vec lambda_global; 1461 IS IS_l2g_lambda; 1462 1463 PetscBool skip_node,fully_redundant; 1464 PetscInt i,j,k,s,n_boundary_dofs,sum_dof_sizes,n_global_lambda,n_vertices; 1465 PetscInt n_local_lambda,n_lambda_for_dof,dual_size,n_neg_values,n_pos_values; 1466 PetscMPIInt rank,nprocs,partial_sum; 1467 PetscScalar scalar_value; 1468 1469 PetscInt *vertex_indices,*temp_indices; 1470 PetscInt *dual_dofs_boundary_indices,*aux_local_numbering_1,*aux_global_numbering; 1471 PetscInt *aux_sums,*cols_B_delta,*l2g_indices; 1472 PetscMPIInt *aux_local_numbering_2,*aux_global_numbering_mpi,*dof_sizes,*dof_displs; 1473 PetscMPIInt *all_aux_global_numbering_mpi_1,*all_aux_global_numbering_mpi_2,*global_dofs_numbering; 1474 PetscScalar *array,*scaling_factors,*vals_B_delta; 1475 1476 /* For communication of scaling factors */ 1477 PetscInt *ptrs_buffer,neigh_position; 1478 PetscScalar **all_factors,*send_buffer,*recv_buffer; 1479 MPI_Request *send_reqs,*recv_reqs; 1480 1481 /* tests */ 1482 Vec test_vec; 1483 PetscBool test_fetidp; 1484 PetscViewer viewer; 1485 1486 PetscFunctionBegin; 1487 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 1488 ierr = MPI_Comm_size(comm,&nprocs);CHKERRQ(ierr); 1489 1490 /* Default type of lagrange multipliers is non-redundant */ 1491 fully_redundant = PETSC_FALSE; 1492 ierr = PetscOptionsGetBool(PETSC_NULL,"-fetidp_fullyredundant",&fully_redundant,PETSC_NULL);CHKERRQ(ierr); 1493 1494 /* Evaluate local and global number of lagrange multipliers */ 1495 ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr); 1496 n_local_lambda = 0; 1497 partial_sum = 0; 1498 n_boundary_dofs = 0; 1499 s = 0; 1500 n_vertices = 0; 1501 /* Get Vertices used to define the BDDC */ 1502 ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(*vertex_indices),&vertex_indices);CHKERRQ(ierr); 1503 for (i=0;i<pcbddc->local_primal_size;i++) { 1504 ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&j,(const PetscInt**)&temp_indices,PETSC_NULL);CHKERRQ(ierr); 1505 if (j == 1) { 1506 vertex_indices[n_vertices]=temp_indices[0]; 1507 n_vertices++; 1508 } 1509 ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&j,(const PetscInt**)&temp_indices,PETSC_NULL);CHKERRQ(ierr); 1510 } 1511 dual_size = pcis->n_B-n_vertices; 1512 ierr = PetscSortInt(n_vertices,vertex_indices);CHKERRQ(ierr); 1513 ierr = PetscMalloc(dual_size*sizeof(*dual_dofs_boundary_indices),&dual_dofs_boundary_indices);CHKERRQ(ierr); 1514 ierr = PetscMalloc(dual_size*sizeof(*aux_local_numbering_1),&aux_local_numbering_1);CHKERRQ(ierr); 1515 ierr = PetscMalloc(dual_size*sizeof(*aux_local_numbering_2),&aux_local_numbering_2);CHKERRQ(ierr); 1516 1517 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 1518 for (i=0;i<pcis->n;i++){ 1519 j = mat_graph->count[i]; /* RECALL: mat_graph->count[i] does not count myself */ 1520 k = 0; 1521 if (j > 0) { 1522 k = (mat_graph->neighbours_set[i][0] == -1 ? 1 : 0); 1523 } 1524 j = j - k ; 1525 if ( j > 0 ) { n_boundary_dofs++; } 1526 1527 skip_node = PETSC_FALSE; 1528 if ( s < n_vertices && vertex_indices[s]==i) { /* it works for a sorted set of vertices */ 1529 skip_node = PETSC_TRUE; 1530 s++; 1531 } 1532 if (j < 1) {skip_node = PETSC_TRUE;} 1533 if ( !skip_node ) { 1534 if (fully_redundant) { 1535 /* fully redundant set of lagrange multipliers */ 1536 n_lambda_for_dof = (j*(j+1))/2; 1537 } else { 1538 n_lambda_for_dof = j; 1539 } 1540 n_local_lambda += j; 1541 /* needed to evaluate global number of lagrange multipliers */ 1542 array[i]=(1.0*n_lambda_for_dof)/(j+1.0); /* already scaled for the next global sum */ 1543 /* store some data needed */ 1544 dual_dofs_boundary_indices[partial_sum] = n_boundary_dofs-1; 1545 aux_local_numbering_1[partial_sum] = i; 1546 aux_local_numbering_2[partial_sum] = (PetscMPIInt)n_lambda_for_dof; 1547 partial_sum++; 1548 } 1549 } 1550 /*printf("I found %d local lambda dofs\n",n_local_lambda); 1551 printf("I found %d boundary dofs (should be %d)\n",n_boundary_dofs,pcis->n_B); 1552 printf("Partial sum %d should be %d\n",partial_sum,dual_size);*/ 1553 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 1554 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 1555 ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1556 ierr = VecScatterEnd (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1557 ierr = VecSum(pcis->vec1_global,&scalar_value);CHKERRQ(ierr); 1558 fetidpmat_ctx->n_lambda = (PetscInt) scalar_value; 1559 /* printf("I found %d global multipliers (%f)\n",fetidpmat_ctx->n_lambda,scalar_value); */ 1560 1561 /* compute global ordering of lagrange multipliers and associate l2g map */ 1562 1563 ierr = PetscMalloc(dual_size*sizeof(*aux_global_numbering),&aux_global_numbering);CHKERRQ(ierr); 1564 ierr = PetscMalloc(dual_size*sizeof(*aux_global_numbering_mpi),&aux_global_numbering_mpi);CHKERRQ(ierr); 1565 j = (rank == 0 ? nprocs : 0); 1566 ierr = PetscMalloc(j*sizeof(*dof_sizes),&dof_sizes);CHKERRQ(ierr); 1567 ierr = PetscMalloc(j*sizeof(*dof_displs),&dof_displs);CHKERRQ(ierr); 1568 ierr = ISLocalToGlobalMappingApply(matis->mapping,dual_size,aux_local_numbering_1,aux_global_numbering);CHKERRQ(ierr); 1569 ierr = MPI_Gather(&dual_size,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr); 1570 sum_dof_sizes=0; 1571 if ( rank == 0 ) { 1572 dof_displs[0]=0; 1573 sum_dof_sizes=dual_size; 1574 for (i=1;i<nprocs;i++) { 1575 dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1]; 1576 sum_dof_sizes += dof_sizes[i]; 1577 } 1578 } 1579 for (i=0;i<dual_size;i++) { 1580 aux_global_numbering_mpi[i]=(PetscMPIInt)aux_global_numbering[i]; 1581 } 1582 ierr = PetscFree(aux_global_numbering);CHKERRQ(ierr); 1583 ierr = PetscMalloc(sum_dof_sizes*sizeof(*all_aux_global_numbering_mpi_1),&all_aux_global_numbering_mpi_1);CHKERRQ(ierr); 1584 ierr = PetscMalloc(sum_dof_sizes*sizeof(*all_aux_global_numbering_mpi_2),&all_aux_global_numbering_mpi_2);CHKERRQ(ierr); 1585 1586 ierr = MPI_Gatherv(aux_global_numbering_mpi,dual_size,MPIU_INT,all_aux_global_numbering_mpi_1,dof_sizes,dof_displs,MPIU_INT,0,comm);CHKERRQ(ierr); 1587 ierr = MPI_Gatherv(aux_local_numbering_2,dual_size,MPIU_INT,all_aux_global_numbering_mpi_2,dof_sizes,dof_displs,MPIU_INT,0,comm);CHKERRQ(ierr); 1588 ierr = PetscFree(aux_local_numbering_2);CHKERRQ(ierr); 1589 ierr = PetscFree(dof_displs);CHKERRQ(ierr); 1590 ierr = PetscFree(dof_sizes);CHKERRQ(ierr); 1591 1592 ierr = PetscMalloc(fetidpmat_ctx->n_lambda*sizeof(*global_dofs_numbering),&global_dofs_numbering);CHKERRQ(ierr); 1593 if ( rank == 0 ) { 1594 ierr = PetscSortMPIIntWithArray(sum_dof_sizes,all_aux_global_numbering_mpi_1,all_aux_global_numbering_mpi_2);CHKERRQ(ierr); 1595 j=-1; 1596 partial_sum = 0; 1597 for (i=0;i<sum_dof_sizes;i++) { 1598 if (j != all_aux_global_numbering_mpi_1[i] ) { 1599 j=all_aux_global_numbering_mpi_1[i]; 1600 for (k=0;k<all_aux_global_numbering_mpi_2[i];k++) { 1601 global_dofs_numbering[partial_sum+k]=all_aux_global_numbering_mpi_1[i]; 1602 } 1603 partial_sum += all_aux_global_numbering_mpi_2[i]; 1604 } 1605 } 1606 /* printf("Partial sum for global dofs %d should be %d\n",partial_sum,fetidpmat_ctx->n_lambda); */ 1607 } 1608 ierr = PetscFree(all_aux_global_numbering_mpi_1);CHKERRQ(ierr); 1609 ierr = PetscFree(all_aux_global_numbering_mpi_2);CHKERRQ(ierr); 1610 ierr = MPI_Bcast(global_dofs_numbering,fetidpmat_ctx->n_lambda,MPIU_INT,0,comm);CHKERRQ(ierr); 1611 1612 /* init data for scaling factors exchange */ 1613 partial_sum = 0; 1614 j = 0; 1615 ierr = PetscMalloc( pcis->n_neigh*sizeof(PetscInt),&ptrs_buffer);CHKERRQ(ierr); 1616 ierr = PetscMalloc( (pcis->n_neigh-1)*sizeof(MPI_Request),&send_reqs);CHKERRQ(ierr); 1617 ierr = PetscMalloc( (pcis->n_neigh-1)*sizeof(MPI_Request),&recv_reqs);CHKERRQ(ierr); 1618 ierr = PetscMalloc( pcis->n*sizeof(PetscScalar*),&all_factors);CHKERRQ(ierr); 1619 ptrs_buffer[0]=0; 1620 for (i=1;i<pcis->n_neigh;i++) { 1621 partial_sum += pcis->n_shared[i]; 1622 ptrs_buffer[i] = ptrs_buffer[i-1]+pcis->n_shared[i]; 1623 } 1624 ierr = PetscMalloc( partial_sum*sizeof(PetscScalar),&send_buffer);CHKERRQ(ierr); 1625 ierr = PetscMalloc( partial_sum*sizeof(PetscScalar),&recv_buffer);CHKERRQ(ierr); 1626 ierr = PetscMalloc( partial_sum*sizeof(PetscScalar),&all_factors[0]);CHKERRQ(ierr); 1627 for (i=0;i<pcis->n-1;i++) { 1628 j = mat_graph->count[i]; 1629 if (j>0) { 1630 k = (mat_graph->neighbours_set[i][0] == -1 ? 1 : 0); 1631 j = j - k; 1632 } 1633 all_factors[i+1]=all_factors[i]+j; 1634 } 1635 /* scatter B scaling to N vec */ 1636 ierr = VecScatterBegin(pcis->N_to_B,pcis->D,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1637 ierr = VecScatterEnd (pcis->N_to_B,pcis->D,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1638 /* communications */ 1639 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 1640 for (i=1;i<pcis->n_neigh;i++) { 1641 for (j=0;j<pcis->n_shared[i];j++) { 1642 send_buffer[ptrs_buffer[i-1]+j]=array[pcis->shared[i][j]]; 1643 } 1644 j = ptrs_buffer[i]-ptrs_buffer[i-1]; 1645 ierr = MPI_Isend(&send_buffer[ptrs_buffer[i-1]],j,MPIU_SCALAR,pcis->neigh[i],0,comm,&send_reqs[i-1]);CHKERRQ(ierr); 1646 ierr = MPI_Irecv(&recv_buffer[ptrs_buffer[i-1]],j,MPIU_SCALAR,pcis->neigh[i],0,comm,&recv_reqs[i-1]);CHKERRQ(ierr); 1647 } 1648 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 1649 ierr = MPI_Waitall((pcis->n_neigh-1),recv_reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 1650 /* put values in correct places */ 1651 for (i=1;i<pcis->n_neigh;i++) { 1652 for (j=0;j<pcis->n_shared[i];j++) { 1653 k = pcis->shared[i][j]; 1654 neigh_position = 0; 1655 while(mat_graph->neighbours_set[k][neigh_position] != pcis->neigh[i]) {neigh_position++;} 1656 s = (mat_graph->neighbours_set[k][0] == -1 ? 1 : 0); 1657 neigh_position = neigh_position - s; 1658 all_factors[k][neigh_position]=recv_buffer[ptrs_buffer[i-1]+j]; 1659 } 1660 } 1661 ierr = MPI_Waitall((pcis->n_neigh-1),send_reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 1662 ierr = PetscFree(send_reqs);CHKERRQ(ierr); 1663 ierr = PetscFree(recv_reqs);CHKERRQ(ierr); 1664 ierr = PetscFree(send_buffer);CHKERRQ(ierr); 1665 ierr = PetscFree(recv_buffer);CHKERRQ(ierr); 1666 ierr = PetscFree(ptrs_buffer);CHKERRQ(ierr); 1667 1668 /* Compute B and B_delta (local actions) */ 1669 ierr = PetscMalloc(pcis->n_neigh*sizeof(*aux_sums),&aux_sums);CHKERRQ(ierr); 1670 ierr = PetscMalloc(n_local_lambda*sizeof(*l2g_indices),&l2g_indices);CHKERRQ(ierr); 1671 ierr = PetscMalloc(n_local_lambda*sizeof(*vals_B_delta),&vals_B_delta);CHKERRQ(ierr); 1672 ierr = PetscMalloc(n_local_lambda*sizeof(*cols_B_delta),&cols_B_delta);CHKERRQ(ierr); 1673 ierr = PetscMalloc(n_local_lambda*sizeof(*scaling_factors),&scaling_factors);CHKERRQ(ierr); 1674 n_global_lambda=0; 1675 partial_sum=0; 1676 for (i=0;i<dual_size;i++) { 1677 while( global_dofs_numbering[n_global_lambda] != aux_global_numbering_mpi[i] ) { n_global_lambda++; } 1678 j = mat_graph->count[aux_local_numbering_1[i]]; 1679 k = (mat_graph->neighbours_set[aux_local_numbering_1[i]][0] == -1 ? 1 : 0); 1680 j = j - k; 1681 aux_sums[0]=0; 1682 for (s=1;s<j;s++) { 1683 aux_sums[s]=aux_sums[s-1]+j-s+1; 1684 } 1685 array = all_factors[aux_local_numbering_1[i]]; 1686 n_neg_values = 0; 1687 while(n_neg_values < j && mat_graph->neighbours_set[aux_local_numbering_1[i]][n_neg_values+k] < rank) {n_neg_values++;} 1688 n_pos_values = j - n_neg_values; 1689 if (fully_redundant) { 1690 for (s=0;s<n_neg_values;s++) { 1691 l2g_indices [partial_sum+s]=aux_sums[s]+n_neg_values-s-1+n_global_lambda; 1692 cols_B_delta [partial_sum+s]=dual_dofs_boundary_indices[i]; 1693 vals_B_delta [partial_sum+s]=-1.0; 1694 scaling_factors[partial_sum+s]=array[s]; 1695 } 1696 for (s=0;s<n_pos_values;s++) { 1697 l2g_indices [partial_sum+s+n_neg_values]=aux_sums[n_neg_values]+s+n_global_lambda; 1698 cols_B_delta [partial_sum+s+n_neg_values]=dual_dofs_boundary_indices[i]; 1699 vals_B_delta [partial_sum+s+n_neg_values]=1.0; 1700 scaling_factors[partial_sum+s+n_neg_values]=array[s+n_neg_values]; 1701 } 1702 partial_sum += j; 1703 } else { 1704 /* l2g_indices and default cols and vals of B_delta */ 1705 for (s=0;s<j;s++) { 1706 l2g_indices [partial_sum+s]=n_global_lambda+s; 1707 cols_B_delta [partial_sum+s]=dual_dofs_boundary_indices[i]; 1708 vals_B_delta [partial_sum+s]=0.0; 1709 } 1710 /* B_delta */ 1711 if ( n_neg_values > 0 ) { /* there's a rank next to me to the left */ 1712 vals_B_delta [partial_sum+n_neg_values-1]=-1.0; 1713 } 1714 if ( n_neg_values < j ) { /* there's a rank next to me to the right */ 1715 vals_B_delta [partial_sum+n_neg_values]=1.0; 1716 } 1717 /* scaling as in Klawonn-Widlund 1999*/ 1718 for (s=0;s<n_neg_values;s++) { 1719 scalar_value = 0.0; 1720 for (k=0;k<s+1;k++) { 1721 scalar_value += array[k]; 1722 } 1723 scalar_value = -scalar_value; 1724 scaling_factors[partial_sum+s] = scalar_value; 1725 } 1726 for (s=0;s<n_pos_values;s++) { 1727 scalar_value = 0.0; 1728 for (k=s+n_neg_values;k<j;k++) { 1729 scalar_value += array[k]; 1730 } 1731 scaling_factors[partial_sum+s+n_neg_values] = scalar_value; 1732 } 1733 partial_sum += j; 1734 } 1735 } 1736 ierr = PetscFree(aux_sums);CHKERRQ(ierr); 1737 ierr = PetscFree(global_dofs_numbering);CHKERRQ(ierr); 1738 ierr = PetscFree(aux_global_numbering_mpi);CHKERRQ(ierr); 1739 ierr = PetscFree(aux_local_numbering_1);CHKERRQ(ierr); 1740 ierr = PetscFree(dual_dofs_boundary_indices);CHKERRQ(ierr); 1741 ierr = PetscFree(all_factors[0]);CHKERRQ(ierr); 1742 ierr = PetscFree(all_factors);CHKERRQ(ierr); 1743 /* printf("I found %d local lambda dofs when numbering them (should be %d)\n",partial_sum,n_local_lambda); */ 1744 1745 /* Local to global mapping of fetidpmat */ 1746 ierr = VecCreate(PETSC_COMM_SELF,&fetidpmat_ctx->lambda_local);CHKERRQ(ierr); 1747 ierr = VecSetSizes(fetidpmat_ctx->lambda_local,n_local_lambda,n_local_lambda);CHKERRQ(ierr); 1748 ierr = VecSetType(fetidpmat_ctx->lambda_local,VECSEQ);CHKERRQ(ierr); 1749 ierr = VecCreate(comm,&lambda_global);CHKERRQ(ierr); 1750 ierr = VecSetSizes(lambda_global,PETSC_DECIDE,fetidpmat_ctx->n_lambda);CHKERRQ(ierr); 1751 ierr = VecSetType(lambda_global,VECMPI);CHKERRQ(ierr); 1752 ierr = ISCreateGeneral(comm,n_local_lambda,l2g_indices,PETSC_OWN_POINTER,&IS_l2g_lambda);CHKERRQ(ierr); 1753 ierr = VecScatterCreate(fetidpmat_ctx->lambda_local,(IS)0,lambda_global,IS_l2g_lambda,&fetidpmat_ctx->l2g_lambda);CHKERRQ(ierr); 1754 ierr = ISDestroy(&IS_l2g_lambda);CHKERRQ(ierr); 1755 1756 /* Create local part of B_delta */ 1757 ierr = MatCreate(PETSC_COMM_SELF,&fetidpmat_ctx->B_delta); 1758 ierr = MatSetSizes(fetidpmat_ctx->B_delta,n_local_lambda,pcis->n_B,n_local_lambda,pcis->n_B);CHKERRQ(ierr); 1759 ierr = MatSetType(fetidpmat_ctx->B_delta,MATSEQAIJ);CHKERRQ(ierr); 1760 ierr = MatSeqAIJSetPreallocation(fetidpmat_ctx->B_delta,1,PETSC_NULL);CHKERRQ(ierr); 1761 ierr = MatSetOption(fetidpmat_ctx->B_delta,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr); 1762 for (i=0;i<n_local_lambda;i++) { 1763 ierr = MatSetValue(fetidpmat_ctx->B_delta,i,cols_B_delta[i],vals_B_delta[i],INSERT_VALUES);CHKERRQ(ierr); 1764 } 1765 ierr = PetscFree(vals_B_delta);CHKERRQ(ierr); 1766 ierr = MatAssemblyBegin(fetidpmat_ctx->B_delta,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 1767 ierr = MatAssemblyEnd (fetidpmat_ctx->B_delta,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 1768 1769 if (fully_redundant) { 1770 ierr = MatCreate(PETSC_COMM_SELF,&ScalingMat); 1771 ierr = MatSetSizes(ScalingMat,n_local_lambda,n_local_lambda,n_local_lambda,n_local_lambda);CHKERRQ(ierr); 1772 ierr = MatSetType(ScalingMat,MATSEQAIJ);CHKERRQ(ierr); 1773 ierr = MatSeqAIJSetPreallocation(ScalingMat,1,PETSC_NULL);CHKERRQ(ierr); 1774 for (i=0;i<n_local_lambda;i++) { 1775 ierr = MatSetValue(ScalingMat,i,i,scaling_factors[i],INSERT_VALUES);CHKERRQ(ierr); 1776 } 1777 ierr = MatAssemblyBegin(ScalingMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 1778 ierr = MatAssemblyEnd (ScalingMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 1779 ierr = MatMatMult(ScalingMat,fetidpmat_ctx->B_delta,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&fetidpmat_ctx->B_Ddelta);CHKERRQ(ierr); 1780 ierr = MatDestroy(&ScalingMat);CHKERRQ(ierr); 1781 } else { 1782 ierr = MatCreate(PETSC_COMM_SELF,&fetidpmat_ctx->B_Ddelta); 1783 ierr = MatSetSizes(fetidpmat_ctx->B_Ddelta,n_local_lambda,pcis->n_B,n_local_lambda,pcis->n_B);CHKERRQ(ierr); 1784 ierr = MatSetType(fetidpmat_ctx->B_Ddelta,MATSEQAIJ);CHKERRQ(ierr); 1785 ierr = MatSeqAIJSetPreallocation(fetidpmat_ctx->B_Ddelta,1,PETSC_NULL);CHKERRQ(ierr); 1786 for (i=0;i<n_local_lambda;i++) { 1787 ierr = MatSetValue(fetidpmat_ctx->B_Ddelta,i,cols_B_delta[i],scaling_factors[i],INSERT_VALUES);CHKERRQ(ierr); 1788 } 1789 ierr = MatAssemblyBegin(fetidpmat_ctx->B_Ddelta,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 1790 ierr = MatAssemblyEnd (fetidpmat_ctx->B_Ddelta,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 1791 } 1792 ierr = PetscFree(scaling_factors);CHKERRQ(ierr); 1793 ierr = PetscFree(cols_B_delta);CHKERRQ(ierr); 1794 1795 /* Create some vectors needed by fetidp */ 1796 ierr = VecDuplicate(pcis->vec1_B,&fetidpmat_ctx->temp_solution_B);CHKERRQ(ierr); 1797 ierr = VecDuplicate(pcis->vec1_D,&fetidpmat_ctx->temp_solution_D);CHKERRQ(ierr); 1798 1799 test_fetidp = PETSC_FALSE; 1800 ierr = PetscOptionsGetBool(PETSC_NULL,"-fetidp_check",&test_fetidp,PETSC_NULL);CHKERRQ(ierr); 1801 1802 if (test_fetidp) { 1803 1804 ierr = PetscViewerASCIIGetStdout(((PetscObject)(fetidpmat_ctx->pc))->comm,&viewer);CHKERRQ(ierr); 1805 ierr = PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);CHKERRQ(ierr); 1806 ierr = PetscViewerASCIIPrintf(viewer,"----------FETI_DP TESTS--------------\n");CHKERRQ(ierr); 1807 ierr = PetscViewerASCIIPrintf(viewer,"All tests should return zero!\n");CHKERRQ(ierr); 1808 ierr = PetscViewerASCIIPrintf(viewer,"FETIDP MAT context in the ");CHKERRQ(ierr); 1809 if (fully_redundant) { 1810 ierr = PetscViewerASCIIPrintf(viewer,"fully redundant case for lagrange multipliers.\n");CHKERRQ(ierr); 1811 } else { 1812 ierr = PetscViewerASCIIPrintf(viewer,"Non-fully redundant case for lagrange multiplier.\n");CHKERRQ(ierr); 1813 } 1814 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 1815 1816 /******************************************************************/ 1817 /* TEST A/B: Test numbering of global lambda dofs */ 1818 /******************************************************************/ 1819 1820 ierr = VecDuplicate(fetidpmat_ctx->lambda_local,&test_vec);CHKERRQ(ierr); 1821 ierr = VecSet(lambda_global,1.0);CHKERRQ(ierr); 1822 ierr = VecSet(test_vec,1.0);CHKERRQ(ierr); 1823 ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1824 ierr = VecScatterEnd (fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1825 scalar_value = -1.0; 1826 ierr = VecAXPY(test_vec,scalar_value,fetidpmat_ctx->lambda_local);CHKERRQ(ierr); 1827 ierr = VecNorm(test_vec,NORM_INFINITY,&scalar_value);CHKERRQ(ierr); 1828 ierr = VecDestroy(&test_vec);CHKERRQ(ierr); 1829 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"A[%04d]: CHECK glob to loc: % 1.14e\n",rank,scalar_value);CHKERRQ(ierr); 1830 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 1831 if (fully_redundant) { 1832 ierr = VecSet(lambda_global,0.0);CHKERRQ(ierr); 1833 ierr = VecSet(fetidpmat_ctx->lambda_local,0.5);CHKERRQ(ierr); 1834 ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1835 ierr = VecScatterEnd (fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1836 ierr = VecSum(lambda_global,&scalar_value);CHKERRQ(ierr); 1837 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"B[%04d]: CHECK loc to glob: % 1.14e\n",rank,scalar_value-fetidpmat_ctx->n_lambda);CHKERRQ(ierr); 1838 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 1839 } 1840 1841 /******************************************************************/ 1842 /* TEST C: It should holds B_delta*w=0, w\in\widehat{W} */ 1843 /* This is the meaning of the B matrix */ 1844 /******************************************************************/ 1845 1846 ierr = VecSetRandom(pcis->vec1_N,PETSC_NULL);CHKERRQ(ierr); 1847 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 1848 ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1849 ierr = VecScatterEnd (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1850 ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1851 ierr = VecScatterEnd (matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1852 ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1853 ierr = VecScatterEnd (pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1854 /* Action of B_delta */ 1855 ierr = MatMult(fetidpmat_ctx->B_delta,pcis->vec1_B,fetidpmat_ctx->lambda_local);CHKERRQ(ierr); 1856 ierr = VecSet(lambda_global,0.0);CHKERRQ(ierr); 1857 ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1858 ierr = VecScatterEnd (fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1859 ierr = VecNorm(lambda_global,NORM_INFINITY,&scalar_value);CHKERRQ(ierr); 1860 ierr = PetscViewerASCIIPrintf(viewer,"C[coll]: CHECK infty norm of B_delta*w (w continuous): % 1.14e\n",scalar_value);CHKERRQ(ierr); 1861 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 1862 1863 /******************************************************************/ 1864 /* TEST D: It should holds E_Dw = w - P_Dw w\in\widetilde{W} */ 1865 /* E_D = R_D^TR */ 1866 /* P_D = B_{D,delta}^T B_{delta} */ 1867 /* eq.44 Mandel Tezaur and Dohrmann 2005 */ 1868 /******************************************************************/ 1869 1870 /* compute a random vector in \widetilde{W} */ 1871 ierr = VecSetRandom(pcis->vec1_N,PETSC_NULL);CHKERRQ(ierr); 1872 scalar_value = 0.0; /* set zero at vertices */ 1873 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 1874 for (i=0;i<n_vertices;i++) { array[vertex_indices[i]]=scalar_value; } 1875 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 1876 /* store w for final comparison */ 1877 ierr = VecDuplicate(pcis->vec1_B,&test_vec);CHKERRQ(ierr); 1878 ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,test_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1879 ierr = VecScatterEnd (pcis->N_to_B,pcis->vec1_N,test_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1880 1881 /* Jump operator P_D : results stored in pcis->vec1_B */ 1882 1883 ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1884 ierr = VecScatterEnd (pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1885 /* Action of B_delta */ 1886 ierr = MatMult(fetidpmat_ctx->B_delta,pcis->vec1_B,fetidpmat_ctx->lambda_local);CHKERRQ(ierr); 1887 ierr = VecSet(lambda_global,0.0);CHKERRQ(ierr); 1888 ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1889 ierr = VecScatterEnd (fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1890 /* Action of B_Ddelta^T */ 1891 ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1892 ierr = VecScatterEnd (fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1893 ierr = MatMultTranspose(fetidpmat_ctx->B_Ddelta,fetidpmat_ctx->lambda_local,pcis->vec1_B);CHKERRQ(ierr); 1894 1895 /* Average operator E_D : results stored in pcis->vec2_B */ 1896 1897 ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1898 ierr = VecScatterEnd (pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1899 ierr = VecPointwiseMult(pcis->vec2_B,pcis->D,pcis->vec2_B);CHKERRQ(ierr); 1900 ierr = VecScatterBegin(pcis->N_to_B,pcis->vec2_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1901 ierr = VecScatterEnd (pcis->N_to_B,pcis->vec2_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1902 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 1903 ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1904 ierr = VecScatterEnd (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1905 ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1906 ierr = VecScatterEnd (matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1907 ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1908 ierr = VecScatterEnd (pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1909 1910 /* test E_D=I-P_D */ 1911 scalar_value = 1.0; 1912 ierr = VecAXPY(pcis->vec1_B,scalar_value,pcis->vec2_B);CHKERRQ(ierr); 1913 scalar_value = -1.0; 1914 ierr = VecAXPY(pcis->vec1_B,scalar_value,test_vec);CHKERRQ(ierr); 1915 ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&scalar_value);CHKERRQ(ierr); 1916 ierr = VecDestroy(&test_vec);CHKERRQ(ierr); 1917 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"D[%04d] CHECK infty norm of E_D + P_D - I: % 1.14e\n",rank,scalar_value);CHKERRQ(ierr); 1918 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 1919 1920 /******************************************************************/ 1921 /* TEST E: It should holds R_D^TP_Dw=0 w\in\widetilde{W} */ 1922 /* eq.48 Mandel Tezaur and Dohrmann 2005 */ 1923 /******************************************************************/ 1924 1925 ierr = VecSetRandom(pcis->vec1_N,PETSC_NULL);CHKERRQ(ierr); 1926 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 1927 scalar_value = 0.0; /* set zero at vertices */ 1928 for (i=0;i<n_vertices;i++) { array[vertex_indices[i]]=scalar_value; } 1929 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 1930 1931 /* Jump operator P_D : results stored in pcis->vec1_B */ 1932 1933 ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1934 ierr = VecScatterEnd (pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1935 /* Action of B_delta */ 1936 ierr = MatMult(fetidpmat_ctx->B_delta,pcis->vec1_B,fetidpmat_ctx->lambda_local);CHKERRQ(ierr); 1937 ierr = VecSet(lambda_global,0.0);CHKERRQ(ierr); 1938 ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1939 ierr = VecScatterEnd (fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1940 /* Action of B_Ddelta^T */ 1941 ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1942 ierr = VecScatterEnd (fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1943 ierr = MatMultTranspose(fetidpmat_ctx->B_Ddelta,fetidpmat_ctx->lambda_local,pcis->vec1_B);CHKERRQ(ierr); 1944 /* diagonal scaling */ 1945 ierr = VecPointwiseMult(pcis->vec1_B,pcis->D,pcis->vec1_B);CHKERRQ(ierr); 1946 /* sum on the interface */ 1947 ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr); 1948 ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1949 ierr = VecScatterEnd (pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1950 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 1951 ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1952 ierr = VecScatterEnd (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1953 ierr = VecNorm(pcis->vec1_global,NORM_INFINITY,&scalar_value);CHKERRQ(ierr); 1954 ierr = PetscViewerASCIIPrintf(viewer,"E[coll]: CHECK infty norm of R^T_D P_D: % 1.14e\n",scalar_value);CHKERRQ(ierr); 1955 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 1956 1957 if (!fully_redundant) { 1958 /******************************************************************/ 1959 /* TEST F: It should holds B_{delta}B^T_{D,delta}=I */ 1960 /* Corollary thm 14 Mandel Tezaur and Dohrmann 2005 */ 1961 /******************************************************************/ 1962 ierr = VecDuplicate(lambda_global,&test_vec);CHKERRQ(ierr); 1963 ierr = VecSetRandom(lambda_global,PETSC_NULL);CHKERRQ(ierr); 1964 /* Action of B_Ddelta^T */ 1965 ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1966 ierr = VecScatterEnd (fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1967 ierr = MatMultTranspose(fetidpmat_ctx->B_Ddelta,fetidpmat_ctx->lambda_local,pcis->vec1_B);CHKERRQ(ierr); 1968 /* Action of B_delta */ 1969 ierr = MatMult(fetidpmat_ctx->B_delta,pcis->vec1_B,fetidpmat_ctx->lambda_local);CHKERRQ(ierr); 1970 ierr = VecSet(test_vec,0.0);CHKERRQ(ierr); 1971 ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,test_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1972 ierr = VecScatterEnd (fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,test_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1973 scalar_value = -1.0; 1974 ierr = VecAXPY(lambda_global,scalar_value,test_vec);CHKERRQ(ierr); 1975 ierr = VecNorm(lambda_global,NORM_INFINITY,&scalar_value);CHKERRQ(ierr); 1976 ierr = PetscViewerASCIIPrintf(viewer,"E[coll]: CHECK infty norm of P^T_D - I: % 1.14e\n",scalar_value);CHKERRQ(ierr); 1977 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 1978 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 1979 ierr = VecDestroy(&test_vec);CHKERRQ(ierr); 1980 } 1981 } 1982 /* final cleanup */ 1983 ierr = PetscFree(vertex_indices);CHKERRQ(ierr); 1984 ierr = VecDestroy(&lambda_global);CHKERRQ(ierr); 1985 1986 PetscFunctionReturn(0); 1987 } 1988 1989 #undef __FUNCT__ 1990 #define __FUNCT__ "PCBDDCSetupFETIDPPCContext" 1991 static PetscErrorCode PCBDDCSetupFETIDPPCContext(Mat fetimat, FETIDPPC_ctx *fetidppc_ctx) 1992 { 1993 FETIDPMat_ctx *mat_ctx; 1994 PetscErrorCode ierr; 1995 1996 PetscFunctionBegin; 1997 ierr = MatShellGetContext(fetimat,&mat_ctx);CHKERRQ(ierr); 1998 /* get references from objects created when setting up feti mat context */ 1999 ierr = PetscObjectReference((PetscObject)mat_ctx->lambda_local);CHKERRQ(ierr); 2000 fetidppc_ctx->lambda_local = mat_ctx->lambda_local; 2001 ierr = PetscObjectReference((PetscObject)mat_ctx->B_Ddelta);CHKERRQ(ierr); 2002 fetidppc_ctx->B_Ddelta = mat_ctx->B_Ddelta; 2003 ierr = PetscObjectReference((PetscObject)mat_ctx->l2g_lambda);CHKERRQ(ierr); 2004 fetidppc_ctx->l2g_lambda = mat_ctx->l2g_lambda; 2005 PetscFunctionReturn(0); 2006 } 2007 2008 #undef __FUNCT__ 2009 #define __FUNCT__ "FETIDPMatMult" 2010 static PetscErrorCode FETIDPMatMult(Mat fetimat, Vec x, Vec y) 2011 { 2012 FETIDPMat_ctx *mat_ctx; 2013 PC_IS *pcis; 2014 PetscErrorCode ierr; 2015 2016 PetscFunctionBegin; 2017 ierr = MatShellGetContext(fetimat,&mat_ctx);CHKERRQ(ierr); 2018 pcis = (PC_IS*)mat_ctx->pc->data; 2019 /* Application of B_delta^T */ 2020 ierr = VecScatterBegin(mat_ctx->l2g_lambda,x,mat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 2021 ierr = VecScatterEnd(mat_ctx->l2g_lambda,x,mat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 2022 ierr = MatMultTranspose(mat_ctx->B_delta,mat_ctx->lambda_local,pcis->vec1_B);CHKERRQ(ierr); 2023 /* Application of \widetilde{S}^-1 */ 2024 ierr = VecSet(pcis->vec1_D,0.0);CHKERRQ(ierr); 2025 ierr = PCBDDCApplyInterfacePreconditioner(mat_ctx->pc);CHKERRQ(ierr); 2026 /* Application of B_delta */ 2027 ierr = MatMult(mat_ctx->B_delta,pcis->vec1_B,mat_ctx->lambda_local);CHKERRQ(ierr); 2028 ierr = VecSet(y,0.0);CHKERRQ(ierr); 2029 ierr = VecScatterBegin(mat_ctx->l2g_lambda,mat_ctx->lambda_local,y,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 2030 ierr = VecScatterEnd(mat_ctx->l2g_lambda,mat_ctx->lambda_local,y,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 2031 PetscFunctionReturn(0); 2032 } 2033 2034 #undef __FUNCT__ 2035 #define __FUNCT__ "FETIDPPCApply" 2036 static PetscErrorCode FETIDPPCApply(PC fetipc, Vec x, Vec y) 2037 { 2038 FETIDPPC_ctx *pc_ctx; 2039 PC_IS *pcis; 2040 PetscErrorCode ierr; 2041 2042 PetscFunctionBegin; 2043 ierr = PCShellGetContext(fetipc,(void**)&pc_ctx); 2044 pcis = (PC_IS*)pc_ctx->pc->data; 2045 /* Application of B_Ddelta^T */ 2046 ierr = VecScatterBegin(pc_ctx->l2g_lambda,x,pc_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 2047 ierr = VecScatterEnd(pc_ctx->l2g_lambda,x,pc_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 2048 ierr = VecSet(pcis->vec2_B,0.0);CHKERRQ(ierr); 2049 ierr = MatMultTranspose(pc_ctx->B_Ddelta,pc_ctx->lambda_local,pcis->vec2_B);CHKERRQ(ierr); 2050 /* Application of S */ 2051 ierr = PCISApplySchur(pc_ctx->pc,pcis->vec2_B,pcis->vec1_B,(Vec)0,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr); 2052 /* Application of B_Ddelta */ 2053 ierr = MatMult(pc_ctx->B_Ddelta,pcis->vec1_B,pc_ctx->lambda_local);CHKERRQ(ierr); 2054 ierr = VecSet(y,0.0);CHKERRQ(ierr); 2055 ierr = VecScatterBegin(pc_ctx->l2g_lambda,pc_ctx->lambda_local,y,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 2056 ierr = VecScatterEnd(pc_ctx->l2g_lambda,pc_ctx->lambda_local,y,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 2057 PetscFunctionReturn(0); 2058 } 2059 2060 #undef __FUNCT__ 2061 #define __FUNCT__ "PCBDDCSetupLocalAdjacencyGraph" 2062 static PetscErrorCode PCBDDCSetupLocalAdjacencyGraph(PC pc) 2063 { 2064 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 2065 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 2066 PetscInt nvtxs,*xadj,*adjncy; 2067 Mat mat_adj; 2068 PetscBool symmetrize_rowij=PETSC_TRUE,compressed_rowij=PETSC_FALSE,flg_row=PETSC_TRUE; 2069 PCBDDCGraph mat_graph=pcbddc->mat_graph; 2070 PetscErrorCode ierr; 2071 2072 PetscFunctionBegin; 2073 /* get CSR adjacency from local matrix if user has not yet provided local graph using PCBDDCSetLocalAdjacencyGraph function */ 2074 if (!mat_graph->xadj) { 2075 ierr = MatConvert(matis->A,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr); 2076 ierr = MatGetRowIJ(mat_adj,0,symmetrize_rowij,compressed_rowij,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr); 2077 if (!flg_row) { 2078 SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ called in %s\n",__FUNCT__); 2079 } 2080 /* Get adjacency into BDDC workspace */ 2081 ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr); 2082 ierr = MatRestoreRowIJ(mat_adj,0,symmetrize_rowij,compressed_rowij,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr); 2083 if (!flg_row) { 2084 SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__); 2085 } 2086 ierr = MatDestroy(&mat_adj);CHKERRQ(ierr); 2087 } 2088 PetscFunctionReturn(0); 2089 } 2090 /* -------------------------------------------------------------------------- */ 2091 #undef __FUNCT__ 2092 #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner" 2093 static PetscErrorCode PCBDDCApplyInterfacePreconditioner(PC pc) 2094 { 2095 PetscErrorCode ierr; 2096 PC_BDDC* pcbddc = (PC_BDDC*)(pc->data); 2097 PC_IS* pcis = (PC_IS*) (pc->data); 2098 const PetscScalar zero = 0.0; 2099 2100 PetscFunctionBegin; 2101 /* Application of PHI^T */ 2102 ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr); 2103 if (pcbddc->prec_type) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); } 2104 2105 /* Scatter data of coarse_rhs */ 2106 if (pcbddc->coarse_rhs) { ierr = VecSet(pcbddc->coarse_rhs,zero);CHKERRQ(ierr); } 2107 ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 2108 2109 /* Local solution on R nodes */ 2110 ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr); 2111 ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 2112 ierr = VecScatterEnd (pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 2113 if (pcbddc->prec_type) { 2114 ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 2115 ierr = VecScatterEnd (pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 2116 } 2117 ierr = PCBDDCSolveSaddlePoint(pc);CHKERRQ(ierr); 2118 ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr); 2119 ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 2120 ierr = VecScatterEnd (pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 2121 if (pcbddc->prec_type) { 2122 ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 2123 ierr = VecScatterEnd (pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 2124 } 2125 2126 /* Coarse solution */ 2127 ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_rhs,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 2128 if (pcbddc->coarse_rhs) { 2129 if (pcbddc->CoarseNullSpace) { 2130 ierr = MatNullSpaceRemove(pcbddc->CoarseNullSpace,pcbddc->coarse_rhs,PETSC_NULL);CHKERRQ(ierr); 2131 } 2132 ierr = KSPSolve(pcbddc->coarse_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr); 2133 if (pcbddc->CoarseNullSpace) { 2134 ierr = MatNullSpaceRemove(pcbddc->CoarseNullSpace,pcbddc->coarse_vec,PETSC_NULL);CHKERRQ(ierr); 2135 } 2136 } 2137 ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 2138 ierr = PCBDDCScatterCoarseDataEnd (pc,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 2139 2140 /* Sum contributions from two levels */ 2141 ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr); 2142 if (pcbddc->prec_type) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); } 2143 PetscFunctionReturn(0); 2144 } 2145 /* -------------------------------------------------------------------------- */ 2146 #undef __FUNCT__ 2147 #define __FUNCT__ "PCBDDCSolveSaddlePoint" 2148 static PetscErrorCode PCBDDCSolveSaddlePoint(PC pc) 2149 { 2150 PetscErrorCode ierr; 2151 PC_BDDC* pcbddc = (PC_BDDC*)(pc->data); 2152 2153 PetscFunctionBegin; 2154 ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr); 2155 if (pcbddc->local_auxmat1) { 2156 ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec2_R,pcbddc->vec1_C);CHKERRQ(ierr); 2157 ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr); 2158 } 2159 PetscFunctionReturn(0); 2160 } 2161 /* -------------------------------------------------------------------------- */ 2162 #undef __FUNCT__ 2163 #define __FUNCT__ "PCBDDCScatterCoarseDataBegin" 2164 static PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode) 2165 { 2166 PetscErrorCode ierr; 2167 PC_BDDC* pcbddc = (PC_BDDC*)(pc->data); 2168 2169 PetscFunctionBegin; 2170 switch(pcbddc->coarse_communications_type){ 2171 case SCATTERS_BDDC: 2172 ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr); 2173 break; 2174 case GATHERS_BDDC: 2175 break; 2176 } 2177 PetscFunctionReturn(0); 2178 } 2179 /* -------------------------------------------------------------------------- */ 2180 #undef __FUNCT__ 2181 #define __FUNCT__ "PCBDDCScatterCoarseDataEnd" 2182 static PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc,Vec vec_from, Vec vec_to, InsertMode imode, ScatterMode smode) 2183 { 2184 PetscErrorCode ierr; 2185 PC_BDDC* pcbddc = (PC_BDDC*)(pc->data); 2186 PetscScalar* array_to; 2187 PetscScalar* array_from; 2188 MPI_Comm comm=((PetscObject)pc)->comm; 2189 PetscInt i; 2190 2191 PetscFunctionBegin; 2192 2193 switch(pcbddc->coarse_communications_type){ 2194 case SCATTERS_BDDC: 2195 ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,vec_from,vec_to,imode,smode);CHKERRQ(ierr); 2196 break; 2197 case GATHERS_BDDC: 2198 if (vec_from) VecGetArray(vec_from,&array_from); 2199 if (vec_to) VecGetArray(vec_to,&array_to); 2200 switch(pcbddc->coarse_problem_type){ 2201 case SEQUENTIAL_BDDC: 2202 if (smode == SCATTER_FORWARD) { 2203 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); 2204 if (vec_to) { 2205 if (imode == ADD_VALUES) { 2206 for (i=0;i<pcbddc->replicated_primal_size;i++) { 2207 array_to[pcbddc->replicated_local_primal_indices[i]]+=pcbddc->replicated_local_primal_values[i]; 2208 } 2209 } else { 2210 for (i=0;i<pcbddc->replicated_primal_size;i++) { 2211 array_to[pcbddc->replicated_local_primal_indices[i]]=pcbddc->replicated_local_primal_values[i]; 2212 } 2213 } 2214 } 2215 } else { 2216 if (vec_from) { 2217 if (imode == ADD_VALUES) { 2218 printf("Scatter mode %d, insert mode %d for case %d not implemented!\n",smode,imode,pcbddc->coarse_problem_type); 2219 } 2220 for (i=0;i<pcbddc->replicated_primal_size;i++) { 2221 pcbddc->replicated_local_primal_values[i]=array_from[pcbddc->replicated_local_primal_indices[i]]; 2222 } 2223 } 2224 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); 2225 } 2226 break; 2227 case REPLICATED_BDDC: 2228 if (smode == SCATTER_FORWARD) { 2229 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); 2230 if (imode == ADD_VALUES) { 2231 for (i=0;i<pcbddc->replicated_primal_size;i++) { 2232 array_to[pcbddc->replicated_local_primal_indices[i]]+=pcbddc->replicated_local_primal_values[i]; 2233 } 2234 } else { 2235 for (i=0;i<pcbddc->replicated_primal_size;i++) { 2236 array_to[pcbddc->replicated_local_primal_indices[i]]=pcbddc->replicated_local_primal_values[i]; 2237 } 2238 } 2239 } else { /* no communications needed for SCATTER_REVERSE since needed data is already present */ 2240 if (imode == ADD_VALUES) { 2241 for (i=0;i<pcbddc->local_primal_size;i++) { 2242 array_to[i]+=array_from[pcbddc->local_primal_indices[i]]; 2243 } 2244 } else { 2245 for (i=0;i<pcbddc->local_primal_size;i++) { 2246 array_to[i]=array_from[pcbddc->local_primal_indices[i]]; 2247 } 2248 } 2249 } 2250 break; 2251 case MULTILEVEL_BDDC: 2252 break; 2253 case PARALLEL_BDDC: 2254 break; 2255 } 2256 if (vec_from) VecRestoreArray(vec_from,&array_from); 2257 if (vec_to) VecRestoreArray(vec_to,&array_to); 2258 break; 2259 } 2260 PetscFunctionReturn(0); 2261 } 2262 /* -------------------------------------------------------------------------- */ 2263 #undef __FUNCT__ 2264 #define __FUNCT__ "PCBDDCCreateConstraintMatrix" 2265 static PetscErrorCode PCBDDCCreateConstraintMatrix(PC pc) 2266 { 2267 PetscErrorCode ierr; 2268 PC_IS* pcis = (PC_IS*)(pc->data); 2269 PC_BDDC* pcbddc = (PC_BDDC*)pc->data; 2270 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 2271 PetscInt *nnz,*is_indices; 2272 PetscScalar *temp_quadrature_constraint; 2273 PetscInt *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B,*local_to_B; 2274 PetscInt local_primal_size,i,j,k,total_counts,max_size_of_constraint; 2275 PetscInt n_constraints,n_vertices,size_of_constraint; 2276 PetscScalar quad_value; 2277 PetscBool nnsp_has_cnst=PETSC_FALSE,use_nnsp_true=pcbddc->use_nnsp_true; 2278 PetscInt nnsp_size=0,nnsp_addone=0,temp_constraints,temp_start_ptr; 2279 IS *used_IS; 2280 MatType impMatType=MATSEQAIJ; 2281 PetscBLASInt Bs,Bt,lwork,lierr; 2282 PetscReal tol=1.0e-8; 2283 MatNullSpace nearnullsp; 2284 const Vec *nearnullvecs; 2285 Vec *localnearnullsp; 2286 PetscScalar *work,*temp_basis,*array_vector,*correlation_mat; 2287 PetscReal *rwork,*singular_vals; 2288 PetscBLASInt Bone=1,*ipiv; 2289 Vec temp_vec; 2290 Mat temp_mat; 2291 KSP temp_ksp; 2292 PC temp_pc; 2293 PetscInt s,start_constraint,dual_dofs; 2294 PetscBool compute_submatrix,useksp=PETSC_FALSE; 2295 PetscInt *aux_primal_permutation,*aux_primal_numbering; 2296 PetscBool boolforface,*change_basis; 2297 /* some ugly conditional declarations */ 2298 #if defined(PETSC_MISSING_LAPACK_GESVD) 2299 PetscScalar dot_result; 2300 PetscScalar one=1.0,zero=0.0; 2301 PetscInt ii; 2302 PetscScalar *singular_vectors; 2303 PetscBLASInt *iwork,*ifail; 2304 PetscReal dummy_real,abs_tol; 2305 PetscBLASInt eigs_found; 2306 #if defined(PETSC_USE_COMPLEX) 2307 PetscScalar val1,val2; 2308 #endif 2309 #endif 2310 PetscBLASInt dummy_int; 2311 PetscScalar dummy_scalar; 2312 2313 PetscFunctionBegin; 2314 /* check if near null space is attached to global mat */ 2315 ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr); 2316 if (nearnullsp) { 2317 ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr); 2318 } else { /* if near null space is not provided it uses constants */ 2319 nnsp_has_cnst = PETSC_TRUE; 2320 use_nnsp_true = PETSC_TRUE; 2321 } 2322 if (nnsp_has_cnst) { 2323 nnsp_addone = 1; 2324 } 2325 /* 2326 Evaluate maximum storage size needed by the procedure 2327 - temp_indices will contain start index of each constraint stored as follows 2328 - temp_indices_to_constraint [temp_indices[i],...,temp[indices[i+1]-1] will contain the indices (in local numbering) on which the constraint acts 2329 - 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 2330 - temp_quadrature_constraint [temp_indices[i],...,temp[indices[i+1]-1] will contain the scalars representing the constraint itself 2331 */ 2332 2333 total_counts = pcbddc->n_ISForFaces+pcbddc->n_ISForEdges; 2334 total_counts *= (nnsp_addone+nnsp_size); 2335 ierr = ISGetSize(pcbddc->ISForVertices,&n_vertices);CHKERRQ(ierr); 2336 total_counts += n_vertices; 2337 ierr = PetscMalloc((total_counts+1)*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr); 2338 ierr = PetscMalloc((total_counts+1)*sizeof(PetscBool),&change_basis);CHKERRQ(ierr); 2339 total_counts = 0; 2340 max_size_of_constraint = 0; 2341 for (i=0;i<pcbddc->n_ISForEdges+pcbddc->n_ISForFaces;i++){ 2342 if (i<pcbddc->n_ISForEdges){ 2343 used_IS = &pcbddc->ISForEdges[i]; 2344 } else { 2345 used_IS = &pcbddc->ISForFaces[i-pcbddc->n_ISForEdges]; 2346 } 2347 ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr); 2348 total_counts += j; 2349 if (j>max_size_of_constraint) max_size_of_constraint=j; 2350 } 2351 total_counts *= (nnsp_addone+nnsp_size); 2352 total_counts += n_vertices; 2353 ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&temp_quadrature_constraint);CHKERRQ(ierr); 2354 ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint);CHKERRQ(ierr); 2355 ierr = PetscMalloc(total_counts*sizeof(PetscInt),&temp_indices_to_constraint_B);CHKERRQ(ierr); 2356 ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&local_to_B);CHKERRQ(ierr); 2357 ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 2358 for (i=0;i<pcis->n;i++) { 2359 local_to_B[i]=-1; 2360 } 2361 for (i=0;i<pcis->n_B;i++) { 2362 local_to_B[is_indices[i]]=i; 2363 } 2364 ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 2365 2366 /* First we issue queries to allocate optimal workspace for LAPACKgesvd or LAPACKsyev/LAPACKheev */ 2367 rwork = 0; 2368 work = 0; 2369 singular_vals = 0; 2370 temp_basis = 0; 2371 correlation_mat = 0; 2372 if (!pcbddc->use_nnsp_true) { 2373 PetscScalar temp_work; 2374 #if defined(PETSC_MISSING_LAPACK_GESVD) 2375 /* POD */ 2376 PetscInt max_n; 2377 max_n = nnsp_addone+nnsp_size; 2378 /* using some techniques borrowed from Proper Orthogonal Decomposition */ 2379 ierr = PetscMalloc(max_n*max_n*sizeof(PetscScalar),&correlation_mat);CHKERRQ(ierr); 2380 ierr = PetscMalloc(max_n*max_n*sizeof(PetscScalar),&singular_vectors);CHKERRQ(ierr); 2381 ierr = PetscMalloc(max_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr); 2382 ierr = PetscMalloc(max_size_of_constraint*(nnsp_addone+nnsp_size)*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr); 2383 #if defined(PETSC_USE_COMPLEX) 2384 ierr = PetscMalloc(3*max_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr); 2385 #endif 2386 ierr = PetscMalloc(5*max_n*sizeof(PetscBLASInt),&iwork);CHKERRQ(ierr); 2387 ierr = PetscMalloc(max_n*sizeof(PetscBLASInt),&ifail);CHKERRQ(ierr); 2388 /* now we evaluate the optimal workspace using query with lwork=-1 */ 2389 Bt = PetscBLASIntCast(max_n); 2390 lwork=-1; 2391 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 2392 #if !defined(PETSC_USE_COMPLEX) 2393 abs_tol=1.e-8; 2394 /* LAPACKsyev_("V","U",&Bt,correlation_mat,&Bt,singular_vals,&temp_work,&lwork,&lierr); */ 2395 LAPACKsyevx_("V","A","U",&Bt,correlation_mat,&Bt,&dummy_real,&dummy_real,&dummy_int,&dummy_int, 2396 &abs_tol,&eigs_found,singular_vals,singular_vectors,&Bt,&temp_work,&lwork,iwork,ifail,&lierr); 2397 #else 2398 /* LAPACKsyev_("V","U",&Bt,correlation_mat,&Bt,singular_vals,&temp_work,&lwork,rwork,&lierr); */ 2399 /* LAPACK call is missing here! TODO */ 2400 SETERRQ(((PetscObject) pc)->comm, PETSC_ERR_SUP, "Not yet implemented for complexes when PETSC_MISSING_GESVD = 1"); 2401 #endif 2402 if ( lierr ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEVX Lapack routine %d",(int)lierr); 2403 ierr = PetscFPTrapPop();CHKERRQ(ierr); 2404 #else /* on missing GESVD */ 2405 /* SVD */ 2406 PetscInt max_n,min_n; 2407 max_n = max_size_of_constraint; 2408 min_n = nnsp_addone+nnsp_size; 2409 if (max_size_of_constraint < ( nnsp_addone+nnsp_size ) ) { 2410 min_n = max_size_of_constraint; 2411 max_n = nnsp_addone+nnsp_size; 2412 } 2413 ierr = PetscMalloc(min_n*sizeof(PetscReal),&singular_vals);CHKERRQ(ierr); 2414 #if defined(PETSC_USE_COMPLEX) 2415 ierr = PetscMalloc(5*min_n*sizeof(PetscReal),&rwork);CHKERRQ(ierr); 2416 #endif 2417 /* now we evaluate the optimal workspace using query with lwork=-1 */ 2418 lwork=-1; 2419 Bs = PetscBLASIntCast(max_n); 2420 Bt = PetscBLASIntCast(min_n); 2421 dummy_int = Bs; 2422 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 2423 #if !defined(PETSC_USE_COMPLEX) 2424 LAPACKgesvd_("O","N",&Bs,&Bt,&temp_quadrature_constraint[0],&Bs,singular_vals, 2425 &dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,&temp_work,&lwork,&lierr); 2426 #else 2427 LAPACKgesvd_("O","N",&Bs,&Bt,&temp_quadrature_constraint[0],&Bs,singular_vals, 2428 &dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,&temp_work,&lwork,rwork,&lierr); 2429 #endif 2430 if ( lierr ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SVD Lapack routine %d",(int)lierr); 2431 ierr = PetscFPTrapPop();CHKERRQ(ierr); 2432 #endif 2433 /* Allocate optimal workspace */ 2434 lwork = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work)); 2435 total_counts = (PetscInt)lwork; 2436 ierr = PetscMalloc(total_counts*sizeof(PetscScalar),&work);CHKERRQ(ierr); 2437 } 2438 /* get local part of global near null space vectors */ 2439 ierr = PetscMalloc(nnsp_size*sizeof(Vec),&localnearnullsp);CHKERRQ(ierr); 2440 for (k=0;k<nnsp_size;k++) { 2441 ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr); 2442 ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 2443 ierr = VecScatterEnd (matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 2444 } 2445 /* Now we can loop on constraining sets */ 2446 total_counts=0; 2447 temp_indices[0]=0; 2448 /* vertices */ 2449 PetscBool used_vertex; 2450 ierr = ISGetIndices(pcbddc->ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr); 2451 if (nnsp_has_cnst) { /* consider all vertices */ 2452 for (i=0;i<n_vertices;i++) { 2453 temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i]; 2454 temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]]; 2455 temp_quadrature_constraint[temp_indices[total_counts]]=1.0; 2456 temp_indices[total_counts+1]=temp_indices[total_counts]+1; 2457 change_basis[total_counts]=PETSC_FALSE; 2458 total_counts++; 2459 } 2460 } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */ 2461 for (i=0;i<n_vertices;i++) { 2462 used_vertex=PETSC_FALSE; 2463 k=0; 2464 while(!used_vertex && k<nnsp_size) { 2465 ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array_vector);CHKERRQ(ierr); 2466 if (PetscAbsScalar(array_vector[is_indices[i]])>0.0) { 2467 temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i]; 2468 temp_indices_to_constraint_B[temp_indices[total_counts]]=local_to_B[is_indices[i]]; 2469 temp_quadrature_constraint[temp_indices[total_counts]]=1.0; 2470 temp_indices[total_counts+1]=temp_indices[total_counts]+1; 2471 change_basis[total_counts]=PETSC_FALSE; 2472 total_counts++; 2473 used_vertex=PETSC_TRUE; 2474 } 2475 ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array_vector);CHKERRQ(ierr); 2476 k++; 2477 } 2478 } 2479 } 2480 ierr = ISRestoreIndices(pcbddc->ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr); 2481 n_vertices=total_counts; 2482 /* edges and faces */ 2483 for (i=0;i<pcbddc->n_ISForEdges+pcbddc->n_ISForFaces;i++){ 2484 if (i<pcbddc->n_ISForEdges){ 2485 used_IS = &pcbddc->ISForEdges[i]; 2486 boolforface = pcbddc->usechangeofbasis; 2487 } else { 2488 used_IS = &pcbddc->ISForFaces[i-pcbddc->n_ISForEdges]; 2489 boolforface = pcbddc->usechangeonfaces; 2490 } 2491 temp_constraints = 0; /* zero the number of constraints I have on this conn comp */ 2492 temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */ 2493 ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr); 2494 ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr); 2495 if (nnsp_has_cnst) { 2496 temp_constraints++; 2497 quad_value = (PetscScalar) (1.0/PetscSqrtReal((PetscReal)size_of_constraint)); 2498 for (j=0;j<size_of_constraint;j++) { 2499 temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j]; 2500 temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]]; 2501 temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value; 2502 } 2503 temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint; /* store new starting point */ 2504 change_basis[total_counts]=boolforface; 2505 total_counts++; 2506 } 2507 for (k=0;k<nnsp_size;k++) { 2508 ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array_vector);CHKERRQ(ierr); 2509 for (j=0;j<size_of_constraint;j++) { 2510 temp_indices_to_constraint[temp_indices[total_counts]+j]=is_indices[j]; 2511 temp_indices_to_constraint_B[temp_indices[total_counts]+j]=local_to_B[is_indices[j]]; 2512 temp_quadrature_constraint[temp_indices[total_counts]+j]=array_vector[is_indices[j]]; 2513 } 2514 ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array_vector);CHKERRQ(ierr); 2515 quad_value = 1.0; 2516 if ( use_nnsp_true ) { /* check if array is null on the connected component in case use_nnsp_true has been requested */ 2517 Bs = PetscBLASIntCast(size_of_constraint); 2518 quad_value = BLASasum_(&Bs,&temp_quadrature_constraint[temp_indices[total_counts]],&Bone); 2519 } 2520 if ( quad_value > 0.0 ) { /* keep indices and values */ 2521 temp_constraints++; 2522 temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint; /* store new starting point */ 2523 change_basis[total_counts]=boolforface; 2524 total_counts++; 2525 } 2526 } 2527 ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr); 2528 /* perform SVD on the constraint if use_nnsp_true has not be requested by the user */ 2529 if (!use_nnsp_true) { 2530 2531 Bs = PetscBLASIntCast(size_of_constraint); 2532 Bt = PetscBLASIntCast(temp_constraints); 2533 2534 #if defined(PETSC_MISSING_LAPACK_GESVD) 2535 ierr = PetscMemzero(correlation_mat,Bt*Bt*sizeof(PetscScalar));CHKERRQ(ierr); 2536 /* Store upper triangular part of correlation matrix */ 2537 for (j=0;j<temp_constraints;j++) { 2538 for (k=0;k<j+1;k++) { 2539 #if defined(PETSC_USE_COMPLEX) 2540 /* hand made complex dot product -> replace */ 2541 dot_result = 0.0; 2542 for (ii=0; ii<size_of_constraint; ii++) { 2543 val1 = temp_quadrature_constraint[temp_indices[temp_start_ptr+j]+ii]; 2544 val2 = temp_quadrature_constraint[temp_indices[temp_start_ptr+k]+ii]; 2545 dot_result += val1*PetscConj(val2); 2546 } 2547 #else 2548 dot_result = BLASdot_(&Bs,&temp_quadrature_constraint[temp_indices[temp_start_ptr+j]],&Bone, 2549 &temp_quadrature_constraint[temp_indices[temp_start_ptr+k]],&Bone); 2550 #endif 2551 correlation_mat[j*temp_constraints+k]=dot_result; 2552 } 2553 } 2554 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 2555 #if !defined(PETSC_USE_COMPLEX) 2556 /* LAPACKsyev_("V","U",&Bt,correlation_mat,&Bt,singular_vals,work,&lwork,&lierr); */ 2557 LAPACKsyevx_("V","A","U",&Bt,correlation_mat,&Bt,&dummy_real,&dummy_real,&dummy_int,&dummy_int, 2558 &abs_tol,&eigs_found,singular_vals,singular_vectors,&Bt,work,&lwork,iwork,ifail,&lierr); 2559 #else 2560 /* LAPACK call is missing here! TODO */ 2561 SETERRQ(((PetscObject) pc)->comm, PETSC_ERR_SUP, "Not yet implemented for complexes when PETSC_MISSING_GESVD = 1"); 2562 #endif 2563 if ( lierr ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEVX Lapack routine %d",(int)lierr); 2564 ierr = PetscFPTrapPop();CHKERRQ(ierr); 2565 /* retain eigenvalues greater than tol: note that lapack SYEV gives eigs in ascending order */ 2566 j=0; 2567 while( j < Bt && singular_vals[j] < tol) j++; 2568 total_counts=total_counts-j; 2569 if (j<temp_constraints) { 2570 for (k=j;k<Bt;k++) { singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]); } 2571 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 2572 BLASgemm_("N","N",&Bs,&Bt,&Bt,&one,&temp_quadrature_constraint[temp_indices[temp_start_ptr]],&Bs,correlation_mat,&Bt,&zero,temp_basis,&Bs); 2573 ierr = PetscFPTrapPop();CHKERRQ(ierr); 2574 /* copy POD basis into used quadrature memory */ 2575 for (k=0;k<Bt-j;k++) { 2576 for (ii=0;ii<size_of_constraint;ii++) { 2577 temp_quadrature_constraint[temp_indices[temp_start_ptr+k]+ii]=singular_vals[Bt-1-k]*temp_basis[(Bt-1-k)*size_of_constraint+ii]; 2578 } 2579 } 2580 } 2581 2582 #else /* on missing GESVD */ 2583 PetscInt min_n = temp_constraints; 2584 if (min_n > size_of_constraint) min_n = size_of_constraint; 2585 dummy_int = Bs; 2586 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 2587 #if !defined(PETSC_USE_COMPLEX) 2588 LAPACKgesvd_("O","N",&Bs,&Bt,&temp_quadrature_constraint[temp_indices[temp_start_ptr]],&Bs,singular_vals, 2589 &dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,work,&lwork,&lierr); 2590 #else 2591 LAPACKgesvd_("O","N",&Bs,&Bt,&temp_quadrature_constraint[temp_indices[temp_start_ptr]],&Bs,singular_vals, 2592 &dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,work,&lwork,rwork,&lierr); 2593 #endif 2594 if ( lierr ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SVD Lapack routine %d",(int)lierr); 2595 ierr = PetscFPTrapPop();CHKERRQ(ierr); 2596 /* retain eigenvalues greater than tol: note that lapack SVD gives eigs in descending order */ 2597 j=0; 2598 while( j < min_n && singular_vals[min_n-j-1] < tol) j++; 2599 total_counts = total_counts-(PetscInt)Bt+(min_n-j); 2600 #endif 2601 } 2602 } 2603 2604 n_constraints=total_counts-n_vertices; 2605 local_primal_size = total_counts; 2606 /* set quantities in pcbddc data structure */ 2607 pcbddc->n_vertices = n_vertices; 2608 pcbddc->n_constraints = n_constraints; 2609 pcbddc->local_primal_size = local_primal_size; 2610 2611 /* Create constraint matrix */ 2612 /* The constraint matrix is used to compute the l2g map of primal dofs */ 2613 /* so we need to set it up properly either with or without change of basis */ 2614 ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr); 2615 ierr = MatSetType(pcbddc->ConstraintMatrix,impMatType);CHKERRQ(ierr); 2616 ierr = MatSetSizes(pcbddc->ConstraintMatrix,local_primal_size,pcis->n,local_primal_size,pcis->n);CHKERRQ(ierr); 2617 /* compute a local numbering of constraints : vertices first then constraints */ 2618 ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr); 2619 ierr = VecGetArray(pcis->vec1_N,&array_vector);CHKERRQ(ierr); 2620 ierr = PetscMalloc(local_primal_size*sizeof(PetscInt),&aux_primal_numbering);CHKERRQ(ierr); 2621 ierr = PetscMalloc(local_primal_size*sizeof(PetscInt),&aux_primal_permutation);CHKERRQ(ierr); 2622 total_counts=0; 2623 /* find vertices: subdomain corners plus dofs with basis changed */ 2624 for (i=0;i<local_primal_size;i++) { 2625 size_of_constraint=temp_indices[i+1]-temp_indices[i]; 2626 if (change_basis[i] || size_of_constraint == 1) { 2627 k=0; 2628 while(k < size_of_constraint && array_vector[temp_indices_to_constraint[temp_indices[i]+size_of_constraint-k-1]] != 0.0) { 2629 k=k+1; 2630 } 2631 j=temp_indices_to_constraint[temp_indices[i]+size_of_constraint-k-1]; 2632 array_vector[j] = 1.0; 2633 aux_primal_numbering[total_counts]=j; 2634 aux_primal_permutation[total_counts]=total_counts; 2635 total_counts++; 2636 } 2637 } 2638 ierr = VecRestoreArray(pcis->vec1_N,&array_vector);CHKERRQ(ierr); 2639 /* permute indices in order to have a sorted set of vertices */ 2640 ierr = PetscSortIntWithPermutation(total_counts,aux_primal_numbering,aux_primal_permutation); 2641 /* nonzero structure */ 2642 ierr = PetscMalloc(local_primal_size*sizeof(PetscInt),&nnz);CHKERRQ(ierr); 2643 for (i=0;i<total_counts;i++) { 2644 nnz[i]=1; 2645 } 2646 j=total_counts; 2647 for (i=n_vertices;i<local_primal_size;i++) { 2648 if (!change_basis[i]) { 2649 nnz[j]=temp_indices[i+1]-temp_indices[i]; 2650 j++; 2651 } 2652 } 2653 ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr); 2654 ierr = PetscFree(nnz);CHKERRQ(ierr); 2655 /* set values in constraint matrix */ 2656 for (i=0;i<total_counts;i++) { 2657 j = aux_primal_permutation[i]; 2658 k = aux_primal_numbering[j]; 2659 ierr = MatSetValue(pcbddc->ConstraintMatrix,i,k,1.0,INSERT_VALUES);CHKERRQ(ierr); 2660 } 2661 for (i=n_vertices;i<local_primal_size;i++) { 2662 if (!change_basis[i]) { 2663 size_of_constraint=temp_indices[i+1]-temp_indices[i]; 2664 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); 2665 total_counts++; 2666 } 2667 } 2668 ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr); 2669 ierr = PetscFree(aux_primal_permutation);CHKERRQ(ierr); 2670 /* assembling */ 2671 ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2672 ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2673 2674 /* Create matrix for change of basis. We don't need it in case pcbddc->usechangeofbasis is FALSE */ 2675 if (pcbddc->usechangeofbasis) { 2676 ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr); 2677 ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,impMatType);CHKERRQ(ierr); 2678 ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,pcis->n_B,pcis->n_B,pcis->n_B,pcis->n_B);CHKERRQ(ierr); 2679 /* work arrays */ 2680 /* we need to reuse these arrays, so we free them */ 2681 ierr = PetscFree(temp_basis);CHKERRQ(ierr); 2682 ierr = PetscFree(work);CHKERRQ(ierr); 2683 ierr = PetscMalloc(pcis->n_B*sizeof(PetscInt),&nnz);CHKERRQ(ierr); 2684 ierr = PetscMalloc((nnsp_addone+nnsp_size)*(nnsp_addone+nnsp_size)*sizeof(PetscScalar),&temp_basis);CHKERRQ(ierr); 2685 ierr = PetscMalloc((nnsp_addone+nnsp_size)*sizeof(PetscScalar),&work);CHKERRQ(ierr); 2686 ierr = PetscMalloc((nnsp_addone+nnsp_size)*sizeof(PetscBLASInt),&ipiv);CHKERRQ(ierr); 2687 for (i=0;i<pcis->n_B;i++) { 2688 nnz[i]=1; 2689 } 2690 /* Overestimated nonzeros per row */ 2691 k=1; 2692 for (i=pcbddc->n_vertices;i<local_primal_size;i++) { 2693 if (change_basis[i]) { 2694 size_of_constraint = temp_indices[i+1]-temp_indices[i]; 2695 if (k < size_of_constraint) { 2696 k = size_of_constraint; 2697 } 2698 for (j=0;j<size_of_constraint;j++) { 2699 nnz[temp_indices_to_constraint_B[temp_indices[i]+j]] = size_of_constraint; 2700 } 2701 } 2702 } 2703 ierr = MatSeqAIJSetPreallocation(pcbddc->ChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr); 2704 ierr = PetscFree(nnz);CHKERRQ(ierr); 2705 /* Temporary array to store indices */ 2706 ierr = PetscMalloc(k*sizeof(PetscInt),&is_indices);CHKERRQ(ierr); 2707 /* Set initial identity in the matrix */ 2708 for (i=0;i<pcis->n_B;i++) { 2709 ierr = MatSetValue(pcbddc->ChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr); 2710 } 2711 /* Now we loop on the constraints which need a change of basis */ 2712 /* Change of basis matrix is evaluated as the FIRST APPROACH in */ 2713 /* Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (6.2.1) */ 2714 temp_constraints = 0; 2715 if (pcbddc->n_vertices < local_primal_size) { 2716 temp_start_ptr = temp_indices_to_constraint_B[temp_indices[pcbddc->n_vertices]]; 2717 } 2718 for (i=pcbddc->n_vertices;i<local_primal_size;i++) { 2719 if (change_basis[i]) { 2720 compute_submatrix = PETSC_FALSE; 2721 useksp = PETSC_FALSE; 2722 if (temp_start_ptr == temp_indices_to_constraint_B[temp_indices[i]]) { 2723 temp_constraints++; 2724 if (i == local_primal_size -1 || temp_start_ptr != temp_indices_to_constraint_B[temp_indices[i+1]]) { 2725 compute_submatrix = PETSC_TRUE; 2726 } 2727 } 2728 if (compute_submatrix) { 2729 if (temp_constraints > 1 || pcbddc->use_nnsp_true) { 2730 useksp = PETSC_TRUE; 2731 } 2732 size_of_constraint = temp_indices[i+1]-temp_indices[i]; 2733 if (useksp) { /* experimental */ 2734 ierr = MatCreate(PETSC_COMM_SELF,&temp_mat);CHKERRQ(ierr); 2735 ierr = MatSetType(temp_mat,impMatType);CHKERRQ(ierr); 2736 ierr = MatSetSizes(temp_mat,size_of_constraint,size_of_constraint,size_of_constraint,size_of_constraint);CHKERRQ(ierr); 2737 ierr = MatSeqAIJSetPreallocation(temp_mat,size_of_constraint,PETSC_NULL);CHKERRQ(ierr); 2738 } 2739 /* First _size_of_constraint-temp_constraints_ columns */ 2740 dual_dofs = size_of_constraint-temp_constraints; 2741 start_constraint = i+1-temp_constraints; 2742 for (s=0;s<dual_dofs;s++) { 2743 is_indices[0] = s; 2744 for (j=0;j<temp_constraints;j++) { 2745 for (k=0;k<temp_constraints;k++) { 2746 temp_basis[j*temp_constraints+k]=temp_quadrature_constraint[temp_indices[start_constraint+k]+s+j+1]; 2747 } 2748 work[j]=-temp_quadrature_constraint[temp_indices[start_constraint+j]+s]; 2749 is_indices[j+1]=s+j+1; 2750 } 2751 Bt = temp_constraints; 2752 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 2753 LAPACKgesv_(&Bt,&Bone,temp_basis,&Bt,ipiv,work,&Bt,&lierr); 2754 if ( lierr ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESV Lapack routine %d",(int)lierr); 2755 ierr = PetscFPTrapPop();CHKERRQ(ierr); 2756 j = temp_indices_to_constraint_B[temp_indices[start_constraint]+s]; 2757 ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,temp_constraints,&temp_indices_to_constraint_B[temp_indices[start_constraint]+s+1],1,&j,work,INSERT_VALUES);CHKERRQ(ierr); 2758 if (useksp) { 2759 /* temp mat with transposed rows and columns */ 2760 ierr = MatSetValues(temp_mat,1,&s,temp_constraints,&is_indices[1],work,INSERT_VALUES);CHKERRQ(ierr); 2761 ierr = MatSetValue(temp_mat,is_indices[0],is_indices[0],1.0,INSERT_VALUES);CHKERRQ(ierr); 2762 } 2763 } 2764 if (useksp) { 2765 /* last rows of temp_mat */ 2766 for (j=0;j<size_of_constraint;j++) { 2767 is_indices[j] = j; 2768 } 2769 for (s=0;s<temp_constraints;s++) { 2770 k = s + dual_dofs; 2771 ierr = MatSetValues(temp_mat,1,&k,size_of_constraint,is_indices,&temp_quadrature_constraint[temp_indices[start_constraint+s]],INSERT_VALUES);CHKERRQ(ierr); 2772 } 2773 ierr = MatAssemblyBegin(temp_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2774 ierr = MatAssemblyEnd(temp_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2775 ierr = MatGetVecs(temp_mat,&temp_vec,PETSC_NULL);CHKERRQ(ierr); 2776 ierr = KSPCreate(PETSC_COMM_SELF,&temp_ksp);CHKERRQ(ierr); 2777 ierr = KSPSetOperators(temp_ksp,temp_mat,temp_mat,SAME_PRECONDITIONER);CHKERRQ(ierr); 2778 ierr = KSPSetType(temp_ksp,KSPPREONLY);CHKERRQ(ierr); 2779 ierr = KSPGetPC(temp_ksp,&temp_pc);CHKERRQ(ierr); 2780 ierr = PCSetType(temp_pc,PCLU);CHKERRQ(ierr); 2781 ierr = KSPSetUp(temp_ksp);CHKERRQ(ierr); 2782 for (s=0;s<temp_constraints;s++) { 2783 ierr = VecSet(temp_vec,0.0);CHKERRQ(ierr); 2784 ierr = VecSetValue(temp_vec,s+dual_dofs,1.0,INSERT_VALUES);CHKERRQ(ierr); 2785 ierr = VecAssemblyBegin(temp_vec);CHKERRQ(ierr); 2786 ierr = VecAssemblyEnd(temp_vec);CHKERRQ(ierr); 2787 ierr = KSPSolve(temp_ksp,temp_vec,temp_vec);CHKERRQ(ierr); 2788 ierr = VecGetArray(temp_vec,&array_vector);CHKERRQ(ierr); 2789 j = temp_indices_to_constraint_B[temp_indices[start_constraint+s]+size_of_constraint-s-1]; 2790 /* last columns of change of basis matrix associated to new primal dofs */ 2791 ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,&temp_indices_to_constraint_B[temp_indices[start_constraint+s]],1,&j,array_vector,INSERT_VALUES);CHKERRQ(ierr); 2792 ierr = VecRestoreArray(temp_vec,&array_vector);CHKERRQ(ierr); 2793 } 2794 ierr = MatDestroy(&temp_mat);CHKERRQ(ierr); 2795 ierr = KSPDestroy(&temp_ksp);CHKERRQ(ierr); 2796 ierr = VecDestroy(&temp_vec);CHKERRQ(ierr); 2797 } else { 2798 /* last columns of change of basis matrix associated to new primal dofs */ 2799 for (s=0;s<temp_constraints;s++) { 2800 j = temp_indices_to_constraint_B[temp_indices[start_constraint+s]+size_of_constraint-s-1]; 2801 ierr = MatSetValues(pcbddc->ChangeOfBasisMatrix,size_of_constraint,&temp_indices_to_constraint_B[temp_indices[start_constraint+s]],1,&j,&temp_quadrature_constraint[temp_indices[start_constraint+s]],INSERT_VALUES);CHKERRQ(ierr); 2802 } 2803 } 2804 /* prepare for the next cycle */ 2805 temp_constraints = 0; 2806 if (i != local_primal_size -1 ) { 2807 temp_start_ptr = temp_indices_to_constraint_B[temp_indices[i+1]]; 2808 } 2809 } 2810 } 2811 } 2812 /* assembling */ 2813 ierr = MatAssemblyBegin(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2814 ierr = MatAssemblyEnd(pcbddc->ChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2815 ierr = PetscFree(ipiv);CHKERRQ(ierr); 2816 ierr = PetscFree(is_indices);CHKERRQ(ierr); 2817 } 2818 /* free workspace no longer needed */ 2819 ierr = PetscFree(rwork);CHKERRQ(ierr); 2820 ierr = PetscFree(work);CHKERRQ(ierr); 2821 ierr = PetscFree(temp_basis);CHKERRQ(ierr); 2822 ierr = PetscFree(singular_vals);CHKERRQ(ierr); 2823 ierr = PetscFree(correlation_mat);CHKERRQ(ierr); 2824 ierr = PetscFree(temp_indices);CHKERRQ(ierr); 2825 ierr = PetscFree(change_basis);CHKERRQ(ierr); 2826 ierr = PetscFree(temp_indices_to_constraint);CHKERRQ(ierr); 2827 ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr); 2828 ierr = PetscFree(local_to_B);CHKERRQ(ierr); 2829 ierr = PetscFree(temp_quadrature_constraint);CHKERRQ(ierr); 2830 #if defined(PETSC_MISSING_LAPACK_GESVD) 2831 ierr = PetscFree(iwork);CHKERRQ(ierr); 2832 ierr = PetscFree(ifail);CHKERRQ(ierr); 2833 ierr = PetscFree(singular_vectors);CHKERRQ(ierr); 2834 #endif 2835 for (k=0;k<nnsp_size;k++) { 2836 ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr); 2837 } 2838 ierr = PetscFree(localnearnullsp);CHKERRQ(ierr); 2839 PetscFunctionReturn(0); 2840 } 2841 /* -------------------------------------------------------------------------- */ 2842 #undef __FUNCT__ 2843 #define __FUNCT__ "PCBDDCCoarseSetUp" 2844 static PetscErrorCode PCBDDCCoarseSetUp(PC pc) 2845 { 2846 PetscErrorCode ierr; 2847 2848 PC_IS* pcis = (PC_IS*)(pc->data); 2849 PC_BDDC* pcbddc = (PC_BDDC*)pc->data; 2850 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 2851 Mat change_mat_all; 2852 IS is_R_local; 2853 IS is_V_local; 2854 IS is_C_local; 2855 IS is_aux1; 2856 IS is_aux2; 2857 VecType impVecType; 2858 MatType impMatType; 2859 PetscInt n_R=0; 2860 PetscInt n_D=0; 2861 PetscInt n_B=0; 2862 PetscScalar zero=0.0; 2863 PetscScalar one=1.0; 2864 PetscScalar m_one=-1.0; 2865 PetscScalar* array; 2866 PetscScalar *coarse_submat_vals; 2867 PetscInt *idx_R_local; 2868 PetscInt *idx_V_B; 2869 PetscScalar *coarsefunctions_errors; 2870 PetscScalar *constraints_errors; 2871 /* auxiliary indices */ 2872 PetscInt i,j,k; 2873 /* for verbose output of bddc */ 2874 PetscViewer viewer=pcbddc->dbg_viewer; 2875 PetscBool dbg_flag=pcbddc->dbg_flag; 2876 /* for counting coarse dofs */ 2877 PetscInt n_vertices,n_constraints; 2878 PetscInt size_of_constraint; 2879 PetscInt *row_cmat_indices; 2880 PetscScalar *row_cmat_values; 2881 PetscInt *vertices,*nnz,*is_indices,*temp_indices; 2882 2883 PetscFunctionBegin; 2884 /* Set Non-overlapping dimensions */ 2885 n_B = pcis->n_B; n_D = pcis->n - n_B; 2886 /* Set types for local objects needed by BDDC precondtioner */ 2887 impMatType = MATSEQDENSE; 2888 impVecType = VECSEQ; 2889 /* get vertex indices from constraint matrix */ 2890 ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscInt),&vertices);CHKERRQ(ierr); 2891 n_vertices=0; 2892 for (i=0;i<pcbddc->local_primal_size;i++) { 2893 ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,PETSC_NULL);CHKERRQ(ierr); 2894 if (size_of_constraint == 1) { 2895 vertices[n_vertices]=row_cmat_indices[0]; 2896 n_vertices++; 2897 } 2898 ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,PETSC_NULL);CHKERRQ(ierr); 2899 } 2900 /* Set number of constraints */ 2901 n_constraints = pcbddc->local_primal_size-n_vertices; 2902 2903 /* vertices in boundary numbering */ 2904 if (n_vertices) { 2905 ierr = VecSet(pcis->vec1_N,m_one);CHKERRQ(ierr); 2906 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 2907 for (i=0; i<n_vertices; i++) { array[ vertices[i] ] = i; } 2908 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 2909 ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 2910 ierr = VecScatterEnd (pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 2911 ierr = PetscMalloc(n_vertices*sizeof(PetscInt),&idx_V_B);CHKERRQ(ierr); 2912 ierr = VecGetArray(pcis->vec1_B,&array);CHKERRQ(ierr); 2913 for (i=0; i<n_vertices; i++) { 2914 j=0; 2915 while (array[j] != i ) {j++;} 2916 idx_V_B[i]=j; 2917 } 2918 ierr = VecRestoreArray(pcis->vec1_B,&array);CHKERRQ(ierr); 2919 } 2920 2921 /* transform local matrices if needed */ 2922 if (pcbddc->usechangeofbasis) { 2923 ierr = PetscMalloc(pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr); 2924 ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 2925 for (i=0;i<n_D;i++) { 2926 nnz[is_indices[i]]=1; 2927 } 2928 ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 2929 ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 2930 k=1; 2931 for (i=0;i<n_B;i++) { 2932 ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr); 2933 nnz[is_indices[i]]=j; 2934 if ( k < j) { 2935 k = j; 2936 } 2937 ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr); 2938 } 2939 ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 2940 /* assemble change of basis matrix on the whole set of local dofs */ 2941 ierr = PetscMalloc(k*sizeof(PetscInt),&temp_indices);CHKERRQ(ierr); 2942 ierr = MatCreate(PETSC_COMM_SELF,&change_mat_all);CHKERRQ(ierr); 2943 ierr = MatSetSizes(change_mat_all,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr); 2944 ierr = MatSetType(change_mat_all,MATSEQAIJ);CHKERRQ(ierr); 2945 ierr = MatSeqAIJSetPreallocation(change_mat_all,0,nnz);CHKERRQ(ierr); 2946 ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 2947 for (i=0;i<n_D;i++) { 2948 ierr = MatSetValue(change_mat_all,is_indices[i],is_indices[i],1.0,INSERT_VALUES);CHKERRQ(ierr); 2949 } 2950 ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 2951 ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 2952 for (i=0;i<n_B;i++) { 2953 ierr = MatGetRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr); 2954 for (k=0;k<j;k++) { 2955 temp_indices[k]=is_indices[row_cmat_indices[k]]; 2956 } 2957 ierr = MatSetValues(change_mat_all,1,&is_indices[i],j,temp_indices,row_cmat_values,INSERT_VALUES);CHKERRQ(ierr); 2958 ierr = MatRestoreRow(pcbddc->ChangeOfBasisMatrix,i,&j,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr); 2959 } 2960 ierr = MatAssemblyBegin(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2961 ierr = MatAssemblyEnd(change_mat_all,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2962 ierr = MatPtAP(matis->A,change_mat_all,MAT_INITIAL_MATRIX,1.0,&pcbddc->local_mat);CHKERRQ(ierr); 2963 ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr); 2964 ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr); 2965 ierr = MatDestroy(&pcis->A_BB);CHKERRQ(ierr); 2966 ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&pcis->A_IB);CHKERRQ(ierr); 2967 ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&pcis->A_BI);CHKERRQ(ierr); 2968 ierr = MatGetSubMatrix(pcbddc->local_mat,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&pcis->A_BB);CHKERRQ(ierr); 2969 ierr = MatDestroy(&change_mat_all);CHKERRQ(ierr); 2970 ierr = PetscFree(nnz);CHKERRQ(ierr); 2971 ierr = PetscFree(temp_indices);CHKERRQ(ierr); 2972 } else { 2973 /* without change of basis, the local matrix is unchanged */ 2974 ierr = PetscObjectReference((PetscObject)matis->A);CHKERRQ(ierr); 2975 pcbddc->local_mat = matis->A; 2976 } 2977 /* Change global null space passed in by the user if change of basis has been performed */ 2978 if (pcbddc->NullSpace && pcbddc->usechangeofbasis) { 2979 ierr = PCBDDCAdaptNullSpace(pc);CHKERRQ(ierr); 2980 } 2981 2982 /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */ 2983 ierr = VecSet(pcis->vec1_N,one);CHKERRQ(ierr); 2984 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 2985 for (i=0;i<n_vertices;i++) { array[ vertices[i] ] = zero; } 2986 ierr = PetscMalloc(( pcis->n - n_vertices )*sizeof(PetscInt),&idx_R_local);CHKERRQ(ierr); 2987 for (i=0, n_R=0; i<pcis->n; i++) { if (array[i] == one) { idx_R_local[n_R] = i; n_R++; } } 2988 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 2989 if (dbg_flag) { 2990 ierr = PetscViewerASCIIPrintf(viewer,"--------------------------------------------------\n");CHKERRQ(ierr); 2991 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 2992 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr); 2993 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr); 2994 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"r_size = %d, v_size = %d, constraints = %d, local_primal_size = %d\n",n_R,n_vertices,n_constraints,pcbddc->local_primal_size);CHKERRQ(ierr); 2995 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr); 2996 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 2997 } 2998 2999 /* Allocate needed vectors */ 3000 ierr = VecDuplicate(pcis->vec1_global,&pcbddc->original_rhs);CHKERRQ(ierr); 3001 ierr = VecDuplicate(pcis->vec1_global,&pcbddc->temp_solution);CHKERRQ(ierr); 3002 ierr = VecDuplicate(pcis->vec1_D,&pcbddc->vec4_D);CHKERRQ(ierr); 3003 ierr = VecCreate(PETSC_COMM_SELF,&pcbddc->vec1_R);CHKERRQ(ierr); 3004 ierr = VecSetSizes(pcbddc->vec1_R,n_R,n_R);CHKERRQ(ierr); 3005 ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr); 3006 ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr); 3007 ierr = VecCreate(PETSC_COMM_SELF,&pcbddc->vec1_P);CHKERRQ(ierr); 3008 ierr = VecSetSizes(pcbddc->vec1_P,pcbddc->local_primal_size,pcbddc->local_primal_size);CHKERRQ(ierr); 3009 ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr); 3010 3011 /* Creating some index sets needed */ 3012 /* For submatrices */ 3013 ierr = ISCreateGeneral(PETSC_COMM_SELF,n_R,idx_R_local,PETSC_OWN_POINTER,&is_R_local);CHKERRQ(ierr); 3014 if (n_vertices) { 3015 ierr = ISCreateGeneral(PETSC_COMM_SELF,n_vertices,vertices,PETSC_OWN_POINTER,&is_V_local);CHKERRQ(ierr); 3016 } 3017 if (n_constraints) { 3018 ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_C_local);CHKERRQ(ierr); 3019 } 3020 3021 /* For VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */ 3022 { 3023 PetscInt *aux_array1; 3024 PetscInt *aux_array2; 3025 PetscInt *idx_I_local; 3026 3027 ierr = PetscMalloc( (pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr); 3028 ierr = PetscMalloc( (pcis->n_B-n_vertices)*sizeof(PetscInt),&aux_array2);CHKERRQ(ierr); 3029 3030 ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&idx_I_local);CHKERRQ(ierr); 3031 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3032 for (i=0; i<n_D; i++) { array[idx_I_local[i]] = 0; } 3033 ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&idx_I_local);CHKERRQ(ierr); 3034 for (i=0, j=0; i<n_R; i++) { if ( array[idx_R_local[i]] == one ) { aux_array1[j] = i; j++; } } 3035 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3036 ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_COPY_VALUES,&is_aux1);CHKERRQ(ierr); 3037 ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3038 ierr = VecScatterEnd (pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3039 ierr = VecGetArray(pcis->vec1_B,&array);CHKERRQ(ierr); 3040 for (i=0, j=0; i<n_B; i++) { if ( array[i] == one ) { aux_array2[j] = i; j++; } } 3041 ierr = VecRestoreArray(pcis->vec1_B,&array);CHKERRQ(ierr); 3042 ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_COPY_VALUES,&is_aux2);CHKERRQ(ierr); 3043 ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr); 3044 ierr = PetscFree(aux_array1);CHKERRQ(ierr); 3045 ierr = PetscFree(aux_array2);CHKERRQ(ierr); 3046 ierr = ISDestroy(&is_aux1);CHKERRQ(ierr); 3047 ierr = ISDestroy(&is_aux2);CHKERRQ(ierr); 3048 3049 if (pcbddc->prec_type || dbg_flag ) { 3050 ierr = PetscMalloc(n_D*sizeof(PetscInt),&aux_array1);CHKERRQ(ierr); 3051 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3052 for (i=0, j=0; i<n_R; i++) { if (array[idx_R_local[i]] == zero) { aux_array1[j] = i; j++; } } 3053 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3054 ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_COPY_VALUES,&is_aux1);CHKERRQ(ierr); 3055 ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr); 3056 ierr = PetscFree(aux_array1);CHKERRQ(ierr); 3057 ierr = ISDestroy(&is_aux1);CHKERRQ(ierr); 3058 } 3059 } 3060 3061 /* Creating PC contexts for local Dirichlet and Neumann problems */ 3062 { 3063 Mat A_RR; 3064 PC pc_temp; 3065 /* Matrix for Dirichlet problem is A_II -> we already have it from pcis.c code */ 3066 ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr); 3067 ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr); 3068 ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II,SAME_PRECONDITIONER);CHKERRQ(ierr); 3069 ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr); 3070 ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,"dirichlet_");CHKERRQ(ierr); 3071 /* default */ 3072 ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr); 3073 ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr); 3074 /* Allow user's customization */ 3075 ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr); 3076 /* umfpack interface has a bug when matrix dimension is zero */ 3077 if (!n_D) { 3078 ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr); 3079 } 3080 /* Set Up KSP for Dirichlet problem of BDDC */ 3081 ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr); 3082 /* set ksp_D into pcis data */ 3083 ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr); 3084 ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr); 3085 pcis->ksp_D = pcbddc->ksp_D; 3086 /* Matrix for Neumann problem is A_RR -> we need to create it */ 3087 ierr = MatGetSubMatrix(pcbddc->local_mat,is_R_local,is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr); 3088 ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr); 3089 ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr); 3090 ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR,SAME_PRECONDITIONER);CHKERRQ(ierr); 3091 ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr); 3092 ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,"neumann_");CHKERRQ(ierr); 3093 /* default */ 3094 ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr); 3095 ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr); 3096 /* Allow user's customization */ 3097 ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr); 3098 /* umfpack interface has a bug when matrix dimension is zero */ 3099 if (!pcis->n) { 3100 ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr); 3101 } 3102 /* Set Up KSP for Neumann problem of BDDC */ 3103 ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr); 3104 /* check Dirichlet and Neumann solvers */ 3105 { 3106 Vec temp_vec; 3107 PetscReal value; 3108 PetscMPIInt use_exact,use_exact_reduced; 3109 3110 ierr = VecDuplicate(pcis->vec1_D,&temp_vec);CHKERRQ(ierr); 3111 ierr = VecSetRandom(pcis->vec1_D,PETSC_NULL);CHKERRQ(ierr); 3112 ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr); 3113 ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,temp_vec);CHKERRQ(ierr); 3114 ierr = VecAXPY(temp_vec,m_one,pcis->vec1_D);CHKERRQ(ierr); 3115 ierr = VecNorm(temp_vec,NORM_INFINITY,&value);CHKERRQ(ierr); 3116 use_exact = 1; 3117 if (PetscAbsReal(value) > 1.e-4) { 3118 use_exact = 0; 3119 } 3120 ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_INT,MPI_LAND,((PetscObject)pc)->comm);CHKERRQ(ierr); 3121 pcbddc->use_exact_dirichlet = (PetscBool) use_exact_reduced; 3122 ierr = VecDestroy(&temp_vec);CHKERRQ(ierr); 3123 if (dbg_flag) { 3124 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3125 ierr = PetscViewerASCIIPrintf(viewer,"--------------------------------------------------\n");CHKERRQ(ierr); 3126 ierr = PetscViewerASCIIPrintf(viewer,"Checking solution of Dirichlet and Neumann problems\n");CHKERRQ(ierr); 3127 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d infinity error for Dirichlet solve = % 1.14e \n",PetscGlobalRank,value);CHKERRQ(ierr); 3128 ierr = VecDuplicate(pcbddc->vec1_R,&temp_vec);CHKERRQ(ierr); 3129 ierr = VecSetRandom(pcbddc->vec1_R,PETSC_NULL);CHKERRQ(ierr); 3130 ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr); 3131 ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,temp_vec);CHKERRQ(ierr); 3132 ierr = VecAXPY(temp_vec,m_one,pcbddc->vec1_R);CHKERRQ(ierr); 3133 ierr = VecNorm(temp_vec,NORM_INFINITY,&value);CHKERRQ(ierr); 3134 ierr = VecDestroy(&temp_vec);CHKERRQ(ierr); 3135 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d infinity error for Neumann solve = % 1.14e \n",PetscGlobalRank,value);CHKERRQ(ierr); 3136 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3137 } 3138 } 3139 /* free Neumann problem's matrix */ 3140 ierr = MatDestroy(&A_RR);CHKERRQ(ierr); 3141 } 3142 3143 /* Assemble all remaining stuff needed to apply BDDC */ 3144 { 3145 Mat A_RV,A_VR,A_VV; 3146 Mat M1; 3147 Mat C_CR; 3148 Mat AUXMAT; 3149 Vec vec1_C; 3150 Vec vec2_C; 3151 Vec vec1_V; 3152 Vec vec2_V; 3153 PetscInt *nnz; 3154 PetscInt *auxindices; 3155 PetscInt index; 3156 PetscScalar* array2; 3157 MatFactorInfo matinfo; 3158 3159 /* Allocating some extra storage just to be safe */ 3160 ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&nnz);CHKERRQ(ierr); 3161 ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&auxindices);CHKERRQ(ierr); 3162 for (i=0;i<pcis->n;i++) {auxindices[i]=i;} 3163 3164 /* some work vectors on vertices and/or constraints */ 3165 if (n_vertices) { 3166 ierr = VecCreate(PETSC_COMM_SELF,&vec1_V);CHKERRQ(ierr); 3167 ierr = VecSetSizes(vec1_V,n_vertices,n_vertices);CHKERRQ(ierr); 3168 ierr = VecSetType(vec1_V,impVecType);CHKERRQ(ierr); 3169 ierr = VecDuplicate(vec1_V,&vec2_V);CHKERRQ(ierr); 3170 } 3171 if (n_constraints) { 3172 ierr = VecCreate(PETSC_COMM_SELF,&vec1_C);CHKERRQ(ierr); 3173 ierr = VecSetSizes(vec1_C,n_constraints,n_constraints);CHKERRQ(ierr); 3174 ierr = VecSetType(vec1_C,impVecType);CHKERRQ(ierr); 3175 ierr = VecDuplicate(vec1_C,&vec2_C);CHKERRQ(ierr); 3176 ierr = VecDuplicate(vec1_C,&pcbddc->vec1_C);CHKERRQ(ierr); 3177 } 3178 /* Precompute stuffs needed for preprocessing and application of BDDC*/ 3179 if (n_constraints) { 3180 ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->local_auxmat2);CHKERRQ(ierr); 3181 ierr = MatSetSizes(pcbddc->local_auxmat2,n_R,n_constraints,n_R,n_constraints);CHKERRQ(ierr); 3182 ierr = MatSetType(pcbddc->local_auxmat2,impMatType);CHKERRQ(ierr); 3183 ierr = MatSeqDenseSetPreallocation(pcbddc->local_auxmat2,PETSC_NULL);CHKERRQ(ierr); 3184 3185 /* Create Constraint matrix on R nodes: C_{CR} */ 3186 ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_C_local,is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr); 3187 ierr = ISDestroy(&is_C_local);CHKERRQ(ierr); 3188 3189 /* Assemble local_auxmat2 = - A_{RR}^{-1} C^T_{CR} needed by BDDC application */ 3190 for (i=0;i<n_constraints;i++) { 3191 ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr); 3192 /* Get row of constraint matrix in R numbering */ 3193 ierr = VecGetArray(pcbddc->vec1_R,&array);CHKERRQ(ierr); 3194 ierr = MatGetRow(C_CR,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr); 3195 for (j=0;j<size_of_constraint;j++) { array[ row_cmat_indices[j] ] = - row_cmat_values[j]; } 3196 ierr = MatRestoreRow(C_CR,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,(const PetscScalar**)&row_cmat_values);CHKERRQ(ierr); 3197 ierr = VecRestoreArray(pcbddc->vec1_R,&array);CHKERRQ(ierr); 3198 /* Solve for row of constraint matrix in R numbering */ 3199 ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr); 3200 /* Set values */ 3201 ierr = VecGetArray(pcbddc->vec2_R,&array);CHKERRQ(ierr); 3202 ierr = MatSetValues(pcbddc->local_auxmat2,n_R,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr); 3203 ierr = VecRestoreArray(pcbddc->vec2_R,&array);CHKERRQ(ierr); 3204 } 3205 ierr = MatAssemblyBegin(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3206 ierr = MatAssemblyEnd(pcbddc->local_auxmat2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3207 3208 /* Assemble AUXMAT = ( LUFactor )( -C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1} */ 3209 ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&AUXMAT);CHKERRQ(ierr); 3210 ierr = MatFactorInfoInitialize(&matinfo);CHKERRQ(ierr); 3211 ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,0,1,&is_aux1);CHKERRQ(ierr); 3212 ierr = MatLUFactor(AUXMAT,is_aux1,is_aux1,&matinfo);CHKERRQ(ierr); 3213 ierr = ISDestroy(&is_aux1);CHKERRQ(ierr); 3214 3215 /* Assemble explicitly M1 = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1} needed in preproc */ 3216 ierr = MatCreate(PETSC_COMM_SELF,&M1);CHKERRQ(ierr); 3217 ierr = MatSetSizes(M1,n_constraints,n_constraints,n_constraints,n_constraints);CHKERRQ(ierr); 3218 ierr = MatSetType(M1,impMatType);CHKERRQ(ierr); 3219 ierr = MatSeqDenseSetPreallocation(M1,PETSC_NULL);CHKERRQ(ierr); 3220 for (i=0;i<n_constraints;i++) { 3221 ierr = VecSet(vec1_C,zero);CHKERRQ(ierr); 3222 ierr = VecSetValue(vec1_C,i,one,INSERT_VALUES);CHKERRQ(ierr); 3223 ierr = VecAssemblyBegin(vec1_C);CHKERRQ(ierr); 3224 ierr = VecAssemblyEnd(vec1_C);CHKERRQ(ierr); 3225 ierr = MatSolve(AUXMAT,vec1_C,vec2_C);CHKERRQ(ierr); 3226 ierr = VecScale(vec2_C,m_one);CHKERRQ(ierr); 3227 ierr = VecGetArray(vec2_C,&array);CHKERRQ(ierr); 3228 ierr = MatSetValues(M1,n_constraints,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr); 3229 ierr = VecRestoreArray(vec2_C,&array);CHKERRQ(ierr); 3230 } 3231 ierr = MatAssemblyBegin(M1,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3232 ierr = MatAssemblyEnd(M1,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3233 ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr); 3234 /* Assemble local_auxmat1 = M1*C_{CR} needed by BDDC application in KSP and in preproc */ 3235 ierr = MatMatMult(M1,C_CR,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr); 3236 3237 } 3238 3239 /* Get submatrices from subdomain matrix */ 3240 if (n_vertices){ 3241 ierr = MatGetSubMatrix(pcbddc->local_mat,is_R_local,is_V_local,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr); 3242 ierr = MatGetSubMatrix(pcbddc->local_mat,is_V_local,is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr); 3243 ierr = MatGetSubMatrix(pcbddc->local_mat,is_V_local,is_V_local,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr); 3244 } 3245 3246 /* Matrix of coarse basis functions (local) */ 3247 ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_B);CHKERRQ(ierr); 3248 ierr = MatSetSizes(pcbddc->coarse_phi_B,n_B,pcbddc->local_primal_size,n_B,pcbddc->local_primal_size);CHKERRQ(ierr); 3249 ierr = MatSetType(pcbddc->coarse_phi_B,impMatType);CHKERRQ(ierr); 3250 ierr = MatSeqDenseSetPreallocation(pcbddc->coarse_phi_B,PETSC_NULL);CHKERRQ(ierr); 3251 if (pcbddc->prec_type || dbg_flag ) { 3252 ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->coarse_phi_D);CHKERRQ(ierr); 3253 ierr = MatSetSizes(pcbddc->coarse_phi_D,n_D,pcbddc->local_primal_size,n_D,pcbddc->local_primal_size);CHKERRQ(ierr); 3254 ierr = MatSetType(pcbddc->coarse_phi_D,impMatType);CHKERRQ(ierr); 3255 ierr = MatSeqDenseSetPreallocation(pcbddc->coarse_phi_D,PETSC_NULL);CHKERRQ(ierr); 3256 } 3257 3258 if (dbg_flag) { 3259 ierr = PetscMalloc( pcbddc->local_primal_size*sizeof(PetscScalar),&coarsefunctions_errors);CHKERRQ(ierr); 3260 ierr = PetscMalloc( pcbddc->local_primal_size*sizeof(PetscScalar),&constraints_errors);CHKERRQ(ierr); 3261 } 3262 /* Subdomain contribution (Non-overlapping) to coarse matrix */ 3263 ierr = PetscMalloc ((pcbddc->local_primal_size)*(pcbddc->local_primal_size)*sizeof(PetscScalar),&coarse_submat_vals);CHKERRQ(ierr); 3264 3265 /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */ 3266 for (i=0;i<n_vertices;i++){ 3267 ierr = VecSet(vec1_V,zero);CHKERRQ(ierr); 3268 ierr = VecSetValue(vec1_V,i,one,INSERT_VALUES);CHKERRQ(ierr); 3269 ierr = VecAssemblyBegin(vec1_V);CHKERRQ(ierr); 3270 ierr = VecAssemblyEnd(vec1_V);CHKERRQ(ierr); 3271 /* solution of saddle point problem */ 3272 ierr = MatMult(A_RV,vec1_V,pcbddc->vec1_R);CHKERRQ(ierr); 3273 ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr); 3274 ierr = VecScale(pcbddc->vec1_R,m_one);CHKERRQ(ierr); 3275 if (n_constraints) { 3276 ierr = MatMult(pcbddc->local_auxmat1,pcbddc->vec1_R,vec1_C);CHKERRQ(ierr); 3277 ierr = MatMultAdd(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr); 3278 ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr); 3279 } 3280 ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr); 3281 ierr = MatMultAdd(A_VV,vec1_V,vec2_V,vec2_V);CHKERRQ(ierr); 3282 3283 /* Set values in coarse basis function and subdomain part of coarse_mat */ 3284 /* coarse basis functions */ 3285 ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr); 3286 ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3287 ierr = VecScatterEnd (pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3288 ierr = VecGetArray(pcis->vec1_B,&array);CHKERRQ(ierr); 3289 ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr); 3290 ierr = VecRestoreArray(pcis->vec1_B,&array);CHKERRQ(ierr); 3291 ierr = MatSetValue(pcbddc->coarse_phi_B,idx_V_B[i],i,one,INSERT_VALUES);CHKERRQ(ierr); 3292 if ( pcbddc->prec_type || dbg_flag ) { 3293 ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3294 ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3295 ierr = VecGetArray(pcis->vec1_D,&array);CHKERRQ(ierr); 3296 ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&i,array,INSERT_VALUES);CHKERRQ(ierr); 3297 ierr = VecRestoreArray(pcis->vec1_D,&array);CHKERRQ(ierr); 3298 } 3299 /* subdomain contribution to coarse matrix */ 3300 ierr = VecGetArray(vec2_V,&array);CHKERRQ(ierr); 3301 for (j=0;j<n_vertices;j++) { coarse_submat_vals[i*pcbddc->local_primal_size+j] = array[j]; } /* WARNING -> column major ordering */ 3302 ierr = VecRestoreArray(vec2_V,&array);CHKERRQ(ierr); 3303 if (n_constraints) { 3304 ierr = VecGetArray(vec1_C,&array);CHKERRQ(ierr); 3305 for (j=0;j<n_constraints;j++) { coarse_submat_vals[i*pcbddc->local_primal_size+j+n_vertices] = array[j]; } /* WARNING -> column major ordering */ 3306 ierr = VecRestoreArray(vec1_C,&array);CHKERRQ(ierr); 3307 } 3308 3309 if ( dbg_flag ) { 3310 /* assemble subdomain vector on nodes */ 3311 ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr); 3312 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3313 ierr = VecGetArray(pcbddc->vec1_R,&array2);CHKERRQ(ierr); 3314 for (j=0;j<n_R;j++) { array[idx_R_local[j]] = array2[j]; } 3315 array[ vertices[i] ] = one; 3316 ierr = VecRestoreArray(pcbddc->vec1_R,&array2);CHKERRQ(ierr); 3317 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3318 /* assemble subdomain vector of lagrange multipliers (i.e. primal nodes) */ 3319 ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr); 3320 ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr); 3321 ierr = VecGetArray(vec2_V,&array);CHKERRQ(ierr); 3322 for (j=0;j<n_vertices;j++) { array2[j]=array[j]; } 3323 ierr = VecRestoreArray(vec2_V,&array);CHKERRQ(ierr); 3324 if (n_constraints) { 3325 ierr = VecGetArray(vec1_C,&array);CHKERRQ(ierr); 3326 for (j=0;j<n_constraints;j++) { array2[j+n_vertices]=array[j]; } 3327 ierr = VecRestoreArray(vec1_C,&array);CHKERRQ(ierr); 3328 } 3329 ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr); 3330 ierr = VecScale(pcbddc->vec1_P,m_one);CHKERRQ(ierr); 3331 /* check saddle point solution */ 3332 ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr); 3333 ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr); 3334 ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[i]);CHKERRQ(ierr); 3335 ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr); 3336 ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr); 3337 array[i]=array[i]+m_one; /* shift by the identity matrix */ 3338 ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr); 3339 ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[i]);CHKERRQ(ierr); 3340 } 3341 } 3342 3343 for (i=0;i<n_constraints;i++){ 3344 ierr = VecSet(vec2_C,zero);CHKERRQ(ierr); 3345 ierr = VecSetValue(vec2_C,i,m_one,INSERT_VALUES);CHKERRQ(ierr); 3346 ierr = VecAssemblyBegin(vec2_C);CHKERRQ(ierr); 3347 ierr = VecAssemblyEnd(vec2_C);CHKERRQ(ierr); 3348 /* solution of saddle point problem */ 3349 ierr = MatMult(M1,vec2_C,vec1_C);CHKERRQ(ierr); 3350 ierr = MatMult(pcbddc->local_auxmat2,vec1_C,pcbddc->vec1_R);CHKERRQ(ierr); 3351 ierr = VecScale(vec1_C,m_one);CHKERRQ(ierr); 3352 if (n_vertices) { ierr = MatMult(A_VR,pcbddc->vec1_R,vec2_V);CHKERRQ(ierr); } 3353 /* Set values in coarse basis function and subdomain part of coarse_mat */ 3354 /* coarse basis functions */ 3355 index=i+n_vertices; 3356 ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr); 3357 ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3358 ierr = VecScatterEnd (pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3359 ierr = VecGetArray(pcis->vec1_B,&array);CHKERRQ(ierr); 3360 ierr = MatSetValues(pcbddc->coarse_phi_B,n_B,auxindices,1,&index,array,INSERT_VALUES);CHKERRQ(ierr); 3361 ierr = VecRestoreArray(pcis->vec1_B,&array);CHKERRQ(ierr); 3362 if ( pcbddc->prec_type || dbg_flag ) { 3363 ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3364 ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3365 ierr = VecGetArray(pcis->vec1_D,&array);CHKERRQ(ierr); 3366 ierr = MatSetValues(pcbddc->coarse_phi_D,n_D,auxindices,1,&index,array,INSERT_VALUES);CHKERRQ(ierr); 3367 ierr = VecRestoreArray(pcis->vec1_D,&array);CHKERRQ(ierr); 3368 } 3369 /* subdomain contribution to coarse matrix */ 3370 if (n_vertices) { 3371 ierr = VecGetArray(vec2_V,&array);CHKERRQ(ierr); 3372 for (j=0;j<n_vertices;j++) {coarse_submat_vals[index*pcbddc->local_primal_size+j]=array[j];} /* WARNING -> column major ordering */ 3373 ierr = VecRestoreArray(vec2_V,&array);CHKERRQ(ierr); 3374 } 3375 ierr = VecGetArray(vec1_C,&array);CHKERRQ(ierr); 3376 for (j=0;j<n_constraints;j++) {coarse_submat_vals[index*pcbddc->local_primal_size+j+n_vertices]=array[j];} /* WARNING -> column major ordering */ 3377 ierr = VecRestoreArray(vec1_C,&array);CHKERRQ(ierr); 3378 3379 if ( dbg_flag ) { 3380 /* assemble subdomain vector on nodes */ 3381 ierr = VecSet(pcis->vec1_N,zero);CHKERRQ(ierr); 3382 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3383 ierr = VecGetArray(pcbddc->vec1_R,&array2);CHKERRQ(ierr); 3384 for (j=0;j<n_R;j++){ array[ idx_R_local[j] ] = array2[j]; } 3385 ierr = VecRestoreArray(pcbddc->vec1_R,&array2);CHKERRQ(ierr); 3386 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3387 /* assemble subdomain vector of lagrange multipliers */ 3388 ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr); 3389 ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr); 3390 if ( n_vertices) { 3391 ierr = VecGetArray(vec2_V,&array);CHKERRQ(ierr); 3392 for (j=0;j<n_vertices;j++) {array2[j]=-array[j];} 3393 ierr = VecRestoreArray(vec2_V,&array);CHKERRQ(ierr); 3394 } 3395 ierr = VecGetArray(vec1_C,&array);CHKERRQ(ierr); 3396 for (j=0;j<n_constraints;j++) {array2[j+n_vertices]=-array[j];} 3397 ierr = VecRestoreArray(vec1_C,&array);CHKERRQ(ierr); 3398 ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr); 3399 /* check saddle point solution */ 3400 ierr = MatMult(pcbddc->local_mat,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr); 3401 ierr = MatMultTransposeAdd(pcbddc->ConstraintMatrix,pcbddc->vec1_P,pcis->vec2_N,pcis->vec2_N);CHKERRQ(ierr); 3402 ierr = VecNorm(pcis->vec2_N,NORM_INFINITY,&coarsefunctions_errors[index]);CHKERRQ(ierr); 3403 ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr); 3404 ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr); 3405 array[index]=array[index]+m_one; /* shift by the identity matrix */ 3406 ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr); 3407 ierr = VecNorm(pcbddc->vec1_P,NORM_INFINITY,&constraints_errors[index]);CHKERRQ(ierr); 3408 } 3409 } 3410 ierr = MatAssemblyBegin(pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3411 ierr = MatAssemblyEnd (pcbddc->coarse_phi_B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3412 if ( pcbddc->prec_type || dbg_flag ) { 3413 ierr = MatAssemblyBegin(pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3414 ierr = MatAssemblyEnd (pcbddc->coarse_phi_D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3415 } 3416 /* Checking coarse_sub_mat and coarse basis functios */ 3417 /* It shuld be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */ 3418 if (dbg_flag) { 3419 Mat coarse_sub_mat; 3420 Mat TM1,TM2,TM3,TM4; 3421 Mat coarse_phi_D,coarse_phi_B,A_II,A_BB,A_IB,A_BI; 3422 MatType checkmattype=MATSEQAIJ; 3423 PetscScalar value; 3424 3425 ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr); 3426 ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr); 3427 ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr); 3428 ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr); 3429 ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr); 3430 ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr); 3431 ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr); 3432 ierr = MatConvert(coarse_sub_mat,checkmattype,MAT_REUSE_MATRIX,&coarse_sub_mat);CHKERRQ(ierr); 3433 3434 /*PetscViewer view_out; 3435 PetscMPIInt myrank; 3436 char filename[256]; 3437 MPI_Comm_rank(((PetscObject)pc)->comm,&myrank); 3438 sprintf(filename,"coarsesubmat_%04d.m",myrank); 3439 ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&view_out);CHKERRQ(ierr); 3440 ierr = PetscViewerSetFormat(view_out,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr); 3441 ierr = MatView(coarse_sub_mat,view_out);CHKERRQ(ierr); 3442 ierr = PetscViewerDestroy(&view_out);CHKERRQ(ierr);*/ 3443 3444 ierr = PetscViewerASCIIPrintf(viewer,"--------------------------------------------------\n");CHKERRQ(ierr); 3445 ierr = PetscViewerASCIIPrintf(viewer,"Check coarse sub mat and local basis functions\n");CHKERRQ(ierr); 3446 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3447 ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr); 3448 ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr); 3449 ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr); 3450 ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr); 3451 ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr); 3452 ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr); 3453 ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr); 3454 ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr); 3455 ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); 3456 ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); 3457 ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); 3458 ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); 3459 ierr = MatNorm(TM1,NORM_INFINITY,&value);CHKERRQ(ierr); 3460 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"----------------------------------\n");CHKERRQ(ierr); 3461 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d \n",PetscGlobalRank);CHKERRQ(ierr); 3462 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"matrix error = % 1.14e\n",value);CHKERRQ(ierr); 3463 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"coarse functions errors\n");CHKERRQ(ierr); 3464 for (i=0;i<pcbddc->local_primal_size;i++) { ierr = PetscViewerASCIISynchronizedPrintf(viewer,"local %02d-th function error = % 1.14e\n",i,coarsefunctions_errors[i]);CHKERRQ(ierr); } 3465 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"constraints errors\n");CHKERRQ(ierr); 3466 for (i=0;i<pcbddc->local_primal_size;i++) { ierr = PetscViewerASCIISynchronizedPrintf(viewer,"local %02d-th function error = % 1.14e\n",i,constraints_errors[i]);CHKERRQ(ierr); } 3467 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3468 ierr = MatDestroy(&A_II);CHKERRQ(ierr); 3469 ierr = MatDestroy(&A_BB);CHKERRQ(ierr); 3470 ierr = MatDestroy(&A_IB);CHKERRQ(ierr); 3471 ierr = MatDestroy(&A_BI);CHKERRQ(ierr); 3472 ierr = MatDestroy(&TM1);CHKERRQ(ierr); 3473 ierr = MatDestroy(&TM2);CHKERRQ(ierr); 3474 ierr = MatDestroy(&TM3);CHKERRQ(ierr); 3475 ierr = MatDestroy(&TM4);CHKERRQ(ierr); 3476 ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr); 3477 ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr); 3478 ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr); 3479 ierr = PetscFree(coarsefunctions_errors);CHKERRQ(ierr); 3480 ierr = PetscFree(constraints_errors);CHKERRQ(ierr); 3481 } 3482 3483 /* create coarse matrix and data structures for message passing associated actual choice of coarse problem type */ 3484 ierr = PCBDDCSetupCoarseEnvironment(pc,coarse_submat_vals);CHKERRQ(ierr); 3485 /* free memory */ 3486 ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr); 3487 ierr = PetscFree(auxindices);CHKERRQ(ierr); 3488 ierr = PetscFree(nnz);CHKERRQ(ierr); 3489 if (n_vertices) { 3490 ierr = VecDestroy(&vec1_V);CHKERRQ(ierr); 3491 ierr = VecDestroy(&vec2_V);CHKERRQ(ierr); 3492 ierr = MatDestroy(&A_RV);CHKERRQ(ierr); 3493 ierr = MatDestroy(&A_VR);CHKERRQ(ierr); 3494 ierr = MatDestroy(&A_VV);CHKERRQ(ierr); 3495 } 3496 if (n_constraints) { 3497 ierr = VecDestroy(&vec1_C);CHKERRQ(ierr); 3498 ierr = VecDestroy(&vec2_C);CHKERRQ(ierr); 3499 ierr = MatDestroy(&M1);CHKERRQ(ierr); 3500 ierr = MatDestroy(&C_CR);CHKERRQ(ierr); 3501 } 3502 } 3503 /* free memory */ 3504 if (n_vertices) { 3505 ierr = PetscFree(idx_V_B);CHKERRQ(ierr); 3506 ierr = ISDestroy(&is_V_local);CHKERRQ(ierr); 3507 } 3508 ierr = ISDestroy(&is_R_local);CHKERRQ(ierr); 3509 3510 PetscFunctionReturn(0); 3511 } 3512 3513 /* -------------------------------------------------------------------------- */ 3514 3515 #undef __FUNCT__ 3516 #define __FUNCT__ "PCBDDCSetupCoarseEnvironment" 3517 static PetscErrorCode PCBDDCSetupCoarseEnvironment(PC pc,PetscScalar* coarse_submat_vals) 3518 { 3519 3520 3521 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 3522 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 3523 PC_IS *pcis = (PC_IS*)pc->data; 3524 MPI_Comm prec_comm = ((PetscObject)pc)->comm; 3525 MPI_Comm coarse_comm; 3526 3527 /* common to all choiches */ 3528 PetscScalar *temp_coarse_mat_vals; 3529 PetscScalar *ins_coarse_mat_vals; 3530 PetscInt *ins_local_primal_indices; 3531 PetscMPIInt *localsizes2,*localdispl2; 3532 PetscMPIInt size_prec_comm; 3533 PetscMPIInt rank_prec_comm; 3534 PetscMPIInt active_rank=MPI_PROC_NULL; 3535 PetscMPIInt master_proc=0; 3536 PetscInt ins_local_primal_size; 3537 /* specific to MULTILEVEL_BDDC */ 3538 PetscMPIInt *ranks_recv; 3539 PetscMPIInt count_recv=0; 3540 PetscMPIInt rank_coarse_proc_send_to; 3541 PetscMPIInt coarse_color = MPI_UNDEFINED; 3542 ISLocalToGlobalMapping coarse_ISLG; 3543 /* some other variables */ 3544 PetscErrorCode ierr; 3545 MatType coarse_mat_type; 3546 PCType coarse_pc_type; 3547 KSPType coarse_ksp_type; 3548 PC pc_temp; 3549 PetscInt i,j,k; 3550 PetscInt max_it_coarse_ksp=1; /* don't increase this value */ 3551 /* verbose output viewer */ 3552 PetscViewer viewer=pcbddc->dbg_viewer; 3553 PetscBool dbg_flag=pcbddc->dbg_flag; 3554 3555 PetscInt offset,offset2; 3556 PetscMPIInt im_active=0; 3557 PetscMPIInt *auxglobal_primal; 3558 PetscInt *dnz,*onz; 3559 3560 PetscBool setsym,issym=PETSC_FALSE; 3561 3562 PetscFunctionBegin; 3563 ins_local_primal_indices = 0; 3564 ins_coarse_mat_vals = 0; 3565 localsizes2 = 0; 3566 localdispl2 = 0; 3567 temp_coarse_mat_vals = 0; 3568 coarse_ISLG = 0; 3569 3570 ierr = MPI_Comm_size(prec_comm,&size_prec_comm);CHKERRQ(ierr); 3571 ierr = MPI_Comm_rank(prec_comm,&rank_prec_comm);CHKERRQ(ierr); 3572 ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr); 3573 3574 /* Assign global numbering to coarse dofs */ 3575 { 3576 PetscMPIInt *auxlocal_primal; 3577 PetscMPIInt *all_auxglobal_primal; 3578 PetscMPIInt mpi_local_primal_size = (PetscMPIInt)pcbddc->local_primal_size; 3579 PetscInt *row_cmat_indices; 3580 PetscInt *aux_ordering; 3581 PetscInt *row_cmat_global_indices; 3582 PetscInt size_of_constraint; 3583 PetscBool *array_bool; 3584 3585 /* Construct needed data structures for message passing */ 3586 ierr = PetscMalloc(mpi_local_primal_size*sizeof(PetscMPIInt),&pcbddc->local_primal_indices);CHKERRQ(ierr); 3587 j = 0; 3588 if (rank_prec_comm == 0 || pcbddc->coarse_problem_type == REPLICATED_BDDC || pcbddc->coarse_problem_type == MULTILEVEL_BDDC) { 3589 j = size_prec_comm; 3590 } 3591 ierr = PetscMalloc(j*sizeof(PetscMPIInt),&pcbddc->local_primal_sizes);CHKERRQ(ierr); 3592 ierr = PetscMalloc(j*sizeof(PetscMPIInt),&pcbddc->local_primal_displacements);CHKERRQ(ierr); 3593 /* Gather local_primal_size information for all processes */ 3594 if (pcbddc->coarse_problem_type == REPLICATED_BDDC || pcbddc->coarse_problem_type == MULTILEVEL_BDDC) { 3595 ierr = MPI_Allgather(&mpi_local_primal_size,1,MPIU_INT,&pcbddc->local_primal_sizes[0],1,MPIU_INT,prec_comm);CHKERRQ(ierr); 3596 } else { 3597 ierr = MPI_Gather(&mpi_local_primal_size,1,MPIU_INT,&pcbddc->local_primal_sizes[0],1,MPIU_INT,0,prec_comm);CHKERRQ(ierr); 3598 } 3599 pcbddc->replicated_primal_size = 0; 3600 for (i=0; i<j; i++) { 3601 pcbddc->local_primal_displacements[i] = pcbddc->replicated_primal_size ; 3602 pcbddc->replicated_primal_size += pcbddc->local_primal_sizes[i]; 3603 } 3604 if (rank_prec_comm == 0) { 3605 /* allocate some auxiliary space */ 3606 ierr = PetscMalloc(pcbddc->replicated_primal_size*sizeof(*all_auxglobal_primal),&all_auxglobal_primal);CHKERRQ(ierr); 3607 } 3608 ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscMPIInt),&auxlocal_primal);CHKERRQ(ierr); 3609 ierr = PetscMalloc(pcbddc->local_primal_size*sizeof(PetscMPIInt),&auxglobal_primal);CHKERRQ(ierr); 3610 3611 /* First let's count coarse dofs. 3612 This code fragment assumes that the number of local constraints per connected component 3613 is not greater than the number of nodes defined for the connected component 3614 (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */ 3615 /* auxlocal_primal : primal indices in local nodes numbering (internal and interface) with complete queue sorted by global ordering */ 3616 j = 0; 3617 for (i=0;i<pcbddc->local_primal_size;i++) { 3618 ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr); 3619 if ( j < size_of_constraint ) { 3620 j = size_of_constraint; 3621 } 3622 ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr); 3623 } 3624 ierr = PetscMalloc(j*sizeof(PetscInt),&aux_ordering);CHKERRQ(ierr); 3625 ierr = PetscMalloc(j*sizeof(PetscInt),&row_cmat_global_indices);CHKERRQ(ierr); 3626 ierr = PetscMalloc(pcis->n*sizeof(PetscBool),&array_bool);CHKERRQ(ierr); 3627 for (i=0;i<pcis->n;i++) { 3628 array_bool[i] = PETSC_FALSE; 3629 } 3630 for (i=0;i<pcbddc->local_primal_size;i++) { 3631 ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,PETSC_NULL);CHKERRQ(ierr); 3632 for (j=0; j<size_of_constraint; j++) { 3633 aux_ordering[j] = j; 3634 } 3635 ierr = ISLocalToGlobalMappingApply(matis->mapping,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr); 3636 ierr = PetscSortIntWithPermutation(size_of_constraint,row_cmat_global_indices,aux_ordering);CHKERRQ(ierr); 3637 for (j=0; j<size_of_constraint; j++) { 3638 k = row_cmat_indices[aux_ordering[j]]; 3639 if ( !array_bool[k] ) { 3640 array_bool[k] = PETSC_TRUE; 3641 auxlocal_primal[i] = k; 3642 break; 3643 } 3644 } 3645 ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,PETSC_NULL);CHKERRQ(ierr); 3646 } 3647 ierr = PetscFree(aux_ordering);CHKERRQ(ierr); 3648 if (dbg_flag) { 3649 PetscScalar coarsesum,*array; 3650 3651 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3652 ierr = PetscViewerASCIIPrintf(viewer,"--------------------------------------------------\n");CHKERRQ(ierr); 3653 ierr = PetscViewerASCIIPrintf(viewer,"Check coarse indices\n");CHKERRQ(ierr); 3654 ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr); 3655 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3656 for (i=0;i<pcis->n;i++) { 3657 if (array_bool[i]) { 3658 array[i]=1.0; 3659 } 3660 } 3661 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3662 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 3663 ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 3664 ierr = VecScatterEnd (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 3665 ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3666 ierr = VecScatterEnd (matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 3667 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3668 for (i=0;i<pcis->n;i++) { 3669 if (array[i] == 1.0) { 3670 ierr = ISLocalToGlobalMappingApply(matis->mapping,1,&i,&j);CHKERRQ(ierr); 3671 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d: WRONG COARSE INDEX %d (local %d)\n",PetscGlobalRank,j,i);CHKERRQ(ierr); 3672 } 3673 } 3674 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3675 for (i=0;i<pcis->n;i++) { 3676 if( array[i] > 0.0) { 3677 array[i] = 1.0/array[i]; 3678 } 3679 } 3680 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 3681 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 3682 ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 3683 ierr = VecScatterEnd (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 3684 ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr); 3685 ierr = PetscViewerASCIIPrintf(viewer,"Size of coarse problem SHOULD be %lf\n",coarsesum);CHKERRQ(ierr); 3686 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3687 } 3688 ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr); 3689 ierr = PetscFree(array_bool);CHKERRQ(ierr); 3690 3691 /* Now assign them a global numbering */ 3692 /* auxglobal_primal contains indices in global nodes numbering (internal and interface) */ 3693 ierr = ISLocalToGlobalMappingApply(matis->mapping,pcbddc->local_primal_size,auxlocal_primal,auxglobal_primal);CHKERRQ(ierr); 3694 ierr = PetscFree(auxlocal_primal);CHKERRQ(ierr); 3695 /* all_auxglobal_primal contains all primal nodes indices in global nodes numbering (internal and interface) */ 3696 ierr = MPI_Gatherv(&auxglobal_primal[0],pcbddc->local_primal_size,MPIU_INT,&all_auxglobal_primal[0],pcbddc->local_primal_sizes,pcbddc->local_primal_displacements,MPIU_INT,0,prec_comm);CHKERRQ(ierr); 3697 3698 /* After this block all_auxglobal_primal should contains one copy of each primal node's indices in global nodes numbering */ 3699 if (!rank_prec_comm) { 3700 pcbddc->coarse_size=pcbddc->replicated_primal_size; 3701 ierr = PetscSortRemoveDupsMPIInt(&pcbddc->coarse_size,all_auxglobal_primal);CHKERRQ(ierr); 3702 } 3703 ierr = MPI_Bcast(&pcbddc->coarse_size,1,MPIU_INT,0,prec_comm);CHKERRQ(ierr); 3704 if (rank_prec_comm) { 3705 ierr = PetscMalloc(pcbddc->coarse_size*sizeof(PetscMPIInt),&all_auxglobal_primal);CHKERRQ(ierr); 3706 } 3707 /* We only need to broadcast the indices from 0 to pcbddc->coarse_size. Remaning elements of array all_aux_global_primal are garbage. */ 3708 ierr = MPI_Bcast(all_auxglobal_primal,pcbddc->coarse_size,MPIU_INT,0,prec_comm);CHKERRQ(ierr); 3709 3710 /* Now get global coarse numbering of local primal nodes */ 3711 for (i=0;i<pcbddc->local_primal_size;i++) { 3712 k=0; 3713 while( all_auxglobal_primal[k] != auxglobal_primal[i] ) { k++;} 3714 pcbddc->local_primal_indices[i]=k; 3715 } 3716 ierr = PetscFree(auxglobal_primal);CHKERRQ(ierr); 3717 ierr = PetscFree(all_auxglobal_primal);CHKERRQ(ierr); 3718 if (rank_prec_comm==0) { 3719 j=pcbddc->replicated_primal_size; 3720 ierr = PetscMalloc(j*sizeof(PetscMPIInt),&auxglobal_primal);CHKERRQ(ierr); 3721 } 3722 ierr = MPI_Gatherv(pcbddc->local_primal_indices,pcbddc->local_primal_size,MPIU_INT,auxglobal_primal,pcbddc->local_primal_sizes,pcbddc->local_primal_displacements,MPIU_INT,0,prec_comm);CHKERRQ(ierr); 3723 } 3724 3725 if (dbg_flag) { 3726 ierr = PetscViewerASCIIPrintf(viewer,"Size of coarse problem is %d\n",pcbddc->coarse_size);CHKERRQ(ierr); 3727 /*ierr = PetscViewerASCIIPrintf(viewer,"Distribution of local primal indices\n");CHKERRQ(ierr); 3728 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3729 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr); 3730 for (i=0;i<pcbddc->local_primal_size;i++) { 3731 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"local_primal_indices[%d]=%d \n",i,pcbddc->local_primal_indices[i]); 3732 }*/ 3733 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3734 } 3735 3736 if (pcis->n) { im_active = 1; } 3737 ierr = MPI_Allreduce(&im_active,&pcbddc->active_procs,1,MPIU_INT,MPI_SUM,prec_comm);CHKERRQ(ierr); 3738 3739 /* adapt coarse problem type */ 3740 if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) { 3741 if (pcbddc->current_level < pcbddc->max_levels) { 3742 if ( (pcbddc->active_procs/pcbddc->coarsening_ratio) < 2 ) { 3743 if (dbg_flag) { 3744 ierr = PetscViewerASCIIPrintf(viewer,"Not enough active processes on level %d (active %d,ratio %d). Parallel direct solve for coarse problem\n",pcbddc->current_level,pcbddc->active_procs,pcbddc->coarsening_ratio);CHKERRQ(ierr); 3745 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3746 } 3747 pcbddc->coarse_problem_type = PARALLEL_BDDC; 3748 } 3749 } else { 3750 if (dbg_flag) { 3751 ierr = PetscViewerASCIIPrintf(viewer,"Max number of levels reached. Using parallel direct solve for coarse problem\n",pcbddc->max_levels,pcbddc->active_procs,pcbddc->coarsening_ratio);CHKERRQ(ierr); 3752 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 3753 } 3754 pcbddc->coarse_problem_type = PARALLEL_BDDC; 3755 } 3756 } 3757 3758 switch(pcbddc->coarse_problem_type){ 3759 3760 case(MULTILEVEL_BDDC): /* we define a coarse mesh where subdomains are elements */ 3761 { 3762 /* we need additional variables */ 3763 MetisInt n_subdomains,n_parts,objval,ncon,faces_nvtxs; 3764 MetisInt *metis_coarse_subdivision; 3765 MetisInt options[METIS_NOPTIONS]; 3766 PetscMPIInt size_coarse_comm,rank_coarse_comm; 3767 PetscMPIInt procs_jumps_coarse_comm; 3768 PetscMPIInt *coarse_subdivision; 3769 PetscMPIInt *total_count_recv; 3770 PetscMPIInt *total_ranks_recv; 3771 PetscMPIInt *displacements_recv; 3772 PetscMPIInt *my_faces_connectivity; 3773 PetscMPIInt *petsc_faces_adjncy; 3774 MetisInt *faces_adjncy; 3775 MetisInt *faces_xadj; 3776 PetscMPIInt *number_of_faces; 3777 PetscMPIInt *faces_displacements; 3778 PetscInt *array_int; 3779 PetscMPIInt my_faces=0; 3780 PetscMPIInt total_faces=0; 3781 PetscInt ranks_stretching_ratio; 3782 3783 /* define some quantities */ 3784 pcbddc->coarse_communications_type = SCATTERS_BDDC; 3785 coarse_mat_type = MATIS; 3786 coarse_pc_type = PCBDDC; 3787 coarse_ksp_type = KSPRICHARDSON; 3788 3789 /* details of coarse decomposition */ 3790 n_subdomains = pcbddc->active_procs; 3791 n_parts = n_subdomains/pcbddc->coarsening_ratio; 3792 ranks_stretching_ratio = size_prec_comm/pcbddc->active_procs; 3793 procs_jumps_coarse_comm = pcbddc->coarsening_ratio*ranks_stretching_ratio; 3794 3795 /* build CSR graph of subdomains' connectivity */ 3796 ierr = PetscMalloc (pcis->n*sizeof(PetscInt),&array_int);CHKERRQ(ierr); 3797 ierr = PetscMemzero(array_int,pcis->n*sizeof(PetscInt));CHKERRQ(ierr); 3798 for (i=1;i<pcis->n_neigh;i++){/* i=1 so I don't count myself -> faces nodes counts to 1 */ 3799 for (j=0;j<pcis->n_shared[i];j++){ 3800 array_int[ pcis->shared[i][j] ]+=1; 3801 } 3802 } 3803 for (i=1;i<pcis->n_neigh;i++){ 3804 for (j=0;j<pcis->n_shared[i];j++){ 3805 if (array_int[ pcis->shared[i][j] ] > 0 ){ 3806 my_faces++; 3807 break; 3808 } 3809 } 3810 } 3811 3812 ierr = MPI_Reduce(&my_faces,&total_faces,1,MPIU_INT,MPI_SUM,master_proc,prec_comm);CHKERRQ(ierr); 3813 ierr = PetscMalloc (my_faces*sizeof(PetscInt),&my_faces_connectivity);CHKERRQ(ierr); 3814 my_faces=0; 3815 for (i=1;i<pcis->n_neigh;i++){ 3816 for (j=0;j<pcis->n_shared[i];j++){ 3817 if (array_int[ pcis->shared[i][j] ] > 0 ){ 3818 my_faces_connectivity[my_faces]=pcis->neigh[i]; 3819 my_faces++; 3820 break; 3821 } 3822 } 3823 } 3824 if (rank_prec_comm == master_proc) { 3825 ierr = PetscMalloc (total_faces*sizeof(PetscMPIInt),&petsc_faces_adjncy);CHKERRQ(ierr); 3826 ierr = PetscMalloc (size_prec_comm*sizeof(PetscMPIInt),&number_of_faces);CHKERRQ(ierr); 3827 ierr = PetscMalloc (total_faces*sizeof(MetisInt),&faces_adjncy);CHKERRQ(ierr); 3828 ierr = PetscMalloc ((n_subdomains+1)*sizeof(MetisInt),&faces_xadj);CHKERRQ(ierr); 3829 ierr = PetscMalloc ((size_prec_comm+1)*sizeof(PetscMPIInt),&faces_displacements);CHKERRQ(ierr); 3830 } 3831 ierr = MPI_Gather(&my_faces,1,MPIU_INT,&number_of_faces[0],1,MPIU_INT,master_proc,prec_comm);CHKERRQ(ierr); 3832 if (rank_prec_comm == master_proc) { 3833 faces_xadj[0]=0; 3834 faces_displacements[0]=0; 3835 j=0; 3836 for (i=1;i<size_prec_comm+1;i++) { 3837 faces_displacements[i]=faces_displacements[i-1]+number_of_faces[i-1]; 3838 if (number_of_faces[i-1]) { 3839 j++; 3840 faces_xadj[j]=faces_xadj[j-1]+number_of_faces[i-1]; 3841 } 3842 } 3843 } 3844 ierr = MPI_Gatherv(&my_faces_connectivity[0],my_faces,MPIU_INT,&petsc_faces_adjncy[0],number_of_faces,faces_displacements,MPIU_INT,master_proc,prec_comm);CHKERRQ(ierr); 3845 ierr = PetscFree(my_faces_connectivity);CHKERRQ(ierr); 3846 ierr = PetscFree(array_int);CHKERRQ(ierr); 3847 if (rank_prec_comm == master_proc) { 3848 for (i=0;i<total_faces;i++) faces_adjncy[i]=(MetisInt)(petsc_faces_adjncy[i]/ranks_stretching_ratio); /* cast to MetisInt */ 3849 /*printf("This is the face connectivity (actual ranks)\n"); 3850 for (i=0;i<n_subdomains;i++){ 3851 printf("proc %d is connected with \n",i); 3852 for (j=faces_xadj[i];j<faces_xadj[i+1];j++) 3853 printf("%d ",faces_adjncy[j]); 3854 printf("\n"); 3855 }*/ 3856 ierr = PetscFree(faces_displacements);CHKERRQ(ierr); 3857 ierr = PetscFree(number_of_faces);CHKERRQ(ierr); 3858 ierr = PetscFree(petsc_faces_adjncy);CHKERRQ(ierr); 3859 } 3860 3861 if ( rank_prec_comm == master_proc ) { 3862 3863 PetscInt heuristic_for_metis=3; 3864 3865 ncon=1; 3866 faces_nvtxs=n_subdomains; 3867 /* partition graoh induced by face connectivity */ 3868 ierr = PetscMalloc (n_subdomains*sizeof(MetisInt),&metis_coarse_subdivision);CHKERRQ(ierr); 3869 ierr = METIS_SetDefaultOptions(options); 3870 /* we need a contiguous partition of the coarse mesh */ 3871 options[METIS_OPTION_CONTIG]=1; 3872 options[METIS_OPTION_NITER]=30; 3873 if (pcbddc->coarsening_ratio > 1) { 3874 if (n_subdomains>n_parts*heuristic_for_metis) { 3875 options[METIS_OPTION_IPTYPE]=METIS_IPTYPE_EDGE; 3876 options[METIS_OPTION_OBJTYPE]=METIS_OBJTYPE_CUT; 3877 ierr = METIS_PartGraphKway(&faces_nvtxs,&ncon,faces_xadj,faces_adjncy,NULL,NULL,NULL,&n_parts,NULL,NULL,options,&objval,metis_coarse_subdivision); 3878 if (ierr != METIS_OK) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in METIS_PartGraphKway (metis error code %D) called from PCBDDCSetupCoarseEnvironment\n",ierr); 3879 } else { 3880 ierr = METIS_PartGraphRecursive(&faces_nvtxs,&ncon,faces_xadj,faces_adjncy,NULL,NULL,NULL,&n_parts,NULL,NULL,options,&objval,metis_coarse_subdivision); 3881 if (ierr != METIS_OK) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in METIS_PartGraphRecursive (metis error code %D) called from PCBDDCSetupCoarseEnvironment\n",ierr); 3882 } 3883 } else { 3884 for (i=0;i<n_subdomains;i++) { 3885 metis_coarse_subdivision[i]=i; 3886 } 3887 } 3888 ierr = PetscFree(faces_xadj);CHKERRQ(ierr); 3889 ierr = PetscFree(faces_adjncy);CHKERRQ(ierr); 3890 ierr = PetscMalloc(size_prec_comm*sizeof(PetscMPIInt),&coarse_subdivision);CHKERRQ(ierr); 3891 /* copy/cast values avoiding possible type conflicts between PETSc, MPI and METIS */ 3892 for (i=0;i<size_prec_comm;i++) { coarse_subdivision[i]=MPI_PROC_NULL; } 3893 for (i=0;i<n_subdomains;i++) { coarse_subdivision[ranks_stretching_ratio*i]=(PetscInt)(metis_coarse_subdivision[i]); } 3894 ierr = PetscFree(metis_coarse_subdivision);CHKERRQ(ierr); 3895 } 3896 3897 /* Create new communicator for coarse problem splitting the old one */ 3898 if ( !(rank_prec_comm%procs_jumps_coarse_comm) && rank_prec_comm < procs_jumps_coarse_comm*n_parts ){ 3899 coarse_color=0; /* for communicator splitting */ 3900 active_rank=rank_prec_comm; /* for insertion of matrix values */ 3901 } 3902 /* procs with coarse_color = MPI_UNDEFINED will have coarse_comm = MPI_COMM_NULL (from mpi standards) 3903 key = rank_prec_comm -> keep same ordering of ranks from the old to the new communicator */ 3904 ierr = MPI_Comm_split(prec_comm,coarse_color,rank_prec_comm,&coarse_comm);CHKERRQ(ierr); 3905 3906 if ( coarse_color == 0 ) { 3907 ierr = MPI_Comm_size(coarse_comm,&size_coarse_comm);CHKERRQ(ierr); 3908 ierr = MPI_Comm_rank(coarse_comm,&rank_coarse_comm);CHKERRQ(ierr); 3909 } else { 3910 rank_coarse_comm = MPI_PROC_NULL; 3911 } 3912 3913 /* master proc take care of arranging and distributing coarse information */ 3914 if (rank_coarse_comm == master_proc) { 3915 ierr = PetscMalloc (size_coarse_comm*sizeof(PetscMPIInt),&displacements_recv);CHKERRQ(ierr); 3916 ierr = PetscMalloc (size_coarse_comm*sizeof(PetscMPIInt),&total_count_recv);CHKERRQ(ierr); 3917 ierr = PetscMalloc (n_subdomains*sizeof(PetscMPIInt),&total_ranks_recv);CHKERRQ(ierr); 3918 /* some initializations */ 3919 displacements_recv[0]=0; 3920 ierr = PetscMemzero(total_count_recv,size_coarse_comm*sizeof(PetscMPIInt));CHKERRQ(ierr); 3921 /* count from how many processes the j-th process of the coarse decomposition will receive data */ 3922 for (j=0;j<size_coarse_comm;j++) { 3923 for (i=0;i<size_prec_comm;i++) { 3924 if (coarse_subdivision[i]==j) { 3925 total_count_recv[j]++; 3926 } 3927 } 3928 } 3929 /* displacements needed for scatterv of total_ranks_recv */ 3930 for (i=1;i<size_coarse_comm;i++) { displacements_recv[i]=displacements_recv[i-1]+total_count_recv[i-1]; } 3931 /* Now fill properly total_ranks_recv -> each coarse process will receive the ranks (in prec_comm communicator) of its friend (sending) processes */ 3932 ierr = PetscMemzero(total_count_recv,size_coarse_comm*sizeof(PetscMPIInt));CHKERRQ(ierr); 3933 for (j=0;j<size_coarse_comm;j++) { 3934 for (i=0;i<size_prec_comm;i++) { 3935 if (coarse_subdivision[i]==j) { 3936 total_ranks_recv[displacements_recv[j]+total_count_recv[j]]=i; 3937 total_count_recv[j]+=1; 3938 } 3939 } 3940 } 3941 /*for (j=0;j<size_coarse_comm;j++) { 3942 printf("process %d in new rank will receive from %d processes (original ranks follows)\n",j,total_count_recv[j]); 3943 for (i=0;i<total_count_recv[j];i++) { 3944 printf("%d ",total_ranks_recv[displacements_recv[j]+i]); 3945 } 3946 printf("\n"); 3947 }*/ 3948 3949 /* identify new decomposition in terms of ranks in the old communicator */ 3950 for (i=0;i<n_subdomains;i++) { 3951 coarse_subdivision[ranks_stretching_ratio*i]=coarse_subdivision[ranks_stretching_ratio*i]*procs_jumps_coarse_comm; 3952 } 3953 /*printf("coarse_subdivision in old end new ranks\n"); 3954 for (i=0;i<size_prec_comm;i++) 3955 if (coarse_subdivision[i]!=MPI_PROC_NULL) { 3956 printf("%d=(%d %d), ",i,coarse_subdivision[i],coarse_subdivision[i]/procs_jumps_coarse_comm); 3957 } else { 3958 printf("%d=(%d %d), ",i,coarse_subdivision[i],coarse_subdivision[i]); 3959 } 3960 printf("\n");*/ 3961 } 3962 3963 /* Scatter new decomposition for send details */ 3964 ierr = MPI_Scatter(&coarse_subdivision[0],1,MPIU_INT,&rank_coarse_proc_send_to,1,MPIU_INT,master_proc,prec_comm);CHKERRQ(ierr); 3965 /* Scatter receiving details to members of coarse decomposition */ 3966 if ( coarse_color == 0) { 3967 ierr = MPI_Scatter(&total_count_recv[0],1,MPIU_INT,&count_recv,1,MPIU_INT,master_proc,coarse_comm);CHKERRQ(ierr); 3968 ierr = PetscMalloc (count_recv*sizeof(PetscMPIInt),&ranks_recv);CHKERRQ(ierr); 3969 ierr = MPI_Scatterv(&total_ranks_recv[0],total_count_recv,displacements_recv,MPIU_INT,&ranks_recv[0],count_recv,MPIU_INT,master_proc,coarse_comm);CHKERRQ(ierr); 3970 } 3971 3972 /*printf("I will send my matrix data to proc %d\n",rank_coarse_proc_send_to); 3973 if (coarse_color == 0) { 3974 printf("I will receive some matrix data from %d processes (ranks follows)\n",count_recv); 3975 for (i=0;i<count_recv;i++) 3976 printf("%d ",ranks_recv[i]); 3977 printf("\n"); 3978 }*/ 3979 3980 if (rank_prec_comm == master_proc) { 3981 ierr = PetscFree(coarse_subdivision);CHKERRQ(ierr); 3982 ierr = PetscFree(total_count_recv);CHKERRQ(ierr); 3983 ierr = PetscFree(total_ranks_recv);CHKERRQ(ierr); 3984 ierr = PetscFree(displacements_recv);CHKERRQ(ierr); 3985 } 3986 break; 3987 } 3988 3989 case(REPLICATED_BDDC): 3990 3991 pcbddc->coarse_communications_type = GATHERS_BDDC; 3992 coarse_mat_type = MATSEQAIJ; 3993 coarse_pc_type = PCLU; 3994 coarse_ksp_type = KSPPREONLY; 3995 coarse_comm = PETSC_COMM_SELF; 3996 active_rank = rank_prec_comm; 3997 break; 3998 3999 case(PARALLEL_BDDC): 4000 4001 pcbddc->coarse_communications_type = SCATTERS_BDDC; 4002 coarse_mat_type = MATMPIAIJ; 4003 coarse_pc_type = PCREDUNDANT; 4004 coarse_ksp_type = KSPPREONLY; 4005 coarse_comm = prec_comm; 4006 active_rank = rank_prec_comm; 4007 break; 4008 4009 case(SEQUENTIAL_BDDC): 4010 pcbddc->coarse_communications_type = GATHERS_BDDC; 4011 coarse_mat_type = MATSEQAIJ; 4012 coarse_pc_type = PCLU; 4013 coarse_ksp_type = KSPPREONLY; 4014 coarse_comm = PETSC_COMM_SELF; 4015 active_rank = master_proc; 4016 break; 4017 } 4018 4019 switch(pcbddc->coarse_communications_type){ 4020 4021 case(SCATTERS_BDDC): 4022 { 4023 if (pcbddc->coarse_problem_type==MULTILEVEL_BDDC) { 4024 4025 IS coarse_IS; 4026 4027 if(pcbddc->coarsening_ratio == 1) { 4028 ins_local_primal_size = pcbddc->local_primal_size; 4029 ins_local_primal_indices = pcbddc->local_primal_indices; 4030 if (coarse_color == 0) { ierr = PetscFree(ranks_recv);CHKERRQ(ierr); } 4031 /* nonzeros */ 4032 ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&dnz);CHKERRQ(ierr); 4033 ierr = PetscMemzero(dnz,ins_local_primal_size*sizeof(PetscInt));CHKERRQ(ierr); 4034 for (i=0;i<ins_local_primal_size;i++) { 4035 dnz[i] = ins_local_primal_size; 4036 } 4037 } else { 4038 PetscMPIInt send_size; 4039 PetscInt *aux_ins_indices; 4040 PetscInt ii,jj; 4041 MPI_Request *requests; 4042 ierr = PetscMalloc(count_recv*sizeof(PetscMPIInt),&localdispl2);CHKERRQ(ierr); 4043 /* reusing pcbddc->local_primal_displacements and pcbddc->replicated_primal_size */ 4044 ierr = PetscFree(pcbddc->local_primal_displacements);CHKERRQ(ierr); 4045 ierr = PetscMalloc((count_recv+1)*sizeof(PetscMPIInt),&pcbddc->local_primal_displacements);CHKERRQ(ierr); 4046 pcbddc->replicated_primal_size = count_recv; 4047 j = 0; 4048 for (i=0;i<count_recv;i++) { 4049 pcbddc->local_primal_displacements[i] = j; 4050 j += pcbddc->local_primal_sizes[ranks_recv[i]]; 4051 } 4052 pcbddc->local_primal_displacements[count_recv] = j; 4053 ierr = PetscMalloc(j*sizeof(PetscMPIInt),&pcbddc->replicated_local_primal_indices);CHKERRQ(ierr); 4054 /* allocate auxiliary space */ 4055 ierr = PetscMalloc(count_recv*sizeof(PetscMPIInt),&localsizes2);CHKERRQ(ierr); 4056 ierr = PetscMalloc(pcbddc->coarse_size*sizeof(PetscInt),&aux_ins_indices);CHKERRQ(ierr); 4057 ierr = PetscMemzero(aux_ins_indices,pcbddc->coarse_size*sizeof(PetscInt));CHKERRQ(ierr); 4058 /* allocate stuffs for message massing */ 4059 ierr = PetscMalloc((count_recv+1)*sizeof(MPI_Request),&requests);CHKERRQ(ierr); 4060 for (i=0;i<count_recv+1;i++) { requests[i]=MPI_REQUEST_NULL; } 4061 /* send indices to be inserted */ 4062 for (i=0;i<count_recv;i++) { 4063 send_size = pcbddc->local_primal_sizes[ranks_recv[i]]; 4064 ierr = MPI_Irecv(&pcbddc->replicated_local_primal_indices[pcbddc->local_primal_displacements[i]],send_size,MPIU_INT,ranks_recv[i],999,prec_comm,&requests[i]);CHKERRQ(ierr); 4065 } 4066 if (rank_coarse_proc_send_to != MPI_PROC_NULL ) { 4067 send_size = pcbddc->local_primal_size; 4068 ierr = MPI_Isend(pcbddc->local_primal_indices,send_size,MPIU_INT,rank_coarse_proc_send_to,999,prec_comm,&requests[count_recv]);CHKERRQ(ierr); 4069 } 4070 ierr = MPI_Waitall(count_recv+1,requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 4071 j = 0; 4072 for (i=0;i<count_recv;i++) { 4073 ii = pcbddc->local_primal_displacements[i+1]-pcbddc->local_primal_displacements[i]; 4074 localsizes2[i] = ii*ii; 4075 localdispl2[i] = j; 4076 j += localsizes2[i]; 4077 jj = pcbddc->local_primal_displacements[i]; 4078 /* it counts the coarse subdomains sharing the coarse node */ 4079 for (k=0;k<ii;k++) { 4080 aux_ins_indices[pcbddc->replicated_local_primal_indices[jj+k]] += 1; 4081 } 4082 } 4083 /* temp_coarse_mat_vals used to store matrix values to be received */ 4084 ierr = PetscMalloc(j*sizeof(PetscScalar),&temp_coarse_mat_vals);CHKERRQ(ierr); 4085 /* evaluate how many values I will insert in coarse mat */ 4086 ins_local_primal_size = 0; 4087 for (i=0;i<pcbddc->coarse_size;i++) { 4088 if (aux_ins_indices[i]) { 4089 ins_local_primal_size++; 4090 } 4091 } 4092 /* evaluate indices I will insert in coarse mat */ 4093 ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr); 4094 j = 0; 4095 for(i=0;i<pcbddc->coarse_size;i++) { 4096 if(aux_ins_indices[i]) { 4097 ins_local_primal_indices[j] = i; 4098 j++; 4099 } 4100 } 4101 /* processes partecipating in coarse problem receive matrix data from their friends */ 4102 for (i=0;i<count_recv;i++) { 4103 ierr = MPI_Irecv(&temp_coarse_mat_vals[localdispl2[i]],localsizes2[i],MPIU_SCALAR,ranks_recv[i],666,prec_comm,&requests[i]);CHKERRQ(ierr); 4104 } 4105 if (rank_coarse_proc_send_to != MPI_PROC_NULL ) { 4106 send_size = pcbddc->local_primal_size*pcbddc->local_primal_size; 4107 ierr = MPI_Isend(&coarse_submat_vals[0],send_size,MPIU_SCALAR,rank_coarse_proc_send_to,666,prec_comm,&requests[count_recv]);CHKERRQ(ierr); 4108 } 4109 ierr = MPI_Waitall(count_recv+1,requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 4110 /* nonzeros */ 4111 ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&dnz);CHKERRQ(ierr); 4112 ierr = PetscMemzero(dnz,ins_local_primal_size*sizeof(PetscInt));CHKERRQ(ierr); 4113 /* use aux_ins_indices to realize a global to local mapping */ 4114 j=0; 4115 for(i=0;i<pcbddc->coarse_size;i++){ 4116 if(aux_ins_indices[i]==0){ 4117 aux_ins_indices[i]=-1; 4118 } else { 4119 aux_ins_indices[i]=j; 4120 j++; 4121 } 4122 } 4123 for (i=0;i<count_recv;i++) { 4124 j = pcbddc->local_primal_sizes[ranks_recv[i]]; 4125 for (k=0;k<j;k++) { 4126 dnz[aux_ins_indices[pcbddc->replicated_local_primal_indices[pcbddc->local_primal_displacements[i]+k]]] += j; 4127 } 4128 } 4129 /* check */ 4130 for (i=0;i<ins_local_primal_size;i++) { 4131 if (dnz[i] > ins_local_primal_size) { 4132 dnz[i] = ins_local_primal_size; 4133 } 4134 } 4135 ierr = PetscFree(requests);CHKERRQ(ierr); 4136 ierr = PetscFree(aux_ins_indices);CHKERRQ(ierr); 4137 if (coarse_color == 0) { ierr = PetscFree(ranks_recv);CHKERRQ(ierr); } 4138 } 4139 /* create local to global mapping needed by coarse MATIS */ 4140 if (coarse_comm != MPI_COMM_NULL ) {ierr = MPI_Comm_free(&coarse_comm);CHKERRQ(ierr);} 4141 coarse_comm = prec_comm; 4142 active_rank = rank_prec_comm; 4143 ierr = ISCreateGeneral(coarse_comm,ins_local_primal_size,ins_local_primal_indices,PETSC_COPY_VALUES,&coarse_IS);CHKERRQ(ierr); 4144 ierr = ISLocalToGlobalMappingCreateIS(coarse_IS,&coarse_ISLG);CHKERRQ(ierr); 4145 ierr = ISDestroy(&coarse_IS);CHKERRQ(ierr); 4146 } else if (pcbddc->coarse_problem_type==PARALLEL_BDDC) { 4147 /* arrays for values insertion */ 4148 ins_local_primal_size = pcbddc->local_primal_size; 4149 ierr = PetscMalloc(ins_local_primal_size*sizeof(PetscInt),&ins_local_primal_indices);CHKERRQ(ierr); 4150 ierr = PetscMalloc(ins_local_primal_size*ins_local_primal_size*sizeof(PetscScalar),&ins_coarse_mat_vals);CHKERRQ(ierr); 4151 for (j=0;j<ins_local_primal_size;j++){ 4152 ins_local_primal_indices[j]=pcbddc->local_primal_indices[j]; 4153 for (i=0;i<ins_local_primal_size;i++) { 4154 ins_coarse_mat_vals[j*ins_local_primal_size+i]=coarse_submat_vals[j*ins_local_primal_size+i]; 4155 } 4156 } 4157 } 4158 break; 4159 4160 } 4161 4162 case(GATHERS_BDDC): 4163 { 4164 4165 PetscMPIInt mysize,mysize2; 4166 4167 if (rank_prec_comm==active_rank) { 4168 ierr = PetscMalloc ( pcbddc->replicated_primal_size*sizeof(PetscMPIInt),&pcbddc->replicated_local_primal_indices);CHKERRQ(ierr); 4169 ierr = PetscMalloc ( pcbddc->replicated_primal_size*sizeof(PetscScalar),&pcbddc->replicated_local_primal_values);CHKERRQ(ierr); 4170 ierr = PetscMalloc ( size_prec_comm*sizeof(PetscMPIInt),&localsizes2);CHKERRQ(ierr); 4171 ierr = PetscMalloc ( size_prec_comm*sizeof(PetscMPIInt),&localdispl2);CHKERRQ(ierr); 4172 /* arrays for values insertion */ 4173 for (i=0;i<size_prec_comm;i++) { localsizes2[i]=pcbddc->local_primal_sizes[i]*pcbddc->local_primal_sizes[i]; } 4174 localdispl2[0]=0; 4175 for (i=1;i<size_prec_comm;i++) { localdispl2[i]=localsizes2[i-1]+localdispl2[i-1]; } 4176 j=0; 4177 for (i=0;i<size_prec_comm;i++) { j+=localsizes2[i]; } 4178 ierr = PetscMalloc ( j*sizeof(PetscScalar),&temp_coarse_mat_vals);CHKERRQ(ierr); 4179 } 4180 4181 mysize=pcbddc->local_primal_size; 4182 mysize2=pcbddc->local_primal_size*pcbddc->local_primal_size; 4183 if (pcbddc->coarse_problem_type == SEQUENTIAL_BDDC){ 4184 ierr = MPI_Gatherv(&pcbddc->local_primal_indices[0],mysize,MPIU_INT,&pcbddc->replicated_local_primal_indices[0],pcbddc->local_primal_sizes,pcbddc->local_primal_displacements,MPIU_INT,master_proc,prec_comm);CHKERRQ(ierr); 4185 ierr = MPI_Gatherv(&coarse_submat_vals[0],mysize2,MPIU_SCALAR,&temp_coarse_mat_vals[0],localsizes2,localdispl2,MPIU_SCALAR,master_proc,prec_comm);CHKERRQ(ierr); 4186 } else { 4187 ierr = MPI_Allgatherv(&pcbddc->local_primal_indices[0],mysize,MPIU_INT,&pcbddc->replicated_local_primal_indices[0],pcbddc->local_primal_sizes,pcbddc->local_primal_displacements,MPIU_INT,prec_comm);CHKERRQ(ierr); 4188 ierr = MPI_Allgatherv(&coarse_submat_vals[0],mysize2,MPIU_SCALAR,&temp_coarse_mat_vals[0],localsizes2,localdispl2,MPIU_SCALAR,prec_comm);CHKERRQ(ierr); 4189 } 4190 break; 4191 }/* switch on coarse problem and communications associated with finished */ 4192 } 4193 4194 /* Now create and fill up coarse matrix */ 4195 if ( rank_prec_comm == active_rank ) { 4196 4197 Mat matis_coarse_local_mat; 4198 4199 if (pcbddc->coarse_problem_type != MULTILEVEL_BDDC) { 4200 ierr = MatCreate(coarse_comm,&pcbddc->coarse_mat);CHKERRQ(ierr); 4201 ierr = MatSetSizes(pcbddc->coarse_mat,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size);CHKERRQ(ierr); 4202 ierr = MatSetType(pcbddc->coarse_mat,coarse_mat_type);CHKERRQ(ierr); 4203 ierr = MatSetUp(pcbddc->coarse_mat);CHKERRQ(ierr); 4204 ierr = MatSetOption(pcbddc->coarse_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr); /* local values stored in column major */ 4205 ierr = MatSetOption(pcbddc->coarse_mat,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr); 4206 } else { 4207 ierr = MatCreateIS(coarse_comm,1,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size,coarse_ISLG,&pcbddc->coarse_mat);CHKERRQ(ierr); 4208 ierr = MatSetUp(pcbddc->coarse_mat);CHKERRQ(ierr); 4209 ierr = MatISGetLocalMat(pcbddc->coarse_mat,&matis_coarse_local_mat);CHKERRQ(ierr); 4210 ierr = MatSetUp(matis_coarse_local_mat);CHKERRQ(ierr); 4211 ierr = MatSetOption(matis_coarse_local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr); /* local values stored in column major */ 4212 ierr = MatSetOption(matis_coarse_local_mat,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr); 4213 } 4214 /* preallocation */ 4215 if (pcbddc->coarse_problem_type != MULTILEVEL_BDDC) { 4216 PetscInt lrows,lcols; 4217 ierr = MatGetLocalSize(pcbddc->coarse_mat,&lrows,&lcols);CHKERRQ(ierr); 4218 ierr = MatPreallocateInitialize(coarse_comm,lrows,lcols,dnz,onz);CHKERRQ(ierr); 4219 if (pcbddc->coarse_problem_type == PARALLEL_BDDC) { 4220 PetscInt coarse_index_row,coarse_index_col,start_row,owner; 4221 PetscMPIInt *auxpreall_displs; 4222 PetscMPIInt *auxpreall_sizes; 4223 PetscMPIInt *auxpreall_dnz; 4224 PetscMPIInt *auxpreall_onz; 4225 PetscInt *auxpreall_ownership; 4226 if (rank_prec_comm == 0) { 4227 ierr = PetscMalloc((size_prec_comm+1)*sizeof(PetscMPIInt),&auxpreall_displs);CHKERRQ(ierr); 4228 auxpreall_displs[size_prec_comm]=pcbddc->coarse_size; 4229 ierr = PetscMalloc(size_prec_comm*sizeof(PetscMPIInt),&auxpreall_sizes);CHKERRQ(ierr); 4230 ierr = PetscMalloc(pcbddc->coarse_size*sizeof(PetscMPIInt),&auxpreall_dnz);CHKERRQ(ierr); 4231 ierr = PetscMemzero(auxpreall_dnz,pcbddc->coarse_size*sizeof(PetscMPIInt));CHKERRQ(ierr); 4232 ierr = PetscMalloc(pcbddc->coarse_size*sizeof(PetscMPIInt),&auxpreall_onz);CHKERRQ(ierr); 4233 ierr = PetscMemzero(auxpreall_onz,pcbddc->coarse_size*sizeof(PetscMPIInt));CHKERRQ(ierr); 4234 ierr = PetscMalloc(pcbddc->coarse_size*sizeof(PetscInt),&auxpreall_ownership);CHKERRQ(ierr); 4235 } 4236 ierr = MatGetOwnershipRange(pcbddc->coarse_mat,&start_row,PETSC_NULL);CHKERRQ(ierr); 4237 ierr = MPI_Gather(&start_row,1,MPIU_INT,auxpreall_displs,1,MPIU_INT,0,prec_comm);CHKERRQ(ierr); 4238 if (rank_prec_comm == 0) { 4239 k=0; 4240 for (i=0;i<size_prec_comm;i++) { 4241 auxpreall_sizes[i]=auxpreall_displs[i+1]-auxpreall_displs[i]; 4242 for (j=0;j<auxpreall_sizes[i];j++) { 4243 auxpreall_ownership[auxpreall_displs[i]+j]=i; 4244 } 4245 } 4246 for (i=0;i<size_prec_comm;i++) { 4247 for (j=0;j<pcbddc->local_primal_sizes[i];j++) { 4248 coarse_index_row=auxglobal_primal[j+pcbddc->local_primal_displacements[i]]; 4249 for (k=j;k<pcbddc->local_primal_sizes[i];k++) { 4250 coarse_index_col=auxglobal_primal[k+pcbddc->local_primal_displacements[i]]; 4251 owner = auxpreall_ownership[coarse_index_row]; 4252 if (coarse_index_col>auxpreall_displs[owner]-1 && coarse_index_col < auxpreall_displs[owner]+auxpreall_sizes[owner]) { 4253 auxpreall_dnz[coarse_index_row]++; 4254 } else { 4255 auxpreall_onz[coarse_index_row]++; 4256 } 4257 if (k != j) { 4258 owner = auxpreall_ownership[coarse_index_col]; 4259 if (coarse_index_row>auxpreall_displs[owner]-1 && coarse_index_row < auxpreall_displs[owner]+auxpreall_sizes[owner]) { 4260 auxpreall_dnz[coarse_index_col]++; 4261 } else { 4262 auxpreall_onz[coarse_index_col]++; 4263 } 4264 } 4265 } 4266 } 4267 } 4268 } 4269 ierr = MPI_Scatterv(auxpreall_dnz,auxpreall_sizes,auxpreall_displs,MPIU_INT, 4270 dnz,lrows,MPIU_INT,0,prec_comm); 4271 ierr = MPI_Scatterv(auxpreall_onz,auxpreall_sizes,auxpreall_displs,MPIU_INT, 4272 onz,lrows,MPIU_INT,0,prec_comm); 4273 if (rank_prec_comm == 0) { 4274 ierr = PetscFree(auxpreall_displs);CHKERRQ(ierr); 4275 ierr = PetscFree(auxpreall_sizes);CHKERRQ(ierr); 4276 ierr = PetscFree(auxpreall_dnz);CHKERRQ(ierr); 4277 ierr = PetscFree(auxpreall_onz);CHKERRQ(ierr); 4278 ierr = PetscFree(auxpreall_ownership);CHKERRQ(ierr); 4279 } 4280 } else { 4281 for (k=0;k<size_prec_comm;k++){ 4282 offset=pcbddc->local_primal_displacements[k]; 4283 offset2=localdispl2[k]; 4284 ins_local_primal_size = pcbddc->local_primal_sizes[k]; 4285 ins_local_primal_indices = &pcbddc->replicated_local_primal_indices[offset]; 4286 for (j=0;j<ins_local_primal_size;j++) { 4287 ierr = MatPreallocateSet(ins_local_primal_indices[j],ins_local_primal_size,ins_local_primal_indices,dnz,onz);CHKERRQ(ierr); 4288 } 4289 } 4290 } 4291 /* check */ 4292 for (i=0;i<lrows;i++) { 4293 if (dnz[i]>lcols) { 4294 dnz[i]=lcols; 4295 } 4296 if (onz[i]>pcbddc->coarse_size-lcols) { 4297 onz[i]=pcbddc->coarse_size-lcols; 4298 } 4299 } 4300 ierr = MatSeqAIJSetPreallocation(pcbddc->coarse_mat,PETSC_NULL,dnz);CHKERRQ(ierr); 4301 ierr = MatMPIAIJSetPreallocation(pcbddc->coarse_mat,PETSC_NULL,dnz,PETSC_NULL,onz);CHKERRQ(ierr); 4302 ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr); 4303 } else { 4304 ierr = MatSeqAIJSetPreallocation(matis_coarse_local_mat,0,dnz);CHKERRQ(ierr); 4305 ierr = PetscFree(dnz);CHKERRQ(ierr); 4306 } 4307 if (rank_prec_comm == 0) { ierr = PetscFree(auxglobal_primal);CHKERRQ(ierr); } 4308 /* insert values */ 4309 if (pcbddc->coarse_problem_type == PARALLEL_BDDC) { 4310 ierr = MatSetValues(pcbddc->coarse_mat,ins_local_primal_size,ins_local_primal_indices,ins_local_primal_size,ins_local_primal_indices,ins_coarse_mat_vals,ADD_VALUES);CHKERRQ(ierr); 4311 } else if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) { 4312 if (pcbddc->coarsening_ratio == 1) { 4313 ins_coarse_mat_vals = coarse_submat_vals; 4314 ierr = MatSetValues(pcbddc->coarse_mat,ins_local_primal_size,ins_local_primal_indices,ins_local_primal_size,ins_local_primal_indices,ins_coarse_mat_vals,INSERT_VALUES);CHKERRQ(ierr); 4315 } else { 4316 ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr); 4317 for (k=0;k<pcbddc->replicated_primal_size;k++) { 4318 offset = pcbddc->local_primal_displacements[k]; 4319 offset2 = localdispl2[k]; 4320 ins_local_primal_size = pcbddc->local_primal_displacements[k+1]-pcbddc->local_primal_displacements[k]; 4321 ins_local_primal_indices = &pcbddc->replicated_local_primal_indices[offset]; 4322 ins_coarse_mat_vals = &temp_coarse_mat_vals[offset2]; 4323 ierr = MatSetValues(pcbddc->coarse_mat,ins_local_primal_size,ins_local_primal_indices,ins_local_primal_size,ins_local_primal_indices,ins_coarse_mat_vals,ADD_VALUES);CHKERRQ(ierr); 4324 } 4325 } 4326 ins_local_primal_indices = 0; 4327 ins_coarse_mat_vals = 0; 4328 } else { 4329 for (k=0;k<size_prec_comm;k++){ 4330 offset=pcbddc->local_primal_displacements[k]; 4331 offset2=localdispl2[k]; 4332 ins_local_primal_size = pcbddc->local_primal_sizes[k]; 4333 ins_local_primal_indices = &pcbddc->replicated_local_primal_indices[offset]; 4334 ins_coarse_mat_vals = &temp_coarse_mat_vals[offset2]; 4335 ierr = MatSetValues(pcbddc->coarse_mat,ins_local_primal_size,ins_local_primal_indices,ins_local_primal_size,ins_local_primal_indices,ins_coarse_mat_vals,ADD_VALUES);CHKERRQ(ierr); 4336 } 4337 ins_local_primal_indices = 0; 4338 ins_coarse_mat_vals = 0; 4339 } 4340 ierr = MatAssemblyBegin(pcbddc->coarse_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 4341 ierr = MatAssemblyEnd(pcbddc->coarse_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 4342 /* symmetry of coarse matrix */ 4343 if (issym) { 4344 ierr = MatSetOption(pcbddc->coarse_mat,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr); 4345 } 4346 ierr = MatGetVecs(pcbddc->coarse_mat,&pcbddc->coarse_vec,&pcbddc->coarse_rhs);CHKERRQ(ierr); 4347 } 4348 4349 /* create loc to glob scatters if needed */ 4350 if (pcbddc->coarse_communications_type == SCATTERS_BDDC) { 4351 IS local_IS,global_IS; 4352 ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size,0,1,&local_IS);CHKERRQ(ierr); 4353 ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_indices,PETSC_COPY_VALUES,&global_IS);CHKERRQ(ierr); 4354 ierr = VecScatterCreate(pcbddc->vec1_P,local_IS,pcbddc->coarse_vec,global_IS,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr); 4355 ierr = ISDestroy(&local_IS);CHKERRQ(ierr); 4356 ierr = ISDestroy(&global_IS);CHKERRQ(ierr); 4357 } 4358 4359 /* Eval coarse null space */ 4360 if (pcbddc->NullSpace) { 4361 const Vec *nsp_vecs; 4362 PetscInt nsp_size,coarse_nsp_size; 4363 PetscBool nsp_has_cnst; 4364 PetscReal test_null; 4365 Vec *coarse_nsp_vecs; 4366 4367 coarse_nsp_size = 0; 4368 coarse_nsp_vecs = 0; 4369 ierr = MatNullSpaceGetVecs(pcbddc->NullSpace,&nsp_has_cnst,&nsp_size,&nsp_vecs);CHKERRQ(ierr); 4370 if (rank_prec_comm == active_rank) { 4371 ierr = PetscMalloc((nsp_size+1)*sizeof(Vec),&coarse_nsp_vecs);CHKERRQ(ierr); 4372 for (i=0;i<nsp_size+1;i++) { 4373 ierr = VecDuplicate(pcbddc->coarse_vec,&coarse_nsp_vecs[i]);CHKERRQ(ierr); 4374 } 4375 } 4376 if (nsp_has_cnst) { 4377 ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr); 4378 ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr); 4379 ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4380 ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4381 if (rank_prec_comm == active_rank) { 4382 ierr = MatMult(pcbddc->coarse_mat,pcbddc->coarse_vec,pcbddc->coarse_rhs);CHKERRQ(ierr); 4383 ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&test_null);CHKERRQ(ierr); 4384 if (test_null > 1.0e-12 && pcbddc->dbg_flag ) { 4385 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Constant coarse null space error % 1.14e\n",test_null);CHKERRQ(ierr); 4386 } 4387 ierr = VecCopy(pcbddc->coarse_vec,coarse_nsp_vecs[coarse_nsp_size]);CHKERRQ(ierr); 4388 coarse_nsp_size++; 4389 } 4390 } 4391 for (i=0;i<nsp_size;i++) { 4392 ierr = VecScatterBegin(matis->ctx,nsp_vecs[i],pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4393 ierr = VecScatterEnd (matis->ctx,nsp_vecs[i],pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4394 ierr = MatMult(pcbddc->ConstraintMatrix,pcis->vec1_N,pcbddc->vec1_P);CHKERRQ(ierr); 4395 ierr = PCBDDCScatterCoarseDataBegin(pc,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4396 ierr = PCBDDCScatterCoarseDataEnd(pc,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4397 if (rank_prec_comm == active_rank) { 4398 ierr = MatMult(pcbddc->coarse_mat,pcbddc->coarse_vec,pcbddc->coarse_rhs);CHKERRQ(ierr); 4399 ierr = VecNorm(pcbddc->coarse_rhs,NORM_2,&test_null);CHKERRQ(ierr); 4400 if (test_null > 1.0e-12 && pcbddc->dbg_flag ) { 4401 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Vec %d coarse null space error % 1.14e\n",i,test_null);CHKERRQ(ierr); 4402 } 4403 ierr = VecCopy(pcbddc->coarse_vec,coarse_nsp_vecs[coarse_nsp_size]);CHKERRQ(ierr); 4404 coarse_nsp_size++; 4405 } 4406 } 4407 if (coarse_nsp_size > 0) { 4408 /* TODO orthonormalize vecs */ 4409 ierr = VecNormalize(coarse_nsp_vecs[0],PETSC_NULL);CHKERRQ(ierr); 4410 ierr = MatNullSpaceCreate(coarse_comm,PETSC_FALSE,coarse_nsp_size,coarse_nsp_vecs,&pcbddc->CoarseNullSpace);CHKERRQ(ierr); 4411 for (i=0;i<nsp_size+1;i++) { 4412 ierr = VecDestroy(&coarse_nsp_vecs[i]);CHKERRQ(ierr); 4413 } 4414 } 4415 ierr = PetscFree(coarse_nsp_vecs);CHKERRQ(ierr); 4416 } 4417 4418 /* KSP for coarse problem */ 4419 if (rank_prec_comm == active_rank) { 4420 PetscBool isbddc=PETSC_FALSE; 4421 4422 ierr = KSPCreate(coarse_comm,&pcbddc->coarse_ksp);CHKERRQ(ierr); 4423 ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr); 4424 ierr = KSPSetOperators(pcbddc->coarse_ksp,pcbddc->coarse_mat,pcbddc->coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr); 4425 ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,max_it_coarse_ksp);CHKERRQ(ierr); 4426 ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr); 4427 ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr); 4428 ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr); 4429 /* Allow user's customization */ 4430 ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,"coarse_");CHKERRQ(ierr); 4431 /* Set Up PC for coarse problem BDDC */ 4432 if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) { 4433 i = pcbddc->current_level+1; 4434 ierr = PCBDDCSetLevel(pc_temp,i);CHKERRQ(ierr); 4435 ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr); 4436 ierr = PCBDDCSetMaxLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr); 4437 ierr = PCBDDCSetCoarseProblemType(pc_temp,MULTILEVEL_BDDC);CHKERRQ(ierr); 4438 if (pcbddc->CoarseNullSpace) { ierr = PCBDDCSetNullSpace(pc_temp,pcbddc->CoarseNullSpace);CHKERRQ(ierr); } 4439 if (dbg_flag) { 4440 ierr = PetscViewerASCIIPrintf(viewer,"----------------Level %d: Setting up level %d---------------\n",pcbddc->current_level,i);CHKERRQ(ierr); 4441 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 4442 } 4443 } 4444 ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr); 4445 ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr); 4446 4447 ierr = KSPGetTolerances(pcbddc->coarse_ksp,PETSC_NULL,PETSC_NULL,PETSC_NULL,&j);CHKERRQ(ierr); 4448 ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr); 4449 ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr); 4450 if (j == 1) { 4451 ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr); 4452 if (isbddc) { 4453 ierr = PCBDDCSetUseExactDirichlet(pc_temp,PETSC_FALSE);CHKERRQ(ierr); 4454 } 4455 } 4456 } 4457 /* Evaluate condition number of coarse problem for cheby (and verbose output if requested) */ 4458 if ( dbg_flag && rank_prec_comm == active_rank ) { 4459 KSP check_ksp; 4460 PC check_pc; 4461 Vec check_vec; 4462 PetscReal abs_infty_error,infty_error,lambda_min,lambda_max; 4463 KSPType check_ksp_type; 4464 4465 /* Create ksp object suitable for extreme eigenvalues' estimation */ 4466 ierr = KSPCreate(coarse_comm,&check_ksp);CHKERRQ(ierr); 4467 ierr = KSPSetOperators(check_ksp,pcbddc->coarse_mat,pcbddc->coarse_mat,SAME_PRECONDITIONER);CHKERRQ(ierr); 4468 ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr); 4469 if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) { 4470 if (issym) { 4471 check_ksp_type = KSPCG; 4472 } else { 4473 check_ksp_type = KSPGMRES; 4474 } 4475 ierr = KSPSetComputeSingularValues(check_ksp,PETSC_TRUE);CHKERRQ(ierr); 4476 } else { 4477 check_ksp_type = KSPPREONLY; 4478 } 4479 ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr); 4480 ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr); 4481 ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr); 4482 ierr = KSPSetUp(check_ksp);CHKERRQ(ierr); 4483 /* create random vec */ 4484 ierr = VecDuplicate(pcbddc->coarse_vec,&check_vec);CHKERRQ(ierr); 4485 ierr = VecSetRandom(check_vec,PETSC_NULL);CHKERRQ(ierr); 4486 if (pcbddc->CoarseNullSpace) { ierr = MatNullSpaceRemove(pcbddc->CoarseNullSpace,check_vec,PETSC_NULL);CHKERRQ(ierr); } 4487 ierr = MatMult(pcbddc->coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr); 4488 /* solve coarse problem */ 4489 ierr = KSPSolve(check_ksp,pcbddc->coarse_rhs,pcbddc->coarse_vec);CHKERRQ(ierr); 4490 if (pcbddc->CoarseNullSpace) { ierr = MatNullSpaceRemove(pcbddc->CoarseNullSpace,pcbddc->coarse_vec,PETSC_NULL);CHKERRQ(ierr); } 4491 /* check coarse problem residual error */ 4492 ierr = VecAXPY(check_vec,-1.0,pcbddc->coarse_vec);CHKERRQ(ierr); 4493 ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr); 4494 ierr = MatMult(pcbddc->coarse_mat,check_vec,pcbddc->coarse_rhs);CHKERRQ(ierr); 4495 ierr = VecNorm(pcbddc->coarse_rhs,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr); 4496 ierr = VecDestroy(&check_vec);CHKERRQ(ierr); 4497 /* get eigenvalue estimation if inexact */ 4498 if (pcbddc->coarse_problem_type == MULTILEVEL_BDDC) { 4499 ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr); 4500 ierr = KSPGetIterationNumber(check_ksp,&k);CHKERRQ(ierr); 4501 ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem eigenvalues estimated with %d iterations of %s.\n",k,check_ksp_type);CHKERRQ(ierr); 4502 ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem eigenvalues: % 1.14e %1.14e\n",lambda_min,lambda_max);CHKERRQ(ierr); 4503 } 4504 ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem exact infty_error : %1.14e\n",infty_error);CHKERRQ(ierr); 4505 ierr = PetscViewerASCIIPrintf(viewer,"Coarse problem residual infty_error: %1.14e\n",abs_infty_error);CHKERRQ(ierr); 4506 ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr); 4507 } 4508 if (dbg_flag) { ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); } 4509 /* free data structures no longer needed */ 4510 if (coarse_ISLG) { ierr = ISLocalToGlobalMappingDestroy(&coarse_ISLG);CHKERRQ(ierr); } 4511 if (ins_local_primal_indices) { ierr = PetscFree(ins_local_primal_indices);CHKERRQ(ierr); } 4512 if (ins_coarse_mat_vals) { ierr = PetscFree(ins_coarse_mat_vals);CHKERRQ(ierr);} 4513 if (localsizes2) { ierr = PetscFree(localsizes2);CHKERRQ(ierr);} 4514 if (localdispl2) { ierr = PetscFree(localdispl2);CHKERRQ(ierr);} 4515 if (temp_coarse_mat_vals) { ierr = PetscFree(temp_coarse_mat_vals);CHKERRQ(ierr);} 4516 4517 PetscFunctionReturn(0); 4518 } 4519 4520 #undef __FUNCT__ 4521 #define __FUNCT__ "PCBDDCManageLocalBoundaries" 4522 static PetscErrorCode PCBDDCManageLocalBoundaries(PC pc) 4523 { 4524 4525 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 4526 PC_IS *pcis = (PC_IS*)pc->data; 4527 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 4528 PCBDDCGraph mat_graph=pcbddc->mat_graph; 4529 PetscInt *is_indices,*auxis; 4530 PetscInt bs,ierr,i,j,s,k,iindex,neumann_bsize,dirichlet_bsize; 4531 PetscInt total_counts,nodes_touched,where_values=1,vertex_size; 4532 PetscMPIInt adapt_interface=0,adapt_interface_reduced=0,NEUMANNCNT=0; 4533 PetscBool same_set; 4534 MPI_Comm interface_comm=((PetscObject)pc)->comm; 4535 PetscBool use_faces=PETSC_FALSE,use_edges=PETSC_FALSE; 4536 const PetscInt *neumann_nodes; 4537 const PetscInt *dirichlet_nodes; 4538 IS used_IS,*custom_ISForDofs; 4539 PetscScalar *array; 4540 PetscScalar *array2; 4541 PetscViewer viewer=pcbddc->dbg_viewer; 4542 4543 PetscFunctionBegin; 4544 /* Setup local adjacency graph */ 4545 mat_graph->nvtxs=pcis->n; 4546 if (!mat_graph->xadj) { NEUMANNCNT = 1; } 4547 ierr = PCBDDCSetupLocalAdjacencyGraph(pc);CHKERRQ(ierr); 4548 i = mat_graph->nvtxs; 4549 ierr = PetscMalloc4(i,PetscInt,&mat_graph->where,i,PetscInt,&mat_graph->count,i+1,PetscInt,&mat_graph->cptr,i,PetscInt,&mat_graph->queue);CHKERRQ(ierr); 4550 ierr = PetscMalloc2(i,PetscInt,&mat_graph->which_dof,i,PetscBool,&mat_graph->touched);CHKERRQ(ierr); 4551 ierr = PetscMemzero(mat_graph->where,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr); 4552 ierr = PetscMemzero(mat_graph->count,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr); 4553 ierr = PetscMemzero(mat_graph->which_dof,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr); 4554 ierr = PetscMemzero(mat_graph->queue,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr); 4555 ierr = PetscMemzero(mat_graph->cptr,(mat_graph->nvtxs+1)*sizeof(PetscInt));CHKERRQ(ierr); 4556 4557 /* Setting dofs splitting in mat_graph->which_dof 4558 Get information about dofs' splitting if provided by the user 4559 Otherwise it assumes a constant block size */ 4560 vertex_size=0; 4561 if (!pcbddc->n_ISForDofs) { 4562 ierr = MatGetBlockSize(matis->A,&bs);CHKERRQ(ierr); 4563 ierr = PetscMalloc(bs*sizeof(IS),&custom_ISForDofs);CHKERRQ(ierr); 4564 for (i=0;i<bs;i++) { 4565 ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n/bs,i,bs,&custom_ISForDofs[i]);CHKERRQ(ierr); 4566 } 4567 ierr = PCBDDCSetDofsSplitting(pc,bs,custom_ISForDofs);CHKERRQ(ierr); 4568 vertex_size=1; 4569 /* remove my references to IS objects */ 4570 for (i=0;i<bs;i++) { 4571 ierr = ISDestroy(&custom_ISForDofs[i]);CHKERRQ(ierr); 4572 } 4573 ierr = PetscFree(custom_ISForDofs);CHKERRQ(ierr); 4574 } 4575 for (i=0;i<pcbddc->n_ISForDofs;i++) { 4576 ierr = ISGetSize(pcbddc->ISForDofs[i],&k);CHKERRQ(ierr); 4577 ierr = ISGetIndices(pcbddc->ISForDofs[i],(const PetscInt**)&is_indices);CHKERRQ(ierr); 4578 for (j=0;j<k;j++) { 4579 mat_graph->which_dof[is_indices[j]]=i; 4580 } 4581 ierr = ISRestoreIndices(pcbddc->ISForDofs[i],(const PetscInt**)&is_indices);CHKERRQ(ierr); 4582 } 4583 /* use mat block size as vertex size if it has not yet set */ 4584 if (!vertex_size) { 4585 ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr); 4586 } 4587 4588 /* count number of neigh per node */ 4589 total_counts=0; 4590 for (i=1;i<pcis->n_neigh;i++){ 4591 s=pcis->n_shared[i]; 4592 total_counts+=s; 4593 for (j=0;j<s;j++){ 4594 mat_graph->count[pcis->shared[i][j]] += 1; 4595 } 4596 } 4597 /* Take into account Neumann data -> it increments number of sharing subdomains for nodes lying on the interface */ 4598 ierr = PCBDDCGetNeumannBoundaries(pc,&used_IS);CHKERRQ(ierr); 4599 ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr); 4600 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 4601 if (used_IS) { 4602 ierr = ISGetSize(used_IS,&neumann_bsize);CHKERRQ(ierr); 4603 ierr = ISGetIndices(used_IS,&neumann_nodes);CHKERRQ(ierr); 4604 for (i=0;i<neumann_bsize;i++){ 4605 iindex = neumann_nodes[i]; 4606 if (mat_graph->count[iindex] > NEUMANNCNT && array[iindex]==0.0){ 4607 mat_graph->count[iindex]+=1; 4608 total_counts++; 4609 array[iindex]=array[iindex]+1.0; 4610 } else if (array[iindex]>0.0) { 4611 SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_USER,"Error for neumann nodes provided to BDDC! They must be uniquely listed! Found duplicate node %d\n",iindex); 4612 } 4613 } 4614 } 4615 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 4616 /* allocate space for storing the set of neighbours for each node */ 4617 ierr = PetscMalloc(mat_graph->nvtxs*sizeof(PetscInt*),&mat_graph->neighbours_set);CHKERRQ(ierr); 4618 if (mat_graph->nvtxs) { ierr = PetscMalloc(total_counts*sizeof(PetscInt),&mat_graph->neighbours_set[0]);CHKERRQ(ierr); } 4619 for (i=1;i<mat_graph->nvtxs;i++) mat_graph->neighbours_set[i]=mat_graph->neighbours_set[i-1]+mat_graph->count[i-1]; 4620 ierr = PetscMemzero(mat_graph->count,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr); 4621 for (i=1;i<pcis->n_neigh;i++){ 4622 s=pcis->n_shared[i]; 4623 for (j=0;j<s;j++) { 4624 k=pcis->shared[i][j]; 4625 mat_graph->neighbours_set[k][mat_graph->count[k]] = pcis->neigh[i]; 4626 mat_graph->count[k]+=1; 4627 } 4628 } 4629 /* Check consistency of Neumann nodes */ 4630 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 4631 ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 4632 ierr = VecScatterEnd (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 4633 ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4634 ierr = VecScatterEnd (matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4635 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 4636 /* set -1 fake neighbour to mimic Neumann boundary */ 4637 if (used_IS) { 4638 for (i=0;i<neumann_bsize;i++){ 4639 iindex = neumann_nodes[i]; 4640 if (mat_graph->count[iindex] > NEUMANNCNT){ 4641 if (mat_graph->count[iindex]+1 != (PetscInt)array[iindex]) { 4642 SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_USER,"Neumann nodes provided to BDDC must be consistent among neighbours!\nNode %d: number of sharing subdomains %d != number of subdomains for which it is a neumann node %d\n",iindex,mat_graph->count[iindex]+1,(PetscInt)array[iindex]); 4643 } 4644 mat_graph->neighbours_set[iindex][mat_graph->count[iindex]] = -1; 4645 mat_graph->count[iindex]+=1; 4646 } 4647 } 4648 ierr = ISRestoreIndices(used_IS,&neumann_nodes);CHKERRQ(ierr); 4649 } 4650 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 4651 /* sort set of sharing subdomains */ 4652 for (i=0;i<mat_graph->nvtxs;i++) { ierr = PetscSortInt(mat_graph->count[i],mat_graph->neighbours_set[i]);CHKERRQ(ierr); } 4653 /* remove interior nodes and dirichlet boundary nodes from the next search into the graph */ 4654 for (i=0;i<mat_graph->nvtxs;i++){mat_graph->touched[i]=PETSC_FALSE;} 4655 nodes_touched=0; 4656 ierr = PCBDDCGetDirichletBoundaries(pc,&used_IS);CHKERRQ(ierr); 4657 ierr = VecSet(pcis->vec2_N,0.0);CHKERRQ(ierr); 4658 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 4659 ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr); 4660 if (used_IS) { 4661 ierr = ISGetSize(used_IS,&dirichlet_bsize);CHKERRQ(ierr); 4662 if (dirichlet_bsize && matis->pure_neumann) { 4663 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"Dirichlet boundaries are intended to be used with matrices with zeroed rows!\n"); 4664 } 4665 ierr = ISGetIndices(used_IS,&dirichlet_nodes);CHKERRQ(ierr); 4666 for (i=0;i<dirichlet_bsize;i++){ 4667 iindex=dirichlet_nodes[i]; 4668 if (mat_graph->count[iindex] && !mat_graph->touched[iindex]) { 4669 if (array[iindex]>0.0) { 4670 SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_USER,"BDDC cannot have nodes which are marked as Neumann and Dirichlet at the same time! Wrong node %d\n",iindex); 4671 } 4672 mat_graph->touched[iindex]=PETSC_TRUE; 4673 mat_graph->where[iindex]=0; 4674 nodes_touched++; 4675 array2[iindex]=array2[iindex]+1.0; 4676 } 4677 } 4678 ierr = ISRestoreIndices(used_IS,&dirichlet_nodes);CHKERRQ(ierr); 4679 } 4680 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 4681 ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr); 4682 /* Check consistency of Dirichlet nodes */ 4683 ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr); 4684 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 4685 ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 4686 ierr = VecScatterEnd (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 4687 ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4688 ierr = VecScatterEnd (matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4689 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 4690 ierr = VecScatterBegin(matis->ctx,pcis->vec2_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 4691 ierr = VecScatterEnd (matis->ctx,pcis->vec2_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 4692 ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4693 ierr = VecScatterEnd (matis->ctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4694 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 4695 ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr); 4696 if (used_IS) { 4697 ierr = ISGetSize(used_IS,&dirichlet_bsize);CHKERRQ(ierr); 4698 ierr = ISGetIndices(used_IS,&dirichlet_nodes);CHKERRQ(ierr); 4699 for (i=0;i<dirichlet_bsize;i++){ 4700 iindex=dirichlet_nodes[i]; 4701 if (array[iindex]>1.0 && array[iindex]!=array2[iindex] ) { 4702 SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_USER,"Dirichlet nodes provided to BDDC must be consistent among neighbours!\nNode %d: number of sharing subdomains %d != number of subdomains for which it is a neumann node %d\n",iindex,(PetscInt)array[iindex],(PetscInt)array2[iindex]); 4703 } 4704 } 4705 ierr = ISRestoreIndices(used_IS,&dirichlet_nodes);CHKERRQ(ierr); 4706 } 4707 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 4708 ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr); 4709 4710 for (i=0;i<mat_graph->nvtxs;i++){ 4711 if (!mat_graph->count[i]){ /* interior nodes */ 4712 mat_graph->touched[i]=PETSC_TRUE; 4713 mat_graph->where[i]=0; 4714 nodes_touched++; 4715 } 4716 } 4717 mat_graph->ncmps = 0; 4718 i=0; 4719 while(nodes_touched<mat_graph->nvtxs) { 4720 /* find first untouched node in local ordering */ 4721 while(mat_graph->touched[i]) i++; 4722 mat_graph->touched[i]=PETSC_TRUE; 4723 mat_graph->where[i]=where_values; 4724 nodes_touched++; 4725 /* now find all other nodes having the same set of sharing subdomains */ 4726 for (j=i+1;j<mat_graph->nvtxs;j++){ 4727 /* check for same number of sharing subdomains and dof number */ 4728 if (!mat_graph->touched[j] && mat_graph->count[i]==mat_graph->count[j] && mat_graph->which_dof[i] == mat_graph->which_dof[j] ){ 4729 /* check for same set of sharing subdomains */ 4730 same_set=PETSC_TRUE; 4731 for (k=0;k<mat_graph->count[j];k++){ 4732 if (mat_graph->neighbours_set[i][k]!=mat_graph->neighbours_set[j][k]) { 4733 same_set=PETSC_FALSE; 4734 } 4735 } 4736 /* I found a friend of mine */ 4737 if (same_set) { 4738 mat_graph->where[j]=where_values; 4739 mat_graph->touched[j]=PETSC_TRUE; 4740 nodes_touched++; 4741 } 4742 } 4743 } 4744 where_values++; 4745 } 4746 where_values--; if (where_values<0) where_values=0; 4747 ierr = PetscMalloc(where_values*sizeof(PetscMPIInt),&mat_graph->where_ncmps);CHKERRQ(ierr); 4748 /* Find connected components defined on the shared interface */ 4749 if (where_values) { 4750 ierr = PCBDDCFindConnectedComponents(mat_graph, where_values); 4751 } 4752 /* check consistency of connected components among neighbouring subdomains -> it adapt them in case it is needed */ 4753 for (i=0;i<where_values;i++) { 4754 /* We are not sure that on a given subset of the local interface, 4755 two connected components will be the same among sharing subdomains */ 4756 if (mat_graph->where_ncmps[i]>1) { 4757 adapt_interface=1; 4758 break; 4759 } 4760 } 4761 ierr = MPI_Allreduce(&adapt_interface,&adapt_interface_reduced,1,MPIU_INT,MPI_LOR,interface_comm);CHKERRQ(ierr); 4762 if (pcbddc->dbg_flag && adapt_interface_reduced) { 4763 ierr = PetscViewerASCIIPrintf(viewer,"Adapting interface\n");CHKERRQ(ierr); 4764 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 4765 } 4766 if (where_values && adapt_interface_reduced) { 4767 4768 PetscInt sum_requests=0,my_rank; 4769 PetscInt buffer_size,start_of_recv,size_of_recv,start_of_send; 4770 PetscInt temp_buffer_size,ins_val,global_where_counter; 4771 PetscInt *cum_recv_counts; 4772 PetscInt *where_to_nodes_indices; 4773 PetscInt *petsc_buffer; 4774 PetscMPIInt *recv_buffer; 4775 PetscMPIInt *recv_buffer_where; 4776 PetscMPIInt *send_buffer; 4777 PetscMPIInt size_of_send; 4778 PetscInt *sizes_of_sends; 4779 MPI_Request *send_requests; 4780 MPI_Request *recv_requests; 4781 PetscInt *where_cc_adapt; 4782 PetscInt **temp_buffer; 4783 PetscInt *nodes_to_temp_buffer_indices; 4784 PetscInt *add_to_where; 4785 PetscInt *aux_new_xadj,*new_xadj,*new_adjncy; 4786 PetscInt *queue_in_global_numbering; 4787 4788 /* Retrict adjacency graph using information from connected components */ 4789 ierr = PetscMalloc(mat_graph->nvtxs*sizeof(PetscInt),&aux_new_xadj);CHKERRQ(ierr); 4790 for (i=0;i<mat_graph->nvtxs;i++) { 4791 aux_new_xadj[i]=1; 4792 } 4793 for (i=0;i<mat_graph->ncmps;i++) { 4794 k = mat_graph->cptr[i+1]-mat_graph->cptr[i]; 4795 for (j=0;j<k;j++) { 4796 aux_new_xadj[mat_graph->queue[mat_graph->cptr[i]+j]]=k; 4797 } 4798 } 4799 j = 0; 4800 for (i=0;i<mat_graph->nvtxs;i++) { 4801 j += aux_new_xadj[i]; 4802 } 4803 ierr = PetscMalloc((mat_graph->nvtxs+1)*sizeof(PetscInt),&new_xadj);CHKERRQ(ierr); 4804 ierr = PetscMalloc(j*sizeof(PetscInt),&new_adjncy);CHKERRQ(ierr); 4805 new_xadj[0]=0; 4806 for (i=0;i<mat_graph->nvtxs;i++) { 4807 new_xadj[i+1]=new_xadj[i]+aux_new_xadj[i]; 4808 if (aux_new_xadj[i]==1) { 4809 new_adjncy[new_xadj[i]]=i; 4810 } 4811 } 4812 ierr = PetscFree(aux_new_xadj);CHKERRQ(ierr); 4813 for (i=0;i<mat_graph->ncmps;i++) { 4814 k = mat_graph->cptr[i+1]-mat_graph->cptr[i]; 4815 for (j=0;j<k;j++) { 4816 ierr = PetscMemcpy(&new_adjncy[new_xadj[mat_graph->queue[mat_graph->cptr[i]+j]]],&mat_graph->queue[mat_graph->cptr[i]],k*sizeof(PetscInt));CHKERRQ(ierr); 4817 } 4818 } 4819 ierr = PCBDDCSetLocalAdjacencyGraph(pc,mat_graph->nvtxs,new_xadj,new_adjncy,PETSC_OWN_POINTER);CHKERRQ(ierr); 4820 /* For consistency among neughbouring procs, I need to sort (by global ordering) each connected component */ 4821 ierr = PetscMalloc(mat_graph->nvtxs*sizeof(PetscInt),&queue_in_global_numbering);CHKERRQ(ierr); 4822 for (i=0;i<mat_graph->ncmps;i++) { 4823 k = mat_graph->cptr[i+1]-mat_graph->cptr[i]; 4824 ierr = ISLocalToGlobalMappingApply(matis->mapping,k,&mat_graph->queue[mat_graph->cptr[i]],&queue_in_global_numbering[mat_graph->cptr[i]]);CHKERRQ(ierr); 4825 ierr = PetscSortIntWithArray(k,&queue_in_global_numbering[mat_graph->cptr[i]],&mat_graph->queue[mat_graph->cptr[i]]);CHKERRQ(ierr); 4826 } 4827 /* allocate some space */ 4828 ierr = MPI_Comm_rank(interface_comm,&my_rank);CHKERRQ(ierr); 4829 ierr = PetscMalloc((where_values+1)*sizeof(PetscInt),&cum_recv_counts);CHKERRQ(ierr); 4830 ierr = PetscMemzero(cum_recv_counts,(where_values+1)*sizeof(PetscInt));CHKERRQ(ierr); 4831 ierr = PetscMalloc(where_values*sizeof(PetscInt),&where_to_nodes_indices);CHKERRQ(ierr); 4832 /* first count how many neighbours per connected component I will receive from */ 4833 cum_recv_counts[0]=0; 4834 for (i=1;i<where_values+1;i++){ 4835 j=0; 4836 while(mat_graph->where[j] != i) { j++; } 4837 where_to_nodes_indices[i-1]=j; 4838 if (mat_graph->neighbours_set[j][0]!=-1) { cum_recv_counts[i]=cum_recv_counts[i-1]+mat_graph->count[j]; } /* We don't want sends/recvs_to/from_self -> here I don't count myself */ 4839 else { cum_recv_counts[i]=cum_recv_counts[i-1]+mat_graph->count[j]-1; } 4840 } 4841 ierr = PetscMalloc(2*cum_recv_counts[where_values]*sizeof(PetscMPIInt),&recv_buffer_where);CHKERRQ(ierr); 4842 ierr = PetscMalloc(cum_recv_counts[where_values]*sizeof(MPI_Request),&send_requests);CHKERRQ(ierr); 4843 ierr = PetscMalloc(cum_recv_counts[where_values]*sizeof(MPI_Request),&recv_requests);CHKERRQ(ierr); 4844 for (i=0;i<cum_recv_counts[where_values];i++) { 4845 send_requests[i]=MPI_REQUEST_NULL; 4846 recv_requests[i]=MPI_REQUEST_NULL; 4847 } 4848 /* exchange with my neighbours the number of my connected components on the shared interface */ 4849 for (i=0;i<where_values;i++){ 4850 j=where_to_nodes_indices[i]; 4851 k = (mat_graph->neighbours_set[j][0] == -1 ? 1 : 0); 4852 for (;k<mat_graph->count[j];k++){ 4853 ierr = MPI_Isend(&mat_graph->where_ncmps[i],1,MPIU_INT,mat_graph->neighbours_set[j][k],(my_rank+1)*mat_graph->count[j],interface_comm,&send_requests[sum_requests]);CHKERRQ(ierr); 4854 ierr = MPI_Irecv(&recv_buffer_where[sum_requests],1,MPIU_INT,mat_graph->neighbours_set[j][k],(mat_graph->neighbours_set[j][k]+1)*mat_graph->count[j],interface_comm,&recv_requests[sum_requests]);CHKERRQ(ierr); 4855 sum_requests++; 4856 } 4857 } 4858 ierr = MPI_Waitall(sum_requests,recv_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 4859 ierr = MPI_Waitall(sum_requests,send_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 4860 /* determine the connected component I need to adapt */ 4861 ierr = PetscMalloc(where_values*sizeof(PetscInt),&where_cc_adapt);CHKERRQ(ierr); 4862 ierr = PetscMemzero(where_cc_adapt,where_values*sizeof(PetscInt));CHKERRQ(ierr); 4863 for (i=0;i<where_values;i++){ 4864 for (j=cum_recv_counts[i];j<cum_recv_counts[i+1];j++){ 4865 /* The first condition is natural (i.e someone has a different number of cc than me), the second one is just to be safe */ 4866 if ( mat_graph->where_ncmps[i]!=recv_buffer_where[j] || mat_graph->where_ncmps[i] > 1 ) { 4867 where_cc_adapt[i]=PETSC_TRUE; 4868 break; 4869 } 4870 } 4871 } 4872 buffer_size = 0; 4873 for (i=0;i<where_values;i++) { 4874 if (where_cc_adapt[i]) { 4875 for (j=i;j<mat_graph->ncmps;j++) { 4876 if (mat_graph->where[mat_graph->queue[mat_graph->cptr[j]]] == i+1) { /* WARNING -> where values goes from 1 to where_values included */ 4877 buffer_size += 1 + mat_graph->cptr[j+1]-mat_graph->cptr[j]; 4878 } 4879 } 4880 } 4881 } 4882 ierr = PetscMalloc(buffer_size*sizeof(PetscMPIInt),&send_buffer);CHKERRQ(ierr); 4883 /* now get from neighbours their ccs (in global numbering) and adapt them (in case it is needed) */ 4884 /* first determine how much data to send (size of each queue plus the global indices) and communicate it to neighbours */ 4885 ierr = PetscMalloc(where_values*sizeof(PetscInt),&sizes_of_sends);CHKERRQ(ierr); 4886 ierr = PetscMemzero(sizes_of_sends,where_values*sizeof(PetscInt));CHKERRQ(ierr); 4887 sum_requests=0; 4888 start_of_send=0; 4889 start_of_recv=cum_recv_counts[where_values]; 4890 for (i=0;i<where_values;i++) { 4891 if (where_cc_adapt[i]) { 4892 size_of_send=0; 4893 for (j=i;j<mat_graph->ncmps;j++) { 4894 if (mat_graph->where[mat_graph->queue[mat_graph->cptr[j]]] == i+1) { /* WARNING -> where values goes from 1 to where_values included */ 4895 send_buffer[start_of_send+size_of_send]=mat_graph->cptr[j+1]-mat_graph->cptr[j]; 4896 size_of_send+=1; 4897 for (k=0;k<mat_graph->cptr[j+1]-mat_graph->cptr[j];k++) { 4898 send_buffer[start_of_send+size_of_send+k]=queue_in_global_numbering[mat_graph->cptr[j]+k]; 4899 } 4900 size_of_send=size_of_send+mat_graph->cptr[j+1]-mat_graph->cptr[j]; 4901 } 4902 } 4903 j = where_to_nodes_indices[i]; 4904 k = (mat_graph->neighbours_set[j][0] == -1 ? 1 : 0); 4905 sizes_of_sends[i]=size_of_send; 4906 for (;k<mat_graph->count[j];k++){ 4907 ierr = MPI_Isend(&sizes_of_sends[i],1,MPIU_INT,mat_graph->neighbours_set[j][k],(my_rank+1)*mat_graph->count[j],interface_comm,&send_requests[sum_requests]);CHKERRQ(ierr); 4908 ierr = MPI_Irecv(&recv_buffer_where[sum_requests+start_of_recv],1,MPIU_INT,mat_graph->neighbours_set[j][k],(mat_graph->neighbours_set[j][k]+1)*mat_graph->count[j],interface_comm,&recv_requests[sum_requests]);CHKERRQ(ierr); 4909 sum_requests++; 4910 } 4911 start_of_send+=size_of_send; 4912 } 4913 } 4914 ierr = MPI_Waitall(sum_requests,send_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 4915 ierr = MPI_Waitall(sum_requests,recv_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 4916 buffer_size=0; 4917 for (k=0;k<sum_requests;k++) { buffer_size+=recv_buffer_where[start_of_recv+k]; } 4918 ierr = PetscMalloc(buffer_size*sizeof(PetscMPIInt),&recv_buffer);CHKERRQ(ierr); 4919 /* now exchange the data */ 4920 start_of_recv=0; 4921 start_of_send=0; 4922 sum_requests=0; 4923 for (i=0;i<where_values;i++) { 4924 if (where_cc_adapt[i]) { 4925 size_of_send = sizes_of_sends[i]; 4926 j = where_to_nodes_indices[i]; 4927 k = (mat_graph->neighbours_set[j][0] == -1 ? 1 : 0); 4928 for (;k<mat_graph->count[j];k++){ 4929 ierr = MPI_Isend(&send_buffer[start_of_send],size_of_send,MPIU_INT,mat_graph->neighbours_set[j][k],(my_rank+1)*mat_graph->count[j],interface_comm,&send_requests[sum_requests]);CHKERRQ(ierr); 4930 size_of_recv=recv_buffer_where[cum_recv_counts[where_values]+sum_requests]; 4931 ierr = MPI_Irecv(&recv_buffer[start_of_recv],size_of_recv,MPIU_INT,mat_graph->neighbours_set[j][k],(mat_graph->neighbours_set[j][k]+1)*mat_graph->count[j],interface_comm,&recv_requests[sum_requests]);CHKERRQ(ierr); 4932 start_of_recv+=size_of_recv; 4933 sum_requests++; 4934 } 4935 start_of_send+=size_of_send; 4936 } 4937 } 4938 ierr = MPI_Waitall(sum_requests,recv_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 4939 ierr = MPI_Waitall(sum_requests,send_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 4940 ierr = PetscMalloc(buffer_size*sizeof(PetscInt),&petsc_buffer);CHKERRQ(ierr); 4941 for (k=0;k<start_of_recv;k++) { petsc_buffer[k]=(PetscInt)recv_buffer[k]; } 4942 for (j=0;j<buffer_size;) { 4943 ierr = ISGlobalToLocalMappingApply(matis->mapping,IS_GTOLM_MASK,petsc_buffer[j],&petsc_buffer[j+1],&petsc_buffer[j],&petsc_buffer[j+1]);CHKERRQ(ierr); 4944 k=petsc_buffer[j]+1; 4945 j+=k; 4946 } 4947 sum_requests=cum_recv_counts[where_values]; 4948 start_of_recv=0; 4949 ierr = PetscMalloc(mat_graph->nvtxs*sizeof(PetscInt),&nodes_to_temp_buffer_indices);CHKERRQ(ierr); 4950 global_where_counter=0; 4951 for (i=0;i<where_values;i++){ 4952 if (where_cc_adapt[i]){ 4953 temp_buffer_size=0; 4954 /* find nodes on the shared interface we need to adapt */ 4955 for (j=0;j<mat_graph->nvtxs;j++){ 4956 if (mat_graph->where[j]==i+1) { 4957 nodes_to_temp_buffer_indices[j]=temp_buffer_size; 4958 temp_buffer_size++; 4959 } else { 4960 nodes_to_temp_buffer_indices[j]=-1; 4961 } 4962 } 4963 /* allocate some temporary space */ 4964 ierr = PetscMalloc(temp_buffer_size*sizeof(PetscInt*),&temp_buffer);CHKERRQ(ierr); 4965 ierr = PetscMalloc(temp_buffer_size*(cum_recv_counts[i+1]-cum_recv_counts[i])*sizeof(PetscInt),&temp_buffer[0]);CHKERRQ(ierr); 4966 ierr = PetscMemzero(temp_buffer[0],temp_buffer_size*(cum_recv_counts[i+1]-cum_recv_counts[i])*sizeof(PetscInt));CHKERRQ(ierr); 4967 for (j=1;j<temp_buffer_size;j++){ 4968 temp_buffer[j]=temp_buffer[j-1]+cum_recv_counts[i+1]-cum_recv_counts[i]; 4969 } 4970 /* analyze contributions from neighbouring subdomains for i-th conn comp 4971 temp buffer structure: 4972 supposing part of the interface has dimension 5 (global nodes 0,1,2,3,4) 4973 3 neighs procs with structured connected components: 4974 neigh 0: [0 1 4], [2 3]; (2 connected components) 4975 neigh 1: [0 1], [2 3 4]; (2 connected components) 4976 neigh 2: [0 4], [1], [2 3]; (3 connected components) 4977 tempbuffer (row-oriented) should be filled as: 4978 [ 0, 0, 0; 4979 0, 0, 1; 4980 1, 1, 2; 4981 1, 1, 2; 4982 0, 1, 0; ]; 4983 This way we can simply recover the resulting structure account for possible intersections of ccs among neighs. 4984 The mat_graph->where array will be modified to reproduce the following 4 connected components [0], [1], [2 3], [4]; 4985 */ 4986 for (j=0;j<cum_recv_counts[i+1]-cum_recv_counts[i];j++) { 4987 ins_val=0; 4988 size_of_recv=recv_buffer_where[sum_requests]; /* total size of recv from neighs */ 4989 for (buffer_size=0;buffer_size<size_of_recv;) { /* loop until all data from neighs has been taken into account */ 4990 for (k=1;k<petsc_buffer[buffer_size+start_of_recv]+1;k++) { /* filling properly temp_buffer using data from a single recv */ 4991 temp_buffer[ nodes_to_temp_buffer_indices[ petsc_buffer[ start_of_recv+buffer_size+k ] ] ][j]=ins_val; 4992 } 4993 buffer_size+=k; 4994 ins_val++; 4995 } 4996 start_of_recv+=size_of_recv; 4997 sum_requests++; 4998 } 4999 ierr = PetscMalloc(temp_buffer_size*sizeof(PetscInt),&add_to_where);CHKERRQ(ierr); 5000 ierr = PetscMemzero(add_to_where,temp_buffer_size*sizeof(PetscInt));CHKERRQ(ierr); 5001 for (j=0;j<temp_buffer_size;j++){ 5002 if (!add_to_where[j]){ /* found a new cc */ 5003 global_where_counter++; 5004 add_to_where[j]=global_where_counter; 5005 for (k=j+1;k<temp_buffer_size;k++){ /* check for other nodes in new cc */ 5006 same_set=PETSC_TRUE; 5007 for (s=0;s<cum_recv_counts[i+1]-cum_recv_counts[i];s++){ 5008 if (temp_buffer[j][s]!=temp_buffer[k][s]) { 5009 same_set=PETSC_FALSE; 5010 break; 5011 } 5012 } 5013 if (same_set) { add_to_where[k]=global_where_counter; } 5014 } 5015 } 5016 } 5017 /* insert new data in where array */ 5018 temp_buffer_size=0; 5019 for (j=0;j<mat_graph->nvtxs;j++){ 5020 if (mat_graph->where[j]==i+1) { 5021 mat_graph->where[j]=where_values+add_to_where[temp_buffer_size]; 5022 temp_buffer_size++; 5023 } 5024 } 5025 ierr = PetscFree(temp_buffer[0]);CHKERRQ(ierr); 5026 ierr = PetscFree(temp_buffer);CHKERRQ(ierr); 5027 ierr = PetscFree(add_to_where);CHKERRQ(ierr); 5028 } 5029 } 5030 ierr = PetscFree(nodes_to_temp_buffer_indices);CHKERRQ(ierr); 5031 ierr = PetscFree(sizes_of_sends);CHKERRQ(ierr); 5032 ierr = PetscFree(send_requests);CHKERRQ(ierr); 5033 ierr = PetscFree(recv_requests);CHKERRQ(ierr); 5034 ierr = PetscFree(petsc_buffer);CHKERRQ(ierr); 5035 ierr = PetscFree(recv_buffer);CHKERRQ(ierr); 5036 ierr = PetscFree(recv_buffer_where);CHKERRQ(ierr); 5037 ierr = PetscFree(send_buffer);CHKERRQ(ierr); 5038 ierr = PetscFree(cum_recv_counts);CHKERRQ(ierr); 5039 ierr = PetscFree(where_to_nodes_indices);CHKERRQ(ierr); 5040 ierr = PetscFree(where_cc_adapt);CHKERRQ(ierr); 5041 /* We are ready to evaluate consistent connected components on each part of the shared interface */ 5042 if (global_where_counter) { 5043 for (i=0;i<mat_graph->nvtxs;i++){ mat_graph->touched[i]=PETSC_FALSE; } 5044 global_where_counter=0; 5045 for (i=0;i<mat_graph->nvtxs;i++){ 5046 if (mat_graph->where[i] && !mat_graph->touched[i]) { 5047 global_where_counter++; 5048 for (j=i+1;j<mat_graph->nvtxs;j++){ 5049 if (!mat_graph->touched[j] && mat_graph->where[j]==mat_graph->where[i]) { 5050 mat_graph->where[j]=global_where_counter; 5051 mat_graph->touched[j]=PETSC_TRUE; 5052 } 5053 } 5054 mat_graph->where[i]=global_where_counter; 5055 mat_graph->touched[i]=PETSC_TRUE; 5056 } 5057 } 5058 where_values=global_where_counter; 5059 } 5060 if (global_where_counter) { 5061 ierr = PetscMemzero(mat_graph->cptr,(mat_graph->nvtxs+1)*sizeof(PetscInt));CHKERRQ(ierr); 5062 ierr = PetscMemzero(mat_graph->queue,mat_graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr); 5063 ierr = PetscFree(mat_graph->where_ncmps);CHKERRQ(ierr); 5064 ierr = PetscMalloc(where_values*sizeof(PetscMPIInt),&mat_graph->where_ncmps);CHKERRQ(ierr); 5065 ierr = PCBDDCFindConnectedComponents(mat_graph, where_values); 5066 } 5067 ierr = PetscFree(queue_in_global_numbering);CHKERRQ(ierr); 5068 } /* Finished adapting interface */ 5069 PetscInt nfc=0; 5070 PetscInt nec=0; 5071 PetscInt nvc=0; 5072 PetscBool twodim_flag=PETSC_FALSE; 5073 for (i=0; i<mat_graph->ncmps; i++) { 5074 if ( mat_graph->cptr[i+1]-mat_graph->cptr[i] > vertex_size ){ 5075 if (mat_graph->count[mat_graph->queue[mat_graph->cptr[i]]]==1){ /* 1 neigh Neumann fake included */ 5076 nfc++; 5077 } else { /* note that nec will be zero in 2d */ 5078 nec++; 5079 } 5080 } else { 5081 nvc+=mat_graph->cptr[i+1]-mat_graph->cptr[i]; 5082 } 5083 } 5084 if (!nec) { /* we are in a 2d case -> no faces, only edges */ 5085 nec = nfc; 5086 nfc = 0; 5087 twodim_flag = PETSC_TRUE; 5088 } 5089 /* allocate IS arrays for faces, edges. Vertices need a single index set. */ 5090 k=0; 5091 for (i=0; i<mat_graph->ncmps; i++) { 5092 j=mat_graph->cptr[i+1]-mat_graph->cptr[i]; 5093 if ( j > k) { 5094 k=j; 5095 } 5096 if (j<=vertex_size) { 5097 k+=vertex_size; 5098 } 5099 } 5100 ierr = PetscMalloc(k*sizeof(PetscInt),&auxis);CHKERRQ(ierr); 5101 if (!pcbddc->vertices_flag && !pcbddc->edges_flag) { 5102 ierr = PetscMalloc(nfc*sizeof(IS),&pcbddc->ISForFaces);CHKERRQ(ierr); 5103 use_faces=PETSC_TRUE; 5104 } 5105 if (!pcbddc->vertices_flag && !pcbddc->faces_flag) { 5106 ierr = PetscMalloc(nec*sizeof(IS),&pcbddc->ISForEdges);CHKERRQ(ierr); 5107 use_edges=PETSC_TRUE; 5108 } 5109 nfc=0; 5110 nec=0; 5111 for (i=0; i<mat_graph->ncmps; i++) { 5112 if ( mat_graph->cptr[i+1]-mat_graph->cptr[i] > vertex_size ){ 5113 for (j=0;j<mat_graph->cptr[i+1]-mat_graph->cptr[i];j++) { 5114 auxis[j]=mat_graph->queue[mat_graph->cptr[i]+j]; 5115 } 5116 if (mat_graph->count[mat_graph->queue[mat_graph->cptr[i]]]==1){ 5117 if (twodim_flag) { 5118 if (use_edges) { 5119 ierr = ISCreateGeneral(PETSC_COMM_SELF,j,auxis,PETSC_COPY_VALUES,&pcbddc->ISForEdges[nec]);CHKERRQ(ierr); 5120 nec++; 5121 } 5122 } else { 5123 if (use_faces) { 5124 ierr = ISCreateGeneral(PETSC_COMM_SELF,j,auxis,PETSC_COPY_VALUES,&pcbddc->ISForFaces[nfc]);CHKERRQ(ierr); 5125 nfc++; 5126 } 5127 } 5128 } else { 5129 if (use_edges) { 5130 ierr = ISCreateGeneral(PETSC_COMM_SELF,j,auxis,PETSC_COPY_VALUES,&pcbddc->ISForEdges[nec]);CHKERRQ(ierr); 5131 nec++; 5132 } 5133 } 5134 } 5135 } 5136 pcbddc->n_ISForFaces=nfc; 5137 pcbddc->n_ISForEdges=nec; 5138 nvc=0; 5139 if ( !pcbddc->constraints_flag ) { 5140 for (i=0; i<mat_graph->ncmps; i++) { 5141 if ( mat_graph->cptr[i+1]-mat_graph->cptr[i] <= vertex_size ){ 5142 for ( j=mat_graph->cptr[i];j<mat_graph->cptr[i+1];j++) { 5143 auxis[nvc]=mat_graph->queue[j]; 5144 nvc++; 5145 } 5146 } 5147 } 5148 } 5149 /* sort vertex set (by local ordering) */ 5150 ierr = PetscSortInt(nvc,auxis);CHKERRQ(ierr); 5151 ierr = ISCreateGeneral(PETSC_COMM_SELF,nvc,auxis,PETSC_COPY_VALUES,&pcbddc->ISForVertices);CHKERRQ(ierr); 5152 if (pcbddc->dbg_flag) { 5153 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr); 5154 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Details from PCBDDCManageLocalBoundaries for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr); 5155 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Matrix graph has %d connected components", mat_graph->ncmps);CHKERRQ(ierr); 5156 for (i=0;i<mat_graph->ncmps;i++) { 5157 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\nDetails for connected component number %02d: size %04d, count %01d. Nodes follow.\n", 5158 i,mat_graph->cptr[i+1]-mat_graph->cptr[i],mat_graph->count[mat_graph->queue[mat_graph->cptr[i]]]);CHKERRQ(ierr); 5159 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"subdomains: "); 5160 for (j=0;j<mat_graph->count[mat_graph->queue[mat_graph->cptr[i]]]; j++) { 5161 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%d ",mat_graph->neighbours_set[mat_graph->queue[mat_graph->cptr[i]]][j]); 5162 } 5163 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n"); 5164 for (j=mat_graph->cptr[i]; j<mat_graph->cptr[i+1]; j++){ 5165 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%d, ",mat_graph->queue[j]);CHKERRQ(ierr); 5166 } 5167 } 5168 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n--------------------------------------------------------------\n");CHKERRQ(ierr); 5169 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d detected %02d local vertices\n",PetscGlobalRank,nvc);CHKERRQ(ierr); 5170 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d detected %02d local faces\n",PetscGlobalRank,nfc);CHKERRQ(ierr); 5171 ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Subdomain %04d detected %02d local edges\n",PetscGlobalRank,nec);CHKERRQ(ierr); 5172 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 5173 } 5174 ierr = PetscFree(auxis);CHKERRQ(ierr); 5175 PetscFunctionReturn(0); 5176 } 5177 5178 /* -------------------------------------------------------------------------- */ 5179 5180 /* The following code has been adapted from function IsConnectedSubdomain contained 5181 in source file contig.c of METIS library (version 5.0.1) 5182 It finds connected components of each partition labeled from 1 to n_dist */ 5183 5184 #undef __FUNCT__ 5185 #define __FUNCT__ "PCBDDCFindConnectedComponents" 5186 static PetscErrorCode PCBDDCFindConnectedComponents(PCBDDCGraph graph, PetscInt n_dist ) 5187 { 5188 PetscInt i, j, k, nvtxs, first, last, nleft, ncmps,pid,cum_queue,n,ncmps_pid; 5189 PetscInt *xadj, *adjncy, *where, *queue; 5190 PetscInt *cptr; 5191 PetscBool *touched; 5192 5193 PetscFunctionBegin; 5194 5195 nvtxs = graph->nvtxs; 5196 xadj = graph->xadj; 5197 adjncy = graph->adjncy; 5198 where = graph->where; 5199 touched = graph->touched; 5200 queue = graph->queue; 5201 cptr = graph->cptr; 5202 5203 for (i=0; i<nvtxs; i++) { 5204 touched[i] = PETSC_FALSE; 5205 } 5206 5207 cum_queue=0; 5208 ncmps=0; 5209 5210 for (n=0; n<n_dist; n++) { 5211 pid = n+1; /* partition labeled by 0 is discarded */ 5212 nleft = 0; 5213 for (i=0; i<nvtxs; i++) { 5214 if (where[i] == pid) 5215 nleft++; 5216 } 5217 for (i=0; i<nvtxs; i++) { 5218 if (where[i] == pid) 5219 break; 5220 } 5221 touched[i] = PETSC_TRUE; 5222 queue[cum_queue] = i; 5223 first = 0; last = 1; 5224 cptr[ncmps] = cum_queue; /* This actually points to queue */ 5225 ncmps_pid = 0; 5226 while (first != nleft) { 5227 if (first == last) { /* Find another starting vertex */ 5228 cptr[++ncmps] = first+cum_queue; 5229 ncmps_pid++; 5230 for (i=0; i<nvtxs; i++) { 5231 if (where[i] == pid && !touched[i]) 5232 break; 5233 } 5234 queue[cum_queue+last] = i; 5235 last++; 5236 touched[i] = PETSC_TRUE; 5237 } 5238 i = queue[cum_queue+first]; 5239 first++; 5240 for (j=xadj[i]; j<xadj[i+1]; j++) { 5241 k = adjncy[j]; 5242 if (where[k] == pid && !touched[k]) { 5243 queue[cum_queue+last] = k; 5244 last++; 5245 touched[k] = PETSC_TRUE; 5246 } 5247 } 5248 } 5249 cptr[++ncmps] = first+cum_queue; 5250 ncmps_pid++; 5251 cum_queue=cptr[ncmps]; 5252 graph->where_ncmps[n] = ncmps_pid; 5253 } 5254 graph->ncmps = ncmps; 5255 5256 PetscFunctionReturn(0); 5257 } 5258