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