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