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